D S %F=$P("Do,Vr,Za,Zo,Ma,Di,Wo",",",%TUM#7+1) G A
Z S %F="" G A
%ED
%ED ;(C) Verweij Heerde Holland; 7 Nov 1992 ; THE Program Editor;
K ^% S ^%=$E($T(%E),4,255)
F I=1:1 S T=$T(%E+I) Q:T="" S S=$F(T," "),^%($E(T,1,S-2))=$E(T,S,255)
W !,"Start the Editor with X ^%" D ^%EDT Q
Q
;
%E X:$T(+0)="" ^%(41) F %0=1:0 S %2=$T(+%0) X ^%(66) W !,%4," ",%5 R !,">>",%1 X:%1="." ^%(99) Q:%1="." X ^%("%F")
%F X ^%($S(%1="?":0,%1="&":11,%1="^":12,%1="#":10,%1[$C(9):9,%1="*":8,%1="@":7,%1=";":6,%1=":":5,%1?1"+".N:4,%1?1"-".N:4,$F(%1," ")>1:3,%1?1E.E:2,1:1))
0 F %11=100:1 Q:'$D(^%(%11)) W !,^%(%11)
1 F %11=0:0 R " R: ",%3 Q:%3="" X:%3["..." ^%(16) X:%3="END" ^%(17) Q:%3="END" W:%2'[%3 " ??",*7 Q:%3=""!(%2'[%3) X ^%(18)
2 X ^%(22) Q:%7="" W:$T(+(%4+%6))="" " ??",*7 Q:$T(+(%4+%6))="" S %0=%4+%6
3 S:$E(%1,$L(%1))=" " %1=$E(%1,1,$L(%1)-1) W ! X:%1="ZS" ^%(31),^%(32),^%(33) X %1
4 S:$L(%1)=1 %1=%1_1 S %1=%0+%1 S:%1<1 %1=1 W:$T(+%1)="" " ??",*7 Q:$T(+%1)="" S %0=%1
5 R "Change every: ",%3 Q:%3="" R " To: ",%4 F %1=1:1 S %2=$T(+%1) Q:%2="" X:%3["..." ^%(16) I %2[%3 X ^%(51) ZR +%1 ZI %2 W !,%2
6 R "Search for: ",%3 Q:%3="" F %1=1:1 S %2=$T(+%1) Q:%2="" I %2[%3 S %0=%1 X ^%(66) W !,%4," ",%5,! F %6=1:0 S %6=$F(%2,%3,%6) Q:%6=0 W ?%6+%7-$L(%3)-2,"|"
7 W "Move labeL +",%0," after label: " R %1 Q:%1="" X ^%(22) Q:%7=0 S %7=%4+%6 Q:%7=%0 S %9=$T(+%7) ZR +%0,+(%7-(%0<%7)) ZI %9,%2 S %0=%7+1-(%0<%7)
8 S %9=$P(%2," ") S:%9="" %9="+"_%0 W "Delete ",%9," N// " R %1 Q:$F("JjyY",%1)<2 ZR +%0 S %0=%0-1 S:%0=0 %0=1
9 W !,"Inserted ..." S %7=$P(%1,$C(9))_" "_$P(%1,$C(9),2) ZR +%0 ZI %2,%7 S %0=%0+1
10 W !,"Line ",%0," duplicated" S %3=" "_$E(%2,$F(%2," "),255) ZI %3 S %0=%0+1
11 S %3=$P(%2," ") S:%3="" %3="+"_%0 W !,"Join Line ",%3," together with Line " R %1 Q:%1="" X ^%(22) Q:%7=""!(%0=%6) S %5=%4+%6,%7=$T(+%5) W:%7="" " ??",*7 Q:%7="" ZR +%5 S %2=%2_%7 S %0=%0-(%5<%0*1) ZR +%0 ZI %2
12 S %3=$P(%2," ") S:%3="" %3="+"_%0 W !,"Break Line ",%4," after " R %3 Q:%3="" S %4=$E(%2,1,$F(%2,%3)-1),%5=$P(%2,%3,2,255) S:$E(%5)'=" " %5=" "_%5 ZR +%0 ZI %4,%5
16 S %5=$F(%3,"..."),%6=$E(%3,1,%5-4),%7=$E(%3,%5,255) S %5=$L(%6),%6=$F(%2,%6)-%5 Q:%6<1 S %8=256 S:%7'="" %8=$F(%2,%7,%6+%5) Q:'%8 S %3=$E(%2,%6,%8-1)
17 R " W: ",%4 S %8=$L(%2)+$L(%4) W:%8>255 *7,!,"Too long" Q:%8>255 S %2=%2_%4 ZR +%0 ZI %2
18 S %5=$F(%2,%3),%6=$E(%2,1,%5-$L(%3)-1) R " W: ",%4 S %7=$E(%2,%5,255),%8=$L(%6)+$L(%4)+$L(%7) W:%8>255 *7,"Too long" Q:%8>255 S %2=%6_%4_%7 ZR +%0 ZI %2
22 S %3=$P(%1,"+"),%4=$P(%1,"+",2) S:%3["-" %3=$P(%1,"-"),%4=$E(%1,$F(%1,"-")-1,255) S (%6,%7)=0 I %3'="" F %6=1:1 S %7=$T(+%6) I %7=""!($P(%7," ")=%3) W:%7="" *7," ??" Q
31 S %9=+$H>21608+$H+1460,%8=%9\1461,%7=%9#1461,%6=%8*4+1837+(%7\365),%4=%7#365+1,%5=1 I %7=1460 S %4=366,%6=%6-1
32 F %3=31,%6#4=0+28,31,30,31,30,31,31,30,31,30,31 Q:%4'>%3 S %4=%4-%3,%5=%5+1
33 S %5=$E("JanFebMrtAprMeiJunJulAugSepOktNovDec",%5*3-2,%5*3),%9=$T(+1),$P(%9,";",3)=" "_%4_" "_%5_" "_%6_" " ZR +1 ZI %9
41 W *7,"Geen Programma. Laadt ..." R % Q:%="" ZL @%
51 F %5=1:0 S %5=$F(%2,%3,%5) Q:%5=0 S %2=$E(%2,1,%5-$L(%3)-1)_%4_$E(%2,%5,255),%5=%5-$L(%3)+$L(%4)
66 S %4=$F(%2," "),%5=$E(%2,%4,255),%7=$L(%4),%4=$E(%2,1,%4-2) S:%4="" %4="+"_%0,%7=$L(%4)+1
F I=1:1 S X=$T(%E+I) Q:X="" S ^%(99+I)=$E(X,3,255)
W !,"For Information type ?",! Q
%E ; Text
; After the Prompt ' >> ' give one of the following :
; ? - To get these Help messages
; Label - Goto line <Label>
; +/- [n] - [n] lines up or down
; <CR> - Edit present line ... > for skip until END > add at end of line
; : - Change every occurrence of the string
; ; - Search for a string
; * - Delete present line
; @ - Move present line after Label
; # - Duplicate present line
; & - Join present line together with other line
; ^ - Break present line after given place in 2 new lines
; <TAB> - Insert line after present line
; . - Leave the Editor
; Command - Direct execution must include at least one <SPACE>
%FL
%FL ;HHV; 18 Nov 1992 ;First line list;
D ^%RSEL S %N="" F S %N=$O(^UTILITY($I,%N)) Q:%N="" X "ZL @%N S %T=$T(+1) W !,$P(%T,"" ""),?10,$P(%T,"" "",2,255)"
Q
Q
%G
%G ;(C) Verweij Heerde; 7 Nov 1992 ;Global print/edit;
S %A="A",%S="View ",DEV=0,$ZT="%ER"
I U 0 W !,%S,"Global ^" R %G I %G="" K %A,%G,%S,%R,%P,%N,%H,%I,%L,%J,%V,%W Q
I %G="?" W ! S %N="",%T=0 F %I=0:1 S %N=$O(@("^ G("""_%N_""")")) I $E(%N)'=" " W:%N="" !!?8,%T," ","Global",$S(%T=1:"",1:"s") G:%N="" I W $E(%N_" ",1,10) S %T=%T+1
I %G="??" G X
O DEV G:DEV'=0 S
I $E(%G,1,2)="ED" S %S="Edit ",%A="E" G I
I $E(%G,1,2)="VI" S %S="View ",%A="A" G I
I $E(%G)'?1U&($E(%G)'?1"%") W *7 G I
S U DEV S %G="^"_%G G:'$F(%G,"(") B I '$F(%G,")") G:$E(%G,$L(%G))=":" V S %L=1,%N(%L)="",%G(1)=%G G:$E(%G,$L(%G))=","!($E(%G,$L(%G))="(") C S %G=%G_")" D:$D(@%G)#10=1 @%A S %G(1)=$E(%G,1,$L(%G)-1)_"," G C
I $D(@%G)#10=0 W *7 G I
D @%A G I
V S %G=$E(%G,1,$L(%G)-1),%W=$F(%G,"(") I %G["," F %V=0:0 S %V=$F(%G,",",%V) Q:%V=0 S %W=%V
S %L=1,%G(%L)=$E(%G,1,%W-1),%N(1)=$E(%G,%W,255) S:$E(%N(1),$L(%N(1)))="""" %N(1)=$E(%N(1),2,$L(%N(1))-1) G CC
B I '$D(@%G) W *7 G I
D:$D(@%G)#10=1 @%A S %L=1,%G(%L)=%G_"(",%N(%L)=""
C S %G=%G(%L)_""""_%N(%L)_""")" S %N(%L)=$O(@%G) I %N(%L)="" S %L=%L-1 G:%L=0 I G C
CC S %G=%G(%L)_""""_%N(%L)_""")" I $D(@%G)#10=1 D @%A
I $D(@%G)\10=1 S %L=%L+1,%G(%L)=$E(%G,1,$L(%G)-1)_",",%N(%L)=""
G C
A S %P=@%G W !,%G,?15," = ",%P
Q
E S %H=@%G F %R=0:0 W !,%G," = ",%H,! R " R: ",%I Q:%I="" G:%I="*" G D:%I["..." D D:%I="END" F I %I'="END" W:%H'[%I *7 I %H[%I S %J=$F(%H,%I),%I(1)=$E(%H,1,%J-$L(%I)-1),%I(3)=$E(%H,%J,255) R " W: ",%I(2) S %H=%I(1)_%I(2)_%I(3),@%G=%H
Q
D S %I(5)=$F(%I,"..."),%I(6)=$E(%I,1,%I(5)-4),%I(7)=$E(%I,%I(5),255),%I(6)=$F(%H,%I(6))-$L(%I(6)),%I(7)=$F(%H,%I(7),%I(6)) S:%I(7)=%I(6) %I(7)=256 S %I=$E(%H,%I(6),%I(7)-1)
Q
F R " W: ",%I(1) W:$L(%I(1))+$L(%H)>255 *7," Too long" Q:$L(%I(1))+$L(%H)>255 S %H=%H_%I(1),@%G=%H Q
G R "Delete Y/N ",%R Q:$F("JjYy",%R)<2 K @%G Q
%ER W *7," <fout>" G %G
ED S %A="E",%S="Edit ",DEV=0 G I
X W !!?2,"The global may be specified as follows :",!
W !?5,"Globalname",?24,"- display entire global (all nodes)"
W !?5,"Name (subscripts",?24,"- display specified level and all descendents"
W !?5,"Name (subscripts:",?24,"- display from specified level till end",!?27,"all subscripts + their descendants"
W !?5,"Name (subscripts) ",?24,"- display specified level only"
W !!?2,"Character subscripts need be enclosed in quotes"
W !!?5,"Use '?' ",?24,"- for a Globaldirectory",!?5," '??'",?24,"- to get these Helpmessages"
W !!?2,"To edit a Global, type ED. or use ED^%G direct"
W !!?5,"Edit global",?24,"- R: > old text",!?24,"- W: > new text"
W !?5,"Use in old text",?24,"- ... > for skip until ",!?24,"- END > add at end of line"
W !?5,"Use '*'",?24,"- To delete displayed level and all descendents",!
G I
%GD
%GD ;HHV; 7 Nov 1992 ;Global directory;
S %N="",%T=0 F S %N=$O(^ G(%N)) Q:%N="" I $E(%N)'=" " W $E(%N_" ",1,10) S %T=%T+1
W !!?8,%T," globals."
Q
%GDEL
%GDEL ;HHV; 9 Dec 1992 ;Global delete for Archimedes MUMPS;
D ^%GSEL W !,"Deleting ..." D DELETE
Q
DELETE W ! S %G="" F S %G=$O(^UTILITY($I,%G)) Q:%G="" K @("^"_%G) W $E(%G_" ",1,10)
Q
%GR
%GR ;HHV; 7 Nov 1992 ;Global restore for Archimedes MUMPS;
R R !,"Inputfile:",%F Q:%F="" O 5:(%F:"r")
U 5 R %SAVED,%COMMENT U 0 W !,%SAVED,!,%COMMENT,!,"Restore Y/n" R %R I %R="N"!(%R="n") C 5 Q
D GLOBALS
C 5 U 0 W !,"File closed."
Q
GLOBALS S %N="" F U 5 R %G,%D Q:%G="**" D SETGL
Q
SETGL I %N="" U 0 W !,"Processing ",%G S %N=%G
I %G'="*" S @%G=%D
E S %N=""
Q
%GS
%GS ;HHV; 18 Nov 1992 ;Global save for Archimedes MUMPS;
S %DEV=5
R !,"Outputfile:",%FL Q:%FL="" O %DEV:(%FL:"w") C %DEV
U 0 R !,"Comment: ",%COMMENT D ^%GSEL S %T=$P($H,",",2),%HR=%T\60\60,%SC=%T\60#60 S:$L(%HR)=1 %HR="0"_%HR S:$L(%SC)=1 %SC="0"_%SC
O %DEV:(%FL:"w") U %DEV S %TUM=+$H D ^%DAT W "Globals saved at: ",$P("Fri^Sat^Sun^Mon^Tue^Wed^Thu","^",+$H#7+1),", ",%DAT," ",%HR,":",%SC,!,"Comment: ",%COMMENT,! D SAVE C %DEV U 0 W !,"File closed."
Q
SAVE U 0 W ! S %GF="" F S %GF=$O(^UTILITY($I,%GF)) Q:%GF="" U %DEV S %G="^"_%GF D B W "*",!,"*",! U 0 W $E(%GF_" ",1,10)
U %DEV W "**",!,"**",!,!,! Q
;Here starts the part that saves an entire global
B I '$D(@%G) Q
D:$D(@%G)#10=1 A S %L=1,%G(%L)=%G_"(",%N(%L)=""
C S %G=%G(%L)_""""_%N(%L)_""")" S %N(%L)=$O(@%G) I %N(%L)="" S %L=%L-1 Q:%L=0 G C
S %G=%G(%L)_""""_%N(%L)_""")" I $D(@%G)#10=1 D A
I $D(@%G)\10=1 S %L=%L+1,%G(%L)=$E(%G,1,$L(%G)-1)_",",%N(%L)=""
G C
A S %P=@%G W %G,!,%P,!
Q
%GSEL
%GSEL ;HHV; 19 Nov 1992 ;Global selector for Archimedes MUMPS;
K ^UTILITY($I)
GLOB U 0 R !,"Globals: ",%G Q:%G="" S SELECT=1 S:$E(%G)="-" SELECT=0,%G=$E(%G,2,255)
I %G="^D" W ! D ^%GD G GLOB
I %G="^L" W ! D LIST G GLOB
I %G["*" D WILDCARD G GLOB
S WR=0 D SETKILL G GLOB
LIST S %G="",%T=0 F S %G=$O(^UTILITY($I,%G)) Q:%G="" D WRITE S %T=%T+1
W !!?8,%T," globals selected."
Q
WILDCARD W ! S (%GS,%G)=$P(%G,"*",1),%L=$L(%GS),WR=1 D SETKILL F S %G=$O(^ G(%G)) Q:%G=""!($E(%G,1,%L)'=$E(%GS,1,%L)) D SETKILL
Q
SETKILL Q:$E(%G)=" "!('$D(^ G(%G)))
I SELECT S ^UTILITY($I,%G)=""
E K ^UTILITY($I,%G)
D:WR WRITE
Q
WRITE W $E(%G_" ",1,10)
Q
%JOBMON
%JOBMON ;HHV; 19 Nov 1992 ; Monitor all jobs in the system;
S %S=","
F D DISPLAY R *%R:1 Q:%R'=-1
Q
DISPLAY W #,"JobNr",?7,"UCI",?11,"Routine",?20,"Status",?27,"Psize",?33,"Pdev",?38,"Open",!
S %JL=$V(9),%N=$L(%JL,%S) ; get list of JOB numbers
F %T=1:1:%N S %JN=$P(%JL,%S,%T) D DISPJOB
Q
DISPJOB S %J=$V(9,%JN) Q:%J="" S %UCI=$P(%J,%S,1),%ROUT=$P(%J,%S,2),%STAT=$P(%J,%S,3),%PSIZE=$P(%J,%S,4),%PDEV=$P(%J,%S,5)
W !,$J(%JN,5),?7,%UCI,?11,%ROUT,?20,$S(%STAT=0:"Input",1:"Interp"),?27,$J(%PSIZE,5),?33,$J(%PDEV,4),?38 F %O=6:1 Q:$P(%J,%S,%O)="" W $J($P(%J,%S,%O),3)
%RCHANGE
%RCHANGE ;HHV; 11 Dec 1992 ;Routine search/replace for Archimedes MUMPS;
S %(1)="ZL @%F S %FND=0 F %I=1:1 S %T=$T(+%I) ZS:%T=""""&(%FND) Q:%T="""" I %T[%S S %GO=1 X %(3),%(2),%(4) X:%ASK %(5) I %GO S %FND=1 ZR +%I ZI %TC"
S %(2)="S %TC=%T F I=1:1:$L(%TC,%S)-1 S %TC=$P(%TC,%S)_%C_$P(%TC,%S,2,255)"
S %(3)="W !,%F,""+"",%I,!,$P(%T,"" "",1),?10,$P(%T,"" "",2,255),!"
S %(4)="W !,$P(%TC,"" "",1),?10,$P(%TC,"" "",2,255),!"
S %(5)="R !,""OK Y//"",%GO S %GO=$F(""N n NO no"",%GO)<2"
D ^%RSEL R !,"Search string: ",%S Q:%S="" R !,"Change to: ",%C Q:%C=%S R !,"Confirm changes N// ",%ASK S %ASK=$F("Y y YES yes",%ASK)>1
D CHANGE
Q
CHANGE S %F="" F S %F=$O(^UTILITY($I,%F)) Q:%F="" X %(1)
Q
%RD
%RD ;HHV; 7 Nov 1992 ;Routine directory;
S %N="",%T=0 F S %N=$O(^ S(%N)) Q:%N="" W $E(%N_" ",1,10) S %T=%T+1
W !!?8,%T," routines."
Q
%RDEL
%RDEL ;HHV; 17 Nov 1992 ;Routine delete for Archimedes MUMPS;
D ^%RSEL W !,"Deleting ..." D DELETE
Q
DELETE W ! S %F="" F S %F=$O(^UTILITY($I,%F)) Q:%F="" ZD @%F W $E(%F_" ",1,10)
S %R=$P($T(R)," ",2,255) F %4=1:1:3 S %R(%4)=$P($T(R+%4)," ",2,255)
X %R K %R,%P,%0,%2,%3,%4,%5,%6,%7,%8,%10 Q
R R !,"Copy from program: ",%4 Q:%4="" ZL @%4 S %0=%4 R " First line: ",%5 X %R(1) S %7=%5 R " Last line: ",%5 X %R(1) S %8=%5 X %R(2) R !,"Insert in program: ",%4 Q:%4="" ZL @%4 R " After line: ",%5 X %R(1) X %R(3) W !,%4," saved" ZS
S %6=0 S:%5["-" %6="-"_$P(%5,"-",2),%5=$P(%5,"-",1) S:%5["+" %6="+"_$P(%5,"+",2),%5=$P(%5,"+",1) F %2=1:1 S %3=$T(+%2) Q:%3="" I $P(%3," ",1)=%5 S %5=%2+%6 Q
S %6=0 F %2=%7:1:%8 S %6=%6+1,%P(%6)=$T(+%2)
S %10=$T(+%5) ZR +%5 ZI %10 F %2=1:1 Q:'$D(%P(%2)) ZI %P(%2)
%RR
%RR ;Routine restore for ARM MUMPS; 10 Dec 1992
S %RR="ZR F U 5 R %R ZS:%R="""" Q:%R="""" ZI %R"
R R !,"Inputfile:",%F Q:%F="" O 5:(%F:"r")
U 5 R %SAVED,%COMMENT U 0 W !,%SAVED,!,%COMMENT,!,"Restore Y/n" R %R I %R="N"!(%R="n") C 5 Q
W !,"Restoring ...",! D FILES
C 5 U 0 W !,"File closed."
Q
FILES F U 5 R %FN Q:%FN="" D:%FN="%RR" ITSELF I %FN'="%RR" X %RR U 0 W $E(%FN_" ",1,10)
Q
ITSELF U 0 W !,"%RR can't restore itself",!
F U 5 R %R Q:%R=""
Q
%RS
%RS ;HHV; 10 Dec 1992 ;Routine save for Archimedes MUMPS;
S %RS="U %DEV ZL @%F F %I=0:1 Q:$T(+%I)="""" W !,$T(+%I)"
S %DEV=5
R !,"Outputfile:",%FL Q:%FL="" O %DEV:(%FL:"w") C %DEV
U 0 R !,"Comment: ",%COMMENT D ^%RSEL S %T=$P($H,",",2),%HR=%T\60\60,%SC=%T\60#60 S:$L(%HR)=1 %HR="0"_%HR S:$L(%SC)=1 %SC="0"_%SC
O %DEV:(%FL:"w") U %DEV S %TUM=+$H D ^%DAT W "Routines saved at: ",$P("Fri^Sat^Sun^Mon^Tue^Wed^Thu","^",+$H#7+1),", ",%DAT," ",%HR,":",%SC,!,"Comment: ",%COMMENT D SAVE C %DEV U 0 W !,"File closed."
Q
SAVE U 0 W ! S %F="" F S %F=$O(^UTILITY($I,%F)) Q:%F="" X %RS U %DEV W ! U 0 W $E(%F_" ",1,10)
U %DEV W !,!,!,! Q
%RSE
%RSE ;HHV; 17 Nov 1992 ;Routine string search for Archimedes MUMPS;
D ^%RSEL R !,"Search string: ",%S D SEARCH
Q
SEARCH S %F="" F S %F=$O(^UTILITY($I,%F)) Q:%F="" X "ZL @%F F %I=1:1 S %T=$T(+%I) Q:%T="""" I %T[%S W !,%F,""+"",%I,!,$P(%T,"" "",1),?10,$P(%T,"" "",2,255),!"
Q
%RSEL
%RSEL ;HHV; 19 Nov 1992 ;Routine selector for Archimedes MUMPS;
K ^UTILITY($I)
FILE U 0 R !,"Routines: ",%F Q:%F="" S SELECT=1 S:$E(%F)="-" SELECT=0,%F=$E(%F,2,255)
I %F="^D" W ! D ^%RD G FILE
I %F="^L" W ! D LIST G FILE
I %F["*" D WILDCARD G FILE
S WR=0 D SETKILL G FILE
LIST S %F="",%T=0 F S %F=$O(^UTILITY($I,%F)) Q:%F="" D WRITE S %T=%T+1
W !!?8,%T," routines selected."
Q
WILDCARD W ! S (%FS,%F)=$P(%F,"*",1),%L=$L(%FS),WR=1 D SETKILL F S %F=$O(^ S(%F)) Q:%F=""!($E(%F,1,%L)'=$E(%FS,1,%L)) D SETKILL
Q
SETKILL Q:'$D(^ S(%F))
I SELECT S ^UTILITY($I,%F)=""
E K ^UTILITY($I,%F)
D:WR WRITE
Q
WRITE W $E(%F_" ",1,10)
Q
%SYSMAN
%SYSMAN ;HHV; 11 Dec 1992 ;System manager;
S %SYSDEV=10 D NEWUSER
F D DISK,LOGIN ;H 1
DISK ZF 2 ;Flush oldest dirty block;
Q
LOGIN O 10::0 I $T U 10 R *R:0 I R'=-1 S %SYSDEV=10 D NEWUSER
Q
NEWUSER O %SYSDEV U %SYSDEV W !,"Archimedes MUMPS login: " R %LOGIN W ! C %SYSDEV Q:%LOGIN="" ZH:%LOGIN="STOP" S %SYSUCI=$P(%LOGIN,":",1),%SYSPRG=$P(%LOGIN,":",2)
I %SYSUCI'?3U W "Invalid UCI name" G NEWUSER
I %SYSPRG'?1.E W "Invalid login ID" G NEWUSER
S $ZT="NUERR" ; Jump to NUERR when JOB generates error
I %SYSPRG="*" J :(%SYSUCI:40:%SYSDEV:1):0 I '$T G NEWUSER
I %SYSPRG'="*" J @("^"_%SYSPRG):(%SYSUCI:20:%SYSDEV:1):0 I '$T G NEWUSER
Q
NUERR W "***Error: ",$ZE,! Q
%TUM
%TUM ;Verweij; 7 Nov 1992 ;Omzet. Datum => $H getal %DAT => %TUM;
I %DAT'?4N&(%DAT'?6N)&(%DAT'?1.2N1P1.2N)&(%DAT'?1.2N1P1.2N1P2.4N)&(%DAT'?1"H"1"+"1N.N)&(%DAT'?1"H"1"-"1N.N)&(%DAT'="H") S %TUM="" G OUT
G:%DAT'["H" A
S %I=+$H,%K=$P(%DAT,"H",2) S:%K'?1P1N.N %K="+0" S @("%TUM=%I"_%K) K %I,%K Q
A I %DAT?4N!(%DAT?6N) S %D=$E(%DAT,1,2),%M=$E(%DAT,3,4),%Y="" S:%DAT?6N %Y=$E(%DAT,5,6) G B
F %D=1:1 Q:%D>$L(%DAT) S %Y=$E(%DAT,%D) I %Y?1P Q
S %D=$P(%DAT,%Y,1),%M=$P(%DAT,%Y,2),%Y=$P(%DAT,%Y,3) G:%Y?4N C
B S %DT=+$H,%H=%DT>21608+%DT,%L=%H\1461,%YR=%H#1461,%Z=%L*4+1841+(%YR\365) S:%Y'?2N %Y=%Z S:%Y?2N %Y=$E(%Z,1,2)_%Y
C I %M>12!(%M+0<1)!(%D+0<1)!(%D+(%M=2*2)-(%Y#4=0*%M=2)-((%M>7+%M)#2)>30) S %TUM="" G OUT
S %TUM=%D+$P("0,31,59,90,120,151,181,212,243,273,304,334",",",%M)+(%M>2&(%Y#4=0)&(%Y#100'=0))+(%Y-1841*365)+(%Y-1841\4)-(%Y>1900) I %TUM<0 S %TUM="" G OUT
OUT K %D,%H,%DT,%M,%Y,%YR,%Z,%L Q
%UCIMAN
%UCIMAN ;HHV; 10 Dec 1992 ; UCI manager ;
START W !,"UCI manager",!!,"1) Create UCI",!,"2) Rename UCI",!,"3) Delete UCI",!,"4) List UCI's",!!,"Choice: " R %CH Q:%CH="" D CREATE:%CH=1,RENAME:%CH=2,DELETE:%CH=3,LIST:%CH=4 G START
CREATE R !!,"Enter name for new UCI: ",%UCI Q:%UCI="" I %UCI'?3U D UPP3 G CREATE
ZU %UCI:1
Q
RENAME R !!,"Enter name of UCI to rename: ",%UCI Q:%UCI="" I %UCI'?3U D UPP3 G RENAME
S %CH=$V(13) I %CH'[%UCI D NEXIST G DELETE
R !,"Enter new name: ",%RUCI Q:%RUCI="" I %RUCI'?3U D UPP3 G RENAME
ZU %UCI:(2:%RUCI)
Q
DELETE R !!,"Enter name of UCI to delete: ",%UCI Q:%UCI="" I %UCI'?3U D UPP3 G DELETE
S %CH=$V(13) I %CH'[%UCI D NEXIST G DELETE
ZU %UCI:3
Q
LIST W !!,"UCI list",!! S %UCI=$V(13) F %CH=1:1:$L(%UCI,",") W $E($P(%UCI,",",%CH)_" ",1,10)
W !!,$L(%UCI,",")," UCI's.",!!
Q
UPP3 W !,"UCI names exist of 3 uppercase letters",! Q
NEXIST W !,"UCI does not exist",! Q
DEFDEV
DEFDEV ;Verweij; 6 Nov 1991 ; Device definition ;
K (PW,POS,POSC,U,INE,INO) W #?20,$P($T(+1),";",4) S U="^"
D HELP
BEG W !!?13,"<?> Device nr " R NR Q:NR="" I NR="?" D LIST G DEFDEV
S SW=0 S:$E(NR)="-" NR=$E(NR,2,55),SW=1 I NR'?1.2N!(NR=0) W *7," <1-2 figures> " R R G BEG
I $D(^%DEV(NR)) S EVA=$G(^%DEV(NR,"D")) W " ",$P(EVA,U,1)," ",$S($P(EVA,U,2)="P":"Printer",1:"Terminal")
E W " niet gedefinieerd"
I SW R !!?15,"Verwijderen ",V K:$F("YyJj",V)>1 ^%DEV(NR) G DEFDEV
PT R !!?5,"(P)rinter (T)erminal ",PT G:PT="" BEG I "PT"'[PT!(PT'?1U) W *7," <P or T> " R R G PT
W !?50,"Available" D PRIL
AK W !!?10,$S(PT=" P":"Printer",1:"Terminal")," number " R TT#4 G:TT="" DEFDEV I $G(D(TT))="" W *7 G AK
S ^%DEV(NR)=^%DEV(PT,D(TT)),^%DEV(NR,"D")=D(TT)_"^"_PT
G DEFDEV
PRIL W ! S N="" F I=1:1 S N=$O(^%DEV(PT,N)) Q:N="" S D(I)=N W !?50,I," ",N
Q
LIST W #?20,"List ",$P($T(+1),";",4),!! S N=0
LST F I=1:1 S N=$O(^%DEV(N)) Q:N="" I N?1.2N S EVA=^(N,"D") W !?15,$J(N,3),$J($P(EVA,U,1),20)," ",$S($P(EVA,U,2)="P":"Printer",1:"Terminal") I $Y>21 R !?75,"<Cr>",R#1,#
R !!?20,"<Cr> ",R#1 Q
HELP W !!?4,"Geef nummer van het te definieren Device, waarna huidige",!?4,"definitie wordt opgegeven.",!?4,"Met '?' wordt een lijst van bestaande devices gegeven."
W !?4,"Indien een '-' voor het Device nummer wordt geplaatst, kan",!?4,"het Device uit het bestand worden verwijderd."
