IMD 1.16: 8/06/2007 11:59:32 ebmmug.006 eastbay micromate users' group micromumps ver. 16.06 initialization routines disk issued: july 5, 1984 GLOBALS DAT GLOBALS DAT !GLOBALS DAT"#$%&'()*+,-./01GLOBALS DAT23456789:;<=>?@AGLOBALS DAT BCDEFGHIJKLMNOPQGLOBALS DAT RSTUVWXYZ[\]^_`aGLOBALS DAT 10 X@0.0101LABEL^R^^0;1^K:$L(X)>30!(X?1E)!(X["""")!(X["=") X0.0110^.1^1^10.01110DA(2)^B00.01111S @(DIC_"""B"",X,DA)=""""")+0.01112K @(DIC_"""B"",X,DA)")t0.01DEL.20]I DUZ(0)'="@",$P(^DD(DA(1),DA,0),"^",2)["X" W !,*7,"ONLY A PROGRAMMER CAN DELETE THIS FIELD!"(0.01DEL10I DA=.01 W *7,"??"O0.01DELID09I $D(^DD(DA(1),0,"ID",DA)) W !,"CAN'T DELETE IDENTIFIER!"DIBT0SORT TEMPLATE^.401I^0^0DIE0INPUT TEMPLATE^.402I^0^0iDIPT50PRINT TEMPLATE^.4I^.01^1.010 CAPTIONED^&.01F1S DIC=DCC,DA=D0 D EN^DIQB CAPTIONED.01BDIQ.011DDq0.01DELT0\I $N(^DD(DA(1),DA,5,0))>0 W *7,!,"CAN'T DELETE A FIELD THAT HAS A 'TRIGGER' POINTING TO IT!"o0.01DELTRB0XS %=+$P(^DD(DA(1),DA,0),U,2) I %,$D(^DD(%,"TRB")) S DA(0)=DA,DA=% D TRIG^DIDH S DA=DA(0)e0.10WTITLE^F^^.1;E1,999^K:$L(X)>80!(+X=X) X I $D(X),$L(X)<32,@("$D("_DIC_"""B"",X,DA))") K X0.110^.1^1^10.1110DA(2)^B50.1111!S:$L(X)<31 @(DIC_"""B"",X,DA)=1")30.1112K:$L(X)<31 @(DIC_"""B"",X,DA)")H0.13:(OPTIONAL) FULL FIELD NAME (MUST BE DIFFERENT FROM LABEL)0.20SPECIFIER^F^^0;20.210^.1^2^2,0.2110DA(2)^SB^ (SUBFILE USED)0SB.11SITE MICROMATE SITE11oDD 3 000.01DELT00.11100.2112 0.29 0.259 0.4112 080 010005090BPOINTER.3/0GL9.1E1,999.26,.1.01112.1.01132.150NM TRIGGERED-BY.21.010.3.011121.4.0111110.40120.40116209.2.4014916200.402.010.40250.50NMFUNCTION(.5.023).7.0110".718200#1.01110$140%1.005.01112&1.010' KWICOS20OS318OS60OS81 OS100!2DD0.1110DA(2)^B50.1111!S:$L(X)<31 @(DIC_"""B"",X,DA)=1")30.1112K:$L(X)<31 @(DIC_"""B"",X,DA)")H0.13:(OPTIONAL) FULL FIELD NAME (MUST BE DIFFERENT FROM LABEL)0.20SPECIFIER^F^^0;20.210^.1^2^2,0.2110DA(2)^SB^ (SUBFILE USED)30.2111S:X @(DIC_"""SB"",+X,DA)=""""")0.2112K:X @(DIC_"""SB"",+X,DA)")0.2120 DA(2)^RQ^40.2121 S:X["R" @(DIC_"""RQ"",DA)=""""")/0.2122K:X["R" @(DIC_"""RQ"",DA)")0.2130^T0.2131@S %=$P(X,"P",2) S:$A(%)=48!%&$D(^DD(+%,0)) ^(0,"PT",DA(1),DA)=""0SB.11SITE MICROMATE SITE11 DD.0.2112K:X @(DIC_"""SB"",+X,DA)")0.2120 DA(2)^RQ^40.2121 S:X["R" @(DIC_"""RQ"",DA)=""""")/0.2122K:X["R" @(DIC_"""RQ"",DA)")0.2130^T0.2131@S %=$P(X,"P",2) S:$A(%)=48!%&$D(^DD(+%,0)) ^(0,"PT",DA(1),DA)=""H0.21324S %=$P(X,"P",2) K:$A(%)=48!% ^DD(+%,0,"PT",DA(1),DA)0.29^Z0.230KLENGTH^CJ3^^ ; ^S @("X=$P("_DCC_"D0,0),U,2)"),X=$P(X,"J",2),X=$S(X:+X,1:"")0.239^]0.240NDECIMAL DEFAULT^CJ1^^ ; ^S @("X=$P("_DCC_"D0,0),U,2)"),X=$P($P(X,"J",2),",",2)0.249^0SB.11SITE MICROMATE SITE11 SDDD("_DIy0.29^Z0.230KLENGTH^CJ3^^ ; ^S @("X=$P("_DCC_"D0,0),U,2)"),X=$P(X,"J",2),X=$S(X:+X,1:"")0.239^]0.240NDECIMAL DEFAULT^CJ1^^ ; ^S @("X=$P("_DCC_"D0,0),U,2)"),X=$P($P(X,"J",2),",",2)0.249^0.250TYPE^CJ9^^ ; ^S @("X=$P("_DCC_"D0,0),U,2)"),X=$S(X["C":"COMPUTED",X["N":"NUMERIC",X["P":"POINTER",X["S":"SET",X["D":"DATE",X["W":"WORD-PROCESSING",1:"FREE TEXT")0.259^>0.260/COMPUTE ALGORITHM^FJ30^^9.1;E1,999^K:$L(X)>50 X0.30POINTER^F^^0;30.39^0.40uGLOBAL SUBSCRIPT LOCATION^RF^^0;4^K:X'?1E.E1";"1E.E X I $D(X),@("$D("_DIC_"""GL"",$P(X,"";"",1),$P(X,"";"",2)))") K X0.410^.1^1^10SB.11SITE MICROMATE SITE11PT",DA(1),DA) ZDDT0:X?.y0.259^>0.260/COMPUTE ALGORITHM^FJ30^^9.1;E1,999^K:$L(X)>50 X0.30POINTER^F^^0;30.39^0.40uGLOBAL SUBSCRIPT LOCATION^RF^^0;4^K:X'?1E.E1";"1E.E X I $D(X),@("$D("_DIC_"""GL"",$P(X,"";"",1),$P(X,"";"",2)))") K X0.410^.1^1^1+0.4110DA(2)^GL (2 SUBSCRIPTS)P0.411180!(+X=X vDDDINIK0.41127K:X'?.P @(DIC_"""GL"",$P(X,"";"",1),$P(X,"";"",2),DA)")0.49^H0.50:INPUT TRANSFORM^CJ44^^ ; ^S @("X=$P("_DCC_"D0,0),U,5,99)")0.59^$010CROSS-REFERENCE^.1^^1;00020#OUTPUT TRANSFORM^F^^2;E1,999;D ^DIM>0301'HELP'-PROMPT^F^^3;E1,999^K:X'?3E.E!($L(X)>200) X0040#XECUTABLE 'HELP'^F^^4;E1,999^D ^DIM080VREAD ACCESS (OPTIONAL)^F^^8;E1,999^I DUZ(0)'="@" F I=1:1:$L(X) I DUZ(0)'[$E(X,I) K X QV083IENTER A STRING OF CHARACTERS WHICH ARE IN YOUR OWN ACCESS CODE ('DUZ(0)')i08.50ZDELETE ACCESS (OPTIONAL)^F^^8.5;E1,999^I DUZ(0)'="@" F I=1:1:$L(X) I DUZ(0)'[$E(X,I) K X Q0SB.11SITE MICROMATE SITE11DIQ",^DIPT("B","DIQ",.01)=1 DD cDDBTc080VREAD ACCESS (OPTIONAL)^F^^8;E1,999^I DUZ(0)'="@" F I=1:1:$L(X) I DUZ(0)'[$E(X,I) K X QV083IENTER A STRING OF CHARACTERS WHICH ARE IN YOUR OWN ACCESS CODE ('DUZ(0)')i08.50ZDELETE ACCESS (OPTIONAL)^F^^8.5;E1,999^I DUZ(0)'="@" F I=1:1:$L(X) I DUZ(0)'[$E(X,I) K X Qd090WWRITE ACCESS (OPTIONAL)^F^^9;E1,999^I DUZ(0)'="@" F I=1:1:$L(X) I DUZ(0)'[$E(X,I) K X Q0100SOURCE^F^^10;E1,99^K:$L(X)>99 XF01038WHERE THIS DATA ELEMENT COMES FROM (UP TO 99 CHARACTERS)%0110DESTINATION^.2LAP^^11;0(0120POINTER SCREEN^^^12;E1,250?012.10/CODE TO SET POINTER SCREEN^^^12.1;E1,250^D ^DIM0SB.11SITE MICROMATE SITE11cDDE-0100SOURCE^F^^10;E1,99^K:$L(X)>99 XF01038WHERE THIS DATA ELEMENT COMES FROM (UP TO 99 CHARACTERS)%0110DESTINATION^.2LAP^^11;0(0120POINTER SCREEN^^^12;E1,250?012.10/CODE TO SET POINTER SCREEN^^^12.1;E1,250^D ^DIM;012.20+EXPRESSION FOR POINTER SCREEN^^^12.2;E1,2500200GROUP^.3LA^^20;0.0500 DATE FIELD LAST EDITED^D^^DT;1^Q0509^,09990TRIGGERED-BY POINTER^.15^^5;009999^0SB.11.10CROSS-REFERENCE^N.10NMCROSS-REFERENCE#.1.010INDEX^F^^0;E1,999^Q11.0010!NUMBER^N^^ ^K:X'>.55!$D(^DD(X)) X@KWIC7^AND^THE^THEN^FOR^FROM^OTHER^THAN^WITH^THEIR^SOME^THIS^SITE MICROMATE SITE11DD  0509^,09990TRIGGERED-BY POINTER^.15^^5;009999^0B 'HELP'-PROMPT3*0BCODE TO SET POINTER SCREEN12.1 0BCOMPUTE ALGORITHM.260BCROSS-REFERENCE1$0BDATE FIELD LAST EDITED500BDECIMAL DEFAULT.24'0BDELETE ACCESS (OPTIONAL)8.50B DESTINATION11-0BEXPRESSION FOR POINTER SCREEN12.2'0BGLOBAL SUBSCRIPT LOCATION.40BGROUP200BINPUT TRANSFORM.50BLABEL.010BLENGTH.230BNUMBER.0010BOUTPUT TRANSFORM20GL04.40GL.1E1,999.10GL1010GL2E1,99920GL3E1,99930GL4E1,99940GL8E1,99980GL8.5E1,9998.5/DDPTa.1.01112KK:$P(X,U,2)]"" @("^DD("_$P(X,"^",1)_",0,""IX"",$P(X,""^"",2),DA(2),DA(1))").1.01120DA(2)^IX0.1.01121S ^DD(DA(2),"IX",DA(1))=""X.1.01122BI $N(^DD(DA(2),DA(1),1,0))=DA,$N(^(DA))=-1 K ^DD(DA(2),"IX",DA(1)).1.01130 ^^TRIGGER.1.01131S Y=$P(X,"^",5),X=$P(X,"^",4) I Y F %=1:1 Q:'% I '$D(^DD(X,Y,5,%,0)) S ^(0)=DA(2)_"^"_DA(1)_"^"_DA F %=-1:0 S ^DD(X,"TRB",DA(2),DA(1),DA,Y)="",Y=X Q:'$D(^DD(X,0,"UP")) S X=^("UP"),Y=$N(^DD(X,"SB",Y,0))1.0010!NUMBER^N^^ ^K:X'>.55!$D(^DD(X)) X@KWIC7^AND^THE^THEN^FOR^FROM^OTHER^THAN^WITH^THEIR^SOME^THIS^SITE MICROMATE SITE11DD x.1.01132S Y=$P(X,"^",5),X=$P(X,"^",4) I Y F %=0:0 S %=$N(^DD(X,Y,5,%)) Q:'$D(^(%,0)) I DA(2)_"^"_DA(1)_"^"_DA=^(0) K ^DD(X,Y,5,%) F %=%:0 K ^DD(X,"TRB",DA(2),DA(1),DA,Y) Q:'$D(^DD(X,0,"UP")) S Y=X,X=^("UP"),Y=$N(^DD(X,"SB",Y,0))).110SET STATEMENT^F^^1;E1,999^Q*.120KILL STATEMENT^F^^2;E1,999^Q.1BINDEX.01.1BKILL STATEMENT2.1B SET STATEMENT1.1GL0E1,999.01.1GL1E1,9991.1GL2E1,9992.1IX.01.150TRIGGERED-BY^3^3.40 ATTRIBUTE^11.0010!NUMBER^N^^ ^K:X'>.55!$D(^DD(X)) X@KWIC7^AND^THE^THEN^FOR^FROM^OTHER^THAN^WITH^THEIR^SOME^THIS^SITE MICROMATE SITE11DD! .150NM TRIGGERED-BY1.15.010 DD NUMBER^N^^0;1^K:'$D(^DD(X)) X".1520FIELD NUMBER^N^^0;2,.1530CROSS-REFERENCE NUMBER^N^^0;3%.15BCROSS-REFERENCE NUMBER3.15B DD NUMBER.01.15B FIELD NUMBER2.15GL01.01.15GL022.15GL033.20DESTINATION^^.01^1.20NM DESTINATION..2.010DESTINATION^P.21^DIC(.2,^0;1^QA.2.0131WHERE THIS DATA GOES (TO WHAT FORM, SYSTEM, ETC.).2B DESTINATION.01.2GL01.01".210DATA DESTINATION^.01^1.210IXB.21.01 .210NMDATA-DESTINATION USER #",%X2.4.010"NAME^F^^0;1^K:$L(X)<2!($L(X)>30) X.4.0110^.1^1^1KDDBT1.4.01111S @(DIC_"""B"",X,DA)="""""),.4.01112K @(DIC_"""B"",X,DA)")8.4.013(NAME OF TEMPLATE MUST BE 2-30 CHARACTERS#.420DATE CREATED^D^^0;2^QT.430FREAD ACCESS^F^^0;3^I DUZ(0)'="@" F I=1:1:$L(X) I DUZ(0)'[$E(X,I) K X Q .440FILE^NJ7,0I^^0;4^Q.450USER #^N^^0;5^QU.460GWRITE ACCESS^F^^0;6^I DUZ(0)'="@" F I=1:1:$L(X) I DUZ(0)'[$E(X,I) K X Q.470406HEADER^CJ60^^ ; ^S X=$S($D(^DIPT(D0,"H")):^("H"),1:"").416200PRINT FIELDS^XCmJ50^^ ; ^S DSAVE=$S($D(DC)#2:DC,1:0) F DD=0:0 S DC=DSAVE,Q="""",C=",",DRK=$S($D(^DIPT(D0,0)):$P(^(0),U,4),1:0),DD=$N(^("F",DD)),(D9,X)="" Q:DD'>0 K DC S DC(0)=D0,DY=^(DD),Y=2,DC=2 D Y^DIP22 X ^DD(.4,1620,9.2)'DD 2 .4010ATTRIBUTE^^491620^9|.4010IDWRITEfS %=$P(^(0),U,2),%X=$P(^(0),U,5) W:% ?30,"(",$E(%,4,5),"/",%#100,"/",$E(%,2,3),")" W:%X " USER #",%X.4010IXB.401.014.401.010"NAME^F^^0;1^K:$L(X)<2!($L(X)>30) X.401.0110^.1^1^1.401.01110.401^B3.401.01111S @(DIC_"""B"",X,DA)=""""")..401.01112K @(DIC_"""B"",X,DA)"):.401.013(NAME OF TEMPLATE MUST BE 2-30 CHARACTERS3^I DUZ(0)'="@" F I=1:1:$L(X) I DUZ(0)'[$E(X,I) K X Q".40140FILE^NJ7,0I^^0;4^Q.40150USER #^N^^0;5^Q11.0010!NUMBER^N^^ ^K:X'>.55!$D(^DD(X)) X@KWIC7^AND^THE^THEN^FOR^FROM^OTHER^THAN^WITH^THEIR^SOME^THIS^SITE MICROMATE SITE11.40 ATTRIBUTE^11DD ;.152%.40120DATE CREATED^D^^0;2^QV.40130FREAD ACCESS^F^^0;3^I DUZ(0)'="@" F I=1:1:$L(X) I DUZ(0)'[$E(X,I) K X Q".40140FILE^NJ7,0I^^0;4^Q.40150USER #^N^^0;5^QW.40160GWRITE ACCESS^F^^0;6^I DUZ(0)'="@" F I=1:1:$L(X) I DUZ(0)'[$E(X,I) K X Q1.401150 SEARCH SPECIFICATIONS^.4011^^O;0.40116200SORT FIELDS^CmJ50^^ ; ^F D=1:1 S X="" Q:'$D(^DIBT(D0,2,D)) S Y=^(D),X=$J("",D+D-2)_$P(Y,U,3)_$P(Y,U,4)_$P(Y,U,5) X:$D(^(D,"F")) ^DD(.401,1620,9.2) X DICMX.40110FIELD.40110NMFIELD/.4011.010SEARCH SPECIFICATIONS^W^^0;1.4020 ATTRIBUTE^|.4020IDWRITEfS %=$P(^(0),U,2),%X=$P(^(0),U,5) W:% ?30,"(",$E(%,4,5),"/",%#100,"/",$E(%,2,3),")" W:%X " USER #",%XTE11CDD=DA,$N 24.402.010"NAME^F^^0;1^K:$L(X)<2!($L(X)>30) X.402.0110^.1^1^1.402.01110.402^B3.402.01111S @(DIC_"""B"",X,DA)=""""")..402.01112K @(DIC_"""B"",X,DA)"):.402.013(NAME OF TEMPLATE MUST BE 2-30 CHARACTERS%.40220DATE CREATED^D^^0;2^QV.40230FREAD ACCESS^F^^0;3^I DUZ(0)'="@" F I=1:1:$L(X) I DUZ(0)'[$E(X,I) K X Q".40240FILE^NJ7,0I^^0;4^Q.40260GWRITE ACCESS^F^^0;6^I DUZ(0)'="@" F I=1:1:$L(X) I DUZ(0)'[$E(X,I) K X Q#.40218040FIELD^.404^^RD;0.4040FIELD^.4040NMFIELD11.0010!NUMBER^N^^ ^K:X'>.55!$D(^DD(X)) X@KWIC7^AND^THE^THEN^FOR^FROM^OTHER^THAN^WITH^THEIR^SOME^THIS^SITE MICROMATE SITE11 NUMBER^N^^0;3DD^DD(.4 2F.470406HEADER^CJ60^^ ; ^S X=$S($D(^DIPT(D0,"H")):^("H"),1:"").416200PRINT FIELDS^XCmJ50^^ ; ^S DSAVE=$S($D(DC)#2:DC,1:0) F DD=0:0 S DC=DSAVE,Q="""",C=",",DRK=$S($D(^DIPT(D0,0)):$P(^(0),U,4),1:0),DD=$N(^("F",DD)),(D9,X)="" Q:DD'>0 K DC S DC(0)=D0,DY=^(DD),Y=2,DC=2 D Y^DIP22 X ^DD(.4,1620,9.2):.416209.2'F D=2:1 Q:'$D(DC(D)) S X=DC(D) X DICMX.4B DATE CREATED2.4BFILE4.4BHEADER704.4BNAME.01.4B PRINT FIELDS1620.4B READ ACCESS3.4BUSER #5.4B WRITE ACCESS6.4GL01.01.4GL022.4GL033.4GL044.4GL055.4GL066.4IX.01^DD(DA(2),"IX",DA(1))="" ;.1,.01,1,2,2 IDDDINI2.40116209.2S Y=^DIBT(D0,2,D,"F"),%Y=$S('$D(^("T")):"",^("T")="z":"",1:^("T")) S:Y[".9999" Y=$P(Y,".",1)+1 X:Y?1"2"6N.NP ^DD("DD") S %=$F(Y,"z"),X=X_" From '"_$S(%:$E(Y,1,%-3)_$C($A(Y,%-2)+1),1:Y)_"'",Y=%Y X:Y]"" ^DD(.401,1620,9.3)S.40116209.3>S:Y[".9999" Y=Y\1 X:Y?1"2"6N.NP ^DD("DD") S X=X_" To '"_Y_"'".4014916200.PRINT TEMPLATE^F^^DIPT;1^K:'$D(^DIPT("B",X)) X.40110FIELD.40110NMFIELD/.4011.010SEARCH SPECIFICATIONS^W^^0;1.4020 ATTRIBUTE^|.4020IDWRITEfS %=$P(^(0),U,2),%X=$P(^(0),U,5) W:% ?30,"(",$E(%,4,5),"/",%#100,"/",$E(%,2,3),")" W:%X " USER #",%X ;.3,0 POINTER^F^^0;3 ;.3,9 ^ ;.4,0 GLOBAL SUBSCRIPT LOCATION^RF^^0;4^K:X'?1E.-+_ RDINIT1DD @2C.4014916200.PRINT TEMPLATE^F^^DIPT;1^K:'$D(^DIPT("B",X)) X.4014916204W !,"IF THIS SORT-TEMPLATE SHOULD ALWAYS BE USED WITH A PARTICULAR",!,"PRINT-TEMPLATE, ENTER THE NAME OF THAT PRINT-TEMPLATE",!.401B DATE CREATED2.401BFILE4.401BNAME.01#.401BPRINT TEMPLATE491620.401B READ ACCESS3&.401BSEARCH SPECIFICATIONS15.401B SORT FIELDS1620.401BUSER #5.401B WRITE ACCESS6.401GL01.01.40110FIELD.40110NMFIELD/.4011.010SEARCH SPECIFICATIONS^W^^0;1.4020 ATTRIBUTE^|.4020IDWRITEfS %=$P(^(0),U,2),%X=$P(^(0),U,5) W:% ?30,"(",$E(%,4,5),"/",%#100,"/",$E(%,2,3),")" W:%X " USER #",%X6aDD 2.40250USER #^N^^0;5^QW.40260GWRITE ACCESS^F^^0;6^I DUZ(0)'="@" F I=1:1:$L(X) I DUZ(0)'[$E(X,I) K X Q#.40218040FIELD^.404^^RD;0.402B DATE CREATED2.402BFIELD1804.402BFILE4.402BNAME.01.402B READ ACCESS3.402BUSER #5.402B WRITE ACCESS6.402GL01.01.402GL022.402GL033.402GL055.402GL066.402IX.01.402SB.4041804.4040FIELD^.4040NMFIELD .404.010FIELD^O^^0;1^Q.404.012nS %=^DIE(D0,"RD",D1,0),Y=$S($D(^DD(+%,+$P(%,";",2),0)):$P(^(0),U,1),1:"") S:Y]"" Y=$N(^DD(+%,0,"NM",0))_": "_Y.50ATTRIBUTE^^10^6.50IXB.5.011^Q^%RCR7 DD)):"",?.21.010.DATA DESTINATION^F^^0;1^K:$L(X)<2!($L(X)>80) X.21.0110^.1^1^1.21.01110.21^B-.21.01111S ^DIC(.2,"B",X,DA)=""*.21.01112K ^DIC(.2,"B",X,DA)!.21BDATA DESTINATION.01.21GL01.01.21IX.01.30 GROUP^^.01^1.30NMGROUP3.3.010#GROUP^F^^0;1^K:$L(X)>30!(X'?.ANP) X.3.0110^.1^1^1.3.011100^GR5.3.01111S ^DD(DA(2),"GR",X,DA(1),DA)=""TERS, ALPHANUMERIC.40 ATTRIBUTE^z.40IDWRITEfS %=$P(^(0),U,2),%X=$P(^(0),U,5) W:% ?30,"(",$E(%,4,5),"/",%#100,"/",$E(%,2,3),")" W:%X " USER #",%X2.4.010"NAME^F^^0;1^K:$L(X)<2!($L(X)>30) X.4.0110^.1^1^1.4.01110.4^B 1?DD=Y") D@KWIC7^AND^THE^THEN^FOR^FROM^OTHER^THAN^WITH^THEIR^SOME^THIS^ OS11*OS0 MUMPS OPERATING SYSTEM^.7^100^13OS10M/11^^63^6000^1OS11B XOS18 X ^DD("$O")%OS118I $D(^UTILITY("ROU",X))[OS1SDPMO @("I:"_DLP) F %=0:0 U I R % Q:$ZA=X&($ZB>Y)!($ZA>X) U IO W:$A(%)'=12 ! W %OS1SDPEND S X=$ZA,Y=$ZBUOS1ZSHZR X "F %Y=0:0 S %Y=$N(^UTILITY($J,0,%Y)) Q:'$D(^(%Y)) ZI ^(%Y)" ZS @X63^3000^1OS21B XOS28 X ^DD("$O")[OS2SDPMO @("I:"_DLP) F %=0:0 U I R % Q:$ZA=X&($ZB>Y)!($ZA>X) U IO W:$A(%)'=12 ! W %OS2SDPEND S X=$ZA,Y=$ZBUOS2ZSHZR X "F %Y=0:0 S %Y=$N(^UTILITY($J,0,%Y)) Q:'$D(^(%Y)) ZI ^(%Y)" ZS @XSITE MICROMATE SITE11 ;.401,1620,9.2 S Y=^DIBT(D0DD2,3)," DOS20DSM^^63^3000^1OS21B XOS28 X ^DD("$O")[OS2SDPMO @("I:"_DLP) F %=0:0 U I R % Q:$ZA=X&($ZB>Y)!($ZA>X) U IO W:$A(%)'=12 ! W %OS2SDPEND S X=$ZA,Y=$ZBUOS2ZSHZR X "F %Y=0:0 S %Y=$N(^UTILITY($J,0,%Y)) Q:'$D(^(%Y)) ZI ^(%Y)" ZS @X OS30VISTA(AOS)^^99^2030OS31B 'XOS38 X ^DD("$O")OS318I $ZD(X)6OS3SDP(O I F %=0:0 U I R % Q:%'="#$#" U IO W %!OS3SDPENDW !,"#$#",! C IO"OS40DATA GENERAL^^63^3000OS41QOS50TANDEM^^48^3500OS51B XOS58 X ^DD("$O")5OS5SDP'O I F %=0:0 U I R % Q:%="#$#" U IO W %!OS5SDPENDW !,"#$#",! C IOSITE MICROMATE SITE11,0,""IX"",$P(X,""^"",2),DA(2),DA(1))=""""") ;.DDIPT(D0 DOS318I $ZD(X)6OS3SDP(O I F %=0:0 U I R % Q:%'="#$#" U IO W %!OS3SDPENDW !,"#$#",! C IO"OS40DATA GENERAL^^63^3000OS41QOS50TANDEM^^48^3500OS51B XOS58 X ^DD("$O")5OS5SDP'O I F %=0:0 U I R % Q:%="#$#" U IO W %!OS5SDPENDW !,"#$#",! C IOOS5ZSS %Y="TEMP" ZFCREATE %Y:(2:255) O %Y U %Y S %=$D(^UTILITY($J,0,0)) X "F %=0:0 S %=$O(^(%)) Q:%="""" W ^(%),!" C %Y ZRPUT @X:%Y VIEW PURGE:%YOS60HARRIS^^127^6000OS61QOS70 M/VX^^63^9999OS71B XOS78 X ^DD("$O")%OS718I $D(^UTILITY("ROU",X))5OS7SDP'O I F %=0:0 U I R % Q:%="#$#" U IO W %!OS7SDPENDW !,"#$#",! C IOSITE MICROMATE SITE11:% ?30,"(",$E(%DD,$E(%, mDOS60HARRIS^^127^6000OS61QOS70 M/VX^^63^9999OS71B XOS78 X ^DD("$O")%OS718I $D(^UTILITY("ROU",X))5OS7SDP'O I F %=0:0 U I R % Q:%="#$#" U IO W %!OS7SDPENDW !,"#$#",! C IOUOS7ZSHZR X "F %Y=0:0 S %Y=$N(^UTILITY($J,0,%Y)) Q:'$D(^(%Y)) ZI ^(%Y)" ZS @X$OS80MICRONETICS^^127^5000^1OS81B XOS88 X ^DD("$O")[OS8SDPMO @("I:"_DLP) F %=0:0 U I R % Q:$ZA=X&($ZB>Y)!($ZA>X) U IO W:$A(%)'=12 ! W %OS8SDPEND S X=$ZA,Y=$ZBUOS8ZSHZR X "F %Y=0:0 S %Y=$N(^UTILITY($J,0,%Y)) Q:'$D(^(%Y)) ZI ^(%Y)" ZS @XOS90DATATREE^^127^3500OS91B XSITE MICROMATE SITE11IELDS^XCmJ50^^ ; ^S DSAVE=$S($D(DC)#2:DC,1:0) F DD=0:0 S DC=DSAVE, PDD100,"/DOS81B XOS88 X ^DD("$O")[OS8SDPMO @("I:"_DLP) F %=0:0 U I R % Q:$ZA=X&($ZB>Y)!($ZA>X) U IO W:$A(%)'=12 ! W %OS8SDPEND S X=$ZA,Y=$ZBUOS8ZSHZR X "F %Y=0:0 S %Y=$N(^UTILITY($J,0,%Y)) Q:'$D(^(%Y)) ZI ^(%Y)" ZS @XOS90DATATREE^^127^3500OS91B XtOS9ZSgS %X="" X "F %Y=0:0 S %Y=$N(^UTILITY($J,0,%Y)) Q:'$D(^(%Y)) S %X=%X_$C(10)_^(%Y)" ZS X:$E(%X,2,999999)OS100LMS-1(IBM SERIES 1)^^254^6000OS101V "BR":X5OS110'MICROMUMPS (CP/M - UC DAVIS)^^99^3500^1OS111B XOS1118I $ZE(X_".MMP")6OS11SDP'O I F %=0:0 U I R % Q:%="#$#" U IO W %$OS11SDPENDW !,"#$#",! C IO:0SITE MICROMATE SITE11RITEfS %=$P(^(0),U,2),%X=$P(^(0),U,5) W:% ?30,"(!|DDDINI D+OS100LMS-1(IBM SERIES 1)^^254^6000OS101V "BR":X5OS110'MICROMUMPS (CP/M - UC DAVIS)^^99^3500^1OS111B XOS1118I $ZE(X_".MMP")6OS11SDP'O I F %=0:0 U I R % Q:%="#$#" U IO W %$OS11SDPENDW !,"#$#",! C IO:0POS11ZSBZR X "F %Y=0:0 S %Y=$N(^UTILITY($J,0,%Y)) Q:%Y<0 ZI ^(%Y)" ZS @XOS120CCSM^^127^6000^1OS121B XOS128 X ^DD("$O")OS1218 I $T(^@X)]""6OS12ZS(S %GLB="^UTILITY($J,0)",%NAM=X D ^%RSAVEOS1000OTHER^Q^40^2000OS1001QOSB DATA GENERAL4OSBDSM2OSBHARRIS6OSBM/111OSBM/VX7OSB MICRONETICS8OSBTANDEM5OSB VISTA(AOS)3SITE MICROMATE SITE11 ;.401,1620,-UDD2,3)," 2.7.0110^.1^1^1.7.01110.7^B-.7.01111S ^DD("OS","B",X,DA)=""*.7.01112K ^DD("OS","B",X,DA)-.710BREAK LOGIC^RF^^1;E1,250^D ^DIM8.720*GLOBAL LENGTH (MAX)^RN^^0;3^K:+X'=X!(X<30)9.730+ROUTINE SIZE (MAX)^RN^^0;4^K:+X'=X!(X<2048)9.740+CLOSING PRINCIPAL DEVICE^S^1:ALLOWED;^0;5^Q2.780$SAVE SYMBOL TABLE^F^^8;E1,250^D ^DIM.718200*ROUTINE EXISTENCE TEST^F^^18;E1,250^D ^DIM6.71904160#WRITE FROM SDP^F^^SDP;E1,250^D ^DIM9.7 190416.10$FIND SDP END^F^^SDPEND;E1,250^D ^DIM11.0010!NUMBER^N^^ ^K:X'>.55!$D(^DD(X)) Xm$OfS Y="%" F %=0:0 S Y=$O(@Y) Q:Y="" S %=$D(@Y) S:%#2 @(X_"Y)="_Y) I %>9 S %X=Y_"(",%Y=X_"Y," D %XY^%RCR ;.#4DDIPT(D0 2;.718200*ROUTINE EXISTENCE TEST^F^^18;E1,250^D ^DIM/.726190ZSAVE CODE^F^^ZS;E1,250^D ^DIM6.71904160#WRITE FROM SDP^F^^SDP;E1,250^D ^DIM9.7 190416.10$FIND SDP END^F^^SDPEND;E1,250^D ^DIM.7B BREAK LOGIC1&.7BCLOSING PRINCIPAL DEVICE4!.7B FIND SDP END 190416.1!.7BGLOBAL LENGTH (MAX)2.7BNAME.01'.7BROUTINE EXISTENCE TEST1820 .7BROUTINE SIZE (MAX)3054.7GL1E1,2501.7GL8E1,2508.7IX.01.7RQ1.7RQ2.7RQ310 ATTRIBUTE^N10NMFILE11.0010!NUMBER^N^^ ^K:X'>.55!$D(^DD(X)) X21.010#NAME^RF^^0;1^K:$L(X)>45!($L(X)<3) X1.0110^.1^1^1SITE11:% ?30,"(",$E(%5=DD 21.011101^B91.01111$S @(DIC_"""B"",$E(X,1,30),DA)=""""")41.01112K @(DIC_"""B"",$E(X,1,30),DA)")01.013!NAME MUST BE 3-45 CHARACTERS LONGJ1.01DEL.503I DIC="^DIC(" D POINT^DIDH I $N(^DD(DA,0,"PT",0))+1,1.01DEL10I DIC="^DIC(" D K^DIU261.01DELTRB0I $D(^DD(DA,"TRB")) D TRIG^DIDHK110>GLOBAL NAME^CJ14^^ ; ^S X=$S($D(^DIC(D0,0,"GL")):^("GL"),1:"")140DESCRIPTION^1.001^^%D;0*1100APPLICATION GROUP^1.005^^%;01.0010 DESCRIPTION%1.001.010DESCRIPTION^W^^0;1 1.0050APPLICATION GROUP^m$OfS Y="%" F %=0:0 S Y=$O(@Y) Q:Y="" S %=$D(@Y) S:%#2 @(X_"Y)="_Y) I %>9 S %X=Y_"(",%Y=X_"Y," D %XY^%RCR%Y)) Q:'$D(^(%Y)) ZI ^(%Y)" ZS @X%TDD ;1,0 2$140DESCRIPTION^1.001^^%D;0*1100APPLICATION GROUP^1.005^^%;01BAPPLICATION GROUP101B DESCRIPTION41B GLOBAL NAME11BNAME.011BNUMBER.0011GL01.011GL%0101GL%D041IX.011RQ.011SB1.00141SB1.005101.0010 DESCRIPTION%1.001.010DESCRIPTION^W^^0;1$1.0050APPLICATION GROUP^^1^21.0050IXB1.005.01#1.0050NMAPPLICATION-GROUP61.005.010#APPLICATION GROUP^MF^^0;1^K:X'?2U X1.005.0110^.1^2^2 1.005.011101.005^B61.005.01111S ^DIC(DA(1),"%","B",X,DA)=""%>9 S %X=Y_"(",%Y=X_"Y," D %XY^%RCRI $ZD(X) ;3,"SDP" O I F %=0:0 U I R &DD,$E(%, 231.005.01112K ^DIC(DA(1),"%","B",X,DA)1.005.011201^AC31.005.01121S ^DIC("AC",X,DA(1),DA)=""01.005.01122K ^DIC("AC",X,DA(1),DA)R1.005.013?A 2-LETTER 'NAMESPACE' INDICATING A PACKAGE ACCESSING THIS FILEh1.00510WPACKAGE NAME^CJ30^^ ; ^S X=$S($D(^DIC(9.4,+$N(^DIC(9.4,"C",X,0)),0)):$P(^(0),U,1),1:"")$1.005BAPPLICATION GROUP.011.005B PACKAGE NAME11.005GL01.011.005IX.01^^0;1^K:$L(X)>70 X1.01.0110^.11.01.011101.01^B<1.01.01111$S @(DIC_"""B"",$E(X,1,30),DA)=""""")m$OfS Y="%" F %=0:0 S Y=$O(@Y) Q:Y="" S %=$D(@Y) S:%#2 @(X_"Y)="_Y) I %>9 S %X=Y_"(",%Y=X_"Y," D %XY^%RCR,1:0) F DD=0:0 S DC=DSAVE,'mDD100,"/ D1.010ATTRIBUTE^.01^21.010IXB1.01.011.010NMOPTION)1.01.0010NUMBER^N^^ ^K:X\1'=X X+1.01.010NAME^RF^^0;1^K:$L(X)>70 X1.01.0110^.11.01.011101.01^B<1.01.01111$S @(DIC_"""B"",$E(X,1,30),DA)=""""")71.01.01112K @(DIC_"""B"",$E(X,1,30),DA)")1.01BNAME.011.01BNUMBER.001.01IX.011.01RQ.01m$OfS Y="%" F %=0:0 S Y=$O(@Y) Q:Y="" S %=$D(@Y) S:%#2 @(X_"Y)="_Y) I %>9 S %X=Y_"(",%Y=X_"Y," D %XY^%RCRDDS Y=$S($E(Y,4,5):$P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC","^",+$E(Y,4,5))_" ",1:"")_$S($E(Y,6,7):+$E(Y,6,7)_",",1:"")_($E(Y,1,3)+1700)_$P("@"_$E(Y_0,9,10)_":"_$E(Y_"000",11,12),U,Y[".")0),U,5) W:% ?30,"(8QDD^(%Y)" 2.50NMFUNCTIONG.5.0107NAME^RF^^0;1^K:$L(X)<2!($L(X)>30)!(X'?1U.ANP)!(X["$") X.5.0110^.1^1^1.5.01110.5^B1.5.01111S @(DIC_"""B"",X,DA)="""""),.5.01112K @(DIC_"""B"",X,DA)")K.5.013;FUNCTION NAME MUST BE 2-30 CHARS LONG, BEGINNING WITH ALPHA.5.01DEL10I DA<100?.5.020/MUMPS CODE^FR^^1;E1,255^D ^DIM W:$D(X) " ..OK".5.023,ENTER MUMPS CODE THAT SETS A VALUE INTO 'X'..5.024W !,"FOR A 1-ARGUMENT FUNCTION, USE 'X' AS ARGUMENT",!,"FOR A 2-ARGUMENT FUNCTION, USE 'X1' AND 'X'",!,"AVOID 'FOR'S, 'IF'S, AND SINGLE-CHARACTER SCRATCH VARIABLES."1.510#EXPLANATION^F^^9;E1,80^K:$L(X)>80 X.70FIELD.7.010 NAME^F^^0;1^Q)pDD$OfS 2<.5.023,ENTER MUMPS CODE THAT SETS A VALUE INTO 'X'..5.024W !,"FOR A 1-ARGUMENT FUNCTION, USE 'X' AS ARGUMENT",!,"FOR A 2-ARGUMENT FUNCTION, USE 'X1' AND 'X'",!,"AVOID 'FOR'S, 'IF'S, AND SINGLE-CHARACTER SCRATCH VARIABLES."1.510#EXPLANATION^F^^9;E1,80^K:$L(X)>80 XW.520IDATE-VALUED^S^D:YES;X:NO;O:OPTIONAL (DEPENDS ON VALUE OF ARGUMENT);^2;1^Q.590+NUMBER OF ARGUMENTS^N^^3;1^K:X\1'=X!(X>8) X@.51001WORD-PROCESSING^S^W:MEANINGFUL ONLY FOR W-P;^10;1.5B EXPLANATION1.5B MUMPS CODE.02.5BNAME.01.5GL01.01.5GL1E1,255.02.5GL9E1,801.5IX.01.5RQ.01.5RQ.02.70FIELD.7.010 NAME^F^^0;1^QM11.4DDICDINI#TG0 FILE^1^1^6.20DESTINATION^.21^0^0.20GL^DIC(.2,.40PRINT TEMPLATE.40DD^.40GL^DIPT(.40RD^.40WR^.4010 SORT TEMPLATE.4010DD^.4010GL^DIBT(.4010RD^.4010WR^.4020INPUT TEMPLATE.4020DD^.4020GL^DIE(.4020RD^.4020WR^.50 FUNCTION^.5I.50DD^.50GL ^DD("FUNC",.50LAYGO@.50WR@10FILE10DD^10GL^DIC(10LAYGO^10RD^10WR^B DESTINATION.2BFILE1BFUNCTION.5BINPUT TEMPLATE.402BPRINT TEMPLATE.4B SORT TEMPLATE.401=$ZA,Y=$ZB ;8,8 X ^DD("$O") ;8,"ZS" ZR X "F %Y=UTILITYN %RCR00.N *7 R:DC?.N Y S DC=$P(DC,",",2)+DC+1 W:$Y # F DE=2:1:6 X ^UTILITY($J,DE)?025W "FILE LIST",?47 S Y=2840630.2 D DT W " PAGE ",DC$03W !,?0,"NUMBER",?32,"NAME"004&W !,?2,"GLOBAL NAME",?18,"DESCRIPTION"705-W !,?4,"APPLICATION GROUP",?36,"PACKAGE NAME"b06XW !,"-------------------------------------------------------------------------------",!!+0H1X ^UTILITY($J,1):$Y>17!(DC[",") %RCR00.010S X=$P(^(X),U,1)1DIK00.011S @(DIC_"""B"",X,DA)=""""")DIK00.1.1'DIK00.10S X=$E(^(X),1,999)6DIK00.11!S:$L(X)<31 @(DIC_"""B"",X,DA)=1")DIK00.20%DIK00.20S X=$P(^(X),U,2)4DIK00.21S:X @(DIC_"""SB"",+X,DA)=""""");qDD 0GL9.1E1,999.260GL10E1,99100GL110110GL12E1,250120GL12.1E1,25012.10GL12.2E1,25012.20GL200200GLDT1500IX.010IX.10IX.20IX.40RQ.010RQ.40SB.110SB.159990SB.2110SB.320 .10CROSS-REFERENCE^N^2^3.10IXIX.1.01.10NMCROSS-REFERENCE#.1.010INDEX^F^^0;E1,999^Q.1.0110^.1^3^3.1.011100^IXf.1.01111PS:$P(X,U,2)]"" @("^DD("_$P(X,"^",1)_",0,""IX"",$P(X,""^"",2),DA(2),DA(1))=""""")0SB.11SITE MICROMATE SITE11DD=Y") - DOS121B XOS128 X ^DD("$O")OS1218 I $T(^@X)]""6OS12ZS(S %GLB="^UTILITY($J,0)",%NAM=X D ^%RSAVEOS1000OTHER^Q^40^2000OS1001QOSBCCSM12OSB DATA GENERAL4OSBDATATREE9OSBDSM2OSBHARRIS6!OSBLMS-1(IBM SERIES 1)10OSBM/111OSBM/VX7*OSBMICROMUMPS (CP/M - UC DAVIS)11OSB MICRONETICS8OSBOTHER100OSBTANDEM5OSB VISTA(AOS)3 ROU3500SITE MICROMATE SITE11 SUB99VERSION16.06)!($ZA>X) U IO W:$A(%)'=12 ! W %OS2SDPEND S X=$ZA,Y=$ZBUOS2ZSHZR X "F %Y=0:0 S %Y=$N(^UTILITY($J,0,%Y)) Q:'$D(^(%Y)) ZI ^(%Y)" ZS @XSITE MICROMATE SITE11 ;.401,1620,9.2 S Y=^DIBT(D0WDD D,FUNC0 COMPUTED-FIELD FUNCTION^.5^99^42FUNC10 SQUAREROOT-FUNC11D SQR^DIXC S X=$S(X'>0:"",1:Y)FUNC20TIME}FUNC21nS X=$E($P(X,".",2)_"0000",1,4),%=X>1159 S:X>1259 X=X-1200 S X=X\100_":"_$E(X#100+100,2,3)_" "_$E("AP",%+1)_"M"FUNC30MONTH*FUNC31S X=$E(X,1,5)_0_0 S:'X X=""FUNC32D^DFUNC40YEAR-FUNC41S X=$E(X,1,3)_"0000" S:'X X=""C42D^DFUNC50DATEFUNC51S X=$P(X,".",1)FUNC52D^DFUNC60 DAYOFWEEKFUNC61 D DW^%DTCFUNC62^DFUNC70CLOSEFUNC71 C X S X=""FUNC80ABSFUNC81 S:X<0 X=-XFUNC950NEXTFUNC960PREVIOUSFUNC970TOTALFUNC980COUNTFUNC990LAST0DD 0BPOINTER.30BPOINTER SCREEN12#0BREAD ACCESS (OPTIONAL)80BSOURCE100B SPECIFIER.20BTITLE.1#0BTRIGGERED-BY POINTER9990BTYPE.25$0BWRITE ACCESS (OPTIONAL)90BXECUTABLE 'HELP'40GL01.010GL02.20GL03.30GL04.40GL.1E1,999.10GL1010GL2E1,99920GL3E1,99930GL4E1,99940GL509990GL8E1,99980GL8.5E1,9998.50GL9E1,9999.2131@S %=$P(X,"P",2) S:$A(%)=48!%&$D(^DD(+%,0)) ^(0,"PT",DA(1),DA)=""0SB.11SITE MICROMATE SITE11,DDCDINIDFUNC42D^DFUNC50DATEFUNC51S X=$P(X,".",1)FUNC52D^DFUNC60 DAYOFWEEKFUNC61 D DW^%DTCFUNC62^DFUNC70CLOSEFUNC71 C X S X=""FUNC80ABSFUNC81 S:X<0 X=-XFUNC90INTERNALFUNC91S X=XFUNC100MAXFUNC101 S:X1>X X=X1FUNC102OFUNC1032FUNC109MAXIMUM OF 2 VALUESFUNC110MINFUNC111 S:X130) X.4.0110^.1^1^1.4.01110.4^B99^K:$L(X)>99 XF01038WHERE THIS DATA ELEMENT COMES FROM (UP TO 99 CHARACTERS)%0110DESTINATION^.2LAP^^11;0(0120POINTER SCREEN^^^12;E1,250?012.10/CODE TO SET POINTER SCREEN^^^12.1;E1,250^D ^DIM;012.20+EXPRESSION FOR POINTER SCREEN^^^12.2;E1,2500200GROUP^.3LAmDD 3.47040.4010.40120.40116209.2.4014916200.401GL0226.402.010.40250.402GL0447.50NMFUNCTION(.5.023).5904.7.0110".718200#!.7BSAVE SYMBOL TABLE851.01110$140%1.005.01112&1.010'1.01GL01.018FUNC0.FUNC420FUNC1099FUNC140:FUNC169;FUNC189<FUNC212=FUNC240>FUNC269?FUNC293@FUNC321AFUNC349B KWICOS20OS318OS60OS81 OS100!OS121-DDD^DD(.4  00.4704021.010DT(D0,"H")):^("H"),1:"").416200PRINT FIELDS^XCmJ50^^ ; ^S DSAVE=$S($D(DC)#2:DC,1:0) F DD=0:0 S DC=DSAVE,Q="""",C=",",DRK=$S($D(^DIPT(D0,0)):$P(^(0),U,4),1:0),DD=$N(^("F",DD)),(D9,X)="" Q:DD'>0 K DC S DC(0)=D0,DY=^(DD),Y=2,DC=2 D Y^DIP22 X ^DD(.4,1620,9.2):.416209.2'F D=2:1 z-+G$=DD 21.011101^B91.01111$S @(DIC_"""B"",$E(X,1,30),DA)=""""")41.01112K @(DIC_"""B"",$E(X,1,30),DA)")01.013!NAME MUST BE 3-45 CHARACTERS LONGJ1.01DEL.503I DIC="^DIC(" D POINT^DIDH I $N(^DD(DA,0,"PT",0))+1,1.01DEL10I DIC="^DIC(" D K^DIU261.01DELTRB0I $D(^DD(DA,"TRB")) D TRIG^DIDHK110>GDDILITYH 29.590+NUMBER OF ARGUMENTS^N^^3;1^K:X\1'=X!(X>8) X@.51001WORD-PROCESSING^S^W:MEANINGFUL ONLY FOR W-P;^10;1.5B DATE-VALUED2.5B EXPLANATION1.5B MUMPS CODE.02.5BNAME.01!.5BNUMBER OF ARGUMENTS9.5BWORD-PROCESSING10.5GL01.01.5GL1E1,255.02.5GL212.5GL319.5GL9E1,801.5GL10110.5IX.01.5RQ.01.5RQ.02.70FIELD^190416.1^10.70IXB.7.01.7.010 NAME^F^^0;1^Q.011S ^DD(DA(2),"GR",X,DA(1),DA)=""0!NUMBER^N^^ ^K:X'>.55!$D(^DD(X)) X@KWIC7^AND^THE^THEN^FOR^FROM^OTHER^THAN^WITH^THEIR^SOME^THIS^SITE MICROMATE SITE11"DD: 2.7BSAVE SYMBOL TABLE8!.7BWRITE FROM SDP190416.7B ZSAVE CODE2619.7GL01.01.7GL032.7GL043.7GL054.7GL1E1,2501.7GL8E1,2508.7GL18E1,2501820.7GLSDPE1,250190416#.7GLSDPENDE1,250 190416.1.7GLZSE1,2502619.7IX.01.7RQ1.7RQ2.7RQ310ATTRIBUTE^N^10^510IXAC1.005.0110IXB1.0110NMFILE11.0010!NUMBER^N^^ ^K:X'>.55!$D(^DD(X)) X21.010#NAME^RF^^0;1^K:$L(X)>45!($L(X)<3) X1.0110^.1^1^101DELID09I $D(^DD(DA(1),0,"ID",DA)) W !,"CAN'T DELETE IDENTIFIER!"$DD2.401GL022.401GL033.401GL044.401GL055.401GL066.401GLDIPT1491620.401GLO015.401IX.01.401SB.401115.40110 FIELD^.01^1.40110NMFIELD/.4011.010SEARCH SPECIFICATIONS^W^^0;1(.4011BSEARCH SPECIFICATIONS.01.4011GL01.01.4020ATTRIBUTE^^1804^7|.4020IDWRITEfS %=$P(^(0),U,2),%X=$P(^(0),U,5) W:% ?30,"(",$E(%,4,5),"/",%#100,"/",$E(%,2,3),")" W:%X " USER #",%X.4020IXB.402.01CAN DELETE THIS FIELD!"(0.01DEL10I DA=.01 W *7,"??"O0.01DELID09I $D(^DD(DA(1),0,"ID",DA)) W !,"CAN'T DELETE IDENTIFIER!"2DDILITY2.402GL044.402GL055.402GL066.402GLRD01804.402IX.01.402SB.4041804.4040 FIELD^^.01^1.4040NMFIELD .404.010FIELD^O^^0;1^Q.404.012nS %=^DIE(D0,"RD",D1,0),Y=$S($D(^DD(+%,+$P(%,";",2),0)):$P(^(0),U,1),1:"") S:Y]"" Y=$N(^DD(+%,0,"NM",0))_": "_Y.404BFIELD.01.404GL01.01.50ATTRIBUTE^^10^6.50IXB.5.01=^("UP"),Y=$N(^DD(X,"SB",Y,0))DIK0.3.010'DIK0.3.010S X=$P(^(X),U,1)6DIK0.3.011S ^DD(DA(2),"GR",X,DA(1),DA)=""0!NUMBER^N^^ ^K:X'>.55!$D(^DD(X)) X@KWIC7^AND^THE^THEN^FOR^FROM^OTHER^THAN^WITH^THEIR^SOME^THIS^SITE MICROMATE SITE11(tDDILITY*D1.01GL01.011.01IX.011.01RQ.01m$OfS Y="%" F %=0:0 S Y=$O(@Y) Q:Y="" S %=$D(@Y) S:%#2 @(X_"Y)="_Y) I %>9 S %X=Y_"(",%Y=X_"Y," D %XY^%RCRDDS Y=$S($E(Y,4,5):$P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC","^",+$E(Y,4,5))_" ",1:"")_$S($E(Y,6,7):+$E(Y,6,7)_",",1:"")_($E(Y,1,3)+1700)_$P("@"_$E(Y_0,9,10)_":"_$E(Y_"000",11,12),U,Y[".")FUNC0COMPUTED-FIELD FUNCTION^.5^FUNC10 SQUAREROOT-FUNC11D SQR^DIXC S X=$S(X'>0:"",1:Y)FUNC20TIMEFUNC71 C X S X=""FUNC950NEXTFUNC960PREVIOUSFUNC970TOTALFUNC980COUNTFUNC990LAST&1.010' KWICOS20OS318OS60OS81 OS100!.WDDILITYN sD#FUNC109MAXIMUM OF 2 VALUESFUNC110MINFUNC111 S:X1($S($D(IOSL):IOSL,1:24)-$Y)&$D(^UTILITY($J,1))&'$D(^("W")) ^(1) S:'$D(DIWF) DIWF="" S DIWF="B"_X_$P(DIWF,"B",1)_$P(DIWF,"B",2),X=""CFUNC1793START NEW OUTPUT PAGE IF LESS THAN (ARG) LINES LEFTFUNC1710WFUNC180 BREAKABLEFUNC181B 1T DEVICE CAN BE INTERRUPTED IF ARGUMENT IS NON-ZEROFUNC190NUMMONTHFUNC191S X=+$E(X,4,5)FUNC192^D.FUNC199MONTH NUMBER (0-12) FOR A DATEFUNC200NUMDAYFUNC201S X=+$E(X,6,7)FUNC202^DFUNC950NEXTFUNC960PREVIOUSFUNC970TOTALFUNC980COUNTFUNC990LASTD")="S Y=<DDDH=DH( DHFUNC1898OUTPUT DEVICE CAN BE INTERRUPTED IF ARGUMENT IS NON-ZEROFUNC190NUMMONTHFUNC191S X=+$E(X,4,5)FUNC192^D.FUNC199MONTH NUMBER (0-12) FOR A DATEFUNC200NUMDAYFUNC201S X=+$E(X,6,7)FUNC202^D,FUNC209DAY NUMBER (0-31) FOR A DATEFUNC210NUMYEARFUNC211S:X X=$E(X,2,3)FUNC212^D.FUNC219YEAR NUMBER (00-99) FOR A DATEFUNC220NUMDATE;FUNC221+S:X X=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)FUNC222^D)FUNC229DATE IN 'NN/NN/NN' FORMATFUNC230REPLACEFUNC950NEXTFUNC960PREVIOUSFUNC970TOTALFUNC980COUNTFUNC990LAST S (DA,DCNT)=0,X=1 D DD G CNT^DIK1=?DDILITY DFUNC212^D.FUNC219YEAR NUMBER (00-99) FOR A DATEFUNC220NUMDATE;FUNC221+S:X X=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)FUNC222^D)FUNC229DATE IN 'NN/NN/NN' FORMATFUNC230REPLACEWFUNC231GX "F %=0:0 Q:X2'[X1!'$L(X1) S X2=$P(X2,X1,1)_X_$P(X2,X1,2,999)" S X=X2FUNC2333^FUNC239NTHE 1ST ARGUMENT, WITH ALL OCCURRENCES OF THE 2ND ARGUMENT REPLACED BY THE 3RDFUNC240NOWMFUNC241=S %=$P($H,",",2),X=DT_(%\60#60/100+(%\3600)+(%#60/10000)/100)FUNC242DFUNC2430!FUNC249CURRENT DATE/TIMEFUNC250TODAYFUNC251S X=DTFUNC950NEXTFUNC960PREVIOUSFUNC970TOTALFUNC980COUNTFUNC990LAST>DDILITYN DFUNC240NOWMFUNC241=S %=$P($H,",",2),X=DT_(%\60#60/100+(%\3600)+(%#60/10000)/100)FUNC242DFUNC2430!FUNC249CURRENT DATE/TIMEFUNC250TODAYFUNC251S X=DTFUNC252DFUNC2530FUNC259 CURRENT DATEFUNC260PAGE(FUNC261S X=$S($D(DC)#2:DC,1:"")FUNC2630FUNC269PAGE NUMBER (OF OUTPUT)FUNC270SETTABMFUNC271=S DIWT=X,X="" F %=1:1 S Y="X"_% Q:'$D(@Y) S DIWT=@Y_","_DIWTFUNC273VARIABLEFUNC279 SET TAB STOPSFUNC2710WFUNC280 RIGHT-JUSTIFYFUNC950NEXTFUNC960PREVIOUSFUNC970TOTALFUNC980COUNTFUNC990LASTDIK00.21S:X @(DIC_"""SB"",+X,DA)=""""");?4DDCDINI D'FUNC269PAGE NUMBER (OF OUTPUT)FUNC270SETTABMFUNC271=S DIWT=X,X="" F %=1:1 S Y="X"_% Q:'$D(@Y) S DIWT=@Y_","_DIWTFUNC273VARIABLEFUNC279 SET TAB STOPSFUNC2710WFUNC280 RIGHT-JUSTIFYDFUNC2814S X="" S:'$D(DIWF) DIWF="" S:DIWF'["R" DIWF=DIWF_"R"FUNC2830FUNC2810WFUNC290 DOUBLE-SPACEDFUNC2914S X="" S:'$D(DIWF) DIWF="" S:DIWF'["D" DIWF=DIWF_"D"FUNC2930FUNC2910WFUNC300 SINGLE-SPACEMFUNC301=S:'$D(DIWF) DIWF="" S X="",DIWF=$P(DIWF,"D",1)_$P(DIWF,"D",2)FUNC3030FUNC3010WFUNC310BLANKFUNC950NEXTFUNC960PREVIOUSFUNC970TOTALFUNC980COUNTFUNC990LAST %Y=@qDD DFUNC2930FUNC2910WFUNC300 SINGLE-SPACEMFUNC301=S:'$D(DIWF) DIWF="" S X="",DIWF=$P(DIWF,"D",1)_$P(DIWF,"D",2)FUNC3030FUNC3010WFUNC310BLANK_FUNC311OX "F I=1:1:X "_$S($D(^UTILITY($J,"W")):"S X="" |TAB|"" D ^DIWP",1:"W !") S X=""*FUNC319SKIP (ARG) NUMBER OF LINESFUNC3110WFUNC320 MONTHNAMEFUNC321fS X=$P("JANUARY^FEBRUARY^MARCH^APRIL^MAY^JUNE^JULY^AUGUST^SEPTEMBER^OCTOBER^NOVEMBER^DECEMBER","^",+X)CFUNC3293TURNS "1" INTO "JANUARY", "2" INTO "FEBRUARY", ETC.FUNC330SETPAGEFUNC331 S DC=X,X=""FUNC950NEXTFUNC960PREVIOUSFUNC970TOTALFUNC980COUNTFUNC990LASTNTFUNC990LASTADDDH=DH(DvFUNC321fS X=$P("JANUARY^FEBRUARY^MARCH^APRIL^MAY^JUNE^JULY^AUGUST^SEPTEMBER^OCTOBER^NOVEMBER^DECEMBER","^",+X)CFUNC3293TURNS "1" INTO "JANUARY", "2" INTO "FEBRUARY", ETC.FUNC330SETPAGEFUNC331 S DC=X,X=""8FUNC339(PAGE NUMBER ON NEXT PAGE WILL BE (ARG)+1FUNC3310WFUNC340INDENTFUNC341S:'$D(DIWF) DIWF="" S %Y=1,%=$F(DIWF,"I") X:% "F %Y=%:1 Q:$E(DIWF,%Y)'?1N" S DIWF=$E(DIWF,1,%-2)_$E(DIWF,%Y,999)_"I"_(X\1),X=""FUNC349"INDENT FOLLOWING TEXT (ARG) SPACESFUNC3410WFUNC350 SITENUMBER!FUNC351S X=^DD("SITE",1)FUNC3530FUNC950NEXTFUNC960PREVIOUSFUNC970TOTALFUNC980COUNTFUNC990LAST G CNT^DIK1BsDD;W D2FUNC349"INDENT FOLLOWING TEXT (ARG) SPACESFUNC3410WFUNC350 SITENUMBER!FUNC351S X=^DD("SITE",1)FUNC3530BFUNC3592NUMBER IDENTIFYING YOUR SITE (FROM INITIALIZATION)FUNC360WIDTHFUNC361S:'$D(DIWF) DIWF="" S %Y=1,%=$F(DIWF,"C") X:% "F %Y=%:1 Q:$E(DIWF,%Y)'?1N" S DIWF=$E(DIWF,1,%-2)_$E(DIWF,%Y,999)_"C"_(X\1),X=""FUNC369+DISPLAY FOLLOWING TEXT (ARG) COLUMNS ACROSSFUNC3610WFUNC370 PAGESTARTFUNC371S:'$D(DIWF) DIWF="" S %Y=1,%=$F(DIWF,"T") X:% "F %Y=%:1 Q:$E(DIWF,%Y)'?1N" S DIWF=$E(DIWF,1,%-2)_$E(DIWF,%Y,999)_"T"_(X\1),X=""FUNC950NEXTFUNC960PREVIOUSFUNC970TOTALFUNC980COUNTFUNC990LASTEPLACED BY THE 3RDC{DD ;CLD;FUNC369+DISPLAY FOLLOWING TEXT (ARG) COLUMNS ACROSSFUNC3610WFUNC370 PAGESTARTFUNC371S:'$D(DIWF) DIWF="" S %Y=1,%=$F(DIWF,"T") X:% "F %Y=%:1 Q:$E(DIWF,%Y)'?1N" S DIWF=$E(DIWF,1,%-2)_$E(DIWF,%Y,999)_"T"_(X\1),X="";FUNC379+START NEW OUTPUT TEXT ON LINE (ARG) OF PAGEFUNC3710WFUNC950NEXTFUNC960PREVIOUSFUNC970TOTALFUNC980COUNTFUNC990LASTFUNCBABS8FUNCBCLOSE7FUNCBDATE5FUNCB DAYOFWEEK6FUNCBINTERNAL9FUNCB LOWERCASE14FUNCBMAX10FUNCBMIN11FUNCBMONTH3FUNCBREVERSE12FUNCB SQUAREROOT1FUNCBTIME2FUNCB UPPERCASE13FUNCBYEAR4NE (ARG) IF OUTPUFIDDILITY 31.010'1.01GL01.018FUNC0.FUNC420FUNC1099FUNC140:FUNC169;FUNC189<FUNC212=FUNC240>FUNC269?FUNC293@FUNC321AFUNC349BFUNC369CFUNC970FFUNCBNUMDAY20G KWICOS20OS318OS60OS81 OS100!OS121- THE 3RDFUNC240NOWMFUNC241=S %=$P($H,",",2),X=DT_(%\60#60/100+(%\3600)+(%#60/10000)/100)FUNC242DFUNC2430!FUNC249CURRENT DATE/TIMEFUNC250TODAYFUNC251S X=DTFUNC950NEXTFUNC960PREVIOUSFUNC970TOTALFUNC980COUNTFUNC990LASTzDOPTE(%, JDICATT0DATA TYPE^1^7^7DICATT10 DATE/TIME^DICATT20NUMERIC^DICATT30 SET OF CODES^DICATT40 FREE TEXT^!DICATT50WORD-PROCESSING^DICATT60 COMPUTED^#DICATT70POINTER TO A FILE^DICATTBCOMPUTED6DICATTB DATE/TIME1DICATTB FREE TEXT4DICATTBNUMERIC2"DICATTBPOINTER TO A FILE7DICATTB SET OF CODES3 DICATTBWORD-PROCESSING5DIS0CONDITION^1^6^6DIS10NULL^^1DIS20 CONTAINS^^1DIS30 MATCHES^^1DIS40 LESS THAN^<^DIS50 EQUALS^=^1DIS60GREATER THAN^>^DISBCONTAINS2DISBEQUALS5DISB GREATER THAN6DISB LESS THAN4DISBMATCHES3DISBNULL1 DC=DSAVE,IDDILITY DFUNC970TOTALFUNC980COUNTFUNC990LASTFUNCBABS8FUNCBBLANK31FUNCB BREAKABLE18FUNCBCENTER15FUNCBCLOSE7FUNCBCOUNT98FUNCBDATE5FUNCB DAYOFWEEK6FUNCB DOUBLE-SPACE29FUNCBINDENT34FUNCBINTERNAL9FUNCBLAST99FUNCB LOWERCASE14FUNCBMAX10FUNCBMIN11FUNCBMONTH3FUNCB MONTHNAME32FUNCBNEXT95FUNCBNOW24FUNCBNUMDATE2223FUNCBREVERSE12FUNCB RIGHT-JUSTIFY28FUNCBSETTAB27FUNCB SINGLE-SPACE30FUNCB SQUAREROOT1FUNCBTIME2FUNCBTODAY25FUNCB UNDERLINE16FUNCB UPPERCASE13FUNCBYEAR4GDDS, AND DFUNCBNUMDAY20FUNCBNUMMONTH19FUNCBNUMYEAR21FUNCBPAGE26FUNCBPAGEFEED17FUNCB PAGESTART37FUNCBPREVIOUS96FUNCBREPLACE23FUNCBREVERSE12FUNCB RIGHT-JUSTIFY28FUNCBSETPAGE33FUNCBSETTAB27FUNCB SINGLE-SPACE30FUNCB SITENUMBER35FUNCB SQUAREROOT1FUNCBTIME2FUNCBTODAY25FUNCBTOTAL97FUNCB UNDERLINE16FUNCB UPPERCASE13FUNCBWIDTH36FUNCBYEAR4FUNC199MONTH NUMBER (0-12) FOR A DATEFUNC200NUMDAYFUNC201S X=+$E(X,6,7)FUNC202^DFUNC950NEXTFUNC960PREVIOUSFUNC970TOTALFUNC980COUNTFUNC990LASTD")="S Y=DISVITY&0 ^DD("OS",110^DD(DL,.0010^DIC(10 ^DOPT("DID",10 ^DOPT("DII",1INGFUL ONLY FOR W-P;^10;1.5B DATE-VALUED2.5B EXPLANATION1.5B MUMPS CODE.02.5BNAME.01!.5BNUMBER OF ARGUMENTS9.5BWORD-PROCESSING10.5GL01.01.5GL1E1,255.02.5GL212.5GL319.5GL9E1,801.5GL10110.5IX.01.5RQ.01.5RQ.02.70FIELD^190416.1^10.70IXB.7.01.7.010 NAME^F^^0;1^Q.011S ^DD(DA(2),"GR",X,DA(1),DA)=""0!NUMBER^N^^ ^K:X'>.55!$D(^DD(X)) X@KWIC7^AND^THE^THEN^FOR^FROM^OTHER^THAN^WITH^THEIR^SOME^THIS^SITE MICROMATE SITE11DOPT  JDICATTB SET OF CODES3 DICATTBWORD-PROCESSING5"DID0LISTING FORMAT^1.01^3^3DID10STANDARDDID20BRIEFDID30CUSTOM-TAILOREDDIDBBRIEF2DIDBCUSTOM-TAILORED3DIDBSTANDARD1DII0 OPTION^1N^9^9-DII10ENTER OR EDIT FILE ENTRIES^^DIB%DII20PRINT FILE ENTRIES^^DIP&DII30SEARCH FILE ENTRIES^^DIS,DII40MODIFY FILE ATTRIBUTES^^DICATT-DII50INQUIRE TO FILE ENTRIES^INQ^DII$DII60UTILITY FUNCTIONS^^DIUDII70STATISTICS^^DIX'DII80LIST FILE ATTRIBUTES^^DID^1DIS60GREATER THAN^>^DISBCONTAINS2DISBEQUALS5DISB GREATER THAN6DISB LESS THAN4DISBMATCHES3DISBNULL1 Y=X G 1KDOPT") DICATT0EDICATTB SET OF CODES3IDII90KOS11*OS0 MUMPS OPERATING SYSTEM^.7^100^13OS10M/11^^63^6000^1OS11B XOS18 X ^DD("$O")%OS118I $D(^UTILITY("ROU",X))[OS1SDPMO @("I:"_DLP) F %=0:0 U I R % Q:$ZA=X&($ZB>Y)!($ZA>X) U IO W:$A(%)'=12 ! W %OS1SDPEND S X=$ZA,Y=$ZBUOS1ZSHZR X "F %Y=0:0 S %Y=$N(^UTILITY($J,0,%Y)) Q:'$D(^(%Y)) ZI ^(%Y)" ZS @X63^3000^1OS21B XOS28 X ^DD("$O")[OS2SDPMO @("I:"_DLP) F %=0:0 U I R % Q:$ZA=X&($ZB>Y)!($ZA>X) U IO W:$A(%)'=12 ! W %OS2SDPEND S X=$ZA,Y=$ZBUOS2ZSHZR X "F %Y=0:0 S %Y=$N(^UTILITY($J,0,%Y)) Q:'$D(^(%Y)) ZI ^(%Y)" ZS @XSITE MICROMATE SITE11 ;.401,1620,9.2 S Y=^DIBT(D0lDOPTTIONf J#DII90TRANSFER ENTRIES^^DIT(DIIBENTER OR EDIT FILE ENTRIES1%DIIBINQUIRE TO FILE ENTRIES5"DIIBLIST FILE ATTRIBUTES8$DIIBMODIFY FILE ATTRIBUTES4 DIIBPRINT FILE ENTRIES2!DIIBSEARCH FILE ENTRIES3DIIB STATISTICS7DIIBTRANSFER ENTRIES9DIIBUTILITY FUNCTIONS6DIS0CONDITION^1^6^6DIS10NULL^^1DIS20 CONTAINS^^1DIS30 MATCHES^^1DIS40 LESS THAN^<^DIS50 EQUALS^=^1DIS60GREATER THAN^>^DISBCONTAINS2DISBEQUALS5DISB GREATER THAN6DISB LESS THAN4DISBMATCHES3DISBNULL1PRINT FILE ENTRIES^^DIP ;SEARCH FILE ENTRIES^^DIS ;MODIFY FILE ATTRIBUTES^^DICATT %MD^' TO,?;MM Default Routine & Global Drives for Programmer Utilities I U[DIY G:DD=DS L^DICM:DO(2)["O",A^DIC G Y^DIC:DIY="" S X=U G A^DIC I +DIY'=DIY S D=$S($D(DF):DF,1:"B"),X=DIY K DIY,DS G X^DIC G BAD:'$D(DS(DIY)) K DIC("W") S DIY(+DIY)="" G C^DIC ; TIME W *7 S DTOUT=1 G NO^DIC ; O I $D(DFAST)#2,X=DFAST S DFOUT=1 G NO^DIC BAD W:DIC(0)["Q" *7," ??" G A^DIC +-KϧRDIICW61DII ;GFT/SF ; 25APR83 18:11 ; OPTION READER W !!,"FileMan, V."_^DD("VERSION"),! NOKL S DIK="^DOPT(""DII""," G F:$D(^DOPT("DII",9)) S ^(0)="OPTION^1N^" F I=1:1 S X=$E($T(F+I),3,99) Q:X="" S ^DOPT("DII",I,0)=X D IXALL^DIK F S DIC=DIK,DIC(0)="AEQZ" D ^DIC K DIC,DIK Q:Y<0 %MTC44 Su"O1-Terminal Characteristics and Port Definitions0DEFAULT 1OKI82A 2SDP 3SDP 4SDP 5XFERhADM3A^*26,#~*27,*41~*27,*40~79~24~W *27,"=",*DY+32,*DX+32~C-Lier Siegler ADM3A~O %IO U %IO W *27,*40<DEFAULT0!!!!!!!!!!,#~*0~*0~79~24~W ""~C-Default Console~?DM15214#~*4~*24~79~24~W *30,*DX+32,*DY+32~C-DataMedia 1521~*LA120 #~*0~*0~102~66~W ""~P-DEC LA120~>OKI82A3#~*0~*0~131~66~W ""~P-OKIDATA 82A~O %IO U %IO W *29$QUME#~*0~*0~102~66~W ""~P-QUME~=SDP5#~*0~*0~255~99999~W ""~O-CP/M Sequential File~D IOSDPFTV910<*27,"*"~*0~*0~79~24~W *27,*61,*DY+32,*DX+32~C-Televideo 910~ VT52~>XFER5*0~*0~*0~255~999999~W ""~O-Rdr/Pun MUMPS-MUMPS xfer.~)") S DIY=$P(^(0),"^",1) W DIY Q ; U N]%MTC="B""O_VC4404T*24,#~*14~*15~79~23~W *16,*DY+32,*DX+32~C-Volker Craig VC4404 CHAT~O %IO U %IO W *15YVT100O*27,*91,*50,*74,*27,*74,#~*0~*0~80~24~W *27,*91,DY+1,*59,DX+1,*102~C-DEC VT100~JVT52A*27,*72,*27,*74,#~*0~*0~79~24~W *27,*89,*DY+32,*DX+32~C-DEC VT52~LX820C*26,#~*27,*41~*27,*40~79~24~W *27,*61,*DY+32,*DX+32~C-XEROX 820-II~>XFER5*0~*0~*0~255~999999~W ""~O-Rdr/Pun MUMPS-MUMPS xfer.~X=X G NUM G X^DIC DO ; Q:$D(DO) I @("$D("_DIC_"0))") S DO=^(0)  E S DO="0^-1" I $D(DIC("P")) S DO=U_DIC("P"),^(0)=DO DO2 S DO(2)=$P(DO,"^",2) I DO?1"^".E S DO=$N(^DD(+DO(2),0,"NM",0))_DO Q:DO(2)'["I"!$D(DIC("W")) Q:'$D(^DD(+DO(2),0,"ID")) S %=0,DIC("W")="" W S %=$N(^DD(+DO(2),0,"ID",%)) I %MTC)=$E W 0M VC4404N$D(^DIC(+Y,0,"GL")) K DIC S DIC=^("GL") Q I U[X K DIC Q WW W:$X>53 !?9 S %=$S($D(^DIC(+Y,0,"DT")):^("DT"),1:"") S:% %=$E(%,4,5)_"/"_$E(%,6,7)_"/"_$E(%,2,3)_" " I $D(^("GL")),^("GL")'["[",@("$D("_^("GL")_"0))") W ?35," (",% S %=+$P(^(0),U,4) W %," entr",$P("ies^y",U,%=1+1),")" G GOT ; D D DT S D="MODIFY",DIC(0)="LQE",DIC("S")="I Y>1" I DUZ(0)'="@" S DICS="I 1 Q:'$D(^(9)) Q:^(9)=U F DW=1:1:$L(^(9)) I DUZ(0)[$E(^(9),DW) Q",DIC("S")="I 1 Q:'$D(^(0,""DD"")) F DC=1:1:$L(^(""DD"")) I DUZ(0)[$E(^(""DD""),DC) Q" D DIC Q:$T G D:'$P(Y,U,3) K DIC +-lϧRDIC1W61;DIC1 ;GFT/SF ; 05JAN84 15:25 I $D(DIC("A")) S DD=DIC("A") G B -%MU(0)[$ g"%!Programmer Utilities Scratch Area GBL%MD0GBL%MTC0 GBL%MU0 GBLDD0GBLDIBT0 GBLDIC0 GBLDIE0GBLDIPT0GBLDISV0GBLDOPT0GBLUTILITY0%DT,DICS Q ; 0 S X=0 X ^DD("FUNC",18,1) Q 1 S X=1 X ^DD("FUNC",18,1) Q ; W D DT S D="INPUT TO",DIC(0)="LEQ",DIC("S")="I Y-1" I DUZ(0)'="@" S DIC("S")="I 1 Q:'$D(^(0,""WR"")) F DC=1:1:$L(^(""WR"")) I DUZ(0)[$E(^(""WR""),DC) Q" D DIC Q:$T G W:'$P(Y,U,3) K DIC Q ; DIC W ! S U="^",D=D_" WHAT FILE: ",DIC="^DIC(" I $D(^DISV($I,DIC)) S Y=^(DIC) I $D(^DIC(Y,0)) X:$D(DIC("S")) DIC("S") I S Y=Y_U_$P(^DIC(Y,0),U,1),D=D_$P(Y,U,2)_"// " W D R X I I X=""          DIDT ;DELETE THIS LINE AND SAVE AS '%DT'! ; 06SEP83 17:05 %DT ;GFT/SF K % S:$D(%DT)[0 %DT="" I %DT["A" W !,$S($D(%DT("A")):%DT("A"),1:"DATE: ") R X:$S($D(DTIME):DTIME,1:99999) S:'$T X="^",DTOUT=1 I "^"[X S Y=-1 K %I,% Q S %(0)=X G N^%DTC:$P("NOW",X,1)="",R:X'["@",NO:%DT'["T" S Y=$P(X,"@",2,9),X=$P(X,"@",1),Y=$P(Y,":",1)_$P(Y,":",2,9),%I=Y G G:Y?4N,0:Y'?1N.N.AP S:Y<13 Y=Y*100 I %I["A" S:Y>1159 Y=Y-1200 E I Y<1200,%I["P"!(Y<600) S Y=Y+1200 G G 0:Y>2359!'Y,0:Y#100>59 S %(1)=Y/10000 R I %DT["F"!(%DT["P") D TY S %(9)=% 7 I X?7N.E S Y=$E(X,8) I Y?.P S:Y="." %(1)=Y_$P(X,".",2) S X=$E(X,4,5)_$E(X,6,7)_($E(X,1,3)+1700) S %I=0,%="" I X'?.N G T^%DTC:"T+-"[$E(X,1),HELP^%DTC:X?."?",U:X["^"!(X="."),F I %DT'["X",X\300=6!(X?2N) S (%I(1),%I(2))=0,%I(3)=X G 3 F %I=0:1 S Y=$E(X,1,2),X=$E(X,3,9) G OT:Y="",0:%DT["X"&'Y S:%I=2 Y=Y_X,X="" S %I(%I+1)=Y ; F I $D(DFAST)#2,X=DFAST S DFOUT=1 G U X S Y=$E(X,1),X=$E(X,2,99) I Y?1N G A:%?.N,Y I Y?1A G A:%?.A,Y OT D:%]"" % G 0:%I>3,X:Y?1P,0:Y]"",@%I Y D % S %=Y G 0:%I>3,X A S %=%_Y G X ; TY S %=$H#1461,%=$H\1461*4+(%\365)+141-(%=1460) Q ; 0 ; 1 W:%DT["E" *7," ??" B G %DT:%DT["A",NO U S X="^",%(0)=X NO S Y=-1 G Q:%DT'["A",Q:X["^",%DT 2 I %I(2)>31,%DT'["X" S %I(3)=%I(2),%I(2)=0 G 3 D TY S %I(3)=% D PF^%DTC:$D(%(9)) G C 3 I %I(3)?2N S %I(3)=%I(3)+$S(%DT'["P":200,$E(%(9),2,3)<%I(3):100,1:200) G C S %I(3)=%I(3)-1700 G 0:%I(3)'?3N C I %I(1)>12 G 0 I %I(2)>28,$E("303232332323",%I(1))+28<%I(2),%I(1)-2!(%I(2)-29)!(%I(3)#4)!(%I(3)=200) G 0 D D P E I $D(%(1)) S Y=Y_%(1) I %DT["E" W " (" W:%I(1) $P($T(M)," ",%I(1)+2)," " W:%I(2) %I(2),", " W %I(3)+1700 W:Y["." " ",$E(Y_0,9,10),":",$E(Y_"000",11,12) W ")" I $D(%DT(0)) S %=%DT(0),%I=$S(%["-":Y,1:-Y) D:'% NOW^%DTC,Z I %+%I>0 G 0 Q S X=%(0) K %,%I,%H Q ; Z S:%DT(0)["-" %=-% Q ; P S Y=%I(3)_$E(%I(1)+100,2,3)_$E(%I(2)+100,2,3) Q ; % I %?3A.A S %=$F($T(M),$E(%,1,3))-4\4 I %>0,%I=1 S %I(1)=%,%=+%(0) S:%<1 %I=9 S %I=%I+1,%I(%I)=%,%="" ; M ; JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC )=%I(2),%I(2)=0 G 3 D TY S %I(3)=% D PF^%DTC:$D(%(9)) G C 3 I %I(3)?2N S %I(3)=%I(3)+$S(%DT'["P":200,$E(%(9),2,3)<%I(3):100,1:200) G C S %I(3)=%I(3)-1700 G 0:%I(3)'?3N C I %I(1)>12 G 0 I %I(2)>28,$E("303232332323",%I(1))+28<%I(2),%I(1)-2!(%I(2)-29)!(%I(3)#4)!(%I(3)=200) G 0 D D P E I $D(%(1)) S Y=Y_%(1) I %DT["E" W " (" W:%I(1) $P($T(M)," ",%I(1)+2)," " W:%I(2) %I(2),", " W %I(3)+1700 W:Y["." " ",$E(Y_0,9,10),":",$E(Y_"000",11,12) W ")" I $D(%DT(0)) S %=%DT(0),%I=$S(%["-":Y,1:-Y) D:'% NOW^%DTC,Z I %+%I>0 G 0 Q S X=%(0) K %,%I,%H Q ; Z SDIDTC ;BB,GFT/SF ; 14SEP83 17:46 ;**DELETE THIS LINE AND SAVE AS "%DTC"** %DTC ; D I 'X1!'X2 S X="" Q S X=X1 D H S X1=%H,X=X2,X2=%Y+1 D H S X=X1-%H,%Y=%Y+1&X2 K %H,X1,X2 Q ;X=X1-X2 in days, %Y: 1=VALID, 0=NO MONTH OR DAY ; C S X=X1 Q:'X D H S %H=%H+X2 D YMD K X1,X2 Q ;X=X1+X2 %H=X in $H format ; H S %Y=$E(X,1,3),%M=$E(X,4,5),%D=$E(X,6,7) TOH S %H=%M>2&'(%Y#4)+$P("^31^59^90^120^151^181^212^243^273^304^334","^",%M)+%D S %='%M!'%D,%Y=%Y-141,%H=%H+(%Y*365)+(%Y\4)-(%Y>59)+%,%Y=$S(%:-1,1:%H+4#7) K %M,%D,% Q ; %Y=Day of Week, %H=$H date ; DOW D H S Y=%Y K %H,%Y Q ;-1 to 6 DW D H S Y=%Y,X=$P("SUN^MON^TUES^WEDNES^THURS^FRI^SATUR","^",Y+1)_"DAY" S:Y<0 X="" Q ; 7 S %=%H>21549+%H-.1,%Y=%\365.25+141,%=%#365.25\1 S %D=%+306#(%Y#4=0+365)#153#61#31+1,%M=%-%D\29+1 S X=%Y_"00"+%M_"00"+%D Q ; YMD D 7 K %D,%M,%Y Q ; T F %=1:1 S Y=$E(X,%) Q:"+-"[Y G 0^%DT:$E("TODAY",%)'=Y S X=$E(X,%+1,99) G PM:Y="" I +X'=X S X=$S(X?1N.N1"D":+X,X?1N.N1"M":X*30,X?1N.N1"W":X*7,1:0) G 0^%DT:X>999!'X PM S @("%H=$H"_Y_X) D TT G D^%DT ; N G NO^%DT:X=""!(%DT'["T") D NOW S Y=% G E^%DT TT D 7 S %I(1)=%M,%I(2)=%D,%I(3)=%Y K %M,%D,%Y Q NOW S %H=$H D TT S %=$P($H,",",2),%=%#3600\60/100+(%\3600)/100,%=X_% Q ; PF S %H=$H D YMD S %(9)=X,X=%DT["F"*2-1 I @("%I(1)*100+%I(2)"_$E("> <",X+2)_"$E(%(9),4,7)") S %I(3)=%I(3)+X Q ; COMMA S %D=X<0 S:%D X=-X S %=$S($D(X2):+X2,1:2),X=$J(X,1,%),%=$L(X)-3-$E(23,%) F %=%:-3 Q:$E(X,%)="" S X=$E(X,1,%)_","_$E(X,%+1,99) S:$D(X2) X=$E("$",X2["$")_X S X=$J($E("(",%D)_X_$E(" )",%D+1),12) K %,%D Q HELP ; W !,"EXAMPLES OF VALID DATES:" W !," JAN 22 1957 or 22 JAN 57 or 1/22/57 or 012257" W !," T (FOR TODAY), T+1 (FOR TOMORROW), T+2, T+7, etc." W !," T-1 (FOR YESTERDAY), T-3W (3 WEEKS AGO), etc." W !,"IF THE YEAR IS OMITTED, THE COMPUTER ",$S(%DT["P":"ASSUMES A DATE IN THE PAST",1:"USES THE CURRENT YEAR"),! I %DT'["X" W "YOU MAY OMIT THE PRECISE DAY, AS: JAN, 1957",! I %DT["T" W "FOLLOW DATE WITH TIME, AS: JAN 22@10, T@10PM, ETC." G B^%DT 0\60/100+(%\3600)/100,%=X_% Q ; PF S %H=$H D YMD S %(9)=X,X=%DT["F"*2-1 I @("%I(1)*100+%I(2)"_$E("> <",X+2)_"$E(%(9),4,7)") S %I(3)=%I(3)+X Q ; COMMA S %D=X<0 S:%D X=-X S %=$S($D(X2):+X2,1:2),X=$J(X,1,%),%=$L(X)-3-$E(23,%) F %=%:-3 Q:$E(X,%)="" S X=$E(X,1,%)_","_$E(X,%+1,99) S:$D(X2) X=$E("$",X2["$")_X S X=$J($E("(",%D)_X_$E(" )",%D+1),12) K %,%D Q HELP ; W !,"EXAMPLES OF VALID DATES:" W !," JAN 22 1957 or 22 JAN 57 or 1/22/57 or 012257" W !," T (FOR TODAY), T+1 (FOR TOMORROW), T+2, T+7, etc." W !," T-1 (FOR YESTERDAY), T-3W (3 WDIFROM ;GFT/SF ; 10DEC83 15:53 R !,"ENTER THE 2-LETTER NAME OF THE PACKAGE: ",X I X'?2U Q W !,"I AM GOING TO CREATE A ROUTINE CALLED '",X,"INIT'." K ^UTILITY($J),F,DTL,Q,E S U="^",%=0,%B="",DL=0,DTL=X,DN=X_"INI",^UTILITY($J)=DN,X=DN_"T" I $D(^("OS",^DD("OS"),18)) X ^(18) I W *7,!,"THERE IS ALREADY SUCH A ROUTINE NAME ON FILE!" W !,"IS THAT OK" D YN^DICN Q:%-1 S (DP,Q)=$N(^DIC(9.4,"C",DTL,0)) F DH=0:0 S DH=$N(^DIC(9.4,Q,4,DH)) G:'$D(^(DH,0)) DD:$D(F),L S Y=+^(0) I $D(^DIC(Y,0))#2 S F(Y)=$P(^(0),U,1) W !!,F(Y) D SF G Q:%<0 L W !!,"GOOD. THEN PLEASE LIST FOR ME THE FILES THAT YOU WANT TO INITIALIZE---" F F=1:1 K DIC S DIC("S")="I Y>.49&'$D(F(+Y))",DIC(0)="AQEZ",DIC="^DIC(" D ^DIC G:Y<0 Q:X[U,DD S F(+Y)=$P(Y,U,2) D F DD W ! F Y=1,2,3 S D=$P("DIE^DIPT^DIBT",U,Y),DIC=$P("INPUT^PRINT^SORT",U,Y)_" TEMPLATE(S):" F %=0:0 S %=$N(^DIC(9.4,Q,D,%)) Q:'$D(^(%,0)) S DH=$P(^(0),U,1),X=$P(^(0),U,2) D T S F=0,%=2 G Q:$D(F)+$D(Q)=2 W !!,"WANT SECURITY CODES SENT ALONG" D YN^DICN G Q:%<1 S DSEC=%=1 D WAIT^DICD G ^DIFROM0 ; T W !,DIC,?24,DH F F=0:0 S @("F=$N(^"_D_"(""B"",DH,F))"),DIC="" Q:F'>0 I @("$D(^"_D_"(F,0))"),$P(^(0),U,4)=X!'X S Q(D,F)="" G Q W *7," **NOT FOUND** " W:X "FOR FILE #",X Q ; SF G F:$N(^DIC(9.4,Q,4,DH,1,0))'>0 F %=0:0 S %=$N(^DIC(9.4,Q,4,DH,1,%)) Q:%'>0 I $D(^(%,0)) S E=$P(^(0),U,1),D=$N(^DD(+Y,"B",E,0)) I $D(^DD(+Y,D,0)) S F(+Y,+Y,D)="",%C=+$P(^(0),U,2) I %C W " (",E,")" S E(%C)=0,F(+Y,%C)=0 S E(+Y)=1,F(+Y,+Y,.01)=0 G E F S F(+Y,+Y)=0,%=1 K %A F E=0:0 S E=$N(F(+Y,E)) Q:E<0 S E(E)="" F D=0:0 S D=$N(^DD(E,"SB",D)) Q:D<0 I Y-E!'$D(%A)!$D(%A(D)) S F(+Y,D)="" S:$D(%A) %A(D)=0 E S F(+Y,0)=^DIC(+Y,0,"GL"),%=$S($D(^DIC(9.4,Q,4,DH,222.7)):2-(^(222.7)="Y"),1:2),@("D=$P("_F(+Y,0)_"0),U,4)") S:D<2 D="" W !?9,"TRANSFER ",D," '",F(+Y),"' ENTRIES" W:$X>40 !?8 W " AS WELL AS DATA DICTIONARY" D YN^DICN S:%=1 DTL(+Y)=0 K %A Q ; Q  K %A,%C,%Z,%V Q =0:0 S @("F=$N(^"_D_"(""B"",DH,F))"),DIC="" Q:F'>0 I @("$D(^"_D_"(F,0))"),$P(^(0),U,4)=X!'X S Q(D,F)="" G Q W *7," **NOT FOUND** " W:X "FOR FILE #",X Q ; SF G F:$N(^DIC(9.4,Q,4,DH,1,0))'>0 F %=0:0 S %=$N(^DIC(9.4,Q,4,DH,1,%)) Q:%'>0 I $D(^(%,0)) S E=$P(^(0),U,1),D=$N(^DD(+Y,"B",E,0)) I $D(^DD(+Y,D,0)) S F(+Y,+Y,D)="",%C=+$P(^(0),U,2) I %C W " (",E,")" S E(%C)=0,F(+Y,%C)=0 S E(+Y)=1,F(+Y,+Y,.01)=0 G E F S F(+Y,+Y)=0,%=1 K %A F E=0:0 S E=$N(F(+Y,E)) Q:E<0 S E(E)="" F D=0:0 S D=$N(^DD(E,"SB",D)) Q:D<0 I Y-E!'$D(%A)!$D(%A(D)) S F(+Y,D)="" S:$D(%A) %A(D)=0 E S F(+Y,0)=^DIC(+Y,0,"GL"),%=$S($D(^DIC(9.4,Q,4,DH,222.7)):2-(^(222.7)="Y"),1:2),@("D=$P("_F(+Y,0)_"0),U,4)") S:D<2 D="" W !?9,"TRANSFER ",D," '",F(+Y),"' ENTRIES" W:$X>40 !?8 W " AS WELL AS DATA DICTIONARY" D YN^DICN S:%=1 DTL(+Y)=0 K %A Q ; Q DIFROM0 ;GFT/SF ; 14JAN84 20:14 K ^DD(U,$J) S DRN=1001,DH=DTL OP S D=$N(^DIC(19,"B",DH,0)),%X="^DIC(19,D,",%Y="^DD(U,$J,""OPT"",D," D %XY^%RCR:'$D(DTL(19)) S DH=$N(^DIC(19,"B",DH)) G OP:$E(DH,1,2)=DTL S DH=DTL XMB S D=$N(^XMB(3.6,"B",DH,0)),%X="^XMB(3.6,D,",%Y="^DD(U,$J,""XMB"",D," D %XY^%RCR:'$D(DTL(3.6)) K ^DD(U,$J,"XMB",D,2) S DH=$N(^XMB(3.6,"B",DH)) G XMB:$E(DH,1,2)=DTL L S DH=" F I=1:1 S X=$T(Q+I) Q:X="""" S Y=$P(X,""="",2,99),X=$P($E(X,3,99),""="",1) S:X="""" X=$P(Y,""="",1),Y=%_$P(Y,""="",2,99) X NO E S @X=Y",F=$N(F(F)) I F<0 D FILE^DIFROM2:DL G V S ^UTILITY($J,DL+1)="^DIC("_F_",0,""GL"")="_F(F,0),^(DL+2)="^DIC(""B"","""_F(F)_""","_F_")=",DL=DL+2 F E=0,"%","%D" I E'=0!DSEC S %X="^DIC("_F_","""_E_""",",E=0 D %XY F D=0:0 S D=$N(F(F,D)),E=0,%X="^DD("_D_",0" Q:D<0 S DL=DL+1,^UTILITY($J,DL)=%X_")="_^DD(D,0),%X=%X_"," D %XY F X=0:0 S X=$N(^DD(D,X)) Q:X'>0 S %X="^DD("_D_","_X_",",E="%Z#2" D SAVE:$D(F(F,D))<9!$D(F(F,D,X)) I $D(DTL(F)) D FILE^DIFROM2 S E="%Z#2=0",%X=F(F,0),@("D="_%X_"0)"),^DD(U,$J,F)=%X,^(F,0)=D,%Y="^DD(U,$J,"_F_",",%Z=0,%C(-1)=0,%B=0,%A="",DL=0 D N,FILE^DIFROM2 G L ; SAVE K DSV G %XY:DSEC I $D(^(X,8)) S DSV(8)=^(8) K ^(8) I $D(^(9)),^(9)'=U S DSV(9)=^(9) K ^(9) D %XY RESTORE F %Z=8,9 I $D(DSV(%Z)) S ^DD(D,X,%Z)=DSV(%Z) Q ; V S %Y="^DD(U,$J,D,Y,",E=0 F D="DIE","DIPT","DIBT" S %X=U_D_"(Y," F Y=0:0 S @("Y=$N(^"_D_"(Y))") Q:Y'>0 S DSV=^(Y,0),F=$P(DSV,U,4) I F,$D(F(F))!$D(Q(D,Y)) D %XY^%RCR K ^DD(U,$J,D,Y,"ROU"),^("RD") K:'$D(DTL(F)) ^(1) S:'DSEC ^(0)=$P(DSV,U,1,2)_U_U_F W "." S %X="^DD(U,$J," D %XY S DSV=DL K ^DD(U,$J),Q D FILE^DIFROM2:DL G ^DIFROM1 ; %XY W "." S %Z=0,%A="",%C(-1)=0,%Y=%X S S %B=-1 N S @("%B=$N("_%X_%A_"%B))"),%C(%Z)=%C(%Z-1) I '%B,%B'?1"0".E,@E S %B=-1 I %B["," F %C=0:0 S %C=$F(%B,",",%C) Q:'%C S %C(%Z)=%C(%Z)+1 I %B=-1 G Q^DIFROM:'%Z S @("%B="_$P(%A,",",%Z+%C(%Z-2),%Z+%C(%Z-1))),%Z=%Z-1,%A=$P(%A,",",1,%Z+%C(%Z-1))_$E(",",%Z>0) G N I @("$D("_%X_%A_"%B))#2=1") S %V=^(%B) D W:%V'?.ANP S %=%Y_%A_""""_%B_""")" S:$L(%V)+$L(%)>240 DL=DL+1,^UTILITY($J,DL)="%="_$E(%V,1,160),%V=$E(%V,161,999),%="="_% S DL=DL+1,^UTILITY($J,DL)=%_"="_%V I @("$D("_%X_%A_"%B))<9") G N G DOWN:+%B=%B F %C=0:0 S %C=$F(%B,"""",%C) Q:'%C S %B=$E(%B,1,%C-1)_""""_$E(%B,%C,999),%C=%C+1 S %B=""""_%B_"""" DOWN S %A=%A_%B_",",%Z=%Z+1 G S ; W W !,"WARNING--CONTROL CHAR IN ",%X,%A,%B,*7 U_F W "." S %X="^DD(U,$J," D %XY S DSV=DL K ^DD(U,$J),Q D FILE^DIFROM2:DL G ^DIFROM1 ; %XY W "." S %Z=0,%A="",%C(-1)=0,%Y=%X S S %B=-1 N S @("%B=$N("_%X_%A_"%B))"),%C(%Z)=%C(%Z-1) I '%B,%B'?1"0".E,@E S %B=-1 I %B["," F %C=0:0 S %C=$F(%B,",",%C) Q:'%C S %C(%Z)=%C(%Z)+1 I %B=-1 G Q^DIFROM:'%Z S @("%B="_$P(%A,",",%Z+%C(%DIFROM1 ;GFT/SF ; 14JAN84 19:41 S DL=0,DTL=DRN-1,S="" K ^DD(U,$J),^UTILITY($J) S DH=" K (U,QUIT) S %=1,U=""^"" W !!,""ARE YOU SURE EVERYTHING'S OK"" D YN^DICN H:%-1" S Q=" I $D(QUIT(0)) W !,""SHALL I WRITE OVER EXISTING DATA DEFINITIONS AND TEMPLATES"" S %=2 D YN^DICN" S ^($J,2)=" S NO=$P(""I 0^I $D(@X)#2,X[U"",U,%) H:%<1" S ^(8.4)=" K DIC S DIC(0)=""LX"",(DIC,DLAYGO)=3.6,N=""XMB"" D ADD:$D(^XMB(3.6,0)) F X=0:0 S X=$N(XMB(X)) Q:X<0 K XMB(X) W !,""'"",X,""' BULLETIN FILED -- REMEMBER TO ADD ITS USER GROUPS""" S ^(8.45)=" I $D(^DIC(19,0)),^(0)?1""OPTION"".E S (DIC,DLAYGO)=19,N=""OPT"" D ADD F X=0:0 S X=$N(XMB(X)) Q:X<0 K XMB(X) W !,""'"",X,""' MENU OPTION FILED""" S ^(8.5)=" S DIC(""S"")=""I $P(^(0),U,4)=I"" F N=""DIE"",""DIPT"",""DIBT"" S DIC=U_N_""("" D ADD" S ^(19)=" ;",^(20)="ADD F R=0:0 S R=$N(^DD(U,$J,N,R)) Q:R<0 S X=$P(^(R,0),U,1),I=$P(^(0),U,4) D ^DIC I Y>0,NO=""I 0""!$P(Y,U,3) K @(DIC_""+Y)"") S XMB(X)=0,%X=""^DD(U,$J,N,R,"",%Y=DIC_""+Y,"",DA=+Y,DIK=DIC D %XY^%RCR,IX1^DIK" S ^(3)=" D DT^DICRW K ^DD(U,$J),^UTILITY(""DIK"",$J) D WAIT^DICD F R=1001:1:"_DTL_" D @(""^"_DN_"""_$E(R,2,4)) W "".""" S:'DSV ^(8.5)=" ;NO TEMPLATES" S X=7,DD=0,^(8.6)=" K DIC,DLAYGO,XMB" LDD S E="" F DD=DD:0 S DD=$N(E(DD)) Q:DD<0 S E=E_","_DD Q:$L(E)>200 I E]"" S ^(X)=" F D="_$E(E,2,999)_" D IX",X=X+.1 G LDD:DD>0 S ^(8)=" F D=0:0 S D=$N(^DD(U,$J,D)) Q:D'>0 I '$D(QUIT(D)) S DTO=0,(DDF(1),DDT(0))=D,DMRG=1,DTO(0)=^(D),Z=^(D)_""0)"",D0=^(D,0),@Z=D0,DFR(1)=""^DD(U,$J,D,D0,"",DKP=1 F D0=0:0 S D0=$N(^DD(U,$J,D,D0)) Q:'$D(^(D0,0)) S Z=^(0) D I^DITR W "".""" S ^(9)=" K ^DD(U,$J) Q",^(9.1)=" ;",^(10)="IX W ""."" S DIK=""A"" F %=0:0 S DIK=$N(^DD(D,DIK)) Q:DIK<0 K ^(DIK)" S ^(11)=" S DA(1)=D,DIK=""^DD(""_D_"","" G IXALL^DIK",DRN="T1" D ZSAVE^DIFROM2 S Q=$S('$D(^DIC(9.4,DP,"INIT")):1,^("INIT")?1PA.E:^("INIT"),1:1) K ^UTILITY($J) S ^($J,9)=" L W !"_$S(Q:",*7,""OK, I'M DONE."",!",1:"")_",""NO"_$P("TE THAT FILE",U,DSEC)_" SECURITY-CODE PROTECTION HAS BEEN MADE"" "_$S(Q:"Q",1:"G ^"_Q) G ^DIFROM2 :1:"_DTL_" D @(""^"_DN_"""_$E(R,2,4)) W "".""" S:'DSV ^(8.5)=" ;NO TEMPLATES" S X=7,DD=0,^(8.6)=" K DIC,DLAYGO,XMB" LDD S E="" F DD=DD:0 S DD=$N(E(DD)) Q:DD<0 S E=E_","_DD Q:$L(E)>200 I E]"" S ^(X)=" F D="_$E(E,2,999)_" D IX",X=X+.1 G LDD:DD>0 S ^(8)=" F D=0:0 S D=$N(^DD(U,$J,D)) Q:D'>0 I '$D(QUIT(D)) S DTO=0,(DDF(1),DDT(0))=D,DMRG=1,DTO(0)=^(D),Z=^(D)_""0)"",D0=^(D,0),@Z=D0,DFR(1)=""^DD(U,$J,D,D0,"",DKP=1 F D0=0:0 S D0=$N(^DD(U,$J,D,D0)) Q:'$D(^(D0,0)) S Z=^(0) D I^DITR W "".""" S ^(9)=" K ^DD(U,$J) Q",^(9.1)=" ;",^(10)="IX W ""."" S DIK=""A"" F %=0:0 S DIK=$N(^DD(D,DIK)) Q:DIK<0 K ^(DIK)" S ^(11)=" S DA(1)=D,DIK=""^DD(""_D_"","" G IXALL^DIK",DRN="T1" D ZSAVE^DIFROM2 S Q=$S('$D(^DIC(9.4,DP,"INIT")):1,^("INIT")?1PA.E:^("INIT"),1:1) K ^UTILITY($J) S ^($J,9)=" L W !"_$S(Q:",*7,""OK, I'M DONE."",!",1:"")_",""NO"_$PDIFROM2 ;GFT/SF ; 14JAN84 18:52 ; ****'Z' COMMANDS*** S X="T",%DT="" D ^%DT,D^DIO3 S:$D(^DD("SITE")) Y=Y_" (AT "_^("SITE")_")" S DRN=15.88 S ^UTILITY($J,1)=" G Q:QUIT I $D(^DD(""VERSION"")),^(""VERSION"")'<"_DRN_" G GO:$N(^(""VERSION"","_DRN_"))<0 W !,""BUT I'M OBSOLETE!!"" G Q" S ^(2)=" W !,""FIRST, I'LL FRESHEN UP YOUR FILE MANAGER...."" D N^DINIT",^(2.5)="GO "_$S(DSEC:"W !,""NOTE THAT SECURITY-PROTECTION WILL BE ADDED!"",*7 ",1:"")_"D ^"_DN_"T1" S ^(17)="IXF ;",X=0 F F=0:0 S F=$N(F(F)) Q:F<0 S X=X+1,@("DH=$P("_F(F,0)_"0),U,2)"),^UTILITY($J,17+X)=" ;"_DH_";"_F(F)_";"_($D(DTL(F))>0)_";"_F(F,0)_";"_$S($D(E(F)):E(F),1:"") S ^(8)=" F INIT=1:1:"_X_" S %=$T(IXF+INIT),DIK=$P(%,"";"",5),N=$P(%,"";"",2),D=$P(%,"";"",3)_U_N S:$D(^DIC(+N,0))[0 ^(0)=D I '$D(QUIT(+N)),$P(%,"";"",4)!'$D(@(DIK_""0)"")) S ^(0)=D_U D IXALL^DIK:$N(^(0))>0 W "".""" S DH=" K S QUIT=0 W ""HI! I WAS CREATED ON "_Y_""",! D VERSION^DINIT I VERSION<"_DRN_" W ""BUT I NEED VERSION "_DRN_" OF THE FILE MANAGER!"" G Q" S Q=" W ""TO SET UP FOR YOU THE FOLLOWING FILE"_$E("S",X>1)_":"",! F I=1:1:"_X_" D 1" S ^(10)="1 S X=$T(IXF+I),N=+$P(X,"";"",2),N(N)=$P(X,"";"",3),D=$P(X,"";"",4),S=$P(X,"";"",5),U=""^"" W !?3,N,?13,N(N),$P("" (PARTIAL DEFINITION)"",U,$P(X,"";"",6)),$P("" (INCLUDING DATA)"",I,D)" S ^(11)=" S Z=$S($D(^DIC(N,0))#2:^(0),1:"""") I $L($P(Z,N(N),1)) W *7,!,""***BUT YOU'VE ALREADY GOT '"",$P(Z,""^"",1),""' AS FILE #"",N,""!***"" S QUIT=1 Q" S ^(12)=" S %=$P(S,""("",1),DW=0 S:$D(@%)#2 DW=@% S @%=DW ;ERROR MEANS GLOBAL CAN'T BE SET" S ^(13)=" I $L(Z) W *7,!,""NOTE -- YOU ALREADY HAVE '"",$P(Z,""^"",1),""' FILE"" S QUIT(0)=1" S ^(14)=" I D,@(""$N(""_S_""0))+1"") W "" WITH DATA"",!?9,""WANT MY DATA ADDED IN TO YOURS"" S %=1 D YN^DICN H:%<1 S:%=2 QUIT(N)=1" S ^(15)=" W ! Q" K E,F S ^(16)="Q W *7,!!,""NO UPDATING HAS OCCURRED!""",DRN="T",DL=0,D=-9999 G NAME ; FILE S DL=0,Q="Q Q",S=" ;" ZSAVE S D=0 NAME S DNAME=DN_$E(DRN,$L(DRN)-2,9) X "ZR ZI DNAME_"" ;"",DH,Q F L=4:1 S DL=$N(^UTILITY($J,DL)) ZI:$D(^(DL)) S_^(DL) S D=$L($T(+L))+D I D>1650!'$D(^(DL)) ZS @(DNAME) W !,DNAME,"" HAS BEEN FILED!..."" Q" S DRN=DRN+1 G ZSAVE:$D(^(DL)) K %A,%B,%C,%Z,^UTILITY($J) S DL=0 Q ") I $L($P(Z,N(N),1)) W *7,!,""***BUT YOU'VE ALREADY GOT '"",$P(Z,""^"",1),""' AS FILE #"",N,""!***"" S QUIT=1 Q" S ^(12)=" S %=$P(S,""("",1),DW=0 S:$D(@%)#2 DW=@% S @%=DW ;ERROR MEANS GLOBAL CAN'T BE SET" S ^(13)=" I $L(Z) W *7,!,""NOTE -- YOU ALREADY HAVE '"",$P(Z,""^"",1),""' FILE"" S QUIT(0)=1" S ^(14)=" I D,@(""$N(""_S_""0))+1"") W "" WITH DATA"",!?9,""WANT MY DATA ADDED IN TO YOURS"" S %=1 D YN^DICN H:%<1 S:%=2 QUIT(N)=1" S ^(15)=" W ! Q" K E,F S ^(16)="Q W *7,!!,""NO UPDATING HAS OCCURRED!""",DRN="T",DL=0,D=-9999 G NAME ; FILE S DL=0,Q="Q Q",S=" ;" ZSAVE S D=0 NAMDINIT ;GFT/SF ; 22JAN84 11:53 ;FileMan Version 16.06 K N ; S U="^" D VERSION W !!,X,!!,"SITE NAME: " I $D(^DD("SITE")) W ^("SITE"),"// " E S ^DD("SITE")="" R X I X]"",X'?1AN.ANP Q:X="^" W " ENTER NAME OF INSTALLATION SITE",!! G DINIT I X]"" S ^("SITE")=X W !!,"SITE NUMBER: " W:$D(^DD("SITE",1)) ^(1),"// " R X I X]"" S Y=+X=X S:Y ^DD("SITE",1)=X Q:U[X I 'Y W " ENTER A NUMBER, CORRESPONDING TO YOUR INSTITUTION" G N W !! D WAIT^DICD G GO ; VERSION S X=$P($T(DINIT),";",4),VERSION=+$P(X,"Version ",2) Q ; GO D VERSION S U="^",(^DIBT(0),^DIE(0),^DIPT(0))="TEMPLATE^.4I",^(.01,0)="CAPTIONED^",^("F",1)="S DIC=DCC,DA=D0 D EN^DIQ",^DIPT("B","DIQ",.01)=1 DD F I=1:1 S X=$T(DD+I),Y=$P(X," ",3,99) G ^DINIT0:X?.P S @("^DD(0,"_$E($P(X," ",2),2,99)_")=Y") ;0 ATTRIBUTE^N ;"SB",.1,1 ;.001,0 NUMBER^N^^ ^K:$L(X)>10 X ;.01,0 LABEL^R^^0;1^K:$L(X)>30!(X?1E)!(X["""")!(X["=") X ;.01,1,0 ^.1^1^1 ;.01,1,1,0 DA(2)^B ;.01,1,1,1 S @(DIC_"""B"",X,DA)=""""") ;.01,1,1,2 K @(DIC_"""B"",X,DA)") ;.01,"DEL",1,0 I DA=.01 W *7,"??" ;.01,"DEL","TRB",0 S %=+$P(^DD(DA(1),DA,0),U,2) I %,$D(^DD(%,"TRB")) S DA(0)=DA,DA=% D TRIG^DIDH S DA=DA(0) ;.01,"DEL","T",0 I $N(^DD(DA(1),DA,5,0))>0 W *7,!,"CAN'T DELETE A FIELD THAT HAS A 'TRIGGER' POINTING TO IT!" ;.01,"DEL","ID",0 I $D(^DD(DA(1),0,"ID",DA)) W !,"CAN'T DELETE IDENTIFIER!" ;.1,0 TITLE^F^^.1;E1,999^K:$L(X)>80!(+X=X) X I $D(X),$L(X)<32,@("$D("_DIC_"""B"",X,DA))") K X ;.1,1,0 ^.1^1^1 ;.1,1,1,0 DA(2)^B ;.1,1,1,1 S:$L(X)<31 @(DIC_"""B"",X,DA)=1") ;.1,1,1,2 K:$L(X)<31 @(DIC_"""B"",X,DA)") ;.1,3 (OPTIONAL) FULL FIELD NAME (MUST BE DIFFERENT FROM LABEL) ;.2,0 SPECIFIER^F^^0;2 ;.2,1,0 ^.1^2^2 ;.2,1,1,0 DA(2)^SB^ (SUBFILE USED) ;.2,1,1,1 S:X @(DIC_"""SB"",+X,DA)=""""") ;.2,1,1,2 K:X @(DIC_"""SB"",+X,DA)")  ;.2,1,2,0 DA(2)^RQ^ ;.2,1,2,1 S:X["R" @(DIC_"""RQ"",DA)=""""") ;.2,1,2,2 K:X["R" @(DIC_"""RQ"",DA)") ;.2,1,3,0 ^ ;.2,1,3,1 S %=$P(X,"P",2) S:$A(%)=48!%&$D(^DD(+%,0)) ^(0,"PT",DA(1),DA)="" ;.2,1,3,2 S %=$P(X,"P",2) K:$A(%)=48!% ^DD(+%,0,"PT",DA(1),DA) GGER' POINTING TO IT!" ;.01,"DEL","ID",0 I $D(^DD(DA(1),0,"ID",DA)) W !,"CAN'T DELETE IDENTIFIER!" ;.1,0 TITLE^F^^.1;E1,999^K:$L(X)>80!(+X=X) X I $D(X),$L(X)<32,@("$D("_DIC_"""B"",X,DA))") K X ;.1,1,0 ^.1^1^1 ;.1,1,1,0 DA(2)^B ;.1,1,1,1 S:$L(X)<31 @(DIC_"""B"",X,DA)=1") ;.1,1,1,2 K:$L(X)<31 @(DIC_"""B"",X,DA)") ;.1,3 (OPTIONAL) FULL FIELD NAME (MUST BE DIFFERENT FROM LABEL) ;.2,0 SPECIFIER^F^^0;2 ;.2,1,0 ^.1^2^2 ;.2,1,1,0 DA(2)^SB^ (SUBFILE USED) ;.2,1,1,1 S:X @(DIC_"""SB"",+X,DA)=""""") ;.2,1,1,2 K:X @(DIC_"""SB"",+X,DA)") DINIT0 ; ; 31 OCT 83 6:08 PM DD F I=1:1 S X=$T(DD+I),Y=$P(X," ",3,99) G ^DINIT1:X?.P S @("^DD(0,"_$E($P(X," ",2),2,99)_")=Y") ;.2,9 ^ ;.23,0 LENGTH^CJ3^^ ; ^S @("X=$P("_DCC_"D0,0),U,2)"),X=$P(X,"J",2),X=$S(X:+X,1:"") ;.23,9 ^ ;.24,0 DECIMAL DEFAULT^CJ1^^ ; ^S @("X=$P("_DCC_"D0,0),U,2)"),X=$P($P(X,"J",2),",",2) ;.24,9 ^ ;.25,0 TYPE^CJ9^^ ; ^S @("X=$P("_DCC_"D0,0),U,2)"),X=$S(X["C":"COMPUTED",X["N":"NUMERIC",X["P":"POINTER",X["S":"SET",X["D":"DATE",X["W":"WORD-PROCESSING",1:"FREE TEXT") ;.25,9 ^ ;.26,0 COMPUTE ALGORITHM^FJ30^^9.1;E1,999^K:$L(X)>50 X ;.3,0 POINTER^F^^0;3 ;.3,9 ^ ;.4,0 GLOBAL SUBSCRIPT LOCATION^RF^^0;4^K:X'?1E.E1";"1E.E X I $D(X),@("$D("_DIC_"""GL"",$P(X,"";"",1),$P(X,"";"",2)))") K X ;.4,1,0 ^.1^1^1 ;.4,1,1,0 DA(2)^GL (2 SUBSCRIPTS) ;.4,1,1,1 S:X'?.P @(DIC_"""GL"",$P(X,"";"",1),$P(X,"";"",2),DA)=""""") ;.4,1,1,2 K:X'?.P @(DIC_"""GL"",$P(X,"";"",1),$P(X,"";"",2),DA)") ;.4,9 ^ ;.5,0 INPUT TRANSFORM^CJ44^^ ; ^S @("X=$P("_DCC_"D0,0),U,5,99)") ;.5,9 ^ ;1,0 CROSS-REFERENCE^.1^^1;0 ;2,0 OUTPUT TRANSFORM^F^^2;E1,999;D ^DIM ;3,0 'HELP'-PROMPT^F^^3;E1,999^K:X'?3E.E!($L(X)>200) X ;4,0 XECUTABLE 'HELP'^F^^4;E1,999^D ^DIM ;8,0 READ ACCESS (OPTIONAL)^F^^8;E1,999^I DUZ(0)'="@" F I=1:1:$L(X) I DUZ(0)'[$E(X,I) K X Q ;8,3 ENTER A STRING OF CHARACTERS WHICH ARE IN YOUR OWN ACCESS CODE ('DUZ(0)') ;8.5,0 DELETE ACCESS (OPTIONAL)^F^^8.5;E1,999^I DUZ(0)'="@" F I=1:1:$L(X) I DUZ(0)'[$E(X,I) K X Q ;9,0 WRITE ACCESS (OPTIONAL)^F^^9;E1,999^I DUZ(0)'="@" F I=1:1:$L(X) I DUZ(0)'[$E(X,I) K X Q ;10,0 SOURCE^F^^10;E1,99^K:$L(X)>99 X ;10,3 WHERE THIS DATA ELEMENT COMES FROM (UP TO 99 CHARACTERS) ;11,0 DESTINATION^.2LAP^^11;0 ;12,0 POINTER SCREEN^^^12;E1,250 ;12.1,0 CODE TO SET POINTER SCREEN^^^12.1;E1,250^D ^DIM ;12.2,0 EXPRESSION FOR POINTER SCREEN^^^12.2;E1,250 ;20,0 GROUP^.3LA^^20;0 ;50,0 DATE FIELD LAST EDITED^D^^DT;1^Q ;50,9 ^ ;999,0 TRIGGERED-BY POINTER^.15^^5;0 ;999,9 ^ ;.01,"DEL",.2,0 I DUZ(0)'="@",$P(^DD(DA(1),DA,0),"^",2)["X" W !,*7,"ONLY A PROGRAMMER CAN DELETE THIS FIELD!" " F I=1:1:$L(X) I DUZ(0)'[$E(X,I) K X Q ;8,3 ENTER A STRING OF CHARACTERS WHICH ARE IN YOUR OWN ACCESS CODE ('DUZ(0)') ;8.5,0 DELETE ACCESS (OPTIONAL)^F^^8.5;E1,999^I DUZ(0)'="@" F I=1:1:$L(X) I DUZ(0)'[$E(X,I) K X Q ;9,0 WRITE ACCESS (OPTIONAL)^F^^9;E1,999^I DUZ(0)'="@" F I=1:1:$L(X) I DUZ(0)'[$E(X,I) K X Q ;10,0 SOURCE^F^^10;E1,99^K:$L(X)>99 X ;10,3 WHERE THIS DATA ELEMENT COMES FROM (UP TO 99 CHARACTERS) ;11,0 DESTINATION^.2LAP^^11;0 ;12,0 POINTER SCREEN^^^12;E1,250 ;12.1,0 CODE TO SET POINTER SCREEN^^^12.1;E1,250^D ^DIM ;12.2,0 EXPRESSION FOR POINTEDINIT1 ;GFT/SF ; 18DEC83 9:21 K ^DD(.4),^(.404) I '$D(^("KWIC")) S ^("KWIC")="^AND^THE^THEN^FOR^FROM^OTHER^THAN^WITH^THEIR^SOME^THIS^" I '$D(^(1,.001,0)) S ^(0)="NUMBER^N^^ ^K:X'>.55!$D(^DD(X)) X" DD F I=1:1 S X=$T(DD+I),Y=$P(X," ",3,99) G ^DINIT2:X?.P S @("^DD("_$E($P(X," ",2),2,99)_")=Y") ;.1,0,"NM","CROSS-REFERENCE" ;.1,0 CROSS-REFERENCE^N ;.1,.01,0 INDEX^F^^0;E1,999^Q ;.1,.01,1,0 ^.1^3^3 ;.1,.01,1,1,0 0^IX ;.1,.01,1,1,1 S:$P(X,U,2)]"" @("^DD("_$P(X,"^",1)_",0,""IX"",$P(X,""^"",2),DA(2),DA(1))=""""") ;.1,.01,1,1,2 K:$P(X,U,2)]"" @("^DD("_$P(X,"^",1)_",0,""IX"",$P(X,""^"",2),DA(2),DA(1))") ;.1,.01,1,2,0 DA(2)^IX ;.1,.01,1,2,1 S ^DD(DA(2),"IX",DA(1))="" ;.1,.01,1,2,2 I $N(^DD(DA(2),DA(1),1,0))=DA,$N(^(DA))=-1 K ^DD(DA(2),"IX",DA(1)) ;.1,.01,1,3,0 ^^TRIGGER ;.1,.01,1,3,1 S Y=$P(X,"^",5),X=$P(X,"^",4) I Y F %=1:1 Q:'% I '$D(^DD(X,Y,5,%,0)) S ^(0)=DA(2)_"^"_DA(1)_"^"_DA F %=-1:0 S ^DD(X,"TRB",DA(2),DA(1),DA,Y)="",Y=X Q:'$D(^DD(X,0,"UP")) S X=^("UP"),Y=$N(^DD(X,"SB",Y,0)) ;.1,.01,1,3,2 S Y=$P(X,"^",5),X=$P(X,"^",4) I Y F %=0:0 S %=$N(^DD(X,Y,5,%)) Q:'$D(^(%,0)) I DA(2)_"^"_DA(1)_"^"_DA=^(0) K ^DD(X,Y,5,%) F %=%:0 K ^DD(X,"TRB",DA(2),DA(1),DA,Y) Q:'$D(^DD(X,0,"UP")) S Y=X,X=^("UP"),Y=$N(^DD(X,"SB",Y,0)) ;.1,1,0 SET STATEMENT^F^^1;E1,999^Q ;.1,2,0 KILL STATEMENT^F^^2;E1,999^Q ;.1,"IX",.01 ;.15,0 TRIGGERED-BY ;.15,0,"NM","TRIGGERED-BY" ;.15,.01,0 DD NUMBER^N^^0;1^K:'$D(^DD(X)) X ;.15,2,0 FIELD NUMBER^N^^0;2 ;.15,3,0 CROSS-REFERENCE NUMBER^N^^0;3 ;.4,0 ATTRIBUTE^ ;.4,0,"ID","WRITE" S %=$P(^(0),U,2),%X=$P(^(0),U,5) W:% ?30,"(",$E(%,4,5),"/",%#100,"/",$E(%,2,3),")" W:%X " USER #",%X ;.4,.01,0 NAME^F^^0;1^K:$L(X)<2!($L(X)>30) X ;.4,.01,1,0 ^.1^1^1 ;.4,.01,1,1,1 S @(DIC_"""B"",X,DA)=""""") ;.4,.01,1,1,2 K @(DIC_"""B"",X,DA)") ;.4,.01,3 NAME OF TEMPLATE MUST BE 2-30 CHARACTERS ;.4,2,0 DATE CREATED^D^^0;2^Q ;.4,3,0 READ ACCESS^F^^0;3^I DUZ(0)'="@" F I=1:1:$L(X) I DUZ(0)'[$E(X,I) K X Q ;.4,4,0 FILE^NJ7,0I^^0;4^Q ;.4,5,0 USER #^N^^0;5^Q ;.4,6,0 WRITE ACCESS^F^^0;6^I DUZ(0)'="@" F I=1:1:$L(X) I DUZ(0)'[$E(X,I) K X Q 1;E1,999^Q ;.1,2,0 KILL STATEMENT^F^^2;E1,999^Q ;.1,"IX",.01 ;.15,0 TRIGGERED-BY ;.15,0,"NM","TRIGGERED-BY" ;.15,.01,0 DD NUMBER^N^^0;1^K:'$D(^DD(X)) X ;.15,2,0 FIELD NUMBER^N^^0;2 ;.15,3,0 CROSS-REFERENCE NUMBER^N^^0;3 ;.4,0 ATTRIBUTE^ ;.4,0,"ID","WRITE" S %=$P(^(0),U,2),%X=$P(^(0),U,5) W:% ?30,"(",$E(%,4,5),"/",%#100,"/",$E(%,2,3),")" W:%X " USER #",%X ;.4,.01,0 NAME^F^^0;1^K:$L(X)<2!($L(X)>30) X ;.4,.01,1,0 ^.1^1^1 ;.4,.01,1,1,1 S @(DIC_"""B"",X,DA)=""""") ;.4,.01,1,1,2 K @(DIC_"""B"",X,DA)") ;.4,.01,3 NDINIT2 ;GFT/SF ; 18DEC83 9:35 S %X="^DD(.4," F %Y="^DD(.401,","^DD(.402," D %XY^%RCR DD F I=1:1 S X=$T(DD+I),Y=$P(X," ",3,99) G ^DINIT21:X?.P S @("^DD("_$E($P(X," ",2),2,99)_")=Y") ;.4,704,0 HEADER^CJ60^^ ; ^S X=$S($D(^DIPT(D0,"H")):^("H"),1:"") ;.4,1620,0 PRINT FIELDS^XCmJ50^^ ; ^S DSAVE=$S($D(DC)#2:DC,1:0) F DD=0:0 S DC=DSAVE,Q="""",C=",",DRK=$S($D(^DIPT(D0,0)):$P(^(0),U,4),1:0),DD=$N(^("F",DD)),(D9,X)="" Q:DD'>0 K DC S DC(0)=D0,DY=^(DD),Y=2,DC=2 D Y^DIP22 X ^DD(.4,1620,9.2) ;.4,1620,9.2 F D=2:1 Q:'$D(DC(D)) S X=DC(D) X DICMX ;.401,15,0 SEARCH SPECIFICATIONS^.4011^^O;0 ;.4011,0 FIELD ;.4011,0,"NM","FIELD" ;.4011,.01,0 SEARCH SPECIFICATIONS^W^^0;1 ;.401,1620,0 SORT FIELDS^CmJ50^^ ; ^F D=1:1 S X="" Q:'$D(^DIBT(D0,2,D)) S Y=^(D),X=$J("",D+D-2)_$P(Y,U,3)_$P(Y,U,4)_$P(Y,U,5) X:$D(^(D,"F")) ^DD(.401,1620,9.2) X DICMX ;.401,1620,9.2 S Y=^DIBT(D0,2,D,"F"),%Y=$S('$D(^("T")):"",^("T")="z":"",1:^("T")) S:Y[".9999" Y=$P(Y,".",1)+1 X:Y?1"2"6N.NP ^DD("DD") S %=$F(Y,"z"),X=X_" From '"_$S(%:$E(Y,1,%-3)_$C($A(Y,%-2)+1),1:Y)_"'",Y=%Y X:Y]"" ^DD(.401,1620,9.3) ;.401,1620,9.3 S:Y[".9999" Y=Y\1 X:Y?1"2"6N.NP ^DD("DD") S X=X_" To '"_Y_"'" ;.401,491620,0 PRINT TEMPLATE^F^^DIPT;1^K:'$D(^DIPT("B",X)) X ;.401,491620,4 W !,"IF THIS SORT-TEMPLATE SHOULD ALWAYS BE USED WITH A PARTICULAR",!,"PRINT-TEMPLATE, ENTER THE NAME OF THAT PRINT-TEMPLATE",! ;.402,1804,0 FIELD^.404^^RD;0 ;.404,0 FIELD^ ;.404,0,"NM","FIELD" ;.404,.01,0 FIELD^O^^0;1^Q ;.404,.01,2 S %=^DIE(D0,"RD",D1,0),Y=$S($D(^DD(+%,+$P(%,";",2),0)):$P(^(0),U,1),1:"") S:Y]"" Y=$N(^DD(+%,0,"NM",0))_": "_Y ;.2,0 DESTINATION^ ;.2,0,"NM","DESTINATION" ;.2,.01,0 DESTINATION^P^DIC(.2,^0;1^Q ;.2,.01,3 WHERE THIS DATA GOES (TO WHAT FORM, SYSTEM, ETC.) ;.21,0 DATA DESTINATION ;.21,0,"NM","DATA-DESTINATION" ;.21,.01,0 DATA DESTINATION^F^^0;1^K:$L(X)<2!($L(X)>80) X ;.21,.01,1,0 ^.1^1^1 ;.21,.01,1,1,0 .21^B ;.21,.01,1,1,1 S ^DIC(.2,"B",X,DA)="" ;.21,.01,1,1,2 K ^DIC(.2,"B",X,DA) ;.3,0 GROUP^ ;.3,0,"NM","GROUP" ;.3,.01,0 GROUP^F^^0;1^K:$L(X)>30!(X'?.ANP) X ;.3,.01,3 UP TO 30 CHARACTERS, ALPHANUMERIC ;.3,.01,1,0 ^.1^1^1 ;.3,.01,1,1,0 0^GR ;.3,.01,1,1,1 S ^DD(DA(2),"GR",X,DA(1),DA)="" ;.3,.01,1,1,2 K ^DD(DA(2),"GR",X,DA(1),DA)  ;.404,0,"NM","FIELD" ;.404,.01,0 FIELD^O^^0;1^Q ;.404,.01,2 S %=^DIE(D0,"RD",D1,0),Y=$S($D(^DD(+%,+$P(%,";",2),0)):$P(^(0),U,1),1:"") S:Y]"" Y=$N(^DD(+%,0,"NM",0))_": "_Y ;.2,0 DESTINATION^ ;.2,0,"NM","DESTINATION" ;.2,.01,0 DESTINATION^P^DIC(.2,^0;1^Q ;.2,.01,3 WHERE THIS DATA GOES (TO WHAT FORM, SYSTEM, ETC.) ;.21,0 DATA DESTINATION ;.21,0,"NM","DATA-DESTINATION" ;.21,.01,0 DATA DESTINATION^F^^0;1^K:$L(X)<2!($L(X)>80) DINIT21 ;GFT/SF ; 31DEC83 11:50 DD F I=1:1 S X=$T(DD+I),Y=$P(X," ",3,99) G ^DINIT22:X?.P S @("^DD(""OS"","_$E($P(X," ",2),2,99)_")=Y") ;0 MUMPS OPERATING SYSTEM^.7 ;1,0 M/11^^63^6000^1 ;1,1 B X ;1,8 X ^DD("$O") ;1,18 I $D(^UTILITY("ROU",X)) ;1,"SDP" O @("I:"_DLP) F %=0:0 U I R % Q:$ZA=X&($ZB>Y)!($ZA>X) U IO W:$A(%)'=12 ! W % ;1,"SDPEND" S X=$ZA,Y=$ZB ;1,"ZS" ZR X "F %Y=0:0 S %Y=$N(^UTILITY($J,0,%Y)) Q:'$D(^(%Y)) ZI ^(%Y)" ZS @X ;2,0 DSM^^63^3000^1 ;2,1 B X ;2,8 X ^DD("$O") ;2,"SDP" O @("I:"_DLP) F %=0:0 U I R % Q:$ZA=X&($ZB>Y)!($ZA>X) U IO W:$A(%)'=12 ! W % ;2,"SDPEND" S X=$ZA,Y=$ZB ;2,"ZS" ZR X "F %Y=0:0 S %Y=$N(^UTILITY($J,0,%Y)) Q:'$D(^(%Y)) ZI ^(%Y)" ZS @X ;3,0 VISTA(AOS)^^99^2030 ;3,1 B 'X ;3,8 X ^DD("$O") ;3,18 I $ZD(X) ;3,"SDP" O I F %=0:0 U I R % Q:%'="#$#" U IO W % ;3,"SDPEND" W !,"#$#",! C IO ;4,0 DATA GENERAL^^63^3000 ;4,1 Q ;5,0 TANDEM^^48^3500 ;5,1 B X ;5,8 X ^DD("$O") ;5,"SDP" O I F %=0:0 U I R % Q:%="#$#" U IO W % ;5,"SDPEND" W !,"#$#",! C IO ;5,"ZS" S %Y="TEMP" ZFCREATE %Y:(2:255) O %Y U %Y S %=$D(^UTILITY($J,0,0)) X "F %=0:0 S %=$O(^(%)) Q:%="""" W ^(%),!" C %Y ZRPUT @X:%Y VIEW PURGE:%Y ;6,0 HARRIS^^127^6000 ;6,1 Q ;7,0 M/VX^^63^9999 ;7,1 B X ;7,8 X ^DD("$O") ;7,18 I $D(^UTILITY("ROU",X)) ;7,"SDP" O I F %=0:0 U I R % Q:%="#$#" U IO W % ;7,"SDPEND" W !,"#$#",! C IO ;7,"ZS" ZR X "F %Y=0:0 S %Y=$N(^UTILITY($J,0,%Y)) Q:'$D(^(%Y)) ZI ^(%Y)" ZS @X J,0,%Y)) Q:'$D(^(%Y)) ZI ^(%Y)" ZS @X ;3,0 VISTA(AOS)^^99^2030 ;3,1 B 'X ;3,8 X ^DD("$O") ;3,18 I $ZD(X) ;3,"SDP" O I F %=0:0 U I R % Q:%'="#$#" U IO W % ;3,"SDPEND" W !,"#$#",! C IO ;4,0 DATDINIT22 ;GFT/SF ; 31DEC83 11:47 DD F I=1:1 S X=$T(DD+I),Y=$P(X," ",3,99) G ^DINIT23:X?.P S @("^DD(""OS"","_$E($P(X," ",2),2,99)_")=Y") ;8,0 MICRONETICS^^127^5000^1 ;8,1 B X ;8,"SDP" O @("I:"_DLP) F %=0:0 U I R % Q:$ZA=X&($ZB>Y)!($ZA>X) U IO W:$A(%)'=12 ! W % ;8,"SDPEND" S X=$ZA,Y=$ZB ;8,8 X ^DD("$O") ;8,"ZS" ZR X "F %Y=0:0 S %Y=$N(^UTILITY($J,0,%Y)) Q:'$D(^(%Y)) ZI ^(%Y)" ZS @X ;9,0 DATATREE^^127^3500 ;9,1 B X ;9,"ZS" S %X="" X "F %Y=0:0 S %Y=$N(^UTILITY($J,0,%Y)) Q:'$D(^(%Y)) S %X=%X_$C(10)_^(%Y)" ZS X:$E(%X,2,999999) ;10,0 LMS-1(IBM SERIES 1)^^254^6000 ;10,1 V "BR":X ;11,0 MICROMUMPS (CP/M - UC DAVIS)^^99^3500^1 ;11,1 B X ;11,18 I $ZE(X_".MMP") ;11,"SDP" O I F %=0:0 U I R % Q:%="#$#" U IO W % ;11,"SDPEND" W !,"#$#",! C IO:0 ;11,"ZS" ZR X "F %Y=0:0 S %Y=$N(^UTILITY($J,0,%Y)) Q:%Y<0 ZI ^(%Y)" ZS @X ;12,0 CCSM^^127^6000^1 ;12,1 B X ;12,8 X ^DD("$O") ;12,18 I $T(^@X)]"" ;12,"ZS" S %GLB="^UTILITY($J,0)",%NAM=X D ^%RSAVE ;100,0 OTHER^Q^40^2000 ;100,1 Q B>Y)!($ZA>X) U IO W:$A(%)'=12 ! W % ;8,"SDPEND" S X=$ZA,Y=$ZB ;8,8 X ^DD("$O") ;8,"ZS" ZR X "F %Y=0:0 S %Y=$N(^UTILITY($J,0,%Y)) Q:'$D(^(%Y)) ZI ^(%Y)" ZS @X ;9,0 DATATREE^^127^3500 ;9,1 B X ;9,"ZS" S %X="" X "F %Y=0:0 S %Y=$N(^UTILITY($J,0,%Y)) Q:'$D(^(%Y)) S %X=%X_$C(10)_^(%Y)" ZS X:$E(%X,2,999999) ;10,0 LMS-1(IBM SERIES 1)^^254^6000 ;10,1 V "BR":X ;11,0 MICROMUMPS (CP/M - UC DAVIS)^^99^3500^1 ;11,1 B X ;11,18 I $ZE(X_".MMP") ;11,"SDP" O I F %=0:0 U I R % Q:%="#$#" U IO W % ;11,"SDPEND" W !,"#$#",! C IO:0 ;11,"ZS" ZR X "F %Y=0:0 S %Y=$N(^UTILITY($J,0,%Y)) Q:%Y<0 ZI ^(%Y)" ZS @X ;12,0 CCSM^^127^6000^1 ;12,1 BDINIT23 ; ; 27JAN84 11:50 DD F I=1:1 S X=$T(DD+I),Y=$P(X," ",3,99) G ^DINIT3:X?.P S @("^DD("_$E($P(X," ",2),2,99)_")=Y") ;"$O" S Y="%" F %=0:0 S Y=$O(@Y) Q:Y="" S %=$D(@Y) S:%#2 @(X_"Y)="_Y) I %>9 S %X=Y_"(",%Y=X_"Y," D %XY^%RCR ;.7,0 FIELD ;.7,.01,0 NAME^F^^0;1^Q ;.7,.01,1,0 ^.1^1^1 ;.7,.01,1,1,0 .7^B ;.7,.01,1,1,1 S ^DD("OS","B",X,DA)="" ;.7,.01,1,1,2 K ^DD("OS","B",X,DA) ;.7,1,0 BREAK LOGIC^RF^^1;E1,250^D ^DIM ;.7,2,0 GLOBAL LENGTH (MAX)^RN^^0;3^K:+X'=X!(X<30) ;.7,3,0 ROUTINE SIZE (MAX)^RN^^0;4^K:+X'=X!(X<2048) ;.7,4,0 CLOSING PRINCIPAL DEVICE^S^1:ALLOWED;^0;5^Q ;.7,8,0 SAVE SYMBOL TABLE^F^^8;E1,250^D ^DIM ;.7,1820,0 ROUTINE EXISTENCE TEST^F^^18;E1,250^D ^DIM ;.7,190416,0 WRITE FROM SDP^F^^SDP;E1,250^D ^DIM ;.7,190416.1,0 FIND SDP END^F^^SDPEND;E1,250^D ^DIM ;.7,2619,0 ZSAVE CODE^F^^ZS;E1,250^D ^DIM ;1,0 ATTRIBUTE^N ;1,0,"NM","FILE"  ;1,.01,0 NAME^RF^^0;1^K:$L(X)>45!($L(X)<3) X ;1,.01,1,0 ^.1^1^1 ;1,.01,1,1,0 1^B ;1,.01,1,1,1 S @(DIC_"""B"",$E(X,1,30),DA)=""""") ;1,.01,1,1,2 K @(DIC_"""B"",$E(X,1,30),DA)") ;1,.01,3 NAME MUST BE 3-45 CHARACTERS LONG ;1,.01,"DEL",1,0 I DIC="^DIC(" D K^DIU2 ;1,.01,"DEL",.5,0 I DIC="^DIC(" D POINT^DIDH I $N(^DD(DA,0,"PT",0))+1 ;1,.01,"DEL","TRB",0 I $D(^DD(DA,"TRB")) D TRIG^DIDH ;1,1,0 GLOBAL NAME^CJ14^^ ; ^S X=$S($D(^DIC(D0,0,"GL")):^("GL"),1:"") ;1,4,0 DESCRIPTION^1.001^^%D;0 ;1.001,0 DESCRIPTION ;1.001,.01,0 DESCRIPTION^W^^0;1 ;1,10,0 APPLICATION GROUP^1.005^^%;0 ;1.005,0 APPLICATION GROUP^ ;1.005,0,"NM","APPLICATION-GROUP" ;1.005,.01,0 APPLICATION GROUP^MF^^0;1^K:X'?2U X ;1.005,.01,3 A 2-LETTER 'NAMESPACE' INDICATING A PACKAGE ACCESSING THIS FILE ;1.005,.01,1,0 ^.1^2^2 ;1.005,.01,1,1,0 1.005^B ;1.005,.01,1,1,1 S ^DIC(DA(1),"%","B",X,DA)="" ;1.005,.01,1,1,2 K ^DIC(DA(1),"%","B",X,DA) ;1.005,.01,1,2,0 1^AC ;1.005,.01,1,2,1 S ^DIC("AC",X,DA(1),DA)="" ;1.005,.01,1,2,2 K ^DIC("AC",X,DA(1),DA) ;1.005,1,0 PACKAGE NAME^CJ30^^ ; ^S X=$S($D(^DIC(9.4,+$N(^DIC(9.4,"C",X,0)),0)):$P(^(0),U,1),1:"") ;1.01,0 ATTRIBUTE ;1.01,0,"NM","OPTION" ;1.01,.001,0 NUMBER^N^^ ^K:X\1'=X X ;1.01,.01,0 NAME^RF^^0;1^K:$L(X)>70 X ;1.01,.01,1,0 ^.1 ;1.01,.01,1,1,0 1.01^B ;1.01,.01,1,1,1 S @(DIC_"""B"",$E(X,1,30),DA)=""""") ;1.01,.01,1,1,2 K @(DIC_"""B"",$E(X,1,30),DA)") ^^0;1 ;1,10,0 APPLICATION GROUP^1.005^^%;0 ;1.005,0 APPLICATION GROUP^ ;1.005,0,"NM","APPLICATION-GROUP" ;1.005,.01,0 APPLICATION GROUP^MF^^0;1^K:X'?2U X ;1.005,.01,3 A 2-LETTER 'NAMESPACE' INDICATING A PACKAGE ACCESSING THIS FILE ;1.005,.01,1,0 ^.1^2^2 ;1.005,.01,1,1,0 1.005^B ;1.005,.01,1,1,1 S ^DIC(DA(1),"%"DINIT3 ;GFT/SF ; 31DEC83 11:52 DD F I=1:1 S X=$T(DD+I),Y=$P(X," ",3,99) G D:X?.P S @("^DD(.5,"_$E($P(X," ",2),2,99)_")=Y") ;0 ATTRIBUTE^ ;0,"NM","FUNCTION" ;.01,0 NAME^RF^^0;1^K:$L(X)<2!($L(X)>30)!(X'?1U.ANP)!(X["$") X ;.01,1,0 ^.1^1^1 ;.01,1,1,0 .5^B ;.01,1,1,1 S @(DIC_"""B"",X,DA)=""""") ;.01,1,1,2 K @(DIC_"""B"",X,DA)") ;.01,3 FUNCTION NAME MUST BE 2-30 CHARS LONG, BEGINNING WITH ALPHA ;.01,"DEL",1,0 I DA<100 ;.02,0 MUMPS CODE^FR^^1;E1,255^D ^DIM W:$D(X) " ..OK" ;.02,3 ENTER MUMPS CODE THAT SETS A VALUE INTO 'X'. ;.02,4 W !,"FOR A 1-ARGUMENT FUNCTION, USE 'X' AS ARGUMENT",!,"FOR A 2-ARGUMENT FUNCTION, USE 'X1' AND 'X'",!,"AVOID 'FOR'S, 'IF'S, AND SINGLE-CHARACTER SCRATCH VARIABLES." ;1,0 EXPLANATION^F^^9;E1,80^K:$L(X)>80 X ;2,0 DATE-VALUED^S^D:YES;X:NO;O:OPTIONAL (DEPENDS ON VALUE OF ARGUMENT);^2;1^Q ;9,0 NUMBER OF ARGUMENTS^N^^3;1^K:X\1'=X!(X>8) X ;10,0 WORD-PROCESSING^S^W:MEANINGFUL ONLY FOR W-P;^10;1 ; D S ^DIC(0)="FILE^1",^(.2,0)="DESTINATION^.21^",^(0,"GL")="^DIC(.2,",^DIC(1,0)="FILE",^(0,"GL")="^DIC(" D A S ^DIC(.5,0)="FUNCTION^.5I",^(0,"GL")="^DD(""FUNC"",",(^("LAYGO"),^("WR"))="@",^("DD")=U S D=0 F I="^DIPT(","^DIBT(","^DIE(" S X=$P("PRINT^SORT^INPUT",U,D+1)_" TEMPLATE",Y=D/1000+.4,^DD(Y,.01,1,1,0)=Y_"^B",@(I_"0)=X_U_Y_""I"""),^DIC(Y,0)=X,^(0,"GL")=I,D=D+1 D A K ^("LAYGO") S ^DIC("B",X,Y)="" S ^DD("DD")="S Y=$S($E(Y,4,5):$P(""JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC"",""^"",+$E(Y,4,5))_"" "",1:"""")_$S($E(Y,6,7):+$E(Y,6,7)_"","",1:"""")_($E(Y,1,3)+1700)_$P(""@""_$E(Y_0,9,10)_"":""_$E(Y_""000"",11,12),U,Y[""."")" F I=.1,0 D XX,XX F I=.1:.1:.5,.7,.15,.401,.4011,.402,.404,1,.21,1.005,1.01 D XX F DIK="^DIC(","^DIBT(","^DIPT(","^DIE(","^DD(""OS"",","^DIC(.2," D X S ^DD("FUNC",0)="COMPUTED-FIELD FUNCTION^.5^" F I=1:1:5 S ^DD("FUNC",I+94,0)=$P("NEXT^PREVIOUS^TOTAL^COUNT^LAST",U,I)  I $D(^DD("FUNC",7,1)),$D(^DD("VERSION")),^("VERSION")>15.4 E S ^DD("FUNC",7,1)="C X S X=""""" G ^DINIT4 ; XX S DA(1)=I,DIK="^DD("_I_"," X W ".." G IXALL^DIK ; A S (^("RD"),^("LAYGO"),^("WR"),^("DD"))=U "^B",@(I_"0)=X_U_Y_""I"""),^DIC(Y,0)=X,^(0,"GL")=I,D=D+1 D A K ^("LAYGO") S ^DIC("B",X,Y)="" S ^DD("DD")="S Y=$S($E(Y,4,5):$P(""JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC"",""^"",+$E(Y,4,5))_"" "",1:"""")_$S($E(Y,6,7):+$E(Y,6,7)_"","",1:"""")_($E(Y,1,3)+1700)_$P(""@""_$E(Y_0,9,10)_"":""_$E(Y_""000"",11,12),U,Y[""."")" F I=.1,0 D XX,XX F I=.1:.1:.5,.7,.15,.401,.4011,.402,.404,1,.21,1.005,1.01 D XX F DIK="^DIC(","^DIBT(","^DIPT(","^DIE(","^DD(""OS"",","^DIC(.2," D X S ^DD("FUNC",0)="COMPUTED-FIELD FUNCTION^.5^" F I=1:1:5 S ^DD("FUNC",I+94,0)=$P("NEXT^PREVIOUS^TOTAL^COUNT^LAST",U,I) DINIT4 ;GFT/SF ; 27 OCT 83 7:47 PM DD F I=1:1 S X=$E($T(DD+I),3,999) G ^DINIT41:X?.P S ^DD("FUNC",I,0)=$P(X,";",1),Y=1 F DU=1,2,3,9,10 S Y=Y+1 I $P(X,";",Y)]"" S ^(DU)=$P(X,";",Y) ;SQUAREROOT;D SQR^DIXC S X=$S(X'>0:"",1:Y);;; ;TIME;S X=$E($P(X,".",2)_"0000",1,4),%=X>1159 S:X>1259 X=X-1200 S X=X\100_":"_$E(X#100+100,2,3)_" "_$E("AP",%+1)_"M";;; ;MONTH;S X=$E(X,1,5)_0_0 S:'X X="";D^D;; ;YEAR;S X=$E(X,1,3)_"0000" S:'X X="";D^D;; ;DATE;S X=$P(X,".",1);D^D;; ;DAYOFWEEK;D DW^%DTC;^D;; ;CLOSE ;ABS;S:X<0 X=-X;;; ;INTERNAL;S X=X;;; ;MAX;S:X1>X X=X1;O;2;MAXIMUM OF 2 VALUES ;MIN;S:X1($S($D(IOSL):IOSL,1:24)-$Y)&$D(^UTILITY($J,1))&'$D(^("W")) ^(1) S:'$D(DIWF) DIWF="" S DIWF="B"_X_$P(DIWF,"B",1)_$P(DIWF,"B",2),X="";;;START NEW OUTPUT PAGE IF LESS THAN (ARG) LINES LEFT;W ;BREAKABLE;;;;OUTPUT DEVICE CAN BE INTERRUPTED IF ARGUMENT IS NON-ZERO ;NUMMONTH;S X=+$E(X,4,5);^D;;MONTH NUMBER (0-12) FOR A DATE ;NUMDAY;S X=+$E(X,6,7);^D;;DAY NUMBER (0-31) FOR A DATE ;NUMYEAR;S:X X=$E(X,2,3);^D;;YEAR NUMBER (00-99) FOR A DATE ;NUMDATE;S:X X=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3);^D;;DATE IN 'NN/NN/NN' FORMAT ;REPLACE;X "F %=0:0 Q:X2'[X1!'$L(X1) S X2=$P(X2,X1,1)_X_$P(X2,X1,2,999)" S X=X2;;3;THE 1ST ARGUMENT, WITH ALL OCCURRENCES OF THE 2ND ARGUMENT REPLACED BY THE 3RD :'$D(IOST) Q:$A(IOST)-80 S Y=$L(X)<83,%="" X "F Y=1:1:$L(X) "_$S(Y:"S %=$C(8)_%",1:"W $E(X,Y),$C(8)")_"_""_""" S X=$S(%]"":X_%,1:%);;;UNDERLINE (ARG) IF OUTPUTTING TO A PRINTER DEVICE;W ;PAGEFEED;X:X>($S($D(IOSL):IOSL,1:24)-$Y)&$D(^UTILITY($J,1))&'$D(^("W")) ^(1) S:'$D(DIWF) DIWF="" S DIWF="B"_X_$P(DIWF,"B",1)_$P(DIWF,"B",2),X="";;;START NEW OUTPUT PAGE IF LESS THAN (ARG) LINES LEFT;W ;BREAKABLE;;;;OUTPUT DEVICE CAN BE INTERRUPTED IF ARGUMENT IS NON-ZERO ;NUMMONTH;S X=+$E(X,4,5);^D;;MONTH NUMBER (0-12) FOR A DATE ;NUMDAY;S X=+$E(X,6,7);^D;;DAY NUMBER (0-31) FOR A DATE ;NUMYEAR;S:X X=$E(X,2,3);^D;;YEAR NUMBER (00-99) FOR A DATE ;NUMDATE;S:X X=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3);^D;;DATE IN 'NN/NN/NN' FORMAT ;REPLACE;X "F %=0:0 Q:X2'[X1!'$L(X1) S X2=$P(X2,X1,1)_X_$P(X2,X1,2,999)" S X=X2;;3;THE 1ST ARGUMENT, WITH ALL OCDINIT41 ;GFT/SF ; 02DEC83 15:52 DD F I=1:1 S X=$E($T(DD+I),3,999) G ^DINIT5:X?.P S ^DD("FUNC",I+23,0)=$P(X,";",1),Y=1 F DU=1,2,3,9,10 S Y=Y+1 I $P(X,";",Y)]"" S ^(DU)=$P(X,";",Y) ;NOW;S %=$P($H,",",2),X=DT_(%\60#60/100+(%\3600)+(%#60/10000)/100);D;0;CURRENT DATE/TIME ;TODAY;S X=DT;D;0;CURRENT DATE ;PAGE;S X=$S($D(DC)#2:DC,1:"");;0;PAGE NUMBER (OF OUTPUT) ;SETTAB;S DIWT=X,X="" F %=1:1 S Y="X"_% Q:'$D(@Y) S DIWT=@Y_","_DIWT;;VARIABLE;SET TAB STOPS;W ;RIGHT-JUSTIFY;S X="" S:'$D(DIWF) DIWF="" S:DIWF'["R" DIWF=DIWF_"R";;0;;W ;DOUBLE-SPACE;S X="" S:'$D(DIWF) DIWF="" S:DIWF'["D" DIWF=DIWF_"D";;0;;W ;SINGLE-SPACE;S:'$D(DIWF) DIWF="" S X="",DIWF=$P(DIWF,"D",1)_$P(DIWF,"D",2);;0;;W ;BLANK;X "F I=1:1:X "_$S($D(^UTILITY($J,"W")):"S X="" |TAB|"" D ^DIWP",1:"W !") S X="";;;SKIP (ARG) NUMBER OF LINES;W ;MONTHNAME;S X=$P("JANUARY^FEBRUARY^MARCH^APRIL^MAY^JUNE^JULY^AUGUST^SEPTEMBER^OCTOBER^NOVEMBER^DECEMBER","^",+X);;;TURNS "1" INTO "JANUARY", "2" INTO "FEBRUARY", ETC. ;SETPAGE;S DC=X,X="";;;PAGE NUMBER ON NEXT PAGE WILL BE (ARG)+1;W ;INDENT;S:'$D(DIWF) DIWF="" S %Y=1,%=$F(DIWF,"I") X:% "F %Y=%:1 Q:$E(DIWF,%Y)'?1N" S DIWF=$E(DIWF,1,%-2)_$E(DIWF,%Y,999)_"I"_(X\1),X="";;;INDENT FOLLOWING TEXT (ARG) SPACES;W ;SITENUMBER;S X=^DD("SITE",1);;0;NUMBER IDENTIFYING YOUR SITE (FROM INITIALIZATION) ;WIDTH;S:'$D(DIWF) DIWF="" S %Y=1,%=$F(DIWF,"C") X:% "F %Y=%:1 Q:$E(DIWF,%Y)'?1N" S DIWF=$E(DIWF,1,%-2)_$E(DIWF,%Y,999)_"C"_(X\1),X="";;;DISPLAY FOLLOWING TEXT (ARG) COLUMNS ACROSS;W ;PAGESTART;S:'$D(DIWF) DIWF="" S %Y=1,%=$F(DIWF,"T") X:% "F %Y=%:1 Q:$E(DIWF,%Y)'?1N" S DIWF=$E(DIWF,1,%-2)_$E(DIWF,%Y,999)_"T"_(X\1),X="";;;START NEW OUTPUT TEXT ON LINE (ARG) OF PAGE;W E;S X=$P("JANUARY^FEBRUARY^MARCH^APRIL^MAY^JUNE^JULY^AUGUST^SEPTEMBER^OCTOBER^NOVEMBER^DECEMBER","^",+X);;;TURNS "1" INTO "JANUADINIT5 ;GFT/SF ; 28 OCT 83 6:37 PM K ^DOPT("DICATT") S ^DOPT("DICATT",0)="DATA TYPE^1" F I=1:1:7 S ^DOPT("DICATT",I,0)=$P("DATE/TIME^NUMERIC^SET OF CODES^FREE TEXT^WORD-PROCESSING^COMPUTED^POINTER TO A FILE",U,I)_U K ^DOPT("DII"),^("DLA"),^("DIX"),^("DIS"),^("DIU") S ^("DIS",0)="CONDITION^1" F I=1:1:6 S ^DOPT("DIS",I,0)=$P("NULL^^1;CONTAINS^^1;MATCHES^^1;LESS THAN^<^;EQUALS^=^1;GREATER THAN^>^",";",I) F DIK="^DOPT(""DIS"",","^DOPT(""DICATT"",","^DD(""FUNC""," W "." D IXALL^DIK S X="T" D ^%DT S DT=Y,DUZ=0,DUZ(0)="" I '$D(^DD("VERSION")) D FIX K ^DISV G V I ^("VERSION")<14.3 D FIX2 G V I ^("VERSION")<14.7 D FIX3 G V I ^("VERSION")<16 D FIX4 V G ^DINIT6 ; FIX ; S U="^",DH="DIC(" F D=0:1 Q:$N(^DIBT(D))'>0 F DUZ=0:0 S DUZ=$N(^DISV(DUZ)) Q:DUZ'?.N F I=0:0 S I=$N(^DISV(DUZ,I)) Q:I'>0 I $N(^(I,0))>0 D PUT S DIK="^DIBT(" D IXALL^DIK G FIX2 ; PUT S X=^(0),Y=U_$P(X,U,2) I Y]U,@("$D("_Y_"0))") S DIC=+$P(^(0),U,2) I $D(^DIC(DIC,0,"GL")),^("GL")=Y G GOT Q GOT S D=D+1,^DIBT(D,0)=$P(X,U,1)_U_$P(X,U,3)_U_U_+DIC_U_DUZ F X=0:0 S X=$N(^DISV(DUZ,I,X)) Q:X'>0 S ^DIBT(D,1,X)="" S Y="" F X=0:0 S Y=$N(^DISV(DUZ,I,0,Y)) Q:Y<0 S ^DIBT(D,"DIS",Y)=^(Y) Q ; FIX2 F I=1:0 S I=$N(^DIC(I)) Q:I'>0 I $D(^(I,0,"GL")),@("$D("_^("GL")_"0))"),$P(^(0),U,2)["N",'$D(^DD(I,.001)) S ^(.001,0)="NUMBER^N^^ ^K:$L(X)>9 X I $D(X) K:+X'=X!(X'>0) X",^DD(I,"B","NUMBER",.001)="" F I=0:0 S I=$N(^DD(I)) Q:I'>0 F J=0:0 S J=$N(^DD(I,J)) Q:J'>0 S X=$P(^(J,0),U,2),F=$F(X,"P") I 'X,F,@("$D(^"_$P(^(0),U,3)_"0))") S P=+$P(^(0),U,2),^(0)=$P(^DD(I,J,0),U,1)_U_$E(X,1,F-1)_P_$E(X,F,99)_U_$P(^(0),U,3,99) ; FIX3 F I=.9:0 S I=$N(^DIPT(I)) Q:I'>0 I $D(^(I,0)) S X=$P(^(0),U,3) I $P(^(0),U,6)="" S ^(0)=$P(^(0)_"^^^^",U,1,5)_U_X F DD=1:0 S DD=$N(^DD(DD)) Q:DD'>0 F %=0:0 S %=$N(^DD(DD,"SB",%)) Q:%<0 S ^DD(%,0,"UP")=DD ; FIX4 F F=1:0 S F=$N(^DD(F)) Q:F'>0 I $D(^(F,"GR")) K ^("GR") W ".." S DIK="^DD("_F_",",DA(1)=F D IXALL^DIK (D,0)=$P(X,U,1)_U_$P(X,U,3)_U_U_+DIC_U_DUZ F X=0:0 S X=$N(^DISV(DUZ,I,X)) Q:X'>0 S ^DIBT(D,1,X)="" S Y="" F X=0:0 S Y=$N(^DISV(DUZ,I,0,Y)) Q:Y<0 S ^DIBT(D,"DIS",Y)=^(Y) Q ; FIX2 F I=1:0 S I=$N(^DIC(I)) Q:I'>0 I $D(^(I,0,"GL")),@("$D("_^("GL")_"0))"),$P(^(0),U,2)["N",'$D(^DD(I,.001)) S ^(.001,0)="NUMBER^N^^ ^K:$L(X)>9 X I $D(X) K:+X'=X!(X'>0) X",^DD(I,"B","NUMBER",.001)="" F I=0:0 S I=$N(^DD(I)) Q:I'>0 F J=0:0 S J=$N(^DD(I,J)) Q:J'>0 S X=$P(^(J,0),U,2),F=$F(X,"P") I 'X,F,@("$D(^"_$P(^(0),U,3)_"0))") S P=+$P(^(0),U,2),^(0)=$P(^DD(I,J,0),U,1)_U_$E(X,1,F-1)_P_$E(X,F,99)_U_$P(^(0),U,3,99) ; FIX3 F I=.9:0 S I=$N(^DIPT(I)) Q:I'>0 I $D(^(I,0)) S X=$P(^(0),U,3) I $P(^(0),U,6)="" S ^(0)=$P(^(0)_"^^^^",U,1,5)_U_X F DD=1:0 S DD=$N(^DD(DD)) Q:DD'>0 F %=0:0 S %=$N(^DD(DD,"SB",%)) Q:%<0 S ^DD(%,0,"UP")=DD ; FIXDINIT6 ;GFT/SF ; 01OCT83 19:23 W !,*7 S DIC="^DD(""OS"",",DIC(0)="AQE",DIC("A")="TYPE OF MUMPS SYSTEM YOU ARE USING: ",^DD("VERSION")=VERSION S:$D(^("OS"))#2 DIC("B")=^("OS") D ^DIC K DIC S Y=$S(Y>0:+Y,1:100),^DD("OS")=Y,X=^("OS",Y,0),Y=^(1) I '$D(^DD("SUB")) S ^("SUB")=$P(X,U,3) I '$D(^("ROU")) S ^("ROU")=$P(X,U,4) I '$D(^("FUNC",18,1)) S ^(1)=Y E W !,"INITIALIZATION COMPLETED!" 0) X",^DD(I,"B","NUMBER",.001)="" F I=0:0 S I=$N(^DD(I)) Q:I'>0 F J=0:0 S J=$N(^DD(I,J)) Q:J'>0 S X=$P(^(J,0),U,2),F=$F(X,"P") I 'X,F,@("$D(^"_$P(^(0),U,3)_"0))") S P=+$P(^(0),U,2),^(0)=$P(^DD(I,J,0),U,1)_U_$E(X,1,F-1)_P_$E(X,F,99)_U_$P(^(0),U,3,99) ; FIX3 F I=.9:0 S I=$N(^DIPT(I)) Q:I'>0 I $D(^(I,0)) S X=$P(^(0),U,3) I $P(^(0),U,6)="" S ^(0)=$P(^(0)_"^^^^",U,1,5)_U_X F DD=1:0 S DD=$N(^DD(DD)) Q:DD'>0 F %=0:0 S %=$N(^DD(DD,"SB",%)) Q:%<0 S ^DD(%,0,"UP")=DD ; FIXDINTEG ;GFT/SF ; 27JAN84 14:02 D CC F I=1:1 S X=$T(ROU+I),T=$P(X," ",1),U=$P(X,";",2) Q:X="" W !,T X "ZL @T F Y=1:1:99 S L=$T(+Y),LN=$L(L) X CC S:'LN Y=99" W:U-T *7," ROUTINE IS OFF BY ",U-T," BIT",$E("S",U'?.P1"1") Q CC K S CC="F C=1:1:LN S T=$A(L,C)+T" Q ROU ; DI ;4836 DIA ;120817 DIA1 ;111115 DIA2 ;52920 DIA3 ;45718 DIB ;88455 DIBT ;33403 DIC ;110609 DIC1 ;99682 DICATT ;126416 DICATT0 ;103421 DICATT1 ;113674 DICATT2 ;64525 DICATT22 ;80048 DICATT3 ;116056 DICATT4 ;49504 DICATT5 ;110383 DICATT6 ;83820 DICD ;110780 DICE ;93468 DICE0 ;101278 DICE1 ;76128 DICE2 ;125571 DICE3 ;72147 DICE4 ;116764 DICE7 ;103001 DICM ;129107 DICM1 ;106596 DICN ;108286 DICN1 ;81543 DICOMP ;111968 DICOMP0 ;118869 DICOMP1 ;118430 DICOMPX ;101572 DICOMPY ;116788 DICOMPZ ;89662 DICQ ;115557 DICR ;43017 DICRW ;78712 DID ;114681 DID1 ;117899 DID2 ;49100 DIDH ;121661 DIDT ;105020 DIDTC ;111111 DIDX ;58230 DIE ;108522 DIE0 ;71974 DIE1 ;110560 DIE2 ;114166 DIE9 ;111843 DIED ;109551 DIEZ ;93125 DIEZ0 ;108987 DIEZ1 ;104346 DIEZ2 ;100617 DIFROM ;105356 DIFROM0 ;129293 DIFROM1 ;114543 DIFROM2 ;123087 DIG ;117039 DIH ;105485 DII ;108668 DIIS ;15292 DIK ;57918 DIK1 ;75457 DIL ;113503 DIL0 ;122501 DIL1 ;108814 DIL2 ;112321 DILL ;89979 DIM ;64943 DIM1 ;90475 DIM2 ;104306 DIM3 ;106725 DIM4 ;105503 DINIT ;112666 DINIT0 ;119314 DINIT1 ;115834 DINIT2 ;125281 DINIT21 ;77393 DINIT22 ;54652 DINIT23 ;126830 DINIT3 ;119632 DINIT4 ;113543 DINIT41 ;102449 DINIT5 ;111781 DINIT6 ;22387 DIO ;54311 DIO0 ;96867 DIO1 ;109463 DIO2 ;40250 DIO3 ;104187 DIO4 ;55551 DIOS ;106715 DIP ;124173 DIP0 ;106040 DIP1 ;115424 DIP2 ;109733 DIP22 ;65632 DIP3 ;118769 DIP4 ;50837 DIP5 ;46323 DIQ ;128204 DIQQ ;124973 DIQQQ ;43889 DIRCR ;60462 DIS ;128012 DIS0 ;125754 DIS1 ;127478 DIT ;118818 DIT0 ;32447 DIT1 ;81278 DIT2 ;36673 DITP ;91017 DITR ;132982 DITR1 ;27441 DIU ;115859 DIU1 ;110520 DIU2 ;105443 DIU3 ;28253 DIV ;41734 DIVR ;111316 DIWE ;109393 DIWE1 ;129595 DIWE2 ;110067 DIWE3 ;112621 DIWE4 ;106267 DIWE5 ;94613 DIWP ;105967 DIWW ;52371 DIX ;63820 DIXC ;112039 106725 DIM4 ;105503 DINIT ;112666 DINIT0 ;119314 DINIT1 ;115834 DINIT2 ;125281 DINIT21 ;77393 DINIT22 ;54652 DINIT23 ;126830 DINIT3 ;119632 DINIT4 ;113543 DINIT41 ;102449 DINIT5 ;111781 DINIT6 ;22387 DIO ;54311 DIO0 ;96867 DIO1 ;109463 DIO2 ;40250 DIO3 ;104187 DIO4 ;55551 DIOS ;106715 DIP ;124173 DIP0 ;106040 DIP1 ;115424 DIP2 ;109733 DIP22 ;65632 DIP3 ;118769 DIP4 ;50837 DIP5 ;46323 DIQ ;128204 DIQQ ;124973 DIQQDIRCR ;**DELETE THIS LINE AND SAVE AS '%RCR'*** ; 12 NOV 83 2:52 PM %RCR ;GFT/SF ; STORLIST D INIT O S %D=$N(%RCR(%D)) G CALL:%D<0 I $D(@%D)#2 S @(%E_")="_%D) G O:$D(@%D)=1 S %X=%D_"(" D %XY G O ; CALL S %E=%RCR K %RCR,%X,%Y D @%E S %E="^UTILITY(""%RCR"",$J,"_^UTILITY("%RCR",$J)_",%D",^($J)=^($J)-1,%D=0,%X=%E_"," G S @("%D=$N("_%E_"))") I %D<0 K %D,%E,%X,%Y,^($J,^UTILITY("%RCR",$J)+1) Q I $D(^(%D))#2 S @%D=^(%D) G G:$D(^(%D))=1 S %Y=%D_"(" D %XY G G ; %XY ; S %Z=1,%A="",%C(0)=0 S S %B=-1 N S @("%B=$N("_%X_%A_"%B))"),%C(%Z)=%C(%Z-1) I %B["," F %C=0:0 S %C=$F(%B,",",%C) Q:'%C S %C(%Z)=%C(%Z)+1 I %B=-1 G Q:%Z=1 S %Z=%Z-1,@("%B="_$P(%A,",",%Z+%C(%Z-1),%Z+%C(%Z))),%A=$P(%A,",",1,%Z-1+%C(%Z-1))_$E(",",%Z>1) G N I @("$D("_%X_%A_"%B))#10=1") S @(%Y_%A_"%B)="_%X_%A_"%B)") I @("$D("_%X_%A_"%B))<9") G N G DOWN:+%B=%B F %C=0:0 S %C=$F(%B,"""",%C) Q:'%C S %B=$E(%B,1,%C-1)_""""_$E(%B,%C,999),%C=%C+1 S %B=""""_%B_"""" DOWN S %A=%A_%B_",",%Z=%Z+1 G S ; Q K %A,%B,%C,%Z Q ; INIT I $D(^UTILITY("%RCR",$J))[0 S ^UTILITY("%RCR",$J)=0 S ^($J)=^($J)+1,%D="%Z",%E="^UTILITY(""%RCR"",$J,"_^($J)_",%D",%Y=%E_"," K ^($J,^($J))  S @("%D=$N("_%E_"))") I %D<0 K %D,%E,%X,%Y,^($J,^UTILITY("%RCR",$J)+1) Q I $D(^(%D))#2 S @%D=^(%D) G G:$D(^(%D))=1 S %Y=%D_"(" D %XY G G ; %XY ; S %Z=1,%A="",%C(0)=0 S S %B=-1 N S @("%B=$N("_%X_%A_"%B))"),%C(%Z)=%C(%Z-1) I %B["," F %C=0:0 S %C=$F(%B,",",%C) Q:'%C S %C(%Z)=%C(%Z)+1 I %B=-1 G Q:%Z=1 S %Z=%Z-1,@("%B="_$P(%A,",",%Z+%C(%Z-1),%Z+%C(%Z))),%A=$P(%A,",",1,%Z-1+%C(%Z-1))_$E(",",%Z>1) G N I @("$D("_%X_%A_"%B))#10=1") S @(%Y_%A_"%B)="_%X_%A_"%B)") I @("$D("_%X_%A_"%B))<9") G N G DOWN:+%B=%B F %C=0:0 S %C=$F(%B,"""",%C) Q:'%C VOLUME 006 DESCRIPTION: MICRO MUMPS VERSION 4.02 - THREE OF THREE DISKS NUMBER SIZE NAME COMMENTS 006.1 2K -EBMMUG .006 DISK NAME & CONTENTS OF EBMMUG.006 (JUL 5,'84) 006.2 4K DIDT .MMP MICRO MUMPS VERSION 4.02 - GLOBALS 006.3 4K DIDTC .MMP " " " " " 006.4 4K DIFROM .MMP " " " " " 006.5 4K DIFROM0 .MMP " " " " " 006.6 4K DIFROM1 .MMP " " " " " 006.7 4K DIFROM2 .MMP " " " " " 006.8 4K DINIT .MMP " " " " " 006.9 4K DINIT0 .MMP " " " " " 006.10 4K DINIT1 .MMP " " " " " 006.11 4K DINIT2 .MMP " " " " " 006.12 2K DINIT21 .MMP " " " " " 006.13 2K DINIT22 .MMP " " " " " 006.14 4K DINIT23 .MMP " " " " " 006.15 4K DINIT3 .MMP " " " " " 006.16 4K DINIT4 .MMP " " " " " 006.17 2K DINIT41 .MMP " " " " " 006.18 4K DINIT5 .MMP " " " " " 006.19 2K DINIT6 .MMP " " " " " 006.20 4K DINTEG .MMP " " " " " 006.21 2K DIRCR .MMP " " " " " 006.22 2K EBMDIR06.TXT DIRECTORY OF THIS DISK 006.23 200K GLOBALS .DAT MICRO MUMPS VERSION 4.02 - GLOBALS DATA M "I *K  )*= ^#V"O I G  *G )*= N#F*O ? J*G #"G (*I )*= ^#V*O DM? m*I +"I JI G  *G )*= ^#V"Q *I )*= *G )*= N#Fq#p*I )*= *Q s#r*G #"G *I +"I K I  G M   !M G  :S <2S O!T *G s#r*S &l ) *M s#r*I "M ^I K  X:S <2S O!T *K s#r*S &l ) *I s#r*G "K û!" "    #* #" )*= * #" )*= N#Fq#p   * )*= * ) *= ^#VN#F? H * #" )*= ^#V";  *; ^#V" * )*= ^#V"; *;  ͪ  *; q#pÝn* " ! p+q* )*= ^#V"; ! 6> ! i* &*; >OK : <2 E:/ *; ^#V*% DMf KK : *; Nf E*; ~ڻWK þE *; ~SK E = ! 6:! '= :/ = : = !: = : <2 * " !" >! .  * *&͵ "( * *&͵ > j*( #"( *DM*( V"( !" (   K!" }2 : <2 O:* * * "    >! = * DM** +" *( * " Ø* #" *& VOLUME 006 DESCRIPTION: MICRO MUMPS VERSION 4.02 - THREE OF THREE DISKS NUMBER SIZE NAME COMMENTS 006.1 2K -EBMMUG .006 DISK NAME & CONTENTS OF VOLUME 006 (JUL 5,'84) 006.2 4K DIDT .MMP MICRO MUMPS VERSION 4.02 - GLOBALS 006.3 4K DIDTC .MMP " " " " " 006.4 4K DIFROM .MMP " " " " " 006.5 4K DIFROM0 .MMP " " " " " 006.6 4K DIFROM1 .MMP " " " " " 006.7 4K DIFROM2 .MMP " " " " " 006.8 4K DINIT .MMP " " " " " 006.9 4K DINIT0 .MMP " " " " " 006.10 4K DINIT1 .MMP " " " " " 006.11 4K DINIT2 .MMP " " " " " 006.12 2K DINIT21 .MMP " " " " " 006.13 2K DINIT22 .MMP " " " " " 006.14 4K DINIT23 .MMP " " " " " 006.15 4K DINIT3 .MMP " " " " " 006.16 4K DINIT4 .MMP " " " " " 006.17 2K DINIT41 .MMP " " " " " 006.18 4K DINIT5 .MMP " " " " " 006.19 2K DINIT6 .MMP " " " " " 006.20 4K DINTEG .MMP " " " " " 006.21 2K DIRCR .MMP " " " " " 006.22 2K EBMDIR06.TXT DIRECTORY OF THIS DISK 006.23 200K GLOBALS .DAT MICRO MUMPS VERSION 4.02 - GLOBALS DATA  Files: 23 space used: 274k (112k free) -EBMMUG .006 2k : DIFROM2 .MMP 4k : DINIT22 .MMP 2k : DINIT6 .MMP 2k DIDT .MMP 4k : DINIT .MMP 4k : DINIT23 .MMP 4k : DINTEG .MMP 4k DIDTC .MMP 4k : DINIT0 .MMP 4k : DINIT3 .MMP 4k : DIRCR .MMP 2k DIFROM .MMP 4k : DINIT1 .MMP 4k : DINIT4 .MMP 4k : EBMDIR06.TXT 2k DIFROM0 .MMP 4k : DINIT2 .MMP 4k : DINIT41 .MMP 2k : GLOBALS .DAT200k DIFROM1 .MMP 4k : DINIT21 .MMP 2k : DINIT5 .MMP 4k : P 4k : 4K DINIT3 .MMP " " " " " 006.16 4K DINIT4 .MMP " " " " " 006.17 2K DINIT41 .MMP " " " " " 006.18 4K DINIT5 .MMP " " " " " 006.19 2K DINIT6 .MMP " " " " " 006.20 4K DINTEG .MMP " " " " " 006.21 2K DIRCR .MMP " " " " " 006.22 2K EBMDIR06.TXT DIRECTORY OF THIS DISK 006.23 200K GLOBALS .DAT MICRO MUMPS VERSION 4.02 - GLOBALS DATA   !!""##$$%%&&''