IMD 1.16: 8/06/2007 11:57:35 ebmmug.005 eastbay micromate user's group micromumps ver. 16.06 run time routines disk issued: july 5, 1984 DI MMPDIA MMPDIA1 MMPDIA2 MMP DIA3 MMPDIB MMP DIBT MMP DIC MMP DIC1 MMP DICATT MMPDICATT0 MMPDICATT1 MMPDICATT2 MMP DICATT22MMP DICATT3 MMPDICATT4 MMPDICATT5 MMPDICATT6 MMP DICD MMPDICE MMPDICE0 MMPDICE1 MMP DICE2 MMP!"DICE3 MMP #DICE4 MMP$%DICE7 MMP&DICM MMP'(DICM1 MMP)*DICN MMP+,DICN1 MMP-DICOMP MMP./DICOMP0 MMP01DICOMP1 MMP23DICOMPX MMP45DICOMPY MMP67DICOMPZ MMP8DICQ MMP9:DICR MMP;DICRW MMP<DID MMP=>DID1 MMP?@DID2 MMPADIDH MMPBC%DT MMPDE%DTC MMPFGDIDX MMP HDIE MMPIJDIE0 MMP KDIE1 MMPLMDIE2 MMPNODIE9 MMPPQDIED MMPRSDIEZ MMPTDIEZ0 MMPUVDIEZ1 MMPWXDIEZ2 MMPYDIG MMPZ[DIH MMP\]DII MMP`aDIK MMP bDIK1 MMP cDIL MMPdeDIL0 MMPfgDIL1 MMPhiDIL2 MMPjkDILL MMPlDIM MMP mDIM1 MMPnDIM2 MMPopDIM3 MMPqrDIM4 MMPstDIO MMP uDIO0 MMPvDIO1 MMPwxDIO2 MMPyDIO3 MMPz{DIO4 MMP |DIOS MMP}~DIP MMPDIP0 MMPDIP1 MMPDIP2 MMPDIP22 MMP DIP3 MMPDIP4 MMPDIP5 MMPDIQ MMPDIQQ MMPDIQQQ MMP%RCR MMP DIS MMPDIS0 MMPDIS1 MMPDIT MMPDIT0 MMPDIT1 MMP DIT2 MMPDITP MMPDITR MMPDITR1 MMPDIU MMPDIU1 MMPDIU2 MMPDIU3 MMPDIV MMPDIVR MMPDIWE MMPDIWE1 MMPDIWE2 MMPDIWE3 MMPDIWE4 MMPDIWE5 MMPDIWP MMPDIWW MMP DIX MMP DIXC MMP%ZIS MMP-EBMMUG BAK$^_EBMDIR05TXT-EBMMUG 005$DI ;OPTION READER K (DUZ) G ^DII P K (DUZ) G P^DII Q S DUZ=$I,DUZ(0)="?" G ^DII #-AJS@YuuJuu}ͦߦ*Pȧ(d'{AgXJv!)*^#V#^#Vw# ll!J ^#V̀:#!"(COPYRIGHT (C) 1982, DIGITAL RESEARCH 151282/…(+17Ȉ=} ӓ "y2;!":2=2:=;!~;4#.{2!""9"2!;y3]K!Ƃo\b!,_^#V* Ó*"r*r"ÿ<:g:!͐*f}D! ~6t!rͷօO(^ƅƅƅ  :Function = File = !,!"h!9"f! ͉:2t™:!=Hgo:O*;*͂:A2=/::0! dگ61#d ڸïp#:w#6 !6:6 *#!)6.#)͂ O(BDOS > wM  2*7w#6?#7 .,:;[]=<>|!?]45#Ra{i_p# l s sDIA ; ; 03 NOV 83 11:39 AM D DICS S DXS=1 DOWN S F=F+1 I DB S DB(F)=DB,DB=1 G UP:$N(^DD(J(F),.01))'>0 1 S X=^DD(J(F),0),Y=$P(X,U,4) W !?F*3,"EDIT WHICH ",$P(X,U,1) I '$D(DB(F+1)) R ": ALL// ",X G ALL^DIA1:X=""!(X="ALL"),TEMP^DIA1:X?1"[".E&'F,L ED W ": " G NDB:'$D(DB(F+1,J(F))) GDB S Y=$P(DB(F+1,J(F)),";",DB) I "Q"[Y G NDB:Y="" D DB G GDB I Y?.NP,$P(Y,":",2),Y'["/" S Y=+Y_"-"_$P(Y,":",2) W Y,"// " R X I X="" S X=Y L S DSC=X?1"^"1E.E I DSC S X=$E(X,2,999) I X="@" S DB=DB+1 G 2 S DV="",J=$P(X,"-",2) I +J=J,$P(X,"-",1)=+X,J>X S D(F)=J K DA D RANGE^DIA1 K D S Y=DA G X:Y="" D DB G 2 DIC K Y S DIC(0)=$E("E",DV="")_"Z",DIC="^DD(J(F),",DIC("W")="S %=$P(^(0),U,2) I % W $S($P(^DD(+%,.01,0),U,2)[""W"":"" (word-processing)"",1:"" (multiple)"")" D ^DIC I Y>0 D SET S Y=$P(Y(0),U,2) G 2:'Y S J(F+1)=+Y,I(F+1)=""""_$P($P(Y(0),U,4),";",1)_"""" G DOWN S DIC(0)="EY",D="GR" G Q^DIB:X=U,2:X?."?" D IX^DIC I Y>0 D SET G 2  I 'Y S:'DSC&DB DB=DB+1 F Y=0:0 S Y=$N(Y(Y)) G 2:Y<0 D D S Y=X I DUZ(0)="@" D ^DIM I $D(X)=1 S DRS=99,Y=X D DB G 2 F DV="///+","//+","///","//" I Y[DV S DICMX="S DWLC=DWLC+1,"_DIA_"DA,DV,DWLC,0)=X",DA="DR(99,"_DXS_",",DHIT=$P(Y,DV,1),(DP,X)=$P(Y,DV,2,9),J=F*3,DQI="X(" D ^DICOMP,DICS,XEC K DBOOL,X S X=DHIT,DV=DV_DP G DIC X W *7,"??" 2 G 1:'$D(DR(F+1,J(F))) W !?F*3,"THEN EDIT ",$P(^DD(J(F),0),U,1) G ED:DB W ": " R X G L:X]"" UP G ^DIA1:'F S:DB DB=DB(F) K I(F),J(F) S F=F-1 G 2 ; XEC F Y=0:0 S Y=$N(X(Y)) Q:Y<0 S @(DA_"Y)=X(Y)") I $D(X),DP'[";" S %=1,Y="DO YOU MEAN '"_DP_"' AS A VARIABLE" W !?63-$L(Y),Y D YN^DICN Q:%-1 S DRS=99,Y="Q",DXS=DXS+1,DP=U_X G D Q:DP'="@" I DV="//" S DA=U_U Q W !,*7," WARNING: THIS MEANS AUTOMATIC DELETION!!" Q ; SET S Y=+Y_DV DB I DB,'DSC S DB=DB+1 D I '$D(DR(F+1,J(F))) S DR(F+1,J(F))="" I $L(DR(F+1,J(F)))+$L(Y)>230 F %=0:1 I '$D(DW(J(F),%)) S DW(J(F))=F+1,DW(J(F),%)=DR(F+1,J(F)),DR(F+1,J(F))="" Q S DR(F+1,J(F))=DR(F+1,J(F))_Y_";",DRS=DRS+1 Q ; NDB S X=$N(DB(F+1,J(F),-1)) I X>0 S DB=1,DB(F+1,J(F))=DB(F+1,J(F),X) K DB(F+1,J(F),X) G GDB R X G L:X]"",UP ; DICS S DIC("S")="I Y>.001 Q:'$D(^(9)) "_$S(DUZ(0)="@":"I ^(9)'=U!$F($P(^(0),U,2),""C"")",1:"F DW=1:1:$L(^(9)) I DUZ(0)[$E(^(9),DW) Q") DR(F+1,J(F))) W !?F*3,"THEN EDIT ",$P(^DD(J(F),0),U,1) G ED:DB W ": " R X G L:X]"" UP G ^DIA1:'F S:DB DB=DB(F) K I(F),J(F) S F=F-1 G 2 ; XEC F Y=0:0 S Y=$N(X(Y)) Q:Y<0 S @(DA_"Y)=X(Y)") I $D(X),DP'[";" S %=1,Y="DO YOU MEAN '"_DP_"' AS A VARIABLE" W !?63-$L(Y),Y D YN^DICN Q:%-1 S DRS=99,Y="Q",DXS=DXS+1,DP=U_X G D Q:DP'="@" I DV="//" S DA=U_U Q W !,*7," WARNING: THIS MEANS AUTOMATIC DELETION!!" Q ; SET S Y=+Y_DV DB I DB,'DSC S DB=DB+1 D I '$D(DR(F+1,J(F))) S DR(F+1,J(F))="" I $L(DR(F+1,J(F)))+$L(Y)>230 F %=0:1 I '$D(DW(J(F),%)) S DW(J(F))=F+1,DW(JDIA1 ; ; 22 OCT 83 7:33 PM F X=-1:0 S X=$N(DW(X)) Q:X'>0 S F=DW(X),J=DR(F,X),DR(F,X)=DW(X,0),I=1 D OV G GO:DRS<5 R !,"STORE THESE FIELDS IN TEMPLATE: ",X G GO:X="" S DIC(0)="LZEQ",DLAYGO=0 D T K DLAYGO G:Y<0 Q^DIB:X[U,DIA1 S DW=$S($D(^("ROU"))&$D(^("ROUOLD")):^("ROUOLD"),1:1),%=0,X=$P(Y,U,2) I $N(^(0))+1 W *7,!,X_" TEMPLATE ALREADY EXISTS.... OK TO REPLACE" D YN^DICN W ! G DIA1:%-1 K ^DIE(+Y) S ^DIE(+Y,0)=X_U_DT_U_$S('%:DUZ(0),1:$P(Y(0),U,3))_U_J(0)_U_U_$S('%:DUZ(0),1:$P(Y(0),U,6)) S %X="DR(",%Y="^DIE(+Y,""DR""," D %XY^%RCR S X=DW,DP=DIA("P"),DMAX=^DD("ROU") I 'X,$D(^("OS",^("OS"),"ZS")) D EN^DIEZ S DR(1,DIA("P"))=U_DNM GO G ^DIA2 ; ALL K DA D A G DIA1:'F,UP^DIA ; RANGE I X>0 S Y=X-.000001 G B A S Y=0 B S DA="",X=0 G S DG=Y DR S Y=$N(^DD(J(F),Y)) I $D(D(F)),Y'>0!(Y>D(F)) D DG:X Q I Y'>0 D DG:X S DR(F+1,J(F))=DA Q I $D(^(Y,0)),X X DIC("S") G G:$T D DG G DR X DIC("S") E G DR  S X=Y G G ; DG S DA=DA_$E(";",1,$L(DA))_X_$P(":"_DG,U,X'=DG) F DQ=0:0 S DQ=$N(^DD(J(F),"SB",DQ)),DP=$N(^(DQ,0)) Q:DQ<0 I DP'DG S Y(F,DQ)="" Y S X=$N(Y(F,0)) I X>0 K Y(F,X) S DA(F)=DA,Y(F)=Y,F=F+1,J(F)=X D A S F=F-1,Y=Y(F),DA=DA(F) G Y S X="",DG=0 Q ; TEMP ; S DIC(0)="ZEQ" D T K DIC G R^DIB:Y<0 S %=$P(Y(0),U,6) G ED:DUZ(0)="@"!'$L(%) F X=1:1:$L(%) I DUZ(0)[$E(%,X) G ED GT I $D(^("ROU")) S DR(1,DIA("P"))=^("ROU") E S:$D(^("W")) DIE("W")=^("W") S:$D(^("DR"))#2 ^("DR",1,DIA("P"))=^("DR") S %X="^DIE(+Y,""DR"",",%Y="DR(" D %XY^%RCR G GO ; T K DIC("W") S X=$P(X,"]",1),X=$P(X,"[",1)_$P(X,"[",2),DIC="^DIE(",DIC("S")="I $P(^(0),U,4)=J(0)"_$S(DUZ(0)="@":"",1:" S %=$P(^(0),U,3) F DW=1:1:$L(%) I DUZ(0)[$E(%,DW) Q") G ^DIC ; ED S %=2 W !,"WANT TO EDIT '",$P(Y,U,2),"' INPUT TEMPLATE" D YN^DICN G GT:%-1 S DIE="^DIE(",DA=+Y,DR=".01;3;6" D ^DIE K DR G R^DIB:'$D(DA) S:$D(^DIE(DA,"DR"))#2 ^("DR",1,DIA("P"))=^("DR") S %X="^DIE(DA,""DR"",",%Y="DB(" D %XY^%RCR S F=0,DB=1 D DICS^DIA G 1^DIA ; OV I '$D(DW(X,I)) S DR(F,X,I)=J Q S DR(F,X,I)=DW(X,I),I=I+1 G OV F=F-1,Y=Y(F),DA=DA(F) G Y S X="",DG=0 Q ; TEMP ; S DIC(0)="ZEQ" D T K DIC G R^DIB:Y<0 S %=$P(Y(0),U,6) G ED:DUZ(0)="@"!'$L(%) F X=1:1:$L(%) I DUZ(0)[$E(%,X) G ED GT I $D(^("ROU")) S DR(1,DIA("P"))=^("ROU") E S:$D(^("W")) DIE("W")=^("W") S:$D(^("DR"))#2 ^("DR",1,DIA("P"))=^("DR") S %X="^DIE(+Y,""DR"",",%Y="DR(" D %XY^%RCR G GO ; T K DIC("W") S X=$P(X,"]",1),X=$P(X,"[",1)_$P(X,"[",2),DIC="^DIE(",DIC("S")="I $P(^(0),U,4)=J(0)"_$S(DUZ(0)="@":"",1:" S %=$P(^(0),U,3) F DW=1:1:$L(%) I DUZ(0)[$E(%,DW) Q") G ^DIC ; ED S %=2 W !,"WANT TO EDIT '",$P(Y,U,2),"' INPUT TEMPLATE" D YN^DICN G GT:%-1 S DIE="^DIE(",DA=+Y,DR=".01;3;6" D ^DIE K DR G R^DIB:'$D(DA) S:$D(^DIE(DADIA2 ;GFT/SF ; 30APR83 13:48 K ^UTILITY("DIT",$J),DA,DRS,DW I '$D(DR(1,J(0))) S DR(1,J(0))=".01:99999999" I $L(DR(1,J(0)))<235,+DR(1,J(0))=.01 S DR(1,J(0))="S:DIA(9) DQ=2;"_DR(1,J(0)) DIC W !! D L S DIA(1)=+Y,DIA(9)=$P(Y,U,3) I Y>0 D DIE,^DIA3:'$D(DA) G DIC I X'["LOOP" D PTS^DITP:$N(^UTILITY("DIT",$J,0))>0 K ^UTILITY("DIT",$J) G Q^DIB S L="EDIT ENTRIES",DHD="@",IOP=$I,FLDS="",DHIT="D LOOP^DIA2 S:'$D(DCC) DN=0" D EN1^DIP W !!?4,"LOOP ENDED!" G DIC ; L K Y,I,J,F,DIC S (DIC,DIE)=DIA,DIC(0)="QEALM" G ^DIC ; DIE S DP=DIA("P"),DA=+Y,DR=DR(1,DP) K DIC,Y,DB S DIC=DIE L @(DIE_DA_"):0") E W *7,!,"ANOTHER TERMINAL IS EDITING THIS ENTRY!" Q I DR?1"^".AN D @DR L Q E D GO^DIE L Q ; LOOP ; W !!?3 S DI=99,@("X=+$P("_DCC_"0),U,2)") G NUL:'$D(^(D0,0)) S Y=$P(^(0),U,1),C=$P(^DD(X,.01,0),U,2) D Y^DIQ W Y S Y=D0,DIE=DCC D DIE I $D(Y) K Y S %=1 W *7,!!,"WANT TO STOP LOOPING" D YN^DICN I %-2 K DCC NUL S DI=99,DX(0)="Q"  $L(DR(1,J(0)))<235,+DR(1,J(0))=.01 S DR(1,J(0))="S:DIA(9) DQ=2;"_DR(1,J(0)) DIC W !! D L S DIA(1)=+Y,DIA(9)=$P(Y,U,3) I Y>0 D DIE,^DIA3:'$D(DA) G DIC I X'["LOOP" D PTS^DITP:$N(^UTILITY("DIT",$J,0))>0 K ^UTILITY("DIT",$J) G Q^DIB S L="EDIT ENTRIES",DHD="@",IOP=$I,FLDS="",DHIT="D LOOP^DIA2 S:'$D(DCC) DN=0" D EN1^DIP W !!?4,"LOOP ENDED!" G DIC ; L K Y,I,J,F,DIC S (DIC,DIE)=DIA,DIC(0)="QEALM" G ^DIC ; DIE S DP=DIA("P"),DA=+Y,DR=DR(1,DP) K DIC,Y,DB S DIC=DIE L @(DIE_DA_"):0") E W *7,!,"ANOTHER TERMINAL IS EDITING THIS ENTRY!" Q I DR?1"^".AN D @DR L Q E D GO^DIE L Q ; LOOP ; W !!?3 S DI=99,@("X=+$P("_DCC_"0),U,2)") G NUL:'$D(^(D0,0)) S Y=$P(^(0),U,1),C=$P(^DD(X,.01,0),U,2) D Y^DIQ W Y S Y=D0,DIE=DCC D DIE I $D(Y) K Y S %=1 W *7,!!,"WANT TO STOP LOOPING" D YN^DICN I %DIA3 ;GFT/SF ; 30APR83 15:22 ;FIX POINTERS TO DELETED ENTRIES S Y=DIA("P"),DH=1,DTO=DIA D PTS^DIT:'$D(^UTILITY("DIT",$J,0)) S ^UTILITY("DIT",$J,0)=0 Q:$D(^(0))<9 D ASK^DITP Q:%-1 S Y=0 I @("$N("_DIC_"0))'>0") G D C W !,"WHICH DO YOU WANT TO DO? --",!?4,"1) DELETE ALL SUCH POINTERS",!?4,"2) CHANGE ALL SUCH POINTERS TO POINT TO A DIFFERENT '"_$P(^(0),U,1)_"' ENTRY",!!,"CHOOSE 1) OR 2): " R % G F:U[%,W:%=2,C:%'=1 D W !,"DELETE ALL POINTERS" D YN^DICN G F:%<0,C:%-1,DITP W W !,"THEN PLEASE INDICATE WHICH ENTRY SHOULD BE POINTED TO" D L^DIA2 G DITP:Y>0 F W *7,!,"OK... FORGET IT... LET'S GO ON TO EDIT ANOTHER ENTRY" Q DITP S ^UTILITY("DIT",$J,DIA(1))=+Y W !?4,"("_$P("DELETION^RE-POINTING",U,''Y+1)_" WILL OCCUR WHEN YOU LEAVE 'ENTER/EDIT' OPTION)" ,C=$P(^DD(X,.01,0),U,2) D Y^DIQ W Y S Y=D0,DIE=DCC D DIE I $D(Y) K Y S %=1 W *7,!!,"WANT TO STOP LOOPING" D YN^DICN I %DIB ;GFT/SF ; 17MAR83 15:27 ; BEGIN -- SET UP NEW FILE W !! S DLAYGO=1 D W^DICRW K DICS,DIA,DLAYGO Q:Y<0 I '$D(DIC) D DIE G DIB:'$D(DG) S DIC=DG,DIA=DIC K DG,DIE,DE,DQ D EN^DICATT G DIA S DIA=DIC,@("X="_DIC_"0)"),DLAYGO=+$P(X,U,2) DIA S (J(0),DIA("P"))=DLAYGO,DLAYGO=DLAYGO\1 R D QQ S DRS=0,F=-1,I(0)=DIA,DB=0,DSC=0 G ^DIA ; Q K DLAYGO,DIA QQ K IOP,DSC,DHIT,DRS,DIE,DR,DA,DG,DIC,F,DP,DQ,DV,DB,DW,D,X,Y Q ; DIE ; S F=+Y,DG="^DIC("_F_"," G SET:DUZ(0)'="@" W !!,"INTERNAL GLOBAL REFERENCE: ",F R "// ",X G SET:X="" I X?."?" W !,"TYPE A GLOBAL NAME, LIKE '^GLOBAL(' OR '^GLOBAL(4,'",!,"OR JUST HIT 'RETURN' TO STORE DATA IN '^DIC(",F,",'" G DIE I X?1"^".E S X=$P(X,U,2,9) I X?.P W !?9,*7,"NO NEW FILE CREATED!" S DIK="^DIC(",DA=F K DG G ^DIK I "(,"[$E(X,$L(X)),X?1A.E!(X?1"%".E)!(X?1"[".E1"]"1AP.E) S DG=U_X,@("%=$N("_DG_"0))<0") G SET:% W !,*7,"WARNING -- THAT GLOBAL ALREADY EXISTS! --OK" D YN^DICN G SET:%=1 W *7,"??" G DIE SET D WAIT^DICD S X=$P(^DIC(F,0),U,1),^(0,"DT")=DT,^("GL")=DG,^("U")=DUZ I DUZ(0)]"" F %="DD","DEL","RD","WR","LAYGO" S ^(%)=DUZ(0) S %="" I @("$D("_DG_"0))") S %=^(0) S @(DG_"0)=X_U_F_U_$P(%,U,3,9)") K ^DD(F) S ^(F,0)="FIELD^^.01^1",^(0,"NM",X)="",^DD(F,.01,0)="NAME^R^^0;1^K:$L(X)>30!(+X=X)!($L(X)<3)!'(X'?1P.E)!(X'?.ANP) X" S ^(3)="NAME MUST BE 3-30 CHARACTERS, NOT NUMERIC OR STARTING WITH PUNCTUATION" S DA="B",^DD(F,.01,1,0)="^.1",^(1,0)=F_U_DA,X=DG_""""_DA_""",$E(X,1,30),DA)",^(1)="S "_X_"=""""",^(2)="K "_X S DLAYGO=F,DIK="^DD(DLAYGO,",DA=.01,DA(1)=DLAYGO G IX1^DIK ?.P W !?9,*7,"NO NEW FILE CREATED!" S DIK="^DIC(",DA=F K DG G ^DIK I "(,"[$E(X,$L(X)),X?1A.E!(X?1"%".E)!(X?1"[".E1"]"1AP.E) S DG=U_X,@("%=$N("_DG_"0))<0") G SET:% W !,*7,"WARNING -- THAT GLOBAL ALREADY EXISTS! --OK" D YN^DICN G SET:%=1 WDIBT ;GFT/SF ; 11FEB83 14:07 W !! S DIC="^DIBT(",DIC(0)="AEQ",DIC("W")="W ?30,""FILE #"",$P(^(0),U,4),"" "" S %=$P(^(0),U,2) W:% ?40,+$E(%,4,5),""/"",%#100,""/"",$E(%,2,3)" D ^DIC Q:Y<0 S DA=+Y,DIE=DIC,DR="0:9999999" D ^DIE G DIBT ; 1 ; S DIC("S")="I $P(^(0),U,4)="_DI G DIBT ; S ; R !,"STORE IN 'SORT' TEMPLATE: ",X G N:X="" D DIBT^DII G Q^DIP:X=U,S:Y<0 S %X="DPP(",%Y="^DIBT("_+Y_",2," D %XY^%RCR F X=1:1:DPP I $D(DPP(X,"F")),$P(DPP(X),U,4)'["B" W !,"SHOULD TEMPLATE USER BE ASKED 'FROM'-'TO' RANGE FOR '",$P(DPP(X),U,3),"'" S %=2 D YN^DICN Q:%<1 S:%=1 ^DIBT(+Y,2,X,"ASK")="" N G N^DIP1 ?.P W !?9,*7,"NO NEW FILE CREATED!" S DIK="^DIC(",DA=F K DG G ^DIK I "(,"[$E(X,$L(X)),X?1A.E!(X?1"%".E)!(X?1"[".E1"]"1AP.E) S DG=U_X,@("%=$N("_DG_"0))<0") G SET:% W !,*7,"WARNING -- THAT GLOBAL ALREADY EXISTS! --OK" D YN^DICN G SET:%=1 WDIC ; ; 03AUG83 15:40 S D="B" K DF,DS,DFOUT,DTOUT,DUOUT EN K DO,DICR S U="^" I DIC S DIC=^DIC(DIC,0,"GL") ASK I DIC(0)["A" W ! G ^DIC1 X G O^DIC1:X'?.ANP,N:$L(X)>30 I X?.NP,+X=X G NUM^DIC1 I X=" ",$L(DIC)<29,$D(^DISV($I,DIC)) S Y=+^(DIC) G 1 F G NO:X="" S DS=0,DD=0 T S @("Y=$N("_DIC_"D,X,0))"),DIX=X I Y'<0 G DIY:$N(^(Y))'<0 D MN I G K:DS S DS=1 G GOT DIX I DIC(0)'["X" S:X?.N DIX=DIX_" " S @("DIX=$N("_DIC_"D,DIX))") I $P(DIX,X,1)="",DIX'=-1 S Y=$N(^(DIX,0)) G DIY M I DIC(0)["M" S @("D=$N("_DIC_"D))") I D+1 G M:$D(^(D))-10,T:X'?.NP,T:+X'=X D DO^DIC1:'$D(DO) S Y=$N(^DD(+DO(2),0,"IX",D,0)) G T:'$D(^DD(Y,$N(^(Y,0)),0)),M:$P(^(0),U,2)["P",T D D G G:DS=1,W:DS N D DO^DIC1:'$D(DO) G ^DICM ; 1 D S G GOT:$T,F ; MN S DZ=$S($D(^(Y))-1:0,1:^(Y)) I 'DZ,$L(DIX)<30,D="B",'$D(DIC("S")) S DIY="" Q D S S:D="B"&'DZ&($P(DIY,DIX,1)="") DIY=$P(DIY,DIX,2) Q ; S I @("$D("_DIC_"Y,0))") S DIY=$P(^(0),"^",1) E S DIY="" Q X:$D(DIC("S")) DIC("S") Q ; Y S @("Y=$N("_DIC_"D,DIX,Y))") DIY I Y<0 G G:DS=1&(D="B")&(DIX=X),DIX D MN E G Y K F DZ=1:1:DS I $D(DS(DZ)),+DS(DZ)=Y G Y I $S<800 F DZ=1:1:DS-7 K DS(DZ),DIY(DZ) S DS=DS+1,DS(DS)=Y_"^"_$P(DIX,X,2,99),DIY(DS)=DIY G Y:DS#5-1,Y:DS=1,Y:DIC(0)["Y" W S DZ=Y,DD=$N(DS(DD)),Y=+DS(DD),DIY=DIY(DD) W:DIC(0)["E" !?5,DD,?9,$P(X,U,'$D(DICRS))_$P(DS(DD),U,2,9) D WO S Y=DZ I DIC(0)["Y" G W:DDDD G W:DD#5,U^DIC1 G Y^DIC1 ; G S DIY=1,DIX=X I DIC(0)["E",'$D(DICRS) W $P(DS(1),"^",2) C S Y=+DS(DIY),X=X_$P(DS(DIY),"^",2),DIY=DIY(DIY) GOT D WO S Y=Y_"^"_$S(DIY="":X,1:DIY) I DIC(0)["E",DO(2)["O" G OK^DICM R I DIC(0)'["F" S ^DISV($I,$E(DIC,1,28))=$E(DIC,29,999)_+Y I DIC(0)["Z" S @("Y(0)="_DIC_"+Y,0)") Q K DIC("W"),DINUM,DS,DF,DD,DIX,DIY,DZ,DO,D Q ; D S D=$S($D(DF):DF,1:"B") Q ; IX S DF=D G EN ; A K DIY,DS I DIC(0)["A" D D G ASK NO S Y=-1 G Q ; WO Q:DIC(0)'["E" W " " I 'DIY&$D(DO) W DIY E D WR^DIC1 I $D(DIC("W")),@("$D("_DIC_"Y,0))") W " " X DIC("W") D=$N(DS(DD)),Y=+DS(DD),DIY=DIY(DD) W:DIC(0)["E" !?5,DD,?9,$P(X,U,'$D(DICRS))_$P(DS(DD),U,2,9) D WO S Y=DZ I DIC(0)["Y" G W:DDDD G W:DD#5,U^DIC1 G Y^DIC1 ; G S DIY=1,DIX=X I DIC(0)["E",'$D(DICRS) W $P(DS(1),"^",2) C S Y=+DS(DIY),X=X_$P(DS(DIY),"^",2),DIY=DIY(DIY) GOT D WO S Y=Y_"^"_$S(DIY="":X,1:DIY) I DIC(0)["E",DO(2)["O" G OK^DICM R I DIC(0)'["F" S ^DISV($I,$E(DIC,1,28))=$E(DIC,29,999)_+Y I DIC(0)["Z" S @("Y(0)="_DIC_"+Y,0)") Q K DIC("W"),DINUM,DS,DF,DD,DIX,DIY,DZ,DO,D Q ; D S D=$S($D(DF):DFDIC1 ;GFT/SF ; 05JAN84 15:25 I $D(DIC("A")) S DD=DIC("A") G B D DO S Y=$P(DO,"^",1) I D="B",DO(2)>1.9 S X=$P(^DD(+DO(2),.01,0),"^",1) I X'[Y,Y'[X S Y=Y_" "_X S DD="Select "_Y_": " B I $D(DIC("B")),DIC("B")]"" S Y=DIC("B"),@("X=$N("_DIC_"D,Y))"),@("DIY=$S($F(X,Y)-1=$L(Y):X,$D("_DIC_"Y,0)):$P(^(0),U,1),1:Y)") W DD D WR W "// " R X:$S($D(DTIME):DTIME,1:99999) G G:X]"",TIME:'$T S X=DIY G G W DD R X:$S($D(DTIME):DTIME,1:99999) E G TIME:X="" G D DO I X?.NP,$L(X)<30,+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 %+1,$L(DIC("W"))+$L(^(%))<244 S DIC("W")=DIC("W")_" W "" "" "_^(%) G W S DIC("W")=$E(DIC("W"),2,999) Q ; NUM D DO G ^DICM:X<0,C:DO(2)<0!$D(DF) S DD=$D(^DD(+DO(2),.001)),Y=$P(^(.01,0),"^",2) I Y["P",'DD S DS=0,DD=0 G M^DIC I @("$D("_DIC_"X))") G 1:DD I Y'["N",$N(^("A["))<0 G 1 C G F^DIC ; RENUM D DO I ^DD(+DO(2),.01,0)["DINUM",'$D(DF),@("$D("_DIC_"X))") G 1 G C ; 1 S Y=X G 1^DIC ; WR I +DIY'=DIY W DIY G DO D DO I DO(2)["D" W:$E(DIY,4,5) +$E(DIY,4,5),"-" W:$E(DIY,6,7) +$E(DIY,6,7),"-" W DIY\10000+1700 W:DIY["." "@"_$E(DIY_0,9,10)_":"_$E(DIY_"000",11,12) Q I DO(2)["P",@("$D(^"_$P(^DD(+DO(2),.01,0),"^",3)_"DIY,0))") S DIY=$P(^(0),"^",1) W DIY Q ; U ; W !,"TYPE '^' TO STOP, OR" Y ; W !,"CHOOSE "_$N(DS(0))_"-"_DD R ": ",DIY 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 Y'["N",$N(^("A["))<0 G 1 C G F^DIC ; RENUM D DO I ^DD(+DO(2),.01,0)["DINUM",'$D(DF),@("$D("_DIC_"X))") G 1 G C ; 1 S Y=X G 1^DIC ; WR I +DIY'=DIY W DIY G DO D DO I DO(2)["D" W:$E(DIY,4,5) +$E(DIY,4,5),"-" W:$E(DIY,6,7) +$E(DIY,6,7),"-" W DIY\10000+1700 W:DIY["." "@"_$E(DIY_0,9,10)_":"_$E(DIY_"000",11,12) Q I DO(2)["P",@("$D(^"_$P(^DD(+DO(2),.01,0),"^",3)_"DIY,0))") S DIY=$P(^(0),"^",1) W DIY Q ; U ; W !,"TYPE '^' TO STOP, OR" Y ; W !,"CHOOSE "_$N(DS(0))_"-"_DD R ": ",DIY 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 DICATT ; ; 04DEC83 18:58 S DLAYGO=1 D D^DICRW Q:Y<0 I '$D(DIC) D DIE^DIB Q:'$D(DG) S DIC=DG EN ; K I S Q="""",I(0)=DIC,@("B=+$P("_DIC_"0),U,2)"),S=";" B ; K J S A=B,J=0,J(0)=B N ; W !!! K DQ,DIC,DIE,DG,M S E=0,DIC(0)="ALEQZ",DIC="^DD("_A_",",DIC("W")="W:$P(^(0),U,2) "" (multiple)""" S:$D(DICS) DIC("S")=DICS I $P(^DD(A,.01,0),U,2)["W" S DIC(0)="AEQZ",DIC("B")=.01 E I $D(DA),$D(^DD(A,DA,0)),'$P(^(0),U,2),$P(^(0),U,4)'?.P S E=DA D ^DIC I Y<0 G B:A-B,Q S DA=+Y,DA(1)=A,DIE=DIC,M=Y(0),T=$P(M,U,2),DR=$P(".01:.1;",U,DUZ(0)="@"!'$F(T,"X"))_8_$S(T["C":";",1:":")_"11;20:29",O=$S($P(Y,U,3):0,1:1_U_$P(M,U,2,99)),F=$P(M,U,1) K DIC,DQI F X=0:0 S X=$N(^DD(A,DA,1,X)) Q:X'>0 I +^(X,0)=B,$P(^(0),B,2)?1"^"1A.A S DQI=$P(^(0),U,2) I 'T D ^DIE:O G TYPE:$D(DA),N:$P(O,U,4)?.P,^DICATT4 S DR=".01;8;9:11;20" D ^DIE I '$D(DA) S DQ(+T)=0 D KDD G ^DICATT4 S X=$P($P(M,U,4),S,1),M=^DD(A,DA,0),E=$P(M,U,1),A=+T,J=J+3,J(J\3)=A,Y=$E(Q,+X'=X),I(J\3)=Y_X_Y I E'=F S ^(0)=E_" SUB-FIELD^"_$P(^DD(A,0),U,2,9) K ^(0,"NM") S ^("NM",E)="" G 5:$P(M,U,2)["W",N ; NO ; W *7," " TYPE K Y,M,DE,DIE,DQ,DG S N=0,DQI=J\3+8,Y=^DD(A,DA,0),F=$P(Y,U,1),Z="" W !!?J,"DATA TYPE OF ",F,": " I 'O R X G X:X[U,NEW F N=7,6,5,1:1:4 Q:$P(Y,U,2)[$E("DNSFWCP",N) W $P(^DOPT("DICATT",N,0),U,1) G X^DICATT2:$P(Y,U,2)["X",6:N=6 R "// ",X G N:X[U,0:X="" S DIC("S")="I Y-6"_$P(",Y-5",U,N\2-2!(A=B)!(DA-.01)!$N(^DD(A,DA))>0) NEW I 'O,X=" ",E W " <",*7 D E W " DUPLICATED>" G E^DICATT1 S DIC(0)="QE",DIC="^DOPT(""DICATT""," D ^DIC I Y>0 S:N-Y&O M="",O=$P(O,U,1,2)_U_U_$P(O,U,4) S N=+Y G 0 I 'O,X["?",E D DICATT^DIQQQ,E W ", JUST HIT THE SPACE KEY" G TYPE ; E S DE=^DD(A,E,0) W $P(DE,U,1) Q ; X W *7," '",F,"' DELETED!" S DIK="^DD(A,",DA(1)=A D ^DIK G N ; KDD ; S DQ=$N(DQ(0)),X=0 Q:DQ<1 F Y=0:0 S X=$N(^DD(DQ,"SB",X)),DQ(X)=0 D KIX Q:X<0 K DQ(DQ),^DD(DQ) F Y=0:0 S Y=$N(^DIE("AF",DQ,Y)) G KDD:Y<0 F %=0:0 S %=$N(^DIE("AF",DQ,Y,0)) Q:%<0 K ^(%),^DIE(%,"ROU") ; KIX S Y=$N(^DD(A,0,"IX",Y)) Q:Y<0 K:$D(^(Y,DQ)) ^(DQ) G KIX ; 0 S C=$P(O,U,5,99) G @N 1 ; 2 G ^DICATT0 3 ; 4 G ^DICATT6 5 S W="0;1",Z="W^",C="Q",V=1,L=1 G ^DICATT2:O,SUB^DICATT1 6 G ^DICATT3 7 G ^DICATT5 ; Q K T,B,A,J,DA,DIC,E,DR,W,S,Q,P,N,V,I,L,F,DQI,DIK,C,Z,Y,DE,O,DICS 0)="QE",DIC="^DOPT(""DICATT""," D ^DIC I Y>0 S:N-Y&O M="",O=$P(O,U,1,2)_U_U_$P(O,U,4) S N=+Y G 0 I 'O,X["?",E D DICATT^DIQQQ,E W ", JUST HIT THE SPACE KEY" G TYPE ; E S DE=^DD(A,E,0) W $P(DE,U,1) Q ; X W *7," '",F,"' DELETED!" S DIK="^DD(A,",DA(1)=A D ^DIK G N ; KDD ; S DQ=$N(DQ(0)),X=0 Q:DQ<1 F Y=0:0 S X=DICATT0 ;GFT/SF ; 26MAY82 15:04 G @N ; DIE K Y F DP=0:0 S DL=1,DP=$N(DQ(DP)) Q:DP<0 S DQ(DP)=$J("",J)_DQ(DP) S:$D(DE(DP)) DG(DP)=DE(DP) D DQ^DIED K DQ G NO^DICATT:$D(Y),@(N_0) ; 1 S %DT="E",DQ="^I X'?1""DT"".NP D ^%DT S X=Y K:Y<0 X",DQ(1)="EARLIEST DATE (OPTIONAL)^D^^1"_DQ,DQ(0,2)="S:'$L(X) Y=$J(X,J)_""CAN""",DQ(3)="LATEST DATE^RD^^3"_DQ_" I $D(X),XX",1),DE(3)=$P($P(C,"K:",2),P,1) S DQ(4)="CAN DATE BE IMPRECISE (Y/N)^S^Y:YES;N:NO;^4^Q",DE(4)=$E("YN",$P(C,Q,2)["X"+1),DQ(4,3)="E.G., WOULD 'FEB, 1980' BE ALLOWED?" S DQ(5)="CAN TIME OF DAY BE ENTERED (Y/N)^S^Y:YES;N:NO;^5^Q",DE(5)=$E("NY",$P(C,Q,2)["T"+1),DQ(5,3)="E.G., CAN USER ENTER '7DEC@0830'" G DIE 10 S C="S %DT=""E"_$E("T",DG(5)="Y")_$E("X",DG(4)="N")_""" D ^%DT S X=Y K:" F X=1,3 G ND:'$D(DG(X)) S Y(X)=$S(DG(X):DG(X)\10000+1700,1:DG(X)) I DG(X)#100 S Y(X)=DG(X)#100_"/"_Y(X) I $E(DG(X),4,5) S Y(X)=+$E(DG(X),4,5)_"/"_Y(X) I DG(1)]"" S M="TYPE A DATE BETWEEN "_Y(1)_" AND "_Y(3),C=C_DG(3)_P_DG(1)_">X) X" G ED ND S C=C_"Y<1 X" ED S Z="D^",L=7 G H ; 2 S DQ(1)="INCLUSIVE LOWER BOUND^R^^1^K:+X'=X X",DQ(2)="INCLUSIVE UPPER BOUND^R^^2^K:X",2) G DIE 20 S M="TYPE A "_$P("WHOLE ",U,'DG(5))_"NUMBER BETWEEN "_DG(1)_" AND "_DG(2) S C="K:+X'=X",T=DG(5)+1,Z="!(X?.E"_P_T_"N.N)" I DG(3)="Y",DA-.001 S C="S:X[""$"" X=$P(X,""$"",2) "_C_"&(X'?"_$P(".""-""",U,DG(1)<0)_".N"_P_"2N)",Z="" S C=C_"!(X>"_DG(2)_")!(X<"_DG(1)_")"_Z_" X",L=$L(DG(2)\1)+T-(T=1),Z="NJ"_L_","_DG(5)_U H G ^DICATT1 DICATT1 ;GFT/SF ; 30APR83 18:41 I DA=.001 S W=" " G 2 S (DG,W)=$P(O,U,4) G M:W="" S T=0,DP=DA,Y=$P(W,";",1),N=$P(W,";",2) D MX S L=L-T D MAX I T<252 S W=DG G ^DICATT2 D TOO G NO^DICATT M K DE,DG W !?J,"WILL ",F," FIELD BE MULTIPLE: NO// " R X S V=X?1"Y".E I X["?" W !,"FOR A GIVEN ENTRY, WILL THERE BE MORE THAN 1 ",F,!?J," ON FILE AT ONCE: NO// " G M I X'[U G SUB BACK G TYPE^DICATT E ; S V=0,DE(3)=$S($D(^(3)):^(3),1:""),T=0,DP=E,N=$P($P(DE,U,4),";",2) D MX S L=T SUB S T=0 F Y=0:1 Q:'$D(^DD(A,"GL",Y+1)) D MAX:'V I T>250!$D(^DD(A,"GL",Y,0))!V S Y=$S(+Y=Y:Y+1,1:$C($A(Y)+1)) G SB:DUZ(0)'="@" W !!?J,"SUBSCRIPT: ",Y,"// " R X S:X="" X=Y I +X'=X G BACK:X[U,DICATT1^DIQQQ:X["?" I X?1P.E!(X[",")!(X[":")!(X[S)!(X[Q)!(X["=") G SUB I Y'=X S Y=X D MAX I T>250 D TOO G SUB SB S W=Y,X=0 G V:V,U:$D(^DD(A,"GL",W,0)) PIECE S Y=1,P=0 PC S X=$N(^(X)) I X'<0 S P=$P(X,",",2),Y=$S(Y>P:Y,1:P+1) G PC I P S Y="E"_Y_","_(L+Y-1) E F Y=1:1 Q:'$D(^(Y)) S P=Y I DUZ(0)="@" W !?J,"^-PIECE POSITION: ",Y,"// " R P S:P="" P=Y I P["?" W " TYPE A NUMBER FROM 1 TO 99",!?9,"OR AN $EXTRACT RANGE (E.G., ""E2,4"")" G PIECE I P?1"E"1N.N1","1N.N S N=$P(P,",",2)-$E(P,2,9)+1 G USED:N'0,P<100,P\1=P G USED S W="" G BACK:X[U W *7,"??" G SUB ; USED S W=W_S_P,X=P G DE:'$D(^(X)) U W !?J,*7,X," ALREADY USED FOR ",$P(^DD(A,$N(^(X,0)),0),U,1) G SUB ; MAX S N=0 F T=L:0 S N=$N(^DD(A,"GL",Y,N)),DP=$N(^(N,0)) Q:N<0 D MX Q MX I N?1"E".E S T=T+$P(N,",",2)-$E(N,2,9)+1 Q:'N S P=$P(^DD(A,DP,0),U,2),W=$S(P["J":$P(P,"J",2),P["P":9,P["N":14,P["D":7,1:0) G W:W I P["S" F P=1:1 S X=$L($P($P($P(^(0),U,3),";",P),":",1)) S:X>W W=X G W:'X S W=$P(^(0),"$L(X)>",2),W='W*30+W W S T=T+W+1 Q ; V I $D(^DD(A,"GL",W)) W *7,!?9,"CAN'T STORE A MULTIPLE FIELD IN AN ALREADY-USED SUBSCRIPT!" G SUB S W=W_S_0 DE I $D(DE) S ^DD(A,DA,0)=F_U_$P(DE,U,2,3)_U_W_U_$P(DE,U,5,99),DIK="^DD(A,",DA(1)=A,^(3)=DE(3) D IX1^DIK G N^DICATT 2 G ^DICATT2 ; TOO W *7,!," TOO MUCH TO STORE AT THAT SUBSCRIPT!" .N1","1N.N S N=$P(P,",",2)-$E(P,2,9)+1 G USED:N'0,P<100,P\1=P G USED S W="" G BACK:X[U W *7,"??" G SUB ; USED S W=W_S_P,X=P G DE:'$D(^(X)) U W !?J,*7,X," ALREADY USED FOR ",$P(^DD(A,$N(^(X,0)),0),U,1) G SUB ; MAX S N=0 F T=L:0 S N=$N(^DD(A,"GL",Y,N)),DP=$N(^(N,0)) Q:N<0 D MX Q MX I N?1"E".E S T=T+$P(N,",",2)-$E(N,2,9)+1 Q:'N S P=$P(^DD(A,DP,0),U,2),W=$S(P["J":$P(P,"J",2),P["P":9,P["N":14,P["D":7,1:0) G W:W I P["S" F P=1:1 S X=$L($P($P($P(^(0),U,3),";",P),":",1)) S:X>W W=X G W:'X S W=$P(^(0),"$L(X)>",2),W='W*30+W W S T=T+W+1 Q ; V I $D(^DD(A,"GL",W)) W *7,!?9,"CAN'T STORE A MULTIPLE FIELD IN AN ALREADY-USEDICATT2 ;GFT/SF ; 23AUG83 18:19 S T=$E(Z,1) F P="I","O" S:$P(O,U,2)[P Z=$P(Z,U,1)_P_U_$P(Z,U,2) 1 K DS S P=0,V=W[";0",N=J\3,DQ=4,DP=6,DQI=" S:$D(X) DINUM=+X",DREF=$F(O,DQI)-1=$L(O),DE(7,0)="NO",DG(7)="N" S:T="*" T="P" G 1^DICATT22:DA=.001 G ^DICATT22:T="W" I T'["F",T'["S",'O!DREF S:DREF DE(7,0)="YES",DG(7)="Y" S F Y=4:1:6 S DQ(Y)=$P($T(DQ+Y),S,2)_F_$P($T(DQ+Y),S,3)_" (Y/N)^RS^Y:YES;N:NO^"_Y_"^Q" I 'V,DA-.01!'N Q S DG(5)="Y",DE(4,0)="NO",DP=-1,DL=1 I T["P"!(T["N") S DE(5,0)="YES" I O S DE(6,0)=$E("NY",$P(O,U,2)["M"+1) S:$P(O,U,2)["R" DE(4,0)="Y" I DA=.01,N S P=$N(^DD(J(N-1),"SB",A,0)),Y=$P(^DD(J(N-1),P,0),U,2),DE(5,0)=$E("YN",Y["A"+1) K Y D RE^DIED K DQ G:$D(Y) N^DICATT:$P(Z,U,1)["X",NO^DICATT S:DG(5)="N" T=T_"A" I DG(4)="Y",$P(Z,U,1)'["R" S Z="R"_Z I $D(DG(6)),DG(6)="Y",$P(Z,U,1)'["M" S Z="M"_Z G ^DICATT22 ; X ; W " (FIELD DEFINITION IS NOT EDITABLE)" S T=$E(^(0),1),Z=$P(Y,U,2,3),W=$P(Y,U,4),C=$P(Y,U,5,99) G N^DICATT:N=6,1 ; DQ ; ; ; ; ;IS ; ENTRY MANDATORY ;SHOULD USER SEE AN "ADDING A NEW ;?" MESSAGE FOR NEW ENTRIES ;HAVING ENTERED OR EDITED ONE ;, SHOULD USER BE ASKED ANOTHER ,S,2)_F_$P($T(DQ+Y),S,3)_" (Y/N)^RS^Y:YES;N:NO^"_Y_"^Q" I 'V,DA-.01!'N Q S DG(5)="Y",DE(4,0)="NO",DP=-1,DL=1 I T["P"!(T["N") S DE(5,0)="YES" I O S DE(6,0)=$E("NY",$P(O,U,2)["M"+1) S:$P(O,U,2)["R" DE(4,0)="Y" I DA=.01,N S P=$N(^DD(J(N-1),"SB",A,0)),Y=$P(^DD(J(N-1),P,0),U,2),DE(5,0)=$E("YN",Y["A"+1) K Y D RE^DIED K DQ G:$D(Y) N^DICATT:$P(Z,U,1)["X",NO^DICATT S:DG(5)="N" T=T_"A" I DG(4)="Y",$P(Z,U,1)'["R" S Z="R"_Z I $D(DG(6)),DG(6)="Y",$P(Z,U,1)'["M" S Z="M"_Z G ^DICATT22 ; X ; W " (FIELD DEFINITION IS NOT EDITABLE)" S T=$E(^(0),1),Z=$P(Y,U,2,3),DICATT22 ;GFT/SF ; 28DEC83 15:51 G M:V I P,$D(^DD(J(N-1),P,0)) S I=A_$E("I",$P(^(0),U,2)["I") D P I O,DA=.01,'N S @("I=$P("_I(0)_"0),U,2)") D P 1 S ^DD(A,DA,0)=F_U_Z_U_W_U_C D SDIK G I ; Q W *7,!,"NUMBER MUST BE BETWEEN ",A," & ",%+1," AND NOT ALREADY IN USE" M S %=$P(A,".",1) F DE=A:.01:%+.7,%+.7:.001:%+.9,%+.9:.0001 Q:'$D(^DD(DE)) I DUZ(0)="@" W !,"SUB-DICTIONARY NUMBER: ",DE,"// " R DG S:DG]"" DE=DG G Q:+DE'=DE!(DEDE),Q:$D(^(DE)) S ^DD(A,DA,0)=F_U_U_U_W,I=DE D P S W=$P(W,S,1) D SDIK S:+W'=W W=Q_W_Q S N=N+1,I(N)=W,J(N)=DE,^DD(DE,0)=F_" SUB-FIELD^NL^.01^1",^(0,"UP")=A,^("NM",F)="" S DA=.01,^DD(DE,DA,0)=F_U_Z_"^0;1^"_C D SDIK I I $P(O,U,2,99)'=$P(^DD(J(N),DA,0),U,2,99) S:$D(M) ^(3)=M S M(1)=0 I DT-$S($D(^DIC(J(0),0,"DT")):^("DT"),1:1) S ^DD(J(N),DA,"DT")=DT K DR,DG,DB,DQ,DQI,^DD(U,$J) S DIE=DIK,DR=$S(DUZ(0)="@":"3;4",1:3) D ^DIE I T="W" K M,DE G B^DICATT I $D(M)>9,O S V=J\3,DR=$P(Z,U,1),Z=$P(Z,U,2) I @("$N("_I(0)_"0))>0") D V K DR,M G N^DICATT ; V S %=$N(^DIE("AF",J(N),DA,0)) I %>0 K ^(%),^DIE(%,"ROU") G V W !!,"SINCE YOU HAVE CHANGED THE FIELD DEFINITION,",!,"EXISTING '",F,"' DATA WILL NOW BE CHECKED FOR INCONSISTENCIES",!,*7,"OK" S %=1 D YN^DICN Q:%-1 G ^DIVR ; P F Y="S","D","P","A" S:I[Y I=$P(I,Y,1)_$P(I,Y,2)_$P(I,Y,3) S:T[Y I=I_Y S ^(0)=$P(^(0),U,1)_U_I_U_$P(^(0),U,3,99) Q ; SDIK S DA(1)=J(N),DIK="^DD("_J(N)_"," I O K ^DD(J(N),"RQ",DA) G IX1^DIK B-FIELD^NL^.01^1",^(0,"UP")=A,^("NM",F)="" S DA=.01,^DD(DE,DA,0)=F_U_Z_"^0;1^"_C D SDIK I I $P(O,U,2,99)'=$P(^DD(J(N),DA,0),U,2,99) S:$D(M) ^(3)=M S M(1)=0 I DT-$S($D(^DIC(J(0),0,"DT")):^("DT"),1:1) S ^DD(J(N),DA,"DT")=DT K DR,DG,DB,DQ,DQI,^DD(U,$J) S DIE=DIK,DR=$S(DUZ(0)="@":"3;4",1:3) D ^DIE I T="W" K M,DE G B^DICATT I $D(M)>9,ODICATT3 ;GFT/SF ; 21 OCT 83 9:41 PM 6 W !!?J,"'COMPUTED-FIELD' EXPRESSION: " I O,$D(^DD(A,DA,9.1)) S (X,Y)=^(9.1),%=$L(X)>19 W X W:'% "// " I % D RW^DIED W ! G 61 R X,! 61 K DICOMPX S DICOMPX="" I U[X G:X=U N^DICATT:O,NO^DICATT G 6:'O D DEC:$P($P(O,U,2),"J",1)="C" G N^DICATT G DICATT3^DIQQ:X?."?"!(X?.A&'$F("DTNOW",X)) S Z=X,DQI="Y("_A_","_DA_",",DICMX="X DICMX" D ^DICOMP I '$D(X) W *7," ...",I,"??" G 6 I DUZ(0)="@" W !,"TRANSLATES TO THE FOLLOWING CODE:",!,X,! I Y["m" W !,"FIELD IS 'MULTIPLE-VALUED'!",! S N=J\3,(Y,DATE)=$E("D",Y["D")_$E("B",Y["B")_"C"_$S(Y'["m":"",1:"m"_$E("w",Y["w")),^DD(A,DA,0)=F_U_Y_"^^ ; ^"_X,^(9)=U,^(9.1)=Z,^(9.01)=DICOMPX F Y=9.2:.1 Q:'$D(X(Y)) S ^(Y)=X(Y) I O,DT-$S($D(^DIC(J(0),0,"DT")):^("DT"),1:0) S ^DD(A,DA,"DT")=DT K X,DICOMPX D SDIK^DICATT22:'O,DEC:DATE="C" K DATE G N^DICATT ; DEC S C=$P(^DD(A,DA,0),U,2),Y="",Z=$P(C,"J",2) F J=J:0 S N=$E(Z,1) Q:N?.A S Z=$E(Z,2,99),Y=Y_N  W !?J,"NUMBER OF FRACTIONAL DIGITS TO OUTPUT (ONLY ANSWER IF NUMBER-VALUED): " S N=$P(Y,",",2),E=$S(Y:+Y,1:8) I N]"" W N,"// " R DG Q:DG[U S N=$S(DG="":N,DG="@":"",1:DG) G S:N="",DICATT31^DIQQ:N'?1N I C?1"D".E S C=$E(C,2,99),^(0)=$P(^(0),U,1)_U_C_U_$P(^(0),U,3,99) S DG=" S X=$J(X,0,",M=$P(^(0),DG,1),%=M_DG_N_")"'=^(0)+1 W !?J,"SHOULD VALUE ALWAYS BE INTERNALLY ROUNDED TO ",N," DECIMAL PLACE",$E("S",N'=1) D YN^DICN G DEC:'% S ^(0)=M_$P(DG_N_")",U,%) S S DQI="Y(",O=$D(^(9.02)),X=^(9.1) K DICOMPX,^(9.02) G J:'$D(^(9.01)) F Y=1:1 S M=$P(^(9.01),";",Y) Q:M="" S DICOMPX(1,+M,+$P(M,U,2))="S("""_M_""")",DICOMPX="" G J:Y<2 I X'["/",X'["\" G J:X'["*",J:Y<3 D ^DICOMP G J:$D(X)-1 S %=2-O W !?J,"WHEN TOTALLING THIS FIELD, SHOULD THE SUM BE COMPUTED FROM",!?7,"THE SUMS OF THE COMPONENT FIELDS" D YN^DICN I %=1 S ^DD(A,DA,9.02)=X_" S Y=X" J K DICOMPX W !?J,"LENGTH OF FIELD: ",E,"// " R DG I DG,DG\1=DG S E=DG G 0 Q:DG[U I DG]"" W !,"MAXIMUM NUMBER OF CHARACTERS" G J 0 S ^(0)=$P(^DD(A,DA,0),U,1)_U_$P(C,"J",1)_"J"_E_$E(",",N]"")_N_Z_U_$P(^(0),U,3,99) )=$P(^(0),U,1)_U_C_U_$P(^(0),U,3,99) S DG=" S X=$J(X,0,",M=$P(^(0),DG,1),%=M_DG_N_")"'=^(0)+1 W !?J,"SHOULD VALUE ALWAYS BE INTERNALLY ROUNDED TO ",N," DECIMAL PLACE",$E("S",N'=1) D YN^DICN G DEC:'% S ^(0)=M_$P(DG_N_")",U,%) S S DQI="Y(",O=$D(^(9.02)),X=^(9.1) K DICOMPX,^(9.02) G J:'$D(^(9.01)) F Y=1:1 S M=$P(^(9.01),";",Y) Q:M="" S DICOMPX(1,+M,+$P(M,U,2))="S("""_M_""")",DICOMPX="" G J:Y<2 I X'["/",X'["\" G J:X'["*",J:Y<3 D ^DICOMP G J:$D(X)-1 S %=2-O W !?J,"WHEN TOTALLING THIS FIELD, SHOULD THE SUM BE COMPUTED FROM",!?7,"THE SUMS OF THE COMPONENT FIELDS" D YN^DICN I %=1 S ^DD(A,DA,9.02)=X_" S Y=X" J K DICOMPX W !?J,"LENGTH OF FIELD: ",E,"// " R DG I DG,DG\1=DG S E=DG G 0 Q:DG[U DICATT4 ;GFT/SF ; 05NOV82 18:38 ; KILL ALL OCCURENCES OF A FIELD IN THE DATABASE DIEZ S %=$N(^DIE("AF",A,D0,0)) I %>0 K ^(%),^DIE(%,"ROU") G DIEZ K ^DD(A,0,"ID",D0) I @("$N("_I(0)_"0))'>0") G N S %=1,Y=$P(O,U,4),X=$P(Y,S,1),Y=$P(Y,S,2),O=$S(+X=X:X,1:Q_X_Q)_")",E="^("_O I $N(^DD(A,"GL",X,-1))<0 S T="K ^(M,"_O G F I Y S T="U_$P("_E_",U,"_(Y+1)_",999) K:"_E_"?.""^"" "_E S:Y>1 T="$P("_E_",U,1,"_(Y-1)_")_U_"_T E S X=+$E(Y,2,4),Y=+$P(Y,",",2) G N:'X!'Y S T="$E("_E_",1,"_(X-1)_")_$J("""","_(Y-X+1)_")_$E("_E_","_(Y+1)_",999)" S T="I $D(^(M,"_O_")#2 S "_E_"="_T F W *7,!,"OK TO DELETE '",$P(M,U,1),"' FIELDS IN THE EXISTING ENTRIES" D YN^DICN G N:%-1 S M="",X=J/3,Y=I(0) I $D(DQI) K @(I(0)_Q_DQI_""")") L S O="M" S:X O=O_"("_X_")" S Y=Y_O,M=M_"F "_O_"=0:0 S "_O_"=$N("_Y_")) Q:"_O_"'>0 " S X=X-1 I X+1 S Y=Y_","_I(J\3-X)_"," G L X M_"X T W "".""" N G N^DICATT DICATT5 ;GFT/SF ; 02SEP83 20:21 7 K DIC S Y="",%=$P(O,U,3) S:$P(O,U,2)["P"&$L(%) @("Y=$P(^"_%_"0),U,1)") W !?J,"POINT TO WHICH FILE: " W:Y]"" Y_"// " R X I Y]"",X="" S X=Y I X'?1"^"1A.AN1"(".E S DIC=1,DIC(0)="EFQZ" S:DUZ(0)'="@" DIC("S")="I 1 Q:'$D(^(0,""RD"")) F %=1:1:$L(^(""RD"")) I DUZ(0)[$E(^(""RD""),%) Q" D ^DIC K DIC G:Y<0 7:X["?",T S X=^(0,"GL"),DE=Y G 77 I @("$D("_X_"0))") S Y=$P(^(0),U,1),DE=+$P(^(0),U,2)_U_Y W " ("_Y_")" G 77 T G NO^DICATT ; 77 S %=0 I DUZ(0)'="@",$D(^("LAYGO")) F Z=1:1 I DUZ(0)[$E(^("LAYGO"),Z) S:Z>$L(^("LAYGO")) %=1 Q I % W !?J,*7 D A W !?J,"WILL " D B E S %=2-($P(O,U,2)["'") W !?J,"SHOULD " D A W !?J D B,YN^DICN G T:%<1 S Z="P"_+DE_$E("'",%)_X,C="Q",L=9,E=X G H:DUZ(0)'="@" S S D=$S($D(^DD(A,DA,12.1)):^(12.1),1:""),%=2-(D]""),P=$S($D(^(12)):^(12),1:""),I=$S($D(^(12.2)):^(12.2),1:"") W !?J,"SHOULD '"_$P(DE,U,2)_"' ENTRIES BE SCREENED" D YN^DICN G T:%<1 I %=2 K ^(12.1),^(12),^(12.2) G H G M ;W !,"ENTER A TRUTH-VALUED EXPRESSION WHICH MUST BE TRUE OF ANY ENTRY POINTED TO:",!?4 I I]"" W I_"// " W:$X>35 !?4 R X G T:X=U S:X="" X=I I X="" G M:DUZ(0)="@",S K DG,K S ^(12.2)=X,K=100,DQI="Y(",DG(K)=K,K(1,1)=K,DSAVE(1)=99,(DLV,DLV0)=K,J(K)=+DE,I(K)=E,K=0 D EN^DICOMP G S:'$D(X) I $D(X)>1!(X[" ^DIC") W *7,!,"TOO COMPLICATED!" G S S I=0 I 'DBOOL W *7,!?8,"WARNING-- THIS DOESN'T LOOK LIKE A TRUTH-VALUED EXPRESSION" D0 S I=$F(X,E_"D0",I) I I S X=$E(X,1,I-3)_"Y"_$E(X,I,999) G D0 Q S I=$F(X,"""",I) I I S X=$E(X,1,I-1)_""""_$E(X,I,999),I=I+1 G Q S (D,X)="S DIC(""S"")="""_X_" I X""" G E:DUZ(0)'="@" M W !,"MUMPS CODE THAT WILL SET 'DIC(""S"")': " W:D]"" D_"//" R !?J+3,X G T:X=U I X="" S X=D G S:X="" D ^DIM:'$T E G S:'$D(X) W !?J,"EXPLANATION OF SCREEN: " W:P]"" P_"// " R % S:%="" %=P G S:%?.P S ^DD(A,DA,12)=%,^(12.1)=X,C=X_" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X",Z="*"_Z H G ^DICATT1 ; A W "'ADDING A NEW "_$P(DE,U,2)_" FILE ENTRY' (""LAYGO"")" Q B W "BE PROHIBITED WHEN ANSWERING THE '"_F_"' QUESTION"  !?4 R X G T:X=U S:X="" X=I I X="" G M:DUZ(0)="@",S K DG,K S ^(12.2)=X,K=100,DQI="Y(",DG(K)=K,K(1,1)=K,DSAVE(1)=99,(DLV,DLV0)=K,J(K)=+DE,I(K)=E,K=0 D EN^DICOMP G S:'$D(X) I $D(X)>1!(X[" ^DIC") W *7,!,"TOO COMPLICATED!" G S S I=0 I 'DBOOL W *7,!?8,"WARNING-- THIS DOESN'T LOOK LIKE A TRUTH-VALUED EXPRESSION" D0 S I=$F(X,E_"D0",I) I I S X=$E(X,1,I-3)_"Y"_$E(X,I,999) G D0 Q S I=$F(X,"""",I) I I S X=$E(X,1,I-1)_""""_$E(X,I,999),I=I+1 G Q S (D,X)="S DIC(""S"")="""_X_" I X""" G E:DUZ(0)'="@" M W !,"MUMPS CODE THAT WILL SET 'DIC(""S"")': " W:D]"" D_"//" R !?J+3,X G T:X=U I X="" S X=D G S:X="" D ^DIM:'$T E G S:'$D(X) W !?J,"EXPLANATION OF SCREEN: " W:P]"" P_"// " R % S:%="" %=P G S:%?.P S ^DD(A,DA,12)=%,^(12.1)=X,C=X_" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X",Z="*"_Z H G ^DICATT1 ; A WDICATT6 ;GFT/SF ; 30APR83 14:03 G @N ; 3 S Z="",L=1,P=0,Y="INTERNALLY-STORED CODE: " P S P=P+1,C=$P($P(O,U,3),S,P) W !?J,Y W:C]"" $P(C,":",1),"// " R T I T_C]"" G P:T="@" S:T="" T=$P(C,":",1) S X=T,L=$S($L(X)>L:$L(X),1:L) D C I $D(X) W " WILL STAND FOR: " W:C]"" $P(C,":",2),"// " R X S:X="" X=$P(C,":",2) D C I $D(X) G TOO:$L(Z)+$L(T)+$L(X)+$L(F)>235 S Z=Z_T_":"_X_S G P G T:Z=""!'$D(X) S Z="S^"_Z,C="Q" G H C I X["?",P=1 K X W !,"FOR EXAMPLE: INTERNAL CODE 'M' COULD STAND FOR 'MALE'",! Q I X[":"!(X[U)!(X[S)!(X[Q)!(X["=") K X W *7,!,"SORRY, ';' ':' '^' '""' AND '=' AREN'T ALLOWED IN SETS!",! Q ; TOO W *7,!,"TOO MUCH!! -- SHOULD BE 'POINTER', NOT 'SET'" T G NO^DICATT ; 4 S DL=1,DP=-1,DQ(1)="MINIMUM LENGTH^NR^^1^K:X\1'=X!(X<1) X",DQ(2)="MAXIMUM LENGTH^RN^^2^K:X\1'=X!(X>250) X",P=$P(C,")!'",2,9) I P]"" S:P?.E1") X" P=$E(P,1,$L(P)-2) S DE(4)=P S DQ(0,3)="I DG(2)",2),DE(1)=+$P(C,"$L(X)<",2) K Y F L=1,2,4 S DQ(L)=$J("",J)_DQ(L) S:$D(DE(L)) DG(L)=DE(L) D DQ^DIED K DQ G NO^DICATT:$D(Y) S L=DG(2),C=$S(L=DG(1):L,1:DG(1)_"-"_L),M="ANSWER MUST BE "_C_" CHARACTER"_$E("S",C'=1)_" IN LENGTH" I $D(DG(4)) S P=DG(4) I P]"" S:P?1"(".E1")" P=$E(P,2,$L(P)-1) S P=")!'("_P S C="K:$L(X)>"_L_"!($L(X)<"_DG(1)_P_") X",Z="F^" H G ^DICATT1 'T ALLOWED IN SETS!",! Q ; TOO W *7,!,"TOO MUCH!! -- SHOULD BE 'POINTER', NOT 'SET'" T G NO^DICATT ; 4 S DL=1,DP=-1,DQ(1)="MINIMUM LENGTH^NR^^1^K:X\1'=X!(X<1) X",DQ(2)="MAXIMUM LENGTH^RN^^2^K:X\1'=X!(X>250) X",P=$P(C,")!'",2,9) I P]"" S:P?.E1") X" P=$E(P,1,$L(P)-2) S DE(4)=P S DQ(0,3)="I DG(2)0 S DH(DQ)=^(DQ,0) S:$D(^(3)) DH(DQ,3)=^(3) W !! I 'Y S DQ=0 W "NO ",X G ^DICE W X I Y=1 W " IS " S DQ=$N(DH(0)) D L G ^DICE:$D(DH(DQ,3)) S %=2 W !,"WANT TO DELETE IT" D YN^DICN G DEL:%=1,^DICE W "S:" F J=0:0 S J=$N(DH(J)) Q:J'>0 W !?8,J,?14 S DQ=J D L S %=2 W !,"WANT TO DELETE ONE OF THEM" D YN^DICN G ^DICE:%-1 R !,"WHICH NUMBER: ",X G DICD:X\1'=X,DICD:'$D(DH(X))!$D(DH(X,3)) S DQ=X,I=DH(DQ) DEL W " ..OK",! K:I["SOUNDEX" ^DD(DI,0,"LOOK"),^("QUES") D DIEZ^DIU2 S ^DD(J(N),DL,1,0)="^.1",X=^(DQ,2),Y=$P(I,U,2) I Y?1A.E,+I=J(0),I'["MNEM" K @(I(0)_"Y)") G DDD G DDD:X="Q"!$F(I,"BUL") I I'["MUM",I'["TRIG" D DD G DDD S %=1 W "DO YOU WANT THE INDIVIDUAL CROSS-REFERENCE VALUES DELETED" D YN^DICN G Q^DICE:%<1 D DD:%=1 DDD S DIK="^DD(J(N),DL,1,",DA(1)=DL,DA(2)=J(N),DA=DQ D ^DIK G Q^DICE ; L  S I=DH(DQ),X=$P(I,U,3) S:X="" X="REGULAR" W X G E:X["BULL" I X["TRIGGER" S %=+$P(I,U,4),Y=+$P(I,U,5) W " OF" D WR^DIDH:$D(^DD(%,Y,0)) Q W " '",$P(I,U,2),"' INDEX OF " I +I=J(0) W "FILE" W:'$T $P(^DD(+I,0),U,1) W:$D(DH(DQ,3)) !?14,"("_DH(DQ,3)_")" Q ; E F %="CREA","DELE" S %=%_"TE VALUE" I $D(^DD(DI,DA,1,DQ,%)),^(%)'="NO EFFECT" W " ("_^(%)_")" Q ; DD K ^UTILITY("DIK",$J) S J=J(N),^($J,J,DL,1)=X,Y=$P(^DD(DI,DL,0),U,4),^UTILITY("DIK",$J,J,DL)=$P(Y,";",1),Y=$P(Y,";",2),^(DL,0)="S X=$"_$S(Y:"P(^(X),U,"_Y_")",1:"E(^(X),"_+$E(Y,2,9)_","_$P(Y,",",2)_")") I $D(^DD(J,DL,1,DQ,"DIK")) S ^UTILITY("DIK",$J,J,DL,1)="D RCR",^(1,0)=X K Y,DA,DV,DH S DH(1)=J(0) F Y=1:1:N S DV(J(Y-1),1)=I(Y),DV(J(Y-1),1,0)=J(Y) D WAIT S DIK=DIU,DA=0,DCNT=0 G CNT^DIK1 ; WAIT W !,"..." W $P("UH OH^EXCUSE ME PLEASE^SORRY","^",$R(3)+1),", ",$P("THIS MAY TAKE A FEW MOMENTS^LET ME PUT YOU ON 'HOLD' FOR A SECOND^HOLD ON^JUST A MOMENT PLEASE^I'M WORKING AS FAST AS I CAN^LET ME THINK ABOUT THAT A MOMENT","^",$R(6)+1)_"..." DH:$D(^DD(%,Y,0)) Q W " '",$P(I,U,2),"' INDEX OF " I +I=J(0) W "FILE" W:'$T $P(^DD(+I,0),U,1) W:$D(DH(DQ,3)) !?14,"("_DH(DQ,3)_")" Q ; E F %="CREA","DELE" S %=%_"TE VALUE" I $D(^DD(DI,DA,1,DQ,%)),^(%)'="NO EFFECT" W " ("_^(%)_")" Q ; DD K ^UTILITY("DIK",$J) S J=J(N),^($J,J,DL,1)=X,Y=$P(^DD(DI,DL,0),U,4),^UTILITY("DIK",$J,J,DL)=$P(Y,";",1),Y=$P(Y,";",2),^(DL,0)="S X=$"_$S(Y:"P(^(X),U,"_Y_")",1:"E(^(X),"_+$E(Y,2,9)_","_$P(Y,",",2)_")") I $D(^DD(J,DL,1,DQ,"DIK")) S ^UTILITY("DIK",$J,J,DL,1)="D RCR",^(1,0)=X K Y,DA,DV,DH S DH(1)=J(0) F Y=1:1:N S DV(J(Y-1),1)=I(Y),DV(J(Y-1),1,0)=J(Y) D WAIT S DIK=DIU,DA=0,DCNT=0 G CNT^DIK1 ; WAIT W !,"..." W $P("UH OH^EXCUSE ME PLEASE^SORRY","^",$R(3)+1),", ",$P("THIS MAY TAKE A FEW MOMENTS^LET ME PUT YOU ON 'HOLD' FOR A SECOND^HOLD ON^JUST A MOMENTDICE ;GFT/SF ; 03OCT83 19:26 S %=2,DCOND="CROSS-REFERENCE" W !,"WANT TO CREATE A NEW ",DCOND," FOR THIS FIELD" D YN^DICN G Q:%-1 S DH=0,DQ=DQ+1,DIC="^DOPT(""DICR"",",DIC(0)="EQA",DIC("B")=1,DIC("S")="I 1"_$P(",Y-4",U,DUZ(0)'="@")_$P(",Y-5",U,$D(^DD(J(N),0,"LOOK"))>0)_$P(",Y-7",U,'$D(^XMB(3.6))) D ^DIC K DIC D QQ S Y=+Y G X:Y<0,6^DICE0:Y=6,^DICE7:Y=7 G A:'N W !,"WANT TO ",DCOND," WHOLE FILE BY THIS FIELD" D YN^DICN G X:%<1 I %=1 S DH=N G A F DH=N-1:-1 Q:'DH S %=1 W !,"WANT TO "_DCOND_" "_$P(^DD(J(N-DH),0),U,1)_" BY THIS FIELD" D YN^DICN G X:%<1,A:%=1 A S %=1,DIK="" I Y=1!(Y=4) W !,"WANT ",DCOND," TO BE USED FOR LOOKUP AS WELL AS FOR SORTING" D YN^DICN G X:%<1 I %=2 S DIK="A" I Y=3 F I=0:0 S I=$N(^DD(J(N-DH),.01,1,I)) G X:I<0!(DL=.01&'DH) I $D(^(I,0)) S DE=$P(^(0),U,2) G CKF:DE?1U.UN I Y=4 F I=1,2 W !,"MUMPS ",$P("SET^KILL",U,I)," STATEMENT: " R X D ^DIM G Q:'$D(X),Q:U[X S X(I)=X IX F X=$S(Y-1&(Y-3)!(DA-.01):67,1:66):1 S DE=DIK_$C(X) I '$D(^DD(J(N-DH),0,"IX",DE)) Q:DUZ(0)'="@" W !,"INDEX: ",DE,"// " R X S:X]"" DE=X G Q:X[U,IX:DE'?1A.ANP,IX:$D(^(DE)) Q CKF W !,"..." S DREF=Y,X=^DD(J(N),DA,0) I $P(X,U,2)["F" S Y="K:X[""""""""!($A(X)=45) X I $D(X) " I X'[$P(Y,"$",2),$L(^(0))+$L(Y)<254 S ^(0)=$P(^(0),U,1,4)_U_Y_$P(X,U,5,99) D DIEZ^DIU2,^DICE0 S X=^DD(J(N),DA,1,DQ,1),%=1 I DREF=4!$D(^("CONDITION")),@("$N("_DIU_"0))>0") W !,"DO YOU WANT TO CROSS-REFERENCE EXISTING DATA NOW" D YN^DICN D DD^DICD:%=1 Q D QQ K DE,DB,DREF,DCOND,DICOMPX,I,DQ,DA,DH,DIK,DIC,N,DL,J,X,Y,A Q X W *7,"??" G Q ; QQ K ^DD(U,$J),DBOOL,DLAY,DQI,DICOMPX,DIN,DCNEW,DFLD,DREF,DENEW,DLOC,DSUB,DHI,DOLD,DNEW,%X,V DH),.01,1,I)) G X:I<0!(DL=.01&'DH) I $D(^(I,0)) S DE=$P(^(0),U,2) G CKF:DE?1U.UN I Y=4 F I=1,2 W !,"MUMPS ",$P("SET^KILL",U,I)," STATEMENT: " R X D ^DIM G Q:'$D(X),Q:U[X S X(I)=X IX F X=$S(Y-1&(Y-3)!(DA-.01):67,1:66):1 S DE=DIK_$C(X) I '$D(^DICE0 ;GFT/SF ; 10MAR83 12:56 S ^DD(J(N),DA,1,0)="^.1",^(DQ,0)=J(N-DH)_U_DE,X=I(0) F Y=N:-1:DH+1 S X=X_"DA("_Y_"),"_I(N+1-Y)_"," S X=X_""""_DE_""",",Y=",DA)" F %=1:1:DH S Y=",DA("_%_")"_Y D @DREF ;I DE'="B" K DICOMPX S DE(0)=Y(0) D COND^DICE4 S Y(0)=DE(0) I $D(DCOND) S ^(1)=X_" I X S X=DIV "_^DD(J(N),DA,1,DQ,1),^(2)=X_" I X S X=DIV "_^(2),^("CONDITION")=DCOND(0) S DIK="^DD(J(N),",DA(1)=J(N) G IX1^DIK ; 1 S Y="$E(X,1,30)"_Y,^(2)="K "_X_Y ;F %="P","S","D" I $P(^DD(J(N),DA,0),U,2)[% S X=$E(X,1,$L(X)-1)_")="""_%_""",^("""_DE_"""," Q S ^DD(J(N),DA,1,DQ,1)="S "_X_Y_"=""""" Q ; 2 S ^(0)=^(0)_"^KWIC",^(1)="F %=1:1 Q:$P(X,"" "",%,99)="""" S I=$P(X,"" "",%) I $L(I)>2,$L(I)<31,^DD(""KWIC"")'[I S "_X_"I"_Y_"=""""" S ^(2)="F %=1:1 Q:$P(X,"" "",%,99)="""" S I=$P(X,"" "",%) I $L(I)>2,$L(I)<31 K "_X_"I"_Y Q ; 3 D 1 S ^(1)=$E(^(1),1,$L(^(1))-2)_1,^(0)=^(0)_"^MNEMONIC" Q ; 4 S ^(0)=^(0)_"^MUMPS",^(1)=X(1),^(2)=X(2) K X Q ; 5 S ^(0)=^(0)_"^SOUNDEX",X=X_"X_I"_Y,Y="S I=$E(X,1,27) D SOU^DICM ",^(1)=Y_"S "_X_"=""""",^(2)=Y_"K "_X,(^DD(J(N),0,"LOOK"),^("QUES"))="SOUNDEX" Q ; 6 ; D ^DICE1 G Q:U[X S ^DD(U,$J,0)="^^TRIGGER^"_DIN_U_DENEW,^("FIELD")=DCNEW F DIK=1,2 D ^DICE2 G Q:U=X I '$D(^DD(DIN,DENEW,9)) S %=2 W !!,"WANT TO PROTECT THE '",DNEW,"' FIELD, SO THAT",!,"IT CAN'T BE CHANGED BY THE 'ENTER & EDIT' ROUTINE" D YN^DICN G QQ:%<0 S:%=1 ^(9)=U ; X ; S DA=DL D DIEZ^DIU2 S %Y="^DD("_DI_","_DL_",1,"_DQ_",",%X="^DD(U,$J," D %XY^%RCR,QQ S DIK=$P(%Y,",",1,3)_",",(DA,DREF)=DQ,DA(1)=DL,DA(2)=DI,@(DIK_"0)=U_.1") D IX1^DIK W !,"...CROSS-REFERENCE IS SET" S %=2 I @(DIK_DREF_",1)'=""Q"""),@("$N("_DIU_"0))>0") W !!,"DO YOU WANT TO RUN THE CROSS-REFERENCE FOR EXISTING ENTRIES NOW" D YN^DICN I %=1 S X=^DD(DI,DL,1,DQ,1) D DD^DICD Q G Q^DICE QQ G QQ^DICE DICE1 ;GFT/SF ; 24MAR83 14:56 ; TRIGGER FIELD S %=DI,DOLD=$P(^DD(DI,DL,0),U,1) W !!,"WHEN" D WR^DIDH R " IS CHANGED,",!,"WHAT FIELD SHOULD BE 'TRIGGERED': ",X Q:U[X F %=99:0 S %=$N(I(%)) Q:%<0 K I(%),J(%) S DQI="Y(",DCNEW=X,DICOMPX="",DICOMPX(0)="DIV(",DICOMPX(1,DI,DL)="X" D DA,^DICOMP F %=9.2:.1 Q:'$D(X(%)) S ^DD(U,$J,%)=X(%) I '$D(X)!'DICOMPX W !," ...",I,*7,!,"YOU MUST IDENTIFY SOME FIELD, EITHER WITHIN THE",!,"'",@("$P("_DIU_"0),U,1)"),"' FILE OR IN SOME OTHER" G FIELD S DFLD=X,DENEW=+$P(DICOMPX,U,2),DIN=+DICOMPX,DREF="" K X F X=0:100 Q:$N(I(X+99))<0 I DENEW=.001 W *7,!,"CAN'T UPDATE A 'NUMBER' FIELD!" G FIELD I DUZ(0)'="@",$D(^DIC(J(X),0,"DD")) D ACCESS E W *7,!,"YOU DON'T HAVE 'DATA DEFINITION' ACCESS TO",!," THE '",$N(^DD(J(X),0,"NM",0)),"' FILE!" G FIELD F X=X:1 S %=X#100,DREF=DREF_I(X)_$E(",",1,%)_"DIV("_%_"),",A=X S:$S('$D(J(%)):1,1:J(%)-J(X))&'$D(DICOMPX(0,J(X))) DREF(%)=$S('%:J(X),1:$P(^DD(J(X-1),$N(^DD(J(X-1),"SB",J(X),0)),0),U,2)),^DD(U,$J,"DIC")="LOOKUP" Q:J(X)=+DICOMPX!'$D(I(X+1)) S DLOC=$P(^DD(DIN,DENEW,0),U,4),DSUB=$P(DLOC,";",1),DLOC=$P(DLOC,";",2),DNEW=$P(^(0),U,1) S:+DSUB'=DSUB DSUB=Q_DSUB_Q I $P(^(0),U,2)["C" W !,*7,"CAN'T TRIGGER A COMPUTED FIELD!" G FIELD W " ...OK" Q ; DA S DA="^DD("_DI_","_DL_",1,"_DQ_"," Q ; ACCESS F %=1:1:$L(^("DD")) I DUZ(0)[$E(^("DD"),%) Q OME OTHER" G FIELD S DFLD=X,DENEW=+$P(DICOMPX,U,2),DIN=+DICOMPX,DREF="" K X F X=0:100 Q:$N(I(X+99))<0 I DENEW=.001 W *7,!,"CAN'T UPDATE A 'NUMBER' FIELD!" G FIELD I DUZ(0)'="@",$D(^DIC(J(X),0,"DD")) D ACCESS E W *7,!,"YOU DON'T HAVE 'DATA DEFINITION' ACCESS TO",!," THE '",$N(^DD(J(X),0,"NM",0)),"' FILE!" G FIELD F X=X:1 S %=X#100,DREF=DREF_I(X)_$E(",",1,%)_"DIV("_%_"),",A=X S:$S('$D(J(%)):1,1:J(%)-J(X))&'$D(DICOMPX(0,J(X))) DREF(%)=$S('%:J(X),1:$P(^DD(J(X-1),$N(^DD(J(X-DICE2 ;GFT/SF ; 26JAN84 23:04 W !!!,"---",$P("SET^KILL",U,DIK)," LOGIC---" C K DICOMPX,DATE S:DOLD=DNEW DNEW="TRIGGERED "_DNEW S DLAY=0,DNEW=$E(DNEW,1,30),DICOMPX(DNEW)="DIU",DCOND="SET" S:$P(^DD(DIN,DENEW,0),U,2)["D" DICOMPX(DNEW,"DATE")=1 W !!,"IN ANSWERING THE FOLLOWING QUESTION, '"_DNEW_"'",!?2,"CAN BE USED TO REFER TO THE EXISTING TRIGGERED FIELD VALUE.",! S DICOMPX="",DICOMPX(1,DI,DL)="DIV",DA=DA_DIK_"," S %=DIN D OLD W "PLEASE ENTER AN EXPRESSION WHICH WILL BECOME THE VALUE OF",! I $D(^DD(DIN,DENEW,0)) D WR^DIDH D GET Q:U[X I X="@" S X="S X=""""" E D ^DICOMP G DICE2^DIQQ:'$D(X) F %=9.2:.1 Q:'$D(X(%)) S ^DD(U,$J,DIK,%)=X(%) D DA^DICE1 I X="S X=""""" S DCOND="DELE" D DIU^DICE3 G ^DICE4:DENEW-.01,D01:A-N W *7,"??" G C S DE=$P(^DD(DIN,DENEW,0),U,2) I DE["D",'Y["D" W *7,!,"WARNING -- THIS SHOULD PRODUCE A DATE VALUE, AND IT MAY NOT!" S V=$P(DE,"P",2) I V,DICOMPX-V!($P(DICOMPX,U,2)-.001) W !,*7,"WARNING -- THIS MUST BE '",$P(^DIC(+V,0),U,1)," NUMBER'!" I Y["B" W *7,!,"WARNING--THIS TRUTH-VALUED EXPRESSION WILL PRODUCE ONLY VALUES OF '0' OR '1'" I DE'["D",Y["D" W *7,!,"WARNING -- THIS MAY PRODUCE A 'DATE', AND IT SHOULDN'T!" D ^DICE3 Q:X=U G ^DICE4 ; OLD ; I DIK=2 S X=$E("OLD "_DOLD,1,30),DICOMPX(X)="X" W ?2,"NOTE: '"_X_"' CAN BE USED TO REFER TO THE VALUE OF THE",!?2,DOLD_" FIELD BEFORE ITS CHANGE OR DELETION.",! S:$P(^DD(DI,DL,0),U,2)["D" DICOMPX(X,"DATE")=1 Q ; D01 S V=DREF,X=$L(V)-1 F %=X:-1 I "(,"[$E(V,%) S DHI=$E(V,%+1,X) I DHI'?1N1")" S V=$E(V,1,%),X=0 Q DQ S X=$F(V,Q,X) I X>0 S V=$E(V,1,X-1)_Q_$E(V,X,999),X=X+2 G DQ S X="I "_DHI_">0 S DIK(0)=DA,",V="DIK="""_V_""",",DHI="DA="_DHI_" D ^DIK",DTAG="S DA=DIK(0)" F %=1:1:N S X=X_"DIK("_%_")=DA("_%_"),",DTAG=DTAG_",DA("_%_")=DIK("_%_")" F %=1:1:A#100 S DHI="DA("_%_")=DIV("_(A#100-%)_"),"_DHI S X=X_V_DHI,DTAG=DTAG_" K DIK",^DD(U,$J,"DIK")="DELETE" G F^DICE4  ; GET ; W !," WHENEVER THE '"_DOLD_"' FIELD IS "_$P("ENTERED OR CHANGED^CHANGED OR DELETED",U,DIK) R ": ",X S Y=X I X="" S Y="NO EFFECT",^DD(U,$J,DIK)="Q" W " ",Y I DIK=2,^DD(U,$J,1)="Q" W *7,"??" S X=U S ^DD(U,$J,$P("CREA^DELE",U,DIK)_"TE VALUE")=Y TO THE VALUE OF THE",!?2,DOLD_" FIELD BEFORE ITS CHANGE OR DELETION.",! S:$P(^DD(DI,DL,0),U,2)["D" DICOMPX(X,"DATE")=1 Q ; D01 S V=DREF,X=$L(V)-1 F %=X:-1 I "(,"[$E(V,%) S DHI=$E(V,%+1,X) I DHI'?1N1")" S V=$E(V,1,%),X=0 Q DQ S X=$F(V,Q,X) I X>0 S V=$E(V,1,X-1)_Q_$E(V,X,999),X=X+2 G DQ S X="I "_DHI_">0 S DIK(0)=DA,",V="DIK="""_V_""",",DHI="DA="_DHI_" D ^DIK",DTAG="S DA=DIK(0)" F %=1:1:N S X=X_"DIK("_%_")=DA("_%_"),",DTAG=DTAG_",DA("_%_")=DIK("_%_")" F %=1:1:A#100 S DHI="DA("_%_")=DIV("_(A#100-%)_"),"_DHI S X=X_V_DHI,DTAG=DTAG_" K DIK",^DD(U,$J,"DIK")="DELETE" G F^DICE4 DICE3 ;GFT/SF ; 10FEB83 19:00 S DE=0,V=-1,DHI="DIC(0)=""NMF" F %X=9.2:.1:10 I $D(^DD(U,$J,%X)) S Y=^(%X) G LAYGO RY S %X=0 D DIU LAYGO S V=$N(DREF(V)) I V<0 D DIU:%X Q S DE=$F(Y,"DIC(0)=""NMF",DE),%=0 I DE<1 Q:'%X S %X=%X+.1,V=V-.1 G RY:'$D(^DD(U,$J,%X)) S Y=^(%X),DE=0 G LAYGO I $E(Y,DE)=Q!'%X W !!,"DO YOU WANT TO PERMIT ADDING A NEW '",$N(^DD(+DREF(V),0,"NM",0)),"' ENTRY",!," AT THE TIME OF TRIGGERING, IF NECESSARY" D YN^DICN I %<1 S X=U Q G LAYGO:%-1 S DLAY=1,%=2 W !!,"DO YOU WANT TO **FORCE** ADDING A NEW ENTRY EVERY TIME THE TRIGGER OCCURS",!,"(I.E., EVEN IF A MATCHING ENTRY ALREADY EXISTS)" D YN^DICN I %<1 S X=U Q S DHI=$P(",X=""""""""_X_""""""""",U,%=1),DTAG=$E(Y,DE+1,999),Y=$E(Y,1,DE-1)_"L""",%=$F(DTAG," ",$F(DTAG,"D ^DIC")),DDIC=$E(DTAG,1,%-2),DTAG=$E(DTAG,%-1,999) I V S DHI=DHI_",DIC(""P"")="""_DREF(V)_Q F %=1:1:V S DHI=DHI_",DIU("_%_")=$S($D(DA("_%_")):DA("_%_"),1:0),DA("_%_")=DIV("_(V-%)_")",DTAG=" S DA("_%_")=DIU("_%_")"_DTAG  I $L(DDIC)+$L(Y)+$L(DTAG)+$L(DHI)>240 S ^DD(U,$J,DIK_%X)=$E(DDIC,2,999)_DTAG,DDIC=" X "_DA_DIK_%X_")",DTAG="" I $L(Y)+$L(DHI)>215 S ^(DIK+.5)="S "_$E(DHI,2,999),DHI=" X "_DA_DIK_".5)" S Y=Y_DHI_DDIC_DTAG S:%X ^DD(U,$J,%X)=Y K DHI,DTAG,DDIC G LAYGO ; DIU S Y=DFLD_" S DIU=X K Y" (+DREF(V),0,"NM",0)),"' ENTRY",!," AT THE TIME OF TRIGGERING, IF NECESSARY" D YN^DICN I %<1 S X=U Q G LAYGO:%-1 S DLAY=1,%=2 W !!,"DO YOU WANT TO **FORCE** ADDING A NEW ENTRY EVERY TIME THE TRIGGER OCCURS",!,"(I.E., EVEN IF A MATCHING ENTRY ALREADY EXISTS)" D YN^DICN I %<1 S X=U Q S DHI=$P(",X=""""""""_X_""""""""",U,%=1),DTAG=$E(Y,DE+1,999),Y=$E(Y,1,DE-1)_"L""",%=$F(DTAG," ",$F(DTAG,"D ^DIC")),DDIC=$E(DTAG,1,%-2),DTAG=$E(DTAG,%-1,999) I V S DHI=DHI_",DIC(""P"")="""_DREF(V)_Q F %=1:1:V S DHI=DHI_",DIU("_%_")=$S($D(DA("_%_")):DA("_%_"),1:0),DA("_%_")=DIV("_(V-%)_")",DTAG=" S DA("_%_")=DIU("_%_")"_DTAG DICE4 ;GFT/SF ; 26JAN84 23:23 S DE="S X=DIV "_X D SET S DTAG="S DIH=$S($D("_DREF_DSUB_")):^("_DSUB_"),1:""""),DIV=X "_$P("I $D(^(0)) ",Q,A>99)_X_",DIH="_DIN_",DIG="_DENEW_" D ^DICR:$N(^DD(DIH,DIG,1,0))>0",X="" S:$L(DE)+$L(DTAG)>160&($L(DE)>30) ^DD(U,$J,DIK+.1)=DE,DE="X "_DA_DIK_".1)" S X=DE F ; S:$L(Y)+$L(X)>190 ^DD(U,$J,DIK+.2)=Y,Y="X "_DA_DIK_".2)" S:$L(Y) X=Y_" "_X K DICOMPX(DNEW) S DHI=X,DCOND=DCOND_"TING OF '"_DNEW_"'" D COND G P:'$D(DCOND) I DLAY,DICOMPX,DICOMPX-DI W !,"SORRY, CAN'T DO THIS WHEN 'LAYGO' ALLOWED" S X=U Q S DHI="I X S X=DIV "_DHI I $N(J(A))>0 S ^("DIC")="" P S:$L(DHI)+$L(X)>220 ^DD(U,$J,DIK+.3)=X,X="X "_DA_DIK_".3)" S X=X_" "_DHI S:$L(DTAG)+$L(X)>225 ^DD(U,$J,DIK+.4)=DTAG,DTAG="X "_DA_DIK_".4)" S ^DD(U,$J,DIK)=X_" "_DTAG K DTAG Q ; SET G PIECE:DLOC S DHI=$P(DLOC,",",2),%=+$E(DLOC,2,9),X="S DE="_(%-1)_"-$L(DIH),Y=$E(DIH,"_(DHI+1)_",999),^("_DSUB_")=" I %>1 S X=X_"$E(DIH,1,"_(%-1)_")_" S X=X_"$J("""",$S(DE>0:DE,1:0))_DIV_$S(Y?."" "":"""",1:$J("""","_(DHI-%+1)_"-$L(DIV))_Y)" Q PIECE S X=$S(DLOC<3:"",1:"X ""F %=0:0 Q:$L($P(DIH,U,"_(DLOC-1)_",99)) S DIH=DIH_U"" ") S X=X_"S %=$P(DIH,U,"_(DLOC+1)_",999),^("_DSUB_")=" I DLOC>1 S X=X_"$P(DIH,U,1,"_(DLOC-1)_")_U_" S X=X_"DIV_$S(%]"""":U_%,1:"""")" Q ; COND S DE=" DIV=X" F %=0:1:N S DE=DE_",D"_%_"=DA"_$S(%=N:"",1:"("_(N-%)_")") I A#100'<% S DE=DE_",DIV("_%_")=D"_% D CC I $D(DCOND) S DE=DE_" "_X S X="K DIV S "_$E(DE,2,999) Q ; CC ; W !!,"DO YOU WANT TO MAKE THE "_DCOND_" CONDITIONAL" S %=2,DICOMPX="" D YN^DICN I %-1 K DCOND Q I DIK=1 S DICOMPX("Y(0)")="Y(0)",DICOMPX(1,DI,DL)="Y(0)" E W ! D OLD^DICE2 W !,"ENTER AN EXPRESSION FOR THE CONDITION" R ": ",X I X?1"?".E W !,"ENTER A TRUTH-VALUED 'COMPUTED-FIELD' EXPRESSION ",!?4,"(PERHAPS INVOLVING '"_DOLD_"')" G CC S DCOND(0)=X I X]"" D ^DICOMP I $D(X)=1 W:Y'["B" !,"WARNING--THIS DOESN'T LOOK LIKE A CONDITION EXPRESSION!" S X="S Y(0)=X "_X,^DD(U,$J,$P("CREA^DELE",U,DIK)_"TE CONDITION")=DCOND(0) Q W:$D(X) !?9,"TOO LONG" W *7,"??" G CC $P(DIH,U,1,"_(DLOC-1)_")_U_" S X=X_"DIV_$S(%]"""":U_%,1:"""")" Q ; COND S DE=" DIV=X" F %=0:1:N S DE=DE_",D"_%_"=DA"_$S(%=N:"",1:"("_(N-%)_")") I A#100'<% S DE=DE_",DIV("_%_")=D"_% D CC I $D(DCOND) S DE=DE_" "_X S X="K DIV S "_$E(DE,2,999) Q ; CC ; W !!,"DO YOU WANT TO MAKE THE "_DCOND_" CONDITIONAL" S %=2,DICOMPX="" D YN^DICN I %-1 K DCOND Q I DIK=1 S DICOMPX("Y(0)")="Y(0)",DICOMPX(1,DI,DL)="Y(0)" E W ! D OLD^DICE2 W !,"ENTER AN EXPRESSION FOR THE CONDITION" R ": ",X I X?1"?".E W !,"ENTER A TRUTH-VALUED 'COMPUTED-FIELD' EXPRESSION ",!?4,"(PERHAPS INVOLVING '"_DOLD_"')" G CC S DCOND(0)=X I X]"" D ^DICOMP I $D(X)=1 W:Y'["B" !,"WARNING--THIS DOESN'T LODICE7 ;GFT/SF ; 26JAN84 22:31 S DOLD=$P(^DD(DI,DL,0),U,1),^DD(U,$J,0)="^^BULLETIN MESSAGE" F DIK=1,2 D M,DA^DICE1 G QQ:X[U I X]"" S DQI="Y(",DCOND="SENDING OF '"_DREF_"'" D CC^DICE4 S DHI=0,DLAY=$S($D(DCOND):X,1:"") D S G QQ:X=U G X^DICE0 QQ G QQ^DICE ; M W !!!,"---"_$P("SET^KILL",U,DIK)_" LOGIC---",!!,"ENTER THE NAME OF A 'BULLETIN' MESSAGE, IF YOU WANT THAT MESSAGE SENT" D GET^DICE2 Q:X="" S DIC=3.6,DIC(0)="ELMQ",DIC("DR")=".02:9999" D ^DIC K DIC,DICOMPX G M:Y<0 S (X,DREF,^DD(U,$J,$P("CREA^DELE",U,DIK)_"TE VALUE"))=$P(Y,U,2) Q ; S W " ..OK",! S DHI=DHI+1 SS S DLOC="PARAMETER #"_DHI I DHI>1 W !,"NOW, IF THE BULLETIN IS TO HAVE "_DHI_" OR MORE PARAMETERS INSERTED," W !,"ENTER A FIELD NAME (FOR EXAMPLE, '"_DOLD_"'),",!,"OR A 'COMPUTED-FIELD' EXPRESSION,",!,"THE VALUE OF WHICH WILL BE PASSED INTO THE '"_DREF_"' MESSAGE,",!,"AS "_DLOC S X=$N(^XMB(3.6,"B",DREF,0)) I X F Y=1:1 Q:'$D(^XMB(3.6,X,4,Y,0)) I ^(0)=DHI F D=1:1 G T:'$D(^XMB(3.6,X,4,Y,1,D,0)) W !?4,"-- ",^(0) W !,"(NOTE THAT NO SUCH PARAMETER IS DEFINED FOR THE '"_DREF_"' BULLETIN)" T W ! D OLD^DICE2 W DLOC_": " R X G:X?.P SET:X="",QQ:X=U,SS S DSUB=X D ^DICOMP I $D(X)-1 W *7,"??",! G SS S DHI(DHI)=X_$P(" S Y=X X ^DD(""DD"") S X=Y",1,Y["D"),^DD(U,$J,$P("CREA^DELE",U,DIK)_"TE "_DLOC)=DSUB G S SET W ! S ^DD(U,$J,DIK)="S XMB="""_DREF_""" D ^XMB:$D(^XMB(3.6,""B"",XMB)) K Y,XMB",Y="",DHI=185-(DHI*20) F D=1:1 Q:'$D(DHI(D)) S X="S X=Y(0) "_DHI(D)_" S XMB("_D_")=X" S:$L(DREF)+$L(X)+$L(Y)>DHI %=DIK_"."_D,^(%)=X,X="X "_DA_%_")" S Y=Y_" "_X S I="S Y(0)=X,D"_N_"=DA" F %=1:1:N S I=I_",D"_(N-%)_"=DA("_%_")" I $L(DLAY) S Y=" I X"_Y S:$L(I)+$L(Y)+$L(DLAY)>200 ^(DIK+.9)=DLAY,DLAY="X "_DA_(DIK+.9)_")" S DLAY=" "_DLAY S:Y]""!$T ^(DIK)=I_DLAY_Y_" "_^(DIK) PASSED INTO THE '"_DREF_"' MESSAGE,",!,"AS "_DLOC S X=$N(^XMB(3.6,"B",DREF,0)) I X F Y=1:1 Q:'$D(^XMB(3.6,X,4,Y,0)) I DICM ; ; 01JAN84 18:08 G ^DICQ:X?."?" S:X="." X=U I X[U S DUOUT=1 G NO^DIC S:'$D(DICR(1)) DICR=0 I $A(X)=34,X?.E1"""" G N G:$D(^DD(+DO(2),0,"LOOK")) @^("LOOK") R S %="B",Y=+DO(2),%Y=.01 G 1 Z S %=$N(^DD(+DO(2),0,"IX",%)),Y=$N(^(%,0)),%Y=$N(^(Y,0)) 1 G 2:Y<0,Z:$D(DICR(U,Y,%Y)),Z:D'=%&(DIC(0)'["M"),Z:'$D(^DD(Y,%Y,0)) S DICR(U,Y,%Y)=0,DS=^(0) I $D(^(7)) D RS K DS X ^(7) G Y F Y="P","D","S",-1 I $P(DS,U,2)[Y S:%="B" DICR(DICR,6)=0 D A,@Y,RCR Q Y G R:Y<0 2 G K:Y+1 I X?.E1L.E,DIC(0)'["X" D RS S DD="L" D DZ,LC^DICM1 G K:Y+1 I $L(X)>30 D RS S Y="DICR("_DICR_")",DS=$S(DIC(0)["X":"I $P(^(0),U,1)="_Y,1:"I '$L($P(^(0),"_Y_",1))"),X=$E(X,1,30) D 7 G K:Y+1 S DS="" F %=2:1 S DD=$P(X,",",%) I DD'["""" S:$A(DD)=32 DD=$E(DD,2,999) Q:$L(DD)+$L(DS)>210!(DD="") S DS=DS_" S I=$F(%,"""_DD_""") I I,$E(%,I-"_($L(DD)+1)_")?.P" I DS]"",DIC(0)'["X" D RS S X=$P(X,",",1),DS="S %=$P(^(0),U,1)"_DS W:DIC(0)["E" " "_X D 7 K S DD=$D(DICR(DICR,6)) K:'DICR DICR I Y+1 K DIC("W") G R^DIC:DIC(0)["Z" Q D U G:'$T B:DD,NL:DIC(0)["N",L I 'DD!$D(DICR),DO(2)'["Z" S Y=0 F DS=1:1:20 S @("Y=$N("_DIC_"Y))") Q:Y'>0 I $P(^(Y,0),U,1)=X X:$D(DIC("S")) DIC("S") I G GOT NL I '$D(DICR) D NQ G GOT:$T,B:DD L I DIC(0)["L" G ^DICN B G O^DIC1 ; N D RS S X=$E(X,2,$L(X)-1),DS=^DD(+DO(2),.01,0),%=D F Y="P","D","S" I $P(DS,U,2)[Y K:Y="P" DO D @Y Q D L:$D(X),E G B:Y<0,2 ; A I %'="B" S DICR(DICR+1,8)=1 RS S DICR=DICR+1,DICR(DICR)=X,DICR(DICR,0)=DIC(0),DD="A" D DZ S DD="Q" DZ S DIC(0)=$P(DIC(0),DD,1)_$P(DIC(0),DD,2) Q ; RCR S DICRS=1 DIC S Y=-1 I $D(X),$L(X)<31 S DD="L" D DZ:$D(DICR(DICR,8)),RENUM^DIC1 E S D="B",%=DICR,X=DICR(%),DIC(0)=DICR(%,0),DICR=%-1 S:$D(DICR(%,9)) (D,DF)=DICR(%,9) K DICRS,DICR(%) D DO^DIC1:'$D(DO) Q ; GOT S DIY="" G GOT^DIC ; U I @("$N("_DIC_"""A[""))<0") Q ; NQ I $L(X)<14,X?.NP, +X=X,@("$D("_DIC_"X,0))") S Y=X D S^DIC Q ; S G S^DICM1 ; D I $S(X?.N:X>49,1:1) S %DT="T" D ^%DT S X=Y I X>1 Q:DIC(0)'["E" W " " G DT^DIQ NO K X Q ; P G ^DICM1 ; SOUNDEX I DIC(0)["E",'$D(DICRS) W " " D RS,SOU^DICM1 S DD="L" D DZ,RCR Q:Y>0 G R ; 7 S Y=-1,%=$S($D(DIC("S")):DIC("S"),1:1) I $D(DS) S DIC("S")=DS,DD="L" S:'% DIC("S")=DIC("S")_" X DIC(""S1"")",DIC("S1")=% D DZ,F^DIC K DIC("S") S:$D(DIC("S1")) DIC("S")=DIC("S1") K DIC("S1") G E ; OK ; S %=1 I $D(DS),DS=1 W !?9,"...OK" D YN^DICN G R^DIC:%=1,B:%<1 S X=DIX G L ; SOU G SOU^DICM1  S D="B",%=DICR,X=DICR(%),DIC(0)=DICR(%,0),DICR=%-1 S:$D(DICR(%,9)) (D,DF)=DICR(%,9) K DICRS,DICR(%) D DO^DIC1:'$D(DO) Q ; GOT S DIY="" G GOT^DIC ; U I @("$N("_DIC_"""A[""))<0") Q ; NQ I $L(X)<14,X?.NP,DICM1 ;GFT/SF ; 02JAN84 12:15 P ; ;I X?.N,X=DICR(DICR),@("$D("_DIC_"X))"),$N(^("A["))<0 S Y=X Q I $D(DF)#2 S DICR(DICR,9)=DF K DF S DICR(DICR,1)=DIC,DICR(DICR,4)=%,DIC=U_$P(DS,U,3),Y=DIC(0),(D,DIC(0))=$P(DIC(0),"L",1)_$P(DIC(0),"L",2),DICR(DICR,2)=$S(%="B":Y,1:D),DICR(DICR,2.1)=$S($P(DS,U,2)["'":D,1:Y) S DIC(0)=$P(DIC(0),"N",1)_$P(DIC(0),"N",2) F Y="S","P","W" I $D(DIC(Y)) S DICR(DICR,Y)=DIC(Y) K DIC(Y) AST I $P(DS,U,2)["*" S Y=$F(DS," D ^DIC") I Y X $P($E(DS,1,Y-8),U,5,99) I $D(DIC("S")) S DICR(DICR,31)=DIC("S") S Y="("_DICR(DICR,1) G L1:'$D(DO) K DO I @("$N"_Y_"0))'>0") G L1 S %=Y_""""_%_""",Y))",Y=0 I @("$N"_%_">0") S D="I $D"_% E S D="F I=0:0 S I=$N("_DICR(DICR,1)_"I)) Q:I'>0 I +^(I,0)=Y Q" S DIC("S")=$P("X DICR("_DICR_",31) I ",U,$D(DICR(DICR,31)))_D,D="B" D X^DIC L1 K DIC("S") I Y'>0,'$D(DICR(DICR,8)) D DO^DIC1 K DICR(U,+DO(2),.01) S:$D(DICR(DICR,31)) DIC("S")=DICR(DICR,31) S D="B",DIC(0)=DICR(DICR,2.1) D X^DIC G R I DICR(DICR,2)["L",DICR(DICR,2)["E" W !?9,"...OK" S %=1 D YN^DICN W ! I %-1 G NO:%-2 S D="B",DIC("S")="I Y-"_+Y_$S($D(DICR(DICR,31)):" "_DICR(DICR,31),1:""),X=DICR(DICR) W X D X^DIC R K DO,DIC("W"),DIC("S") S DIC=DICR(DICR,1),%=DICR(DICR,2),DIC(0)=$P(%,"M",1)_$P(%,"M",2),D=DICR(DICR,4) F X="S","P","W" S:$D(DICR(DICR,X)) DIC(X)=DICR(DICR,X) D DO^DIC1 S X=+Y K:X'>0 X Q ; NO S Y=-1 G R ; S ; S DICR(DICR,1)=1,Y=$P(DS,U,3),DD=$P(";"_Y,";"_X_":",2) I DD]"" W:DIC(0)["E" " (",$P(DD,";",1),")" Q SS S DD=$P(Y,";",1),Y=$P(Y,";",2,99) I DD]"" G SS:DD'[(":"_X) W:DIC(0)["E" $P(DD,X,2,9) S X=$P(DD,":",1) Q K X S Y=-1 Q ; LC ; F %=1:1 S Y=$E(X,%) I Y?.L Q:Y="" S X=$E(X,1,%-1)_$C($A(Y)-32)_$E(X,%+1,999) G DIC^DICM ; SOU ; S DSOU="01230129022455012623019202",DSOV=X,X=$C($A(X)-(X?1L.E*32)),DIX=$E(DSOU,$A(X)-64) F DIY=2:1 S Y=$E(DSOV,DIY) Q:","[Y I Y?1A S %=$E(DSOU,$A(Y)-$S(Y?1U:64,1:96)) I %-DIX,%-9 S DIX=% I % S X=X_% Q:$L(X)=4 S X=$E(X_"000",1,4) K DSOU,DSOV  Y-"_+Y_$S($D(DICR(DICR,31)):" "_DICR(DICR,31),1:""),X=DICR(DICR) W X D X^DIC R K DO,DIC("W"),DIC("S") S DIC=DICR(DICR,1),%=DICR(DICR,2),DIC(0)=$P(%,"M",1)_$P(%,"M",2),D=DICR(DICR,4) F X="S","P","W" S:$D(DICR(DICR,X)) DIC(X)=DICR(DICR,X) D DO^DIC1 S X=+Y K:X'>0 X Q ; NO S Y=-1 G R ; S ; S DICR(DICR,1)=1,Y=$P(DS,U,3),DD=$P(";"_Y,";"_X_":",2) I DD]"" W:DIC(0)["E" " (",$P(DD,";",1),")" Q SS S DD=$P(Y,";",1),Y=$P(Y,";",2,99) I DD]"" G SS:DD'[(":"_X) W:DIC(0)["E" $P(DD,X,2,9) S X=$P(DD,":",1) Q K X S Y=-1 Q ; LC ; F %=1:1 S Y=$E(X,%) I Y?.L Q:Y="" S X=$E(X,1,%-1)_$C($A(Y)-32)_$E(X,%+1,999) G DIC^DICM ; SOU ; S DSOU="01230129022455012623019202",DSOV=X,X=$C($A(X)-(X?1L.E*32)),DIX=$E(DSOU,$A(X)-64) F DIY=2:1 S Y=$E(DSOV,DIY) Q:","[Y I Y?1A S %=$E(DSOU,$A(Y)-$S(Y?1 DICN ; I $S($D(DLAYGO):DO(2)\1-(DLAYGO\1),1:1),$D(^DIC(+DO(2),0,"LAYGO")),DUZ(0)'="@" F DD=1:1 S DS=$E(^("LAYGO"),DD) G B:DS="" Q:DUZ(0)[DS K DD D DS S DIX=X I X?.NP,X,DIC(0)["E",'$D(DICR),DS'["DINUM",$P(DS,U,2)'["N",DIC(0)["N"!$D(^DD(+DO(2),.001,0)) D N^DICN1 I $D(X) S DD=X G I S X=DIX D VAL G I:$D(X) S X=DIX B G BAD^DIC1 ; 1 I '$D(DIC("S")) W " (THE ",Y,$S(Y#10=1&(Y#100-11):"ST",Y#10=2&(Y#100-12):"ND",Y#10=3&(Y#100-13):"RD",1:"TH"),$S('$D(^DD(+DO(2),0,"UP")):"",1:" FOR THIS "_$N(^DD(^("UP"),0,"NM",0))),")" YN ; W "? ",$P("YES// ^NO// ",U,%) RX R %Y:$S($D(DTIME):DTIME,1:99999) E S DTOUT=1,%Y=U W *7 S:%Y]""!'% %=$A(%Y),%=$S(%=89:1,%=121:1,%=78:2,%=110:2,%=94:-1,1:0) I '%,%Y'?."?" W *7,"??",!?4,"ANSWER 'YES' OR 'NO': " G RX W:$X>73 ! W $P(" (YES)^ (NO)",U,%) K %Y Q ; DS S DS=^DD(+DO(2),.01,0) Q ; VAL I X'?.ANP!($A(X)=45) K X Q I $P(DS,U,2)["*" S:DS["DINUM" DINUM=X Q S %=$F(DS,"%DT=""E"),DS=$E(DS,1,%-2)_$E(DS,%,999) X $P(DS,U,5,99) Q ; I I DIC(0)["E",DO(2)'["A" W *7,!?3,"ARE YOU ADDING " W:DO(2)'["P"&(DO(2)'["D")&'$D(DD) "'"_DIX_"' AS " S %=$P(DO,U,1) W:$X+$L(%)>55 !?7 W "A NEW "_% S %=0,Y=$P(DO,U,4)+1 D 1 G B:%-1 G FILE:'$D(DD) R D DS W !?3,$P(DS,U,1),": " R X G B:X[U,R:X="" D VAL I '$D(X) W *7,"??" W:$D(^DD(+DO(2),.01,3)) !,^(3) G R FILE S DIX=X F1 S X=$P(DO,U,3) D INCR S X=X\DIY*DIY+DIY I $D(DINUM) S X=DINUM D INCR F2 I @("$D("_DIC_"X))") S X=X\DIY*DIY+DIY G F2 S Y=$P(DO,"^",2) I $D(DD) S X=DD E I 'Y,DUZ(0)'="@" G LOCK I DIC(0)["E",$D(^DD(+Y,.001,0)) G NUM^DICN1 LOCK L @(DIC_"X):1") I @("$D("_DIC_"X))!'$T") L W *7 G B:$D(DINUM),F1 S ^(X,0)=DIX,DD=0 L K D S:$D(DA)#2 D=DA S DA=X,X=DIX I @("$D("_DIC_"0))") S ^(0)=$P(^(0),"^",1,2)_"^"_DA_"^"_($P(^(0),"^",4)+1) IX S DD=$N(^DD(+DO(2),.01,1,DD)) I DD>0 G RIX^DICN1:^(DD,0)["TRIGGER" X ^(1) G IX I DIC(0)["E",$N(^DD(+DO(2),0,"ID",0))>0!$D(DIC("DR")) G ^DICN1 D S Y=DA_"^"_X_"^"_1 S:$D(D)#2 DA=D G R^DIC ; INCR S DIY=1 I $P(DO,U,2)>1 F %=1:1:$L($P(X,".",2)) S DIY=DIY/10 =$P(DO,U,4)+1 D 1 G B:%-1 G FILE:'$D(DD) R D DS W !?3,$P(DS,U,1),": " R X G B:X[U,R:X="" D VAL I '$D(X) W *7,"??" W:$D(^DD(+DO(2),.01,3)) !,^(3) G R FILE S DIX=X F1 S X=$P(DO,U,3) D INCR S X=X\DIY*DIY+DIY I $D(DINUM) S X=DINUM D INCR F2 I @("$D("_DIC_"X))") S X=X\DIY*DIY+DIY G F2 S Y=$P(DO,"^",2) I $D(DD) S X=DD E I 'Y,DUZ(0)'="@" G LOCK I DIC(0)["E",$D(^DD(+Y,.001,0)) G NUM^DICN1 LOCK L @(DIC_"X):1") I @("$D("_DIC_"X))!'$T") L W *7 G B:$D(DINUM),F1 S ^(X,0)=DIX,DD=0 L K D S:$D(DA)#2 D=DA S DA=X,X=DIX I @("$D("_DIC_"0))") S ^(0)=$P(^(0),"^",1,2)_"^"_DA_"^"_($P(^(0),"^",4)+1) IX S DD=$N(^DD(+DO(2),.01,1,DD)) I DD>0 G RIX^DICN1:^(DD,0)["TRIGGER" X ^(1) G DICN1 ;GFT/SF ; 27DEC83 16:00 K DICRS,Y,%RCR F Y="I","J","X","DO","DC","DA","DE","DG","DIE","DR","DIC","D","D0","D1","D2","D3","D4","D5","D6","DI","DH","DIA","DICR","DK","DIK","DL","DLAYGO","DM","DP","DQ","DU","DW","DV" S %RCR(Y)="" S DZ="W !?3,"""_$P(DO,U,1)_" ""_$P(DQ(DQ),U,1)_"": """ I $D(DIC("DR")) S DD=DIC("DR") E S DD="" F Y=0:0 S Y=$N(^DD(+DO(2),0,"ID",Y)) Q:Y'>0 D CKID S %RCR="RCR^DICN1" D STORLIST^%RCR G D^DICN:$D(Y)<9 S:$D(D)#2 DA=D K Y,DO G A^DIC ; CKID I $D(DUZ(0)),DUZ(0)'="@",$D(^DD(+DO(2),Y,9)),^(9)]"" F %=1:1 I DUZ(0)[$E(^(9),%) G Q:$L(^(9))<% Q S DD=DD_Y_";" Q Q ; RCR ; K DR,DQ,DG,DE,DO S DIE=DIC,DR=DD,DIE("W")=DZ K DIC D ^DIE K DIE("W") Q:$D(Y)<9 S DIK=DIE W !?6,"<'",*7,@("$P("_DIK_"DA,0),U,1)"),"' DELETED>" D ^DIK S Y(0)=0 Q ; RIX K %RCR F %="Y","DIC","DIU","DIV","DO","D","DD","DICR","X" S %RCR(%)="" S %RCR="RR^DICN1",DZ=^(1) D STORLIST^%RCR G IX^DICN  ; RR X DZ Q ; NUM ; I '$D(DD),DIC="^DIC(",$D(^DD("SITE",1)),X\1000'=^(1) S X=^(1)*1000 G F2^DICN S %=$P(^DD(+Y,.001,0),U,2),X=$S(%'["N"!(%["O"):0,1:X),%Y=X I X F %=1:1 D N Q:$D(X) S X=0 Q:%>50 S X=%Y+DIY,%Y=X W !?3,$P(DO,U,1)_" "_$P(^DD(+Y,.001,0),U,1),": " W:X X,"// " R Y:$S($D(DTIME):DTIME,1:99999) E S DTOUT=1,Y=U W *7 I Y="?" W:$D(^(3)) !,^(3) X:$D(^(4)) ^(4) G F1^DICN G BAD^DIC1:Y[U S:Y]"" X=Y D N I '$D(X) W *7,"??" W:$D(^DD(+DO(2),.001,3)) !,^(3) X:$D(^(4)) ^(4) G F1^DICN G LOCK^DICN ; N X:$D(^DD(+$P(DO,U,2),.001,0)) $P(^(0),U,5,99) I $D(X),$L(X)<15,+X=X,X>0 Q K X W") Q:$D(Y)<9 S DIK=DIE W !?6,"<'",*7,@("$P("_DIK_"DA,0),U,1)"),"' DELETED>" D ^DIK S Y(0)=0 Q ; RIX K %RCR F %="Y","DIC","DIU","DIV","DO","D","DD","DICR","X" S %RCR(%)="" S %RCR="RR^DICN1",DZ=^(1) D STORLIST^%RCR G IX^DICN DICOMP ; ; 23JAN84 16:26 K DG,K F DLV=0:1 Q:'$D(J(DLV+1)) F I=DLV:0 S I=$N(J(I)),DSAVE(1)=DLV,DLV0=0,K=0 Q:I<0 K I(I),J(I) EN ; S I=X,DIM=9.1,DIMW="" K X,DIC,DATE,DPS,M,Y,W Q:" "[I!(+I=I)!(I'?.ANP)!(I?."?")!($E(I,$L(I))=":") S Q="""",(M,DPS,DBOOL,DG(0))=0,DSAVE=I,DPUNC=",'+-():[]!&\/*_=<>",V=90,DIC(0)="ZF" I DPUNC[$E(I,1),$A(I)-40,$A(I)-39 Q G D I I +X=X,X<1700!'$D(DATE(K-1))!'DBOOL G N:W'=":",N:$D(DPS(DPS,"$S")) I X="" G N:I]"",^DICOMP1 G E:$L(X)>30,FUNC:W="(",N:X?1"$"1U V I $D(DICOMPX(X))#2 D DATE^DICOMP0:$D(DICOMPX(X,"DATE")) S X=DICOMPX(X) G N E K Y D ^DICOMP0 G 0:+X'=X&'$D(Y) N ; I X]"" S K=K+1,K(K)=X S I=$E(I,M,999),M=0 G G:$F(DPUNC,W)<2 I W=":",'$D(DPS(DPS,"$S")) S I=$E(I,2,999) D I,^DICOMPX S W="" G N:$D(X),0 S X=W,W="",M=2 G N:X="" G DPS:X=")",C:",:"[X,0:"+-'"[X&'$L($E(I,M,999)) I X="(" D ST G N S DBOOL="><]['=!&"[X G N:"[]!&\/_*><="'[X I $E(I,M,999)_W]"",$D(K(K)),")'"[K(K)!'$F(DPUNC,K(K)),$F("[]!&\/_*<>=",W)<2 G N:K(K)'="'" S K(K)="'"_X,X="" G N:DBOOL 0 G 0^DICOMP1 ; I I $A(I,M+1)=34 S M=$F(I,Q,M+2)-1 G I:M>0 S W=0,M=999,X=U Q MR F M=M+1:1 S W=$E(I,M) Q:DPUNC[W S X=$E(I,1,M-1) Q ; C S DICF=X D DG S K(K+1,2)=0 I $N(DPS(DPS,"$"))["$" S DPS(DPS)=DPS(DPS)_Y_DICF G N G 0:'$D(W(DPS)) S (W,W(DPS))=W(DPS)-1 K:W<2 W(DPS) S DPS(DPS)=" S X"_W_"="_Y_DPS(DPS) G N ; DPS G ^DICOMPY ; FUNC S Y=$N(^DD("FUNC","B",X,0)) I '$D(^DD("FUNC",Y,0)),X'?1N.N2U,X'?1"$"1U G V S DICF=X D ST I $D(^(1)) D 1 G B I DICF'?1"$"1U.U D SPEC^DICOMPX S W="" G DPS:DPS,0 S DPS(DPS,DICF)=DPS(DPS),DPS(DPS)=" S X="_DICF_W B S M=M+1,W="" G 0:$E(I,M)=")",N ; 2 ; D ST 1 G ^DICOMPZ ; ST S DPS=DPS+1,%="" S I 'K S X="",DPS(DPS)=$P(" S X="_%_"X",U,%]"") Q S %Y=K(K)?1P,Y=$F("'+",K(K))-1 I %Y,Y,$S(K=1:1,1:K(K-1)?1P) S %=K(K)_%,K=K-1 G S D DG S DPS(DPS)="" S:%Y DPS(DPS)=" S Y="_%_"X,X="_Y_",X=X",DPS(DPS,U)=K(K)_"Y",K=K-1 S:$D(DATE(K)) DPS(DPS,"DATE")=1 S:DBOOL DBOOL=0,DPS(DPS,"BOOL")=1 S K(K+1,2)=0 Q ; DG S (Y,DG(DLV0))=DG(DLV0)+1,Y=DQI_Y_")",X=" S "_Y_"=X" DPS)) S (W,W(DPS))=W(DPS)-1 K:W<2 W(DPS) S DPS(DPS)=" S X"_W_"="_Y_DPS(DPS) G N ; DPS G ^DICOMPY ; FUNC S Y=$N(^DD("FUNC","B",X,0)) I '$D(^DD("FUNC",Y,0)),X'?1N.N2U,X'?1"$"1U G V S DICF=X D ST I $D(^(1)) D 1 G B I DICF'?1"$"1U.U D SPEC^DICOMPX S W="" G DPS:DPS,0 S DPS(DPS,DICF)=DPS(DPS),DPS(DPS)=" S X="_DICF_W B S M=M+1,W="" G 0:$E(I,M)=")",N ; 2 ; D ST 1 G ^DICOMPZ ; ST S DPS=DPS+1,%="" S I 'K S X="",DPS(DPS)=$P(" S X="_%_"X",U,%]"") Q S %Y=K(K)?1P,Y=$F("'+",K(K))-1 I %Y,Y,$S(K=1:1,1:K(K-1)?1P) S %=K(K)_%,K=K- DICOMP0 ; ; 06JAN84 10:56 I X?1"""".E1"""" S Y=0 Q L S T=DLV G M:'$D(J(T)) TRY S DIC="^DD("_J(T)_",",DIC("S")=$S(W="["!($E(I,M,M+1)="'[")!$D(DICMX):"I 1",1:"S %=$P(^(0),U,2) I '%,%'[""m""")_$P(",Y-DA",U,DSAVE(1)=T&DA) D DICS^DICOMPX I X?1"#"1NP.NP S X=$E(X,2,99) D ^DIC G A:Y>0 I X?.E1"NUMBER",$P($N(^DD(J(T),0,"NM",0))_" ",$P(X,"NUMBER",1),1)="" S Y=.001,Y(0)=0 G D S T=T-1 G TRY:$D(J(T)),M:T<0 F T=T-99:1 G TRY:'$D(J(T+1)) A F M=M:1:$L(I)+1 Q:$F(X,$E(I,1,M))-1-M S W=$E(I,M+1) D S D=$P(Y(0),"^",2) D DATE:D["D"&'$D(DPS(DPS,"INTERNAL")) S %=T\100*100,DICN=+Y I $D(DICOMPX)#2 S %Y=J(T)_U_DICN_$E(";",1,$L(DICOMPX)) S:";"_DICOMPX_";"'[(";"_%Y) DICOMPX=%Y_DICOMPX I D["m"!D G MUL^DICOMPZ I $D(DICOMPX(1,J(T),+Y)) S X=DICOMPX(1,J(T),+Y) G O I D["C" S:'$D(DG(%,T,+Y)) DG(%)=DG(%)+1,DG(%,T,+Y)=DG(%) S X=DQI_DG(%,T,+Y)_")" Q D G^DICOMPY O Q:$D(DPS(DPS,"INTERNAL")) S %=DLV0 I D["O",$D(^DD(J(T),DICN,2)) S DICF=X D ST^DICOMP S K=K+2,K(K-1)=X,K(K)=" S Y="_DICF_" X:$D(^DD("_J(T)_","_DICN_",2)) ^(2) S X=Y" G DPS^DICOMPY S I D["S" S DG(%)=DG(%)+1,DG(%,DG(%))="$C(59)_$S($D(^DD("_J(T)_","_DICN_",0)):$P(^(0),U,3)",X="$P($P("_DQI_DG(%)_"),$C(59)_"_X_"_"":"",2),$C(59),1)" Q:D'["P" S %Y=U_$P(Y(0),U,3),DICN=+$P(@(%Y_"0)"),U,2),D=$S($D(^DD(DICN,.01,0)):$P(^(0),U,2),1:""),DICF=W=":"&'$D(DPS(DPS,"$S")) I 'DICF,D'["S",D'["P" D DATE:D["D" S X="$S('$D("_%Y_"+"_X_",0)):"""",1:$P(^(0),U,1))" Q S (DLV,DLV0)=DLV\100+1*100,I(DLV)=%Y,J(DLV)=DICN D SN^DICOMPX S X=" S D0="_X_" S:'$D("_%Y_"+D0,0)) D0=-1" I $D(DICOMPX(0)) S X=X_" S "_DICOMPX(0)_"0)=D0",DICOMPX(0,DICN)="" I DICF S M=M+1,W="" S:$E(I,M,999) I=$E(I,1,M-1)_"#"_$E(I,M,999) Q S I="#.01"_$E(I,M,999),M=0 Q ; M S T=$F(X," IN ") I T S X=$E(X,1,T-5),W=":",M=T-4,I=X_W_$E(I,T,999),T=$F(I," FILE",M) S:T&$F(DPUNC,$E(I,T)) I=$E(I,1,T-6)_$E(I,T,999) G DICOMP0 I $L(X)<32 S DICF=X,T=$N(^DD("FUNC","B",X,0)) I T+1,$D(^DD("FUNC",T,3)),^(3)?1"0".E,$D(^(1)) D 2^DICOMP S Y(0)=0,K=K+1,K(K)=X D DATE:$S($D(^(2)):^(2)?1"D".E,1:0),DPS^DICOMPY Q S %DT="T" D ^%DT I Y<0 G BAD:M'<$L(I)!(+X=X) D MR^DICOMP G L S X=Y Y0 S Y(0)=0 DATE S DATE(K+1)=1 Q ; BAD K Y "),DICF=W=":"&'$D(DPS(DPS,"$S")) I 'DICF,D'["S",D'["P" D DATE:D["D" S X="$S('$D("_%Y_"+"_X_",0)):"""",1:$P(^(0),U,1))" Q S (DLV,DLV0)=DLV\100+1*100,I(DLV)=%Y,J(DLV)=DICN D SN^DICOMPX S X=" S D0="_X_" S:'$D("_%Y_"+D0,0)) D0=-1" I $D(DICOMPX(0)) S X=X_" S "_DICOMPX(0)_"0)=D0",DICOMPX(0,DICN)="" I DICF S M=M+1,W="" S:$E(I,M,999) I=$E(I,1,M-1)_"#"_$E(I,M,999) Q S I="#.01"_$E(I,M,999),M=0 Q ; M S T=$F(X," IN ") I T S X=$E(X,1,T-5),W=":",M=T-4,I=X_W_$E(I,T,999),T=$F(I," FILE",M) S:T&$F(DPUNC,$E(I,T)) I=$E(I,1,T-6)_$E(I,T,999) G DICOMP0 I $L(X)<32 S DIC DICOMP1 ;GFT/SF ; 09 DEC 83 1:25 PM G 0:DPS S DG=-1,T=99,M=DIM,DLV0=0,X="",K=1,W=0 K DIM ST S DG=$N(DG(DLV0,DG)),Y=$P(DG,U,2) I DG<0 D EX S W=0 G NN I Y]"" S:+Y'=Y Y=Q_Y_Q S I=DQI_DG(DLV0,DG)_")=$S($D(^(" D X:T-DG!(DG180 S X=X_I G ST:$D(DG(DLV0,DG))[0 S I=DQI_+DG_")="_DG(DLV0,DG) G OV:DG?.N1A 9 S I=I_",1:"""")" OV I $L(I)+$L(X)>180 D M S:'W X=X_" S " S X=X_I_",",W=2 G ST ; X S I=$P(I,U,1) F T=0:1:DG#100 S I=I_I(DG\100*100+T)_$E(",",1,T)_$S(DG180 G 1 I 'W D M:$L(X)+$L(K(K))>165 S X=X_" S X=",W=6 1 G P:K(K)?1P,A:'$D(DATE(K)) S Y=1 I K>1,K(K-1)="+" S X=X_"0,X2=X,X1="_K(K) G DTC 2 G A:'$D(K(K+2)) K DATE(K) I '$D(DATE(K+2)),$F("+-",K(K+1))>1 S X=X_K(K)_",X1=X,X2="_K(K+1)_K(K+2),DATE(K+2)=1 E G A:K(K+1)'="-" K DATE(K+2) S X=X_K(K)_",X1=X,X2="_K(K+2),Y=0 S K=K+2 DTC S K=K+1,X=X_",X="""" D"_$P(":X2 ^ C",U,Y+1)_"^%DTC:X1" G S:'$D(K(K)) D SX G NN:'Y S K=K-1,K(K)="" G 2 ; P I "\/"[K(K),$D(K(K+1)),K(K+1)'?.NP S K=K+1,K(K)=",X=$S("_K(K)_":X"_K(K-1)_K(K)_",1:""*******"")" I $L(X)>150,$F(DPUNC,K(K))>3 D M,SX A S W='$D(K(K,2)),X=X_K(K),K=K+1 G NN:$D(K(K))#2 S F I=-1:0 S I=$N(M(I)),W=0 Q:I<0 D M:$L(X)>235 S X=X_" S D"_I_"="_DQI_M(I,$N(M(I,-1)))_")" D SS I X'?1"S X="1N.NP G Q 0 K X,DIM,DATE I DSAVE[" ",DUZ(0)="@" S X=DSAVE,DIM=1 D ^DIM Q I '$D(DICOMPX) F K=DSAVE(1):0 S K=$N(I(K)) Q:K<0 K I(K),J(K) S Y=$E("W",$D(DPS("W")))_DIMW_$E("D",$D(DATE)>9)_$E("B",DBOOL)_$E("X",$D(DIM)) K V,K,W,T,M,DG,DIM,DICN,DICF,DLV,DPS,DIC,DSAVE,DLV0,DPUNC,DICMX,DIMW Q ; ; EX S X=$E(X,1,$L(X)-W+1) Q ; AS D EX I $L(K(K))+$L(X)<160 S K(K)=$E(K(K),4,999),X=X_"," E D M G 1 ; M D SS,EX S M=M+.1,X(M)=X,X="X "_$S(DA:"^DD("_A_","_DA_",",1:DA)_M_")",W=0 Q ; SS S:$A(X)=32 X=$E(X,2,999) Q ; SX S X=X_" S X=X",W=1 -1)_K(K)_",1:""*******"")" I $L(X)>150,$F(DPUNC,K(K))>3 D M,SX A S W='$D(K(K,2)),X=X_K(K),K=K+1 G NN:$D(K(K))#2 S F I=-1:0 S I=$N(M(I)),W=0 Q:I<0 D M:$L(X)>235 S X=X_" S D"_I_"="_DQI_M(I,$N(M(I,-1)))_")" D SS I X'?1"S X="1N.NP G Q 0 K X,DIM,DATE I DSAVE[" ",DUZ(0)="@" S X=DSAVE,DIM=1 D ^DIM Q I '$D(DICOMPX) F K=DSAVE(1):0 S K=$N(I(K)) Q:K<0 K I(K),J(K) S Y=$E("W",$D(DPS("W")))_DIMW_$E("D",$D(DATE)>9)_$E("B",DBOOL)_$E("X",$D(DIM)) K V,K,W,T,M,DICOMPX ;GFT/SF ; 07SEP83 17:32 ; POINTERS D M Q:'$D(X) S X=" K DIC S "_$P("Y=-1,",U,%>0)_"DIC="""_X_""",DIC(0)=""NMF"" D ^DIC"_$P(":D"_(%-1)_">0",U,%>0)_" S D"_%_"=+Y" I $D(DICOMPX(0)) S X=X_","_DICOMPX(0)_%_")=+Y" I W=":" S M=M+1 Q S I="#.01"_$E(I,M,999),M=0 Q ; M S DIC("S")="I $P(^(0),U,2)",DICN=X,T=DLV D DICS S:X?1"#".NP X=$E(X,2,9) TRY S DIC="^DD("_J(T)_"," D ^DIC I Y<0 S T=T-1 G TRY:$D(J(T)),FILE:T<0 F T=T-99:1 G TRY:'$D(J(T+1)) F M=M:1:$L(I)+1 Q:$F(X,$E(I,1,M))-1-M S W=$E(I,M+1) S (DLV0,DLV)=DLV0+100 F %=T\100*100:1 Q:%>T S J(DLV)=J(%),I(DLV)=I(%),DLV=DLV+1 S X=$P($P(Y(0),U,4),";",1) I +X'=X S X=Q_X_Q S I(DLV)=X,X=I(DLV0),J(DLV)=+$P(Y(0),U,2) F Y=0:0 S Y=$F(X,Q,Y) Q:Y<1 S X=$E(X,1,Y-1)_$E(X,Y-1,999),Y=Y+1 D REF G SN ; REF F Y=DLV0+1:1:DLV S DICN=I(Y) S:DICN[Q DICN=Q_DICN_Q S X=X_"D"_(Y#100-1)_","_DICN_"," Q ; FILE S X=DICN,DIC=1,DIC("S")="I 1 Q:DUZ(0)=""@ ""!'$D(^(0,""RD"")) F %=1:1:$L(^(""RD"")) I DUZ(0)[$E(^(""RD""),M) Q" D ^DIC I Y<0 K X Q S (DLV,DLV0)=DLV\100+1*100,(I(DLV),X)=^(0,"GL"),J(DLV)=+Y S:X[Q X=+Y SN S %X=DLV0-100 D SV S DG(DLV0)=DLV Q ; SV S (T,DG(%X))=DG(%X)+1,%=DLV-DLV0,K(K+2,1)=DLV0,DG(%X,T)="$S($D(D"_%_"):D"_%,M(%,DLV)=T Q ; DICS S:DUZ(0)'="@" DIC("S")=DIC("S")_" Q:'$D(^(8)) F %=1:1:$L(^(8)) I DUZ(0)[$E(^(8),%) Q" Q ; SPEC ; S K(K+1)=X,I=$E(I,M+1,999) I "PREVIOUSNEXT"[DICF S M=0,%X=DLV0,X=I(0) D REF,SV G S F M=2:1 I ":)"[$E(I,M) S X=$E(I,1,M-1) Q D M G BAD:'$D(X) S S DG(DLV0)=DG(DLV0)+1,DICN=DQI_DG(DLV0)_")",W=%,K=K+2,%="D"_%,K(K)=" S "_DICN_"="""" X ""F "_%_"=0:0 S "_%_"=$N("_X_%_")) Q:"_%_"'>0 " S DIC("S")="I '$P(^(0),U,2)",DIC="^DD("_J(DLV)_",",D=M,M=$F(I,")")-1,X=$E(I,D+1,M-1) G BAD:M<1 S:X?1"#".NP X=$E(X,2,9) S:X="" X=.01 I X="NUMBER" S D=%,%=W,W=D G NUMBER^DICOMPY D DICS,^DIC I Y>0 G MUL^DICOMPY BAD S DPS=0 (DLV),X)=^(0,"GL"),J(DLV)=+Y S:X[Q X=+Y SN S %X=DLV0-100 D SV S DG(DLV0)=DLV Q ; SV S (T,DG(%X))=DG(%X)+1,%=DLV-DLV0,K(K+2,1)=DLV0,DG(%X,T)="$S($D(D"_%_"):D"_%,M(%,DLV)=T Q ; DICS S:DUZ(0)'="@" DIC("S")=DIC("S")_" Q:'$D(^(8)) F %=1:1:$L(^(8)) I DUZ(0)[$E(^(8),%) Q" Q ; SPEC ; S K(K+1)=X,I=$E(I,M+1,999) I "PREVIOUSNEXT"[DICF S M=0,%X=DLV0,X=I(0) D REF,SV G S F M=2:1 I ":)"[$E(I,M) S X=$E(I,1,M-1) Q D M G BAD:'$D(X) S S DG(DLV0)=DG(DLV0)+1,DICN=DQI_DG(DLV0)_")",W=%,K=K+2,%="D"_%,K(K)=" S "_DICN_"="""" X ""F "_%_"=0:0 S "_%_"=$N("_X_%_")) Q:"_%_"'>0 " S DIC("S")="I '$P(^(0),U,2)",DIC="^DD("_J(DLV)_",",D=M,M=$F(I,")")-1,X=$E(I,D+1,M-1) G BAD:M<1 S:X?1"#".NP X=$E(X,2,9) S:X="" X=.01 I X="NUMBER" S D=%,%=W,W=D G NUMBER^DICOMPY D DICS,^DIC I Y>0 G MUL^DICOMPY BAD S DPSDICOMPY ; ; 07SEP83 17:33 I DPS D DPS G N^DICOMP:'$D(W(DPS+1)) 0 G 0^DICOMP1 ; DPS ; S X=DPS(DPS),%=$N(DPS(DPS,"$")) S:M'>$L(I)!(DSAVE'?1"(".E) DBOOL=$D(DPS(DPS,"BOOL")) I %["$" S X=X_"X)"_DPS(DPS,%) I $D(DPS(DPS,"DATE")) S DATE(K+1)=1 I $D(DPS(DPS,U)) S K=K+2,K(K-1)=X,K(K)=$E(DPS(DPS,U),1),X=$E(DPS(DPS,U),2,99) I $D(DATE(K))&$D(DPS(DPS,"O"))!$D(DPS(DPS,"D")) S DATE(K+1)=1 E S K(K+1,9)=0 K DPS(DPS) S DPS=DPS-1 Q ; MUL ; S T=+Y,%=DLV-DLV0,D=$P(Y(0),U,2) S:D["D" DATE(K)=1 I D["C" S W="X",K(K)=K(K)_"X $P(^DD("_J(DLV)_","_T_",0),U,5,99) " G NUMBER D W I X="" S W="D"_% E S:+Y'=Y Y=Q_Q_Y_Q_Q S W="$S($D(^(D"_%_","_Y_")):",Y="(^("_Y_")," D EP S W=W_X_",1:"""""""")" NUMBER I DICF S DG(DLV0)=DG(DLV0)+1,%X=DQI_DG(DLV0)_")",K(K)="0,"_%X_"=0"_K(K) D L S W=W_%X_"="_%X_"+1 I "_%X_"="_+DICF_" S "_DICN_"=Y Q",DPS(DPS,"O")="" E D @DICF I $D(DICOMPX)#2 S %X=J(DLV)_U_T_$E(";",1,$L(DICOMPX)) S:";"_DICOMPX_";"'[(";"_%X) DICOMPX=%X_DICOMPX I $D(DICOMPX(0)) S DICN=DICN_","_DICOMPX(0)_%_")=D"_% S K(K)=K(K)_W_""" S X="_DICN,M=M+1 I "TOTALCOUNT"[DICF K DATE(K) Q Q:$D(DPS(DPS,"INTERNAL")) I D["O",$D(^DD(J(DLV),T,2)) S K=K+1,K(K)=" S Y=X "_^(2)_" S X=Y" Q S X="X",DICN=T,T=DLV,%=DLV0 D S^DICOMP0 S:X'="X" K(K)=K(K)_",X="_X Q ; W S X=$P(Y(0),U,4),Y=$P(X,";",1),X=$P(X,";",2) Q ; G ; D W G P:X]"" S Y=T#100 I T0 D"_%_"=-1,"_DICN_"=""" Q TOTAL S W="S "_DICN_"="_DICN_"+"_W Q COUNT S W="S:"_W_"'?."""" """" "_DICN_"="_DICN_"+1" Q LAST D L S W=W_DICN_"=Y" Q L S W="S Y="_W_" S:Y'?."""" """" " S:D["D" DPS(DPS,"D")=1 ) S K=K+1,K(K)=" S Y=X "_^(2)_" S X=Y" Q S X="X",DICN=T,T=DLV,%=DLV0 D S^DICOMP0 S:X'="X" K(K)=K(K)_",X="_X Q ; W S X=$P(Y(0),U,4),Y=$P(X,";",1),X=$P(X,";",2) Q ; G ; D W G P:X]"" S Y=T#100 I T1 W(DPS)=% Q ; MUL ; I W["'"!(W["[") G CNTNS I D S X=$P(^DD(+D,.01,0),U,2) G WP:X["W" S X="S X=$P(^(0),U,1)"_$S(X["D":",Y=X D D^DIQ S X=Y",X["P":" S:$D(^"_$P(^(0),U,3)_"+X,0)) X=$P(^(0),U,1)",X["S":",Y=$F(^DD("_+D_",.01,0),X_$C(58)) S:Y X=$P($E(^(0),Y,999),$C(59),1)",1:""),DIMW="m" G FOR S DIMW="m"_$E("w",$P(Y(0),U,2)["w"),D=$P(Y(0),U,5,99) F Y=0:0 S Y=$F(D,"X DICMX",Y) Q:Y'>0 S D=$E(D,1,Y-8)_DICMX_$E(D,Y,999),Y=$L(DICMX)-7+Y DIM S DIM=DIM+.1,X(DIM)=D,X=" X "_$S(DA:"^DD("_A_","_DA_",",1:DA)_DIM_")" Q ; WP S DIMW="mw",X="S X=^(0)" FOR S T=T#100,D=$P($P(Y(0),U,4),";",1),X="D)) Q:D'>0 I $D(^(D,0))#2 "_X_" "_DICMX_""" S X=""""",%="""" S:+D'=D D=%_D_% LOOP F Y=0:0 S Y=$F(D,%,Y) Q:Y<1 S D=$E(D,1,Y-1)_%_$E(D,Y,999),Y=Y+1 I T+1 S X="D"_T_","_D_","_X S D=I(DLV0+T),T=T-1 G LOOP S X=" X ""F D=0:0 S D=$N("_D_X Q ; CNTNS K DICF S:$D(DICMX) DICF=DICMX S DPS=DPS+1,DPS(DPS)=DG(DLV0)+1,DG(DLV0)=DPS(DPS)+1,DD=W="'",DICMX="I X["_DQI_DPS(DPS)_") S "_DQI_(DPS(DPS)+1)_")="_'DD_" Q" D WP K DICMX S:$D(DICF) DICMX=DICF S D="S "_DQI_(DPS(DPS)+1)_")="_DD_X D DIM S DIMW="",I=$E(I,M+DD+1,999),DPS(DPS)=" S "_DQI_DPS(DPS)_")=X"_X_" S X="_DQI_(DPS(DPS)+1)_")" K Y D I^DICOMP,^DICOMP0 I $D(Y) S K=K+1,K(K)=X,X=DPS(DPS),DBOOL=1 S DPS=DPS-1 Q "X DICMX",Y) Q:Y'>0 S D=$E(D,1,Y-8)_DICMX_$E(D,Y,999),Y=$L(DICMX)-7+Y DIM S DIM=DIM+.1,X(DIM)=D,X=" X "_$S(DA:"^DD("_A_","_DA_",",1:DA)_DIM_")" Q ; WP S DIMW="mw",X="S X=^(0)" FOR S T=T#100,D=$P($P(Y(0),U,4),";",1),X="D)) Q:D'>0 DICQ ; ; 30DEC83 22:38 S DZ=X D:DIC(0)]"" DQ S X=DZ K DZ G A^DIC ; DQ W ! D:'$D(DO) DO^DIC1 K DS S DD="",Y=$P(DO,U,4),DIY=DO,DIX=D D DIY S X=$S($D(^DD(+DO(2),.001,0)):$P(^(0),U,1),DIC(0)["N":"NUMBER",1:""),DIZ=X]"" G:$D(^DD(+DO(2),0,"QUES")) @^("QUES") I DIZ S DS=.001 D DS IX S X=$N(^DD(+DO(2),0,"IX",DIX,-1)) I X'<0 S DS=$N(^(X,0)),X=$P(^DD(X,DS,0),U,1) D DS I @("$D("_DIC_"DIX))>9"),DD="" S DD=DIX S:'Y Y=2 S DIX=$N(^(DIX)) G IX:DIC(0)["M"&'DIX I DD="" S DIZ=1 S:'$N(^("AZ")) Y=0 I $D(DZ)#2 G C:DZ["??" S:DZ["BAD" Y=0 W " ANSWER WITH ",$P(DO,U,1) S DS=0,%=0 F X=1:1 S DS=$N(DS(DS)) Q:DS<0 W $P(", OR",U,X>1) W:$X+$L(DS(DS))>70 !?4 W " ",DS(DS) K DS W $E(":",Y) G 0:'Y I Y>20 W !," DO YOU WANT THE ENTIRE " W:'$D(DIC("S"))&'$D(DF) Y,"-ENTRY " W $P(DO,U,1)," LIST" D YN^DICN G 0:%-1 C W:Y>1 !,"CHOOSE FROM:" S X=$P(" S DS(1)=X,DS(2)=Y X DIC(""S"") S X=DS(1),Y=DS(2) I ",U,$D(DIC("S") )) I DIZ S DS="I $D(^(Y,0))#2 S X=$P(^(0),""^"",1)"_X_" W:$L(Y)<8 Y,?$X+9-$L(Y)",DIX="S Y=$N("_DIC_"Y)) I Y'>0" G D S DIX="S X=$N("_DIC_""""_DD_""",X)) I X<0",DS=$S(X]""!$D(DIC("W")):"F Y=0:0 S Y=$N("_DIC_""""_DD_""",X,Y)) Q:Y<0 "_$P(" I $D(^(Y))#2,'^(Y)",1,DD="B")_" I $D("_DIC_"Y,0))"_X,1:"I 1")_" W:$X>5 !?3" D I DO(2)["D" S DIY=27,X=":$E(X,4,5) +$E(X,4,5)_""-"" D DT" G M I DO(2)["P" D P S X=" $S($D("_DIY_"X,0))#2:$P(^(0),""^"",1),1:X)",@("DIY="_DIY_"0)") D DIY G M I DO(2)["S" S X=" $P($P(^DD("_+DO(2)_",.01,0),X_"":"",2),"";"",1)" G M S X=" X" M S:DIZ DIY=$L($P(DO,U,3))+DIY+5,Y=0 S DS=DS_" W"_X,X=-1 D Y I $D(DIC("W")) S DIY=999,DS=DS_" I $D("_DIC_"Y,0)) X DIC(""W"")" LST W !?3 S DD=DIY+3 I $Y>DIZ!'$Y R "'^' TO STOP: ",%Y W $C(13),$J("",15),$C(13),?3 G 0:%Y?1P D Y L X DIX I G 0 S DIW=$X X DS I DIW-$X G LST:DD+DIY>79 W ?DD S DD=DD+DIY G L ; Y S DIZ=$Y+21 Q ; 0 K DIW,DIZ,DS G DICQ^DIQQ:DIC(0)["L" Q ; DT W:$E(X,6,7) +$E(X,6,7)_"-" W $E(X,1,3)+1700 W:X["." " ("_$E(X_0,9,10)_":"_$E(X_"000",11,12)_")" Q ; P ; S DIY=U_$P(^DD(+DO(2),.01,0),U,3) Q ; DIY S DIY=$P(^DD(+$P(DIY,U,2),.01,0),"$L(X)>",2),DIY=$S(DIY:DIY,1:30)+7 Q ; SOUNDEX S Y=0 G IX ; DS S:DO'[X DS(DS)=X _""-"" D DT" G M I DO(2)["P" D P S X=" $S($D("_DIY_"X,0))#2:$P(^(0),""^"",1),1:X)",@("DIY="_DIY_"0)") D DIY G M I DO(2)["S" S X=" $P($P(^DD("_+DO(2)_",.01,0),X_"":"",2),"";"",1)" G M S X=" X" M S:DIZ DIY=$L($P(DO,U,3))+DIY+5,Y=0 S DS=DS_" W"_X,X=-1 D Y I $D(DIC("W")) S DIY=999,DS=DS_" I $D("_DIC_"Y,0)) X DIC(""W"")" LST W !?3 S DD=DIY+3 I $Y>DIZ!'$Y R "'^' TO STOP: ",%Y W $C(13),$J("",15),$C(13),?3 G 0:%Y?1P D Y L X DIX I G 0 S DIW=$X X DS I DIW-$X G LST:DD+DIY>79 W ?DD S DD=DD+DIY G L ; Y S DIZ=$Y+21 Q ; 0 K DIW,DIZ,DS G DICQ^DIQQ:DIC(0DICR ;GFT/SF ; 12APR83 10:34 I DIU]"" F DIW=0:0 S DIW=$N(^DD(DIH,DIG,1,DIW)),X=DIU Q:DIW<0 I '$D(DB(0,DIH,DIG,DIW,2)) S DB(0,DIH,DIG,DIW,2)=1 D SAVE X ^(DIW,2) D RESTORE I DIV]"" F DIW=0:0 S DIW=$N(^DD(DIH,DIG,1,DIW)),X=DIV Q:DIW<0 I '$D(DB(0,DIH,DIG,DIW,1)) S DB(0,DIH,DIG,DIW,1)=1 D SAVE X ^(DIW,1) D RESTORE Q ; SAVE F DB=1:1 Q:'$D(DB(DB)) F Y="DIV","DA" F %=-1:0 S @("%=$N("_Y_"(%))") Q:%<0 S DB(DB,Y,%)=@(Y_"(%)") F %="DIC","DIW","DIU","DIV","DIH","DIG","DB","DG","DA" S DB(DB,%)="" I $D(@%)#2 S DB(DB,%)=@% K DA F Y=0:1 Q:'$D(DIV(Y+1)) S DA=DIV(Y) F %=Y-1:-1:0 S DA(Y-%)=DIV(%) Q ; RESTORE F DB=1:1 Q:'$D(DB(DB+1)) F Y="DIV","DA" K @Y F %=-1:0 S %=$N(DB(DB,Y,%)) Q:%<0 S @(Y_"(%)=DB(DB,Y,%)") S Y=0 F %=0:0 S Y=$N(DB(DB,Y)) Q:Y<0 S @Y=DB(DB,Y) K DB(DB) Q ST:DD+DIY>79 W ?DD S DD=DD+DIY G L ; Y S DIZ=$Y+21 Q ; 0 K DIW,DIZ,DS G DICQ^DIQQ:DIC(0 DICRW ;GFT/SF ; 06SEP83 16:32 ;FILE LOOKUP R D DT S D="OUTPUT FROM",DIC(0)="QE" I DUZ(0)'="@" S DICS="I 1 Q:'$D(^(8)) F DW=1:1:$L(^(8)) I DUZ(0)[$E(^(8),DW) Q",DIC("S")="I 1 Q:'$D(^(0,""RD"")) F DC=1:1:$L(^(""RD"")) I DUZ(0)[$E(^(""RD""),DC) Q" D DIC Q:$T G R ; DT W ! S:$D(DUZ)#2-1 DUZ=0 S:$D(DUZ(0))#2-1 DUZ(0)="" D @(DUZ(0)="@") K %DT,DT S IO(0)=$I,X="T" D ^%DT S DT=Y K DIK,DIC,%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="" G WW E S DIC("W")=$E($T(WW),4,999) D ^DIC GOT I $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 ,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="" G WW E S DIC(DID ; ; 19DEC83 12:26 D KL,^DICRW I $D(DIC) S DUB=+Y G SUB KL K DICMX,DIOEND,FLDS,DFF,DID,DUB,DHD,DIC,DICS,POP,DA,DR,S,F,J,K,Z,W,X,Y,M,G,N,I,DJ,IOF,IOM,IOSL,IOBS,IOT Q ; SUB S DFF=+Y,DIC="^DD("_+Y_"," G O:$N(^DD(+Y,"SB",0))'>0 S DIC(0)="AEQZ",DIC("A")="Select SUB-FILE: ",DIC("S")="I $P(^(0),U,2)" D ^DIC I Y>0 S Y=$P(Y(0),U,2) G SUB G KL:X[U S Y=DFF O S DIK="^DOPT(""DID""," G DIP:$D(^DOPT("DID",3)) S ^(0)="LISTING FORMAT^1.01",^(1,0)="STANDARD",^DOPT("DID",2,0)="BRIEF",^DOPT("DID",3,0)="CUSTOM-TAILORED" D IXALL^DIK DIP K DIC S DIC=DIK,DIC(0)="AEQ",DIC("B")=1 D ^DIC G KL:Y<0 K DIC,DIK S DIC="^DD(DFF," G EN^DIP:+Y=3 S FLDS="",DHIT="D ^DID1",DHD="W """" D ^DIDH",L=0,BY="@.001",(FR,TO)="",DIOEND="D END^DID" I +Y=2 S DHIT="D ^DIDX",DID=0,%=1 W !,"ALPHABETICALLY BY LABEL" D YN^DICN Q:%<1 S:%=1 BY="@.01",DID=1 G EN1^DIP ; END ; G D:'$D(^UTILITY($J,"P")) S F="" W !!!?6,"FILES POINTED TO",?44,"FIELDS",!  F I=0:0 S F=$N(^UTILITY($J,"P",F)) Q:F<0 W !,F F %=0:0 S %=$N(^UTILITY($J,"P",F,%)) Q:%<0 W ?33," ",$S(%=F(1):"",1:$P(^DD(%,0)," SUB-FIELD",1)_":") F S=0:0 S S=$N(^UTILITY($J,"P",F,%,S)) Q:S<0 W ?34,$P(^DD(%,S,0),U,1)," (#"_S_")",! D I DC=1,$N(^DD(DFF,"GL",0))<0,@("$N("_DIC_"0))>0"),$P(^(0),U,4)<20 K DJ,DR W !!!?9,"CURRENT ENTRIES",!?9,"------- -------" F DUB=0:0 S @("DUB=$N("_DIC_"DUB))") Q:DUB'>0 S DA=DUB D EN^DIQ G IOF:DHIT["DIDX" S @("A=$P("_DIC_"0),U,1)") F S=1:1:3 W !! S DA=0,W=$P("INPUT^PRINT^SORT",U,S)_" TEMPLATE(S):",DFF="^DI"_$P("E^PT^BT",U,S) X "F %=0:0 S DA=$N("_DFF_"(""B"",DA)) Q:DA=-1 F DUB=0:0 S DUB=$N("_DFF_"(""B"",DA,DUB)) Q:DUB'>0 I $D("_DFF_"(DUB,0)),$P(^(0),U,4)=F(1) D TEMPL" IOF W:IOST'?1"C".E @IOF G KL ; TEMPL W W,!,$P(^(0),U,1),?32 S W="",Y=$P(^(0),U,2) D DT^DIO2 W ?44,"USER #",+$P(^(0),U,5) I $D(^("H")) S Y=^("H") I A_" LIST"'=Y S %=$L(Y) W:55+%>IOM ! W " ",?IOM-%-1,$E(Y,1,IOM-4) I $D(^(2)) S D0=DUB,DICMX="W !?4,X" X $P(^DD(.401,1620,0),U,5,99) I DFF="^DIBT" F Y=1:1 Q:'$D(^DIBT(DUB,"O",Y,0)) W " " S %=^(0) W:$L(%)+$X+5>IOM !?4 W % D(%,0)," SUB-FIELD",1)_":") F S=0:0 S S=$N(^UTILITY($J,"P",F,%,S)) Q:S<0 W ?34,$P(^DD(%,S,0),U,1)," (#"_S_")",! D I DC=1,$N(^DD(DFF,"GL",0))<0,@("$N("_DIC_"0))>0"),$P(^(0),U,4)<20 K DJ,DR W !!!?9,"CURRENT ENTRIES",!?9,"------- -------" F DUB=0:0 S @("DUB=$N("_DIC_"DUB))") Q:DUB'>0 S DA=DUB D EN^DIQ G IOF:DHIT["DIDX" S @("A=$P("_DIC_"0),U,1)") F S=1:1:3 W !! S DA=0,W=$P("INPUT^PRINT^SORT",U,S)_" TEMPLATE(S):",DFF="^DI"_$P("E^PT^BT",U,S) X "F %=0:0 S DA=$N("_DFF_"(""B"",DA)) Q:DA=-1 F DUB=0:0 S DUB=$N("_DFF_"(""B"",DA,DUB)) Q:DUB'>0 I $D("_DFF_"(DUB,0)),$P(^(0),U,4)=F(1) D TEMPL" IOF W:IOST'?1"C".E @IOF G KL ; TEMPL W W,!,$P(^(0),U,1),?32 S W="",Y=$P(^(0),U,2) D DT^DIO2 W ?44,"USER #",+$P(^(0),U,5) I $D(^("H")) S Y=^("H") I A_" LIST"'=Y S %=$L(Y) W:55+%>IOM ! W " ",?IOM-%-1,$E(Y,1,IOM-4) I $D(^(2)) S D0=DUB,DICMX="W !?4,X" X $P(^ DID1 ; ; 05JAN84 16:37 S DJ(Z)=D0 G B ; L S DJ(Z)=0 A S DJ(Z)=$N(^DD(F(Z),DJ(Z))) I DJ(Z)'>0 W !!! S Z=Z-1 Q B S N=^DD(F(Z),DJ(Z),0) D HD:$Y+9>IOSL W !!,F(Z),",",DJ(Z) W ?(Z+Z+12),$P(N,U,1) W:$X>35 ! W ?36,S,$P(N,U,4) W ?M,S,S S X=$P(N,U,2) I X W +X I $D(^DD(+X,.01,0)),$P(^(0),U,2)["W" W " WORD-PROCESSING" S X="" F W="BOOLEAN","COMPUTED","FREE TEXT","SET","DATE","NUMBER","POINTER","XXXX--CAN'T BE ALTERED EXCEPT BY PROGRAMMER" I X[$E(W,1) D W G T:X'["P"!X S Y=$P(N,U,3) I Y]"",@("$D(^"_Y_"0))") S W=$P(^(0),U,1)_" FILE (#"_+$P(X,"P",2)_")",^UTILITY($J,"P",$E(W,1,30),F(Z),DJ(Z))=0,W="TO "_W D W G T S W="***** TO A FILE THAT IS UNDEFINED *******" D W T S W=0 TR S W=$N(^DD(F(Z),DJ(Z),5,W)) G H:W'>0 S I=^(W,0),%=+I I '$D(^DD(%,$P(I,U,2),0))!$D(W(I)) K ^DD(F(Z),DJ(Z),5,W) G TR S W(I)=0 W !?5,"***'TRIGGERED' BY" D WR^DIDH W "***" G TR H K W I $D(^DD(F(Z),DJ(Z),3)) S W=" "_^(3) D W  F W="Required","Add New Entry without Asking","Multiply asked" I X[$E(W,1) S W="("_W_")" D W I $D(^(.1)) W !?(Z+Z+12),^(.1)," ",?M I X["C" S W=$P(N,U,5,99) S:$L(W)<236 W=" MUMPS CODE: "_W D W F I=9.2:.1 G RD:'$D(^(I)) S W=I_" = "_^(I) D W I "Q"'[$P(N,U,5) S W=" Input transform:" D W S W=$P(N,U,5,99) D W I $D(^(2)) S W=" Output transform:" D W S W=$S($D(^(2.1)):^(2.1),1:^(2)) D W I X["S" S N=$P(N,U,3) F I=1:1 S Y=$P(N,";",I) Q:Y="" S W="'"_$P(Y,":",1)_"' FOR "_$P(Y,":",2) W:$P(N,";",I)'="" "; " D W RD D ^DID2:$N(^(3))+1 I 'X S W=" UNEDITABLE" D W:X["I" G IX S Z=Z+1,F(Z)=+X,W=" Multiple" D W F %=0:0 S %=$N(^DD(+X,0,"ID",%)) Q:%'>0 S W="'IDENTIFIED' BY "_$P(^DD(+X,%,0),U,1) D W D L IX F Y=0:0 S Y=$N(^DD(F(Z),DJ(Z),1,Y)) Q:Y'>0 W !?M,"CROSS-REFERENCE: ",^(Y,0)_" " D TP:$P(^(0),U,3)["TRIGG" S X=0 F %=0:0 S X=$N(^DD(F(Z),DJ(Z),1,Y,X)) Q:X<0 S W=^(X) S:$L(W)<248 W=X_")= "_W W ?50 D W W ! D HD:$Y+4>IOSL S X="" G A:Z>1 Q ; TP S X=$P(^(0),U,4) I F(Z)-X,$D(^DIC(X,0)) S ^UTILITY($J,"P",$E($P(^(0),U,1)_" (#"_X_")",1,30),F(Z),DJ(Z))=6 Q ; W W:$X+$L(W)+3>IOM !,?$S(IOM-$L(W)-50 S W="'IDENTIFIED' BY "_$P(^DD(+X,%,0),U,1) D W D L IX F Y=0:0 S Y=$N(^DD(F(Z),DJ(Z),1,Y)) Q:Y'>0 W !?M,"CROSS-REFERENCE: ",^(Y,0)_" " D TP:$P(^(0),U,3)["TRIGG" S X=0 F %=0:0 S X=$N(^DD(F(Z),DJ(Z),1,Y,X)) Q:X<0 S W=^(X) S:$L(W)<248 W=X_")= "_W W ?50 D W W ! D HD:$Y+4>IOSL S X="" G DID2 ;GFT/SF ; 10FEB83 13:24 F I=4,12 I $D(^(I)) S W=^(I) D W I $D(^(9.1))#2 S W=" ALGORITHM: "_^(9.1) D W S W=$P(" (ALWAYS "_$E(N,$L(N)-1)_" DECIMAL DIGITS)",U,N?.E1" S X=$J(X,0,"1N1")") D W I $D(^(9.02))#2 S W=" SUM: "_^(9.02) D W I $D(^(8.5)) S W=" DELETE AUTHORITY: "_^(8.5) D W I $D(^(9))#2,^(9)]"" S W=" WRITE AUTHORITY: "_^(9) D W RD I $D(^(8))#2,^(8)]"" S W=" READ AUTHORITY: "_^(8) D W I $D(^("DT")) S Y=^("DT") D D^DIQ S W=" LAST EDITED: "_Y D W I $D(^(10))#2,^(10)]"" S W=" Source of data: "_^(10) D W I $N(^(11,0))>0 S W=" Destination of data:" F I=0:0 S I=$N(^DD(F(Z),DJ(Z),11,I)) Q:I<0 S:$D(^DIC(.2,+^(I,0),0)) W=W_S_$P(^(0),U,1) I D W I $D(^DD(F(Z),DJ(Z),20)) S W=" GROUP:" F I=0:0 S I=$N(^DD(F(Z),DJ(Z),20,I)) S:I>0 W=W_S_$P(^(I,0),U,1) I I<0 D W Q Q ; ; W W:$X+$L(W)+3>IOM !,?$S(IOM-$L(W)-50") W " *** NO DATA STORED IN THIS FILE YET ***" E S I=$P(^(0),U,4) W:I " ("_I_" ENTR"_$S(I=1:"Y)",1:"IES)") W !!,"DATA",?14,"NAME",?36,"GLOBAL",?M+4,"DESCRIPTION",!,"ELEMENT",?36,"LOCATION",! F I=1:1:IOM W "-" S W="" Q:DC>1 S DG=Z,DIWF="W",DIWL=1,DIWR=IOM F D=0:0 S D=$N(^DIC(DA,"%D",D)) Q:D'>0 S X=^(D,0) D ^DIWP D ^DIWW S Z=DG F X=0:0 S X=$N(^DD(DA,0,"ID",X)) Q:'$D(^DD(DA,X,0)) W !,"'IDENTIFIED' BY "_$P(^(0),U,1) D POINT,TRIG S J=0,K=0 W ! XL S J=$N(^DD(DA,0,"IX",J)) I J+1 W $S(K:", ",1:"CROSS-REFERENCED BY: ") S K=$N(^(J,0)) W:$X+30>IOM !?5 W:$D(^DD(K,$N(^(K,0)),0)) $P(^(0),U,1),"(",J,")" G XL F N="DD","RD","WR","DEL","LAYGO" I $D(^DIC(DA,0,N)) W !?4,N," ACCESS: ",^(N) I $D(^("DT")) W !,"CREATED " S Y=+^("DT") D DT^DIQ I $D(^("U")) W " BY USER #",^("U") Q Q ; POINT ; F X=-1:0 S X=$N(^DD(DA,0,"PT",X)) Q:X<0 F DG=0:0 S DG=$N(^DD(DA,0,"PT",X,DG)) Q:DG<0 D PD Q ; PD I $S('$D(^DD(X,DG,0)):1,$P(^(0),U,2)'[("P"_DA):1,1:0) K ^DD(DA,0,"PT",X,DG) Q S %=X W !,"'POINTED TO' BY" WR ; W " THE '"_$P(^(0),U,1)_"' FIELD" W:$X>52 ! UP W " OF THE '"_$N(^DD(%,0,"NM",0)) I $D(^DD(%,0,"UP")) S %=^("UP") W "' SUB-FIELD" W:$X>44 !?5 G UP W "' FILE" Q ; TRIG K X F X=-1:0 S X=$N(^DD(DA,"TRB",X)) Q:X<0 I X-DA,'$D(^DD(DA,"SB",X)) F %=0:0 S %=$N(^DD(DA,"TRB",X,%)) Q:%<0 F %X=0:0 S %X=$N(^DD(DA,"TRB",X,%,%X)) Q:%X<0 F %Y=0:0 S %Y=$N(^DD(DA,"TRB",X,%,%X,%Y)) Q:%Y'>0 D TT I $D(X)>9 F %X=0:0 S %X=$N(X(%X)) Q:%X<0 F X=0:0 S X=$N(X(%X,X)) Q:X<0 W !,"NOTE: A FIELD IS TRIGGERED BY" S %=%X D WR:$D(^DD(%,X,0)) I 1 ;TRUTH FOR DELETE LOGIC K X,%X,%Y Q ; TT S X(X,%)=0 I $D(^DD(X,%,0)) Q:$P(^(0),U,2) I $D(^(1,%X,0)),^(0)["TRIGGER" Q K X(X,%),^DD(DA,"TRB",X,%,%X,%Y) ,DG)) Q:DG<0 D PD Q ; PD I $S('$D(^DD(X,DG,0)):1,$P(^(0),U,2)'[("P"_DA):1,1:0) K ^DD(DA,0,"PT",X,DG) Q S %=X W !,"'POINTED TO' BY" WR ; W " THE '"_$P(^(0),U,1)_"' FIELD" W:$X>52 ! UP W " OF THE '"_$N(^DD(%,0,"NM",0)) I $D(^DD(%,0,"UP")) S %=^("UP") W "' SUB-FIELD" W:$X>44 !?5 G UP W "' FILE" Q ; TRIG K X F X=-1:0 S X=$N(^DD(DA,"TRB",X)) Q:X<0 I X-DA,'$D(^DD(DA,"SB",X)) F %=0:0 S %=$N(^DD(DA,"TRB",X,%)) Q:%<0 F %X=0:0 S %X=$N(^DD(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 WDIDX ;XAK/SF ; 31 OCT 83 6:43 PM S D1=D0 G B ; L S (DJ(Z),D1)=0 A I DID S DJ(Z)=$N(^DD(F(Z),"B",DJ(Z))),D1=$N(^(DJ(Z),0)) E S D1=$N(^DD(F(Z),D1)) I D1'>0 W !!! S Z=Z-1 Q B S N=^DD(F(Z),D1,0) D HD:$Y+9>IOSL W !!?Z+Z-2,$P(N,U,1),?30,S,F(Z),",",D1,S,S S X=$P(N,U,2) I X W ?M,$J(+X,8) I $D(^DD(+X,.01,0)),$P(^(0),U,2)["W" W " WORD-PROCESSING" S X="" W ?M,S,S F W="BOOLEAN","COMPUTED","FREE TEXT","SET","DATE","NUMBER","POINTER" I X[$E(W,1) D W G T:X'["P"!X S Y=$P(N,U,3) I Y]"",@("$D(^"_Y_"0))") S W="TO "_$P(^(0),U,1)_" FILE (#"_+$P(X,"P",2)_")" D W G T S W="***** TO A FILE THAT IS UNDEFINED *******" D W T S W=0 H I $D(^DD(F(Z),D1,3)) S W=$S(X["D":" DATE ",X["N":"NUMBER",1:U),W=" "_$P(^(3),W,W'=U+1,$S(W=U:2,1:9)) D W I $D(^(.1)) W !?(Z+Z+12),^(.1)," ",?M I X["S" S N=$P(N,U,3) F I=1:1 S Y=$P(N,";",I) Q:Y="" S W="'"_$P(Y,":",1)_"' FOR "_$P(Y,":",2) W:$P(N,";",I)'="" "; " D W RD ;  I X S Z=Z+1,F(Z)=+X,W=" Multiple" D W,L S X="" G A:Z>1 Q ; W W:$X+$L(W)+3>IOM !,?$S(IOM-$L(W)-5IOSL W !!?Z+Z-2,$P(N,U,1),?30,S,F(Z),",",D1,S,S S X=$P(N,U,2) I X W ?M,$J(+X,8) I $D(^DD(+X,.01,0)),$P(^(0),U,2)["W" W " WORD-PROCESSING" S X="" W ?M,S,S F W="BOOLEAN","COMPUTED","FREE TEXT","SET","DATE","NUMBER","POINTER" I X[$E(W,1) D W G T:X'["P"!X S Y=$P(N,U,3) I Y]"",@("$D(^"_Y_"0))") S W="TO "_$P(^(0),U,1)_" FILE (#"_+$P(X,"P",2)_")" D W G T S W="***** TO A FILE THAT IS UNDEFINED *******" D W T S W=0 H I $D(^DD(F(Z),D1,3)) S W=$S(X["D":" DATE ",X["N":"NUMBER",1:U),W=" "_$P(^(3),W,W'=U+1,$S(W=U:2,1:9)) D W I $D(^(.1)) W !?(Z+Z+12),^(.1)," ",?M I X["S" S N=$P(N,U,3) F I=1:1 S Y=$P(N,";",I) Q:Y="" S W="'"_$P(Y,":",1)_"' FOR "_$P(Y,":",2) W:$P(N,";",I)'="" "; " D W RD ; DIE ; ; 27JAN84 14:00 K DB I DIE S DIE=^DIC(DIE,0,"GL") S U="^",@("DP=+$P("_DIE_"0),U,2)") GO S DL=1,DR(1,DP)=DR K DE DL S DQ=0,DK=0,DP(0)=0,@("D"_(DL-1)_"=DA") D INI MR S DK=DK+1,DH=$P(DR,";",DK),DI=$P(DH,":",1) J I +DI'=DI G PB:DI'?.NP1"//".E,MR:'$D(^DD(DP,+DI)) S DE(DQ+1,0)=$P(DH,"//",2,9),(DI,DM)=+DI G S S DM=$P(DH,":",2),DM=$S(DM:DM,1:DI) I DI,$D(^DD(DP,DI)) G S NX S DI=$N(^DD(DP,DI)) G MR:DI'>0,MR:DI>DM S I $S<2000,DQ,'$D(DE(DQ+1)) G H S DQ=DQ+1,DQ(DQ)=^(DI,0),Y=$P(DQ(DQ),"^",4),DG=$P(Y,";",1) I $D(^(1)) S DE=0,DB=DM,DM=0 F DW=1:1 S DE=$N(^DD(DP,DI,1,DE)) Q:DE<1 S DE(Y)=DQ,DE(Y,DW,1)=^(DE,1),DE(Y,DW,2)=^(2) S Y=$P(Y,";",2) I DU'=DG S D="",DU=DG,@DC G B:DU=" ",M:Y=0,EQ:DW[0 S D=^(DG) I Y S:$P(D,"^",Y)]"" DE(DQ)=$P(D,"^",Y) E S Y=$E(D,+$E(Y,2,9),$P(Y,",",2)) S:Y'?." " DE(DQ)=Y EQ G MR:DI=DM,NX:DM S DM=DB K DB G D ; MORE D INI G NX:DI-DM,MR JMP D INI G J INI S DIC=DIE,DU=-1,DC="DW=$D("_DIE_DA_",DG))" Q Q ; PB I DH="" G D:$D(DR(DL,DP))<9 S:'$D(DOV) DOV=0,DR(DL,DP)=DR S DOV=$N(DR(DL,DP,DOV)) G D:DOV'>0 S DR=DR(DL,DP,DOV),DK=0 G MR I 'DQ G TEM:DH?1"[".E S DQ=1,DQ(0,1)=DH G MR S DK=DK-1,(DI,DM)=1 D G DQ^DIED ; E K DQ(DQ) H I DI=DM,+$P(DR,";",DK)=DI S DK=DK-1 E S DI=DI-.00001 G D ; M S Y=$P(DQ(DQ),U,2)_U_DG G DC:DW<9 I $D(DSC(+Y))#2,$P(DSC(+Y),"I $D(^UTILITY(",1)="" X DSC(+Y) S D=$N(^(0)) S @DC S DC=$N(^(DG,0)) G DE S D=$S($D(^(DG,0)):$P(^(0),U,3,4),1:$N(^(0))) DE I D>0 S Y=Y_U_D I DP(0)-Y,$D(^(+D,0)) S DE(DQ)=$P(^(0),U,1) DC S DC=$P(^DD(+Y,0),U,4)_U_Y,Y=^(.01,0),DQ(DQ)="Select "_$P(Y,U,1)_U_1_$P(Y,U,2,99) G D:$P(Y,U,2)'["W" G E:DQ-1 D DIEN^DIWE K DQ,DG,DE S DQ=0 G MORE ; B K DQ(DQ) S DQ=DQ-1,DU=-9 G EQ ; TEM F Y=0:0 S Y=$N(^DIE("B",$P($E(DR,2,99),"]",1),Y)) G Q:'$D(^DIE(+Y,0)) Q:$P(^(0),U,4)=DP  G:$D(^("ROU")) @^("ROU") S:$D(^("W")) DIE("W")=^("W") S %X="^DIE(+Y,""DR"",",%Y="DR(" D %XY^%RCR S DIE("^")=DR,DR=$S($D(^DIE(Y,"DR"))#2:^("DR"),1:DR(1,DP)) D DIE K DR S DR=DIE(U) DK=DK-1,(DI,DM)=1 D G DQ^DIED ; E K DQ(DQ) H I DI=DM,+$P(DR,";",DK)=DI S DK=DK-1 E S DI=DI-.00001 G D ; M S Y=$P(DQ(DQ),U,2)_U_DG G DC:DW<9 I $D(DSC(+Y))#2,$P(DSC(+Y),"I $D(^UTILITY(",1)="" X DSC(+Y) S D=$N(^(0)) S @DC S DC=$N(^(DG,0)) G DE S D=$S($D(^(DG,0)):$P(^(0),U,3,4),1:$N(^(0))) DE I D>0 S Y=Y_U_D I DP(0)-Y,$D(^(+D,0)) S DE(DQ)=$P(^(0),U,1) DC S DC=$P(^DD(+Y,0),U,4)_U_Y,Y=^(.01,0),DQ(DQ)="Select "_$P(Y,U,1)_U_1_$P(Y,U,2,99) G D:$P(Y,U,2)'["W" G E:DQ-1 D DIEN^DIWE K DQ,DG,DE S DQ=0 G MORE ; B K DQ(DQ) S DQ=DQ-1,DU=-9 G EQ ; TEM F Y=0:0 S Y=$N(^DIE("B",$P($E(DR,2,99),"]",1),Y)) G Q:'$D(^DIE(+Y,0)) Q:$P(^(0),U,4)=DP DIE0 ;GFT/SF ; 23AUG83 15:19 G:X'?1"^".E T^DIED:$P($P(DQ(DQ),U,4),";E",2),X I $D(DIE("NO^")) W *7,!?9,"SORRY, ""^"" NOT ALLOWED!" G B^DIED S X=$P(X,U,2),DIC(0)="E" OUT I X=""!(DP<0) S DIK=X,DC=$S($D(DQ(DQ))#2:$P(DQ(DQ),U,4),1:DQ) G OUT^DIE1 I DR]"" S DIC("S")=$P("D OV^DIE0 E ",1,$D(DR(DL,DP))>9)_$E($T(F),3,999) S:'$D(DR(DL,DP)) DR(DL,DP)=DR S DIC="^DD(DP," D ^DIC I Y>0,DR]"" D FF S:$D(DOV) DOV=DU E S DG=DK,DH=":"_DM I $D(DOV) S DR=$S($D(DR(DL,DP,DOV)):DR(DL,DP,DOV),$D(DR(DL,DP)):DR(DL,DP),1:"") K DIC I Y>0 S %=$P(DR,";",DG),DI=$S(%["//":%,1:+Y),DK=DG D ^DIE1 G JMP^DIE X W *7,"??" G B^DIED ; FF I $D(DR(DL,DP))>9 D OV Q:$T F F DG=1:1 S DH=$P(DR(DL,DP),";",DG),DW=$P(DH,":",2) Q:DH="" S:'DW DW=+DH I Y'DW,DH Q S DU=0 Q ; BR S Y=U X DQ(0,DQ) G A^DIED:Y=U S DH=$L(Y)+1,D=DQ,X="" I 0[Y S DQ=0 G OUT I +Y=Y S D=9999 D S D=D+1 I '$D(DQ(D)) G D:$D(DQ(0,D)) S DQ=9999,X=Y,DIC(0)="F" G OUT G D:$F(DQ(D),Y)-DH S DQ=D G RE^DIED ; OV S:'$D(DOV) DOV=0,DR(DL,DP)=DR F %=-1:0 S %=$N(DR(DL,DP,%)) Q:%<0 F DG=1:1 S DH=$P(DR(DL,DP,%),";",DG),DW=$P(DH,":",2) Q:DH="" S:'DW DW=+DH I Y'DW,DH S DU=%,%=999,DR=DR(DL,DP,DU) Q Q ; E ;HANDLE 'UNEDITABLE' AND 'DINUM' FIELDS I X="@" Q:DV'["I" G NO Q:X[U!(X?."?")!DV NO W:'$D(DB(DQ)) *7," NO EDITING!!" K X P,DOV)):DR(DL,DP,DOV),$D(DR(DL,DP)):DR(DL,DP),1:"") K DIC I Y>0 S %=$P(DR,";",DG),DI=$S(%["//":%,1:+Y),DK=DG D ^DIE1 G JMP^DIE X W *7,"??" G B^DIED ; FF I $D(DR(DL,DP))>9 D OV Q:$T F F DG=1:1 S DH=$P(DR(DL,DP),";",DG),DW=$P(DH,":",2) Q:DH="" S:'DW DW=+DH I Y'DW,DH Q S DU=0 Q ; BR S Y=U X DQ(0,DQ) G A^DIED:Y=U S DH=$L(Y)+1,D=DQ,X="" I 0[Y S DQ=0 G OUT I +Y=Y S D=9999 D S D=D+1 I '$D(DQ(D)) G D:$D(DQ(0,D)) S DQ=9999,X=Y,DIC(DIE1 ;GFT/SF ; 22AUG83 17:02 K DQ,DB I DP<0 S DQ=0 Q S DQ=-1,DU=-2,DG="$D("_DIE_DA_",DU))" Y S DQ=$N(DG(DQ)),DW=$P(DQ,";",2) G DE:$P(DQ,";",1)=DU I DU'<0 S ^(DU)=DV,DU=-2 G IX:DQ<0 S DU=$P(DQ,";",1),DV="" I @DG S DV=^(DU) DE I 'DW S DW=$E(DW,2,99),DE=DW-$L(DV)-1,%=$P(DW,",",2)+1,X=$E(DV,%,999),DV=$E(DV,0,DW-1)_$J("",$S(DE>0:DE,1:0))_DG(DQ) S:X'?." " DV=DV_$J("",%-DW-$L(DG(DQ)))_X G Y PC I $P(DV,"^",DW-1,99)="" S DV=DV_"^" G PC S X=$P(DV,"^",DW+1,99),DV=$P(DV,"^",1,DW-1)_$E("^",DW>1)_DG(DQ)_$S(X]"":"^"_X,1:"") G Y ; IX S DQ=$N(DE(" ")) G E1:'$D(DG(DQ)) I $D(DE(DE(DQ)))#2 F DG=1:1 Q:'$D(DE(DQ,DG)) S DIC=DIE,X=DE(DE(DQ)) X DE(DQ,DG,2) S X="" I DG(DQ)]"" F DG=1:1 Q:'$D(DE(DQ,DG)) S DIC=DIE,X=DG(DQ) X DE(DQ,DG,1) E1 K DG,DB,DE S DQ=0 Q ; OUT D DIE1 S Y(DC)=DIK G UP:DL>1,Q:DC=0,QY ; E I DP'<0 S DC=$S($D(X)#2:X,1:"") D DIE1 S X=DC G G:DI>0,UP:DL>1 Q K Y QY K DB,DE,DI,DM,DK,DL,DH,DU,DV,DW,DP,DC,DIK,DOV Q ; M S DD=X,DIC(0)=$P("QE","^",'$D(DB(DQ)))_"LM",DO(2)=$P(DC,"^",2),DO=$E($P(DQ(DQ),"^",1),8,99)_"^"_DO(2)_"^"_$P(DC,"^",4,5) D DOWN I @("'$D("_DIC_"0))") S ^(0)="^"_DO(2) E I DO(2)["I" S %=0,DIC("W")="" D W^DIC1 K DICR S D="B",DLAYGO=DP\1,X=DD D X^DIC I Y>0 S DA=+Y,DI=0,X=$P(Y,U,2) S:+DR=.01!(DR="")&$P(Y,U,3) DI=.01,DK=1,DM=$P($P(DR,";",1),":",2),DM=$S(DR="":9999999,DM="":+DR,1:DM) G D1 S DI(DL-1)=DI(DL-1)-.0001 G U ; DOWN S DP(DL)=DP,DP=+$P(DC,"^",2),DI(DL)=$S(DV'["M":DI,$D(DSC(DP))!$D(DB(DQ)):DI,1:DI-.00001),DIE(DL)=DIE,DK(DL)=DK,DR(DL)=DR,DM(DL)=DM,DK=0,DL=DL+1,DM=9999999,DR="" I $D(DR(DL,DP)) S DM=0,DR=DR(DL,DP) D DIE1,DDA S DIE=DIC Q ; DDA F X=DL+1:-1:1 I $D(DA(X)) S DA(X+1)=DA(X) S DA(1)=DA,DIC=DIE_DA_","""_$P(DC,U,3)_"""," Q ; UDA S DA=DA(1) F X=2:1 Q:'$D(DA(X)) S DA(X-1)=DA(X) K DA(X) Q N ; D DOWN S DA=$P(DC,U,4),DI=.01,^DISV($I,$E(DIC,1,28))=$E(DIC,29,999)_DA D1 S @("D"_(DL-1))=DA G G MORE^DIE ; UP ; S DP(0)=DP U S DQ=0,DL=DL-1,DIE=DIE(DL),DIC=DIE,DM=DM(DL),DI=DI(DL),DP=DP(DL),DR=DR(DL),DK=DK(DL) D UDA G G  D W^DIC1 K DICR S D="B",DLAYGO=DP\1,X=DD D X^DIC I Y>0 S DA=+Y,DI=0,X=$P(Y,U,2) S:+DR=.01!(DR="")&$P(Y,U,3) DI=.01,DK=1,DM=$P($P(DR,";",1),":",2),DM=$S(DR="":9999999,DM="":+DR,1:DM) G D1 S DI(DL-1)=DI(DL-1)-.0001 G U ; DOWN S DP(DL)=DP,DP=+$P(DC,"^",2),DI(DL)=$S(DV'["M":DI,$D(DSC(DP))!$D(DB(DQ)):DI,1:DI-.00001),DIE(DL)=DIE,DK(DL)=DK,DR(DL)=DR,DM(DL)=DM,DK=0,DL=DL+1,DM=9999999,DR="" I $D(DR(DL,DP)) S DM=0,DR=DR(DL,DP) D DIE1,DDA S DIE=DIC Q ; DDA F X=DL+1:-1:1 I $D(DA(X)) S DA(X+1)=DA(X) S DA(1)=DA,DIC=DIE_DA_","""_$P(DC,U,3)_"""," Q ; UDA S DA=DA(1) F X=2:1 Q:'$D(DA(X)) S DA(X-1)=DA(X) K DA(X) Q N ; D DOWN S DA=$P(DC,U,4),DI=.01,^DISV($I,$E(DIC,1,DIE2 ; ; 04JAN84 20:16 D F,DL G B^DIED:Y=2,A^DIED:Y,UP^DIE1:DL>1,Q^DIE1 ; F S D=$P(DQ(DQ),U,4) S:DP+1 D=$N(^DD(DP,"GL",$P(D,";",1),$P(D,";",2),0)) Q ; Z D DL S DU="" I Y=2 G @(DQ_U_DNM) I Y G @("A^"_DNM) G R^DIE9:DL>1,E^DIE9 DL ; S %=DP,X=D,Y=$P(DQ(DQ),U,4)="0;1" G X:$D(DE(DQ))[0,X:DV["R"&'Y,S:DP<0,DD:DUZ(0)="@" I DV S %=+$P(DC,U,2),X=.01 I Y,$D(^DIC(%,0,"DEL")) S X=^("DEL") E G DD:'$D(^DD(%,X,8.5)) S X=^(8.5) G DD:X="" F %=1:1:$L(X) G DD:DUZ(0)[$E(X,%) W !,"'DELETE ACCESS' REQUIRED!!" X I $D(DB(DQ)) D N G A W *7,"??" G R DD G MD:DV S DH=0 F DU=0:0 S DH=$N(^DD(DP,D,"DEL",DH)) Q:DH<0 I $D(^(DH,0)) X ^(0) I G A:$D(DB(DQ)),R S X=DQ(DQ) I Y,@("$E("_DIE_"0),1)'=U") S X=^(0) D D G R:X I Y K DE,DG,DQ S DIK=DIE D ^DIK S Y=0 K:DL<2 DA Q S S X="",DG($P(DQ(DQ),U,4))="" A S Y=1 Q ; D I $D(DB(DQ)) S X=0 Q W *7,!?3,"SURE YOU WANT TO DELETE" I Y W " THE ENTIRE " W:DV'["D"&(DV'["P") "'"_DE(DQ)_"' " W $P(X,U,1) S %=0,X=0 D YN^DICN Q:%=1 S X=1 W:$X>55 !?9 N W *7," " Q ; MD G X:DV["R"&($P(DC,U,5)=1) S Y=DC>1,X=$E(DQ(DQ),8,99) D D I 'X D DDA S DA=$P(DC,U,4),DIK=DIC D ^DIK,UDA K DE(DQ) S @("X=$P("_DIK_"0),U,3,4)"),DC=$P(DC,U,1,3)_U_X,DIC=DIE S:X DE(DQ)=$P(^(+X,0),U,1) R S Y=2 Q ; DDA F X=DL+1:-1:1 I $D(DA(X)) S DA(X+1)=DA(X) S DA(1)=DA,DIC=DIE_DA_","""_$P(DC,U,3)_"""," Q ; UDA S DA=DA(1) F X=2:1 Q:'$D(DA(X)) S DA(X-1)=DA(X) K DA(X) Q ; B ; I $D(DB(DQ)) S Y=DQ Q S X="?BAD" QS ; S DZ=X D F,Q G B^DIED Q ; G M:DV I DP<0 W:$D(DQ(DQ,3)) !?5,DQ(DQ,3) X:$D(DQ(DQ,4)) DQ(DQ,4) G P F DG=.1,3,12 W:$D(^DD(DP,D,DG)) !?5,^(DG) X:$D(^(4)) ^(4) P I DV["P" K DO S DIC=U_DU,D="B",DIC(0)="M"_$E("L",DV'["'") G AST:DV["*" D DQ^DICQ K DIC I DV["D" S %(0)=0,%DT=$P($P($P(DQ(DQ),U,5),"%DT=""",2),"""",1) D HELP^%DTC I DV["S" W !,"CHOOSE FROM: " F DG=1:1 S Y=$P($P(DQ(DQ),U,3),";",DG) Q:Y="" W !?7,$P(Y,":",1),?15," ",$P(Y,":",2) I S:$D(DIE) DIC=DIE Q ; AST S X="?" X $P(DQ(DQ),U,5,99) G I ; M K DO S DIC=DIE_DA_","""_$P(DC,U,3)_""",",D="B",DIC(0)="LM",DZ(1)=0 I @("'$D("_DIC_"0))") S DO=U_+$P(DC,U,2) D DO2^DIC1 D DQ^DICQ G P DA_","""_$P(DC,U,3)_"""," Q ; UDA S DA=DA(1) F X=2:1 Q:'$D(DA(X)) S DA(X-1)=DA(X) K DA(X) Q ; B ; I $D(DB(DQ)) S Y=DQ Q S X="?BAD" QS ; S DZ=X D F,Q G B^DIED Q ; G M:DV I DP<0 W:$D(DQ(DQ,3)) !?5,DQ(DQ,3) X:$D(DQ(DQ,4)) DQ(DQ,4) G P F DG=.1,3,12 W:$D(^DD(DP,D,DG)) !?5,^(DG) X:$D(^(4)) ^(4) P I DV["P" K DO S DIC=U_DU,D="B",DIC(0)="M"_$E("L",DV'["'") G AST:DV["*" D DQ^DICQ K DIC I DV["D" SDIE9 ;GFT/SF ; 07SEP83 15:40 G:$A(X)-94 X:'$P(DW,";E",2),@("T^"_DNM) I $D(DIE("NO^")) W *7,!?3,"SORRY, ""^"" NOT ALLOWED!" G B S X=$P(X,U,2),DIC(0)="E" OUT I 0[X S DM=DW D FILE G ABORT:DL=1,R S DIC="^DD("_DP_",",DIC("S")="I $D(^DIE(""AF"","_DP_",Y,DIEZ))" D ^DIC K DIC S DIC=DIE G X:Y<0 S DNM=^DIE("AF",DP,+Y,DIEZ) D FILE S Y=DNM,DNM=$P(Y,U,2),DQ=+Y,D=0 D @("DE^"_DNM) G @Y ; F ; S DC=$S($D(X)#2:X,1:0) D FILE S X=DC Q FILE ; K DQ Q:$D(DG)<9 S DQ=-1,DU=-2,DG="$D("_DIE_DA_",DU))" Y S DQ=$N(DG(DQ)),DW=$P(DQ,";",2) G DE:$P(DQ,";",1)=DU I DU'<0 S ^(DU)=DV,DU=-2 G E1:DQ<0 S DU=$P(DQ,";",1),DV="" I @DG S DV=^(DU) DE I 'DW S DW=$E(DW,2,99),DE=DW-$L(DV)-1,%=$P(DW,",",2)+1,X=$E(DV,%,999),DV=$E(DV,0,DW-1)_$J("",$S(DE>0:DE,1:0))_DG(DQ) S:X'?." " DV=DV_$J("",%-DW-$L(DG(DQ)))_X G Y PC I $P(DV,"^",DW-1,99)="" S DV=DV_"^" G PC S %=$P(DV,"^",DW+1,99),DV=$P(DV,"^",1,DW-1)_$E("^",DW>1)_DG(DQ)_$S(%]"":"^"_%,1:"") G Y ; IX I $D(DE(DE(DQ)))#2 F DG=1:1 Q:'$D(DE(DQ,DG)) S DIC=DIE,X=DE(DE(DQ)) X DE(DQ,DG,2) S X="" I DG(DQ)]"" F DG=1:1 Q:'$D(DE(DQ,DG)) S DIC=DIE,X=DG(DQ) X DE(DQ,DG,1) K K DE(DQ) E1 S DQ=$N(DE(" ")) I DQ+1 G IX:$D(DG(DQ)),K K DG,DE S DQ=0 Q ; 1 ; D FILE R D UP G @("R"_DQ_U_DNM) ; UP S DNM=DNM(DL),DQ=DNM(DL,0),DL=DL-1,%=2,DA=DA(1) K DNM(DL+1),DA(1) DA Q:'$D(DA(%)) S DA(%-1)=DA(%) K DA(%) S %=%+1 G DA ; X W *7,"??" B G @(DQ_U_DNM) ; N D DOWN S DA=$P(DC,U,4),^DISV($I,$E(DIC,1,28))=$E(DIC,29,999)_DA,D=0 D1 S @("D"_(DL-1))=DA G @(DGO) ; M S DD=X D DOWN S DO(2)=$P(DC,"^",2),DO=DOW_"^"_DO(2)_"^"_$P(DC,"^",4,5),DIC(0)=$P("QE",U,'$D(DB(DNM(DL,0))))_"LM" I @("'$D("_DIC_"0))") S ^(0)="^"_DO(2) E I DO(2)["I" S %=0,DIC("W")="" D W^DIC1 K DICR S D="B",DLAYGO=DP\1,X=DD D X^DIC I Y'>0 D UP G @(DQ_U_DNM) S DA=+Y,X=$P(Y,U,2),D=$P(Y,U,3) G D1 ; DOWN S DL=DL+1,DNM(DL)=DNM,DNM(DL,0)=DQ D FILE DDA F %=DL+1:-1:1 I $D(DA(%)) S DA(%+1)=DA(%) S DA(1)=DA,DIC=DIE_DA_","""_$P(DC,U,3)_"""," Q ; ABORT D E S Y(DM)="" Q ; 0 ; D FILE E K Y,DE,DB,DP,DW,DU,DC,DV,DH,DIL,DNM,DIEZ,DLB  S DNM=DNM(DL),DQ=DNM(DL,0),DL=DL-1,%=2,DA=DA(1) K DNM(DL+1),DA(1) DA Q:'$D(DA(%)) S DA(%-1)=DA(%) K DA(%) S %=%+1 G DA ; X W *7,"??" B G @(DQ_U_DNM) ; N D DOWN S DA=$P(DC,U,4),^DISV($I,$E(DIC,1,28))=$E(DIC,29,999)_DA,D=0 D1 S @("D"_(DL-1))=DA G @(DGO) ; M S DD=X D DOWN S DO(2)=$P(DC,"^",2),DO=DOW_"^"_DO(2)_"^"_$P(DC,"^",4,5),DIC(0)=$P("QE",U,'$D(DB(DNM(DL,0))))_"LM" I @("'$D("_DIC_"0))") S ^(0)="^"_DO(2) E I DO(2)["I" S %=0,DIC("W")="" D W^DIC1 K DICR S D="B",DLAYGO=DP\1,X=DD D X^DIC I Y'>0 D UP G @(DQ_U_DNM) S DA=+Y,X=$P(Y,U,2),D=$PDIED ; O D W W Y W:$X>45 !?9 I $L(Y)>19,'DV,DV'["P",DV'["S" G RW W:Y]"" "// " R X Q W I $D(DIE("W")) X DIE("W") Q W !?DL+DL-2,$P(DQ(DQ),"^",1),": " Q ; DQ S DQ=1 G B A K DQ(DQ) S DQ=DQ+1 B I '$D(DQ(DQ)) G E^DIE1:'$D(DQ(0,DQ)),BR^DIE0 RE S DV=$P(DQ(DQ),"^",2),DU=$P(DQ(DQ),"^",3) G PR:$D(DE(DQ)) D W R X N I X="" G A:DV'["R",X:'DV,X:$P(DC,U,2)-DP(0),A RD G ^DIE0:X["^",^DIE2:X="@",QS^DIE2:X?."?" T G M^DIE1:DV,P:DV'["S" S %=$P($P(";"_DU,";"_X_":",2),";",1) I %]"" W:'$D(DB(DQ)) " "_% G V F %=1:1 S Y=$P(DU,";",%),DG=$F(Y,":"_X) G X:Y="" Q:DG W:'$D(DB(DQ)) $E(Y,DG,999) S X=$P(Y,":",1) P I DV["P" S DIC=U_DU,DIC(0)=$E("EN",$D(DB(DQ))+1)_"M"_$E("L",DV'["'") I DV'["*" D ^DIC S X=+Y,DIC=DIE G X:X<0 V X $P(DQ(DQ),"^",5,99) I $D(X),X?.ANP S DG($P(DQ(DQ),"^",4))=X G A X W *7,"??" G B^DIE2 ; PR I $D(DE(DQ,0)) S Y=DE(DQ,0) G F:Y?1"/".E I $D(DE(DQ))=10 D Y:$E(Y,1)=U,O G A:X="@",RD:X]"" S X=Y G N S DG=DV,Y=DE(DQ),X=DU I DG["O",$D(^DD(DP,$N(^DD(DP,"B",$P(DQ(DQ),U,1),0)),2)) X ^(2) G RP R I DG["P",@("$D(^"_X_"0))") S X=+$P(^(0),U,2) G RP:'$D(^(Y,0)) S Y=$P(^(0),U,1),X=$P(^DD(X,.01,0),U,3),DG=$P(^(0),U,2) G R X:DG["D" ^DD("DD") I DG["S" S %=$P($P(";"_X,";"_Y_":",2),";",1) S:%]"" Y=% RP D O I X="" S X=DE(DQ) G A:'DV,A:DC<2,N^DIE1 I DV'["I",DQ(DQ)'["DINUM" G RD D E^DIE0 G RD:$D(X),PR ; F S DB(DQ)=1,X=$E(Y,2,999),DH=$F(DQ(DQ),"%DT=""E") I DH S DQ(DQ)=$E(DQ(DQ),1,DH-2)_$E(DQ(DQ),DH,999) I X?1"/".E S X=$E(X,2,999) S:X DH="" X:$E(X,1)=U $E(X,2,999) G:X="" N^DIE1:DV,A I $D(DE(DQ))#2,DV["I"!(DQ(DQ)["DINUM") D E^DIE0 G X:'$D(X),RD:DH]"",V ; Y X $E(Y,2,999) S Y=X Q Q ; RW ; S DG=Y L W:$X>50 ! R " Replace ",X G D:X="",Q:X?1"^".E,Q:X?."?",Q:X="@",E:X="END"!(X="end") I Y[X R " With ",DH S Y=$P(Y,X,1)_DH_$P(Y,X,2,999) G L S D=$P(X,"...",1),DH=$F(Y,D) I DH S X=$P(X,"...",2,99),DH=DH-$L(D)-1,D=$S(X="":999,1:$F(Y,X,DH+2)) I D R " With ",X S Y=$E(Y,1,DH)_X_$E(Y,D,999) G L W *7," ??" G L E R " With ",X S Y=Y_X G L D I DG'=Y S X=Y W !?3 W X I X="" S X="@" D" ^DD("DD") I DG["S" S %=$P($P(";"_X,";"_Y_":",2),";",1) S:%]"" Y=% RP D O I X="" S X=DE(DQ) G A:'DV,A:DC<2,N^DIE1 I DV'["I",DQ(DQ)'["DINUM" G RD D E^DIE0 G RD:$D(X),PR ; F S DB(DQ)=1,X=$E(Y,2,999),DH=$F(DQ(DQ),"%DT=""E") I DH S DQ(DQ)=$E(DQ(DQ),1,DH-2)_$E(DQ(DQ),DH,999) I X?1"/".E S X=$E(X,2,999) S:X DH="" X:$E(X,1)=U $E(X,2,999) G:X="" N^DIE1:DV,A I $D(DE(DQ))#2,DV["I"!(DQ(DQ)["DINUM") D E^DIE0 G X:'$D(X),RD:DH]"",V ; Y X $E(Y,2,999) S Y=X Q Q ; RW ; S DG=Y L W:$X>50 ! R " Replace ",X G D:X="",Q:X?1"^".E,Q:X?."?",Q:X="@",E:X="END"!(X="end") I Y[X R " With ",DH S Y=$P(Y,X,1)_DH_$P(Y,X,2,999) G L S D=$P(X,"...",1),DH=$FDIEZ ;GFT/SF ; 30NOV83 15:29 I '$D(^("OS",^DD("OS"),"ZS")) W "YOUR MUMPS SYSTEM HAS NO WAY TO SAVE ROUTINES",*7 Q I $S($D(DUZ(0)):DUZ(0)'="@",1:1) W *7,"FOR PROGRAMMERS ONLY!!" Q S T=^DD("ROU") W !!,"MAXIMUM ROUTINE SIZE ON THIS COMPUTER (IN BYTES): "_T_"// " R X S:X="" X=T Q:X["^" I +X=X,X>2000 S ^("ROU")=X G TEM W *7,!,"YOUR ANSWER MUST BE A NUMBER GREATER THAN 2000 (THE LARGER THE BETTER)" G DIEZ TEM S DMAX=X-1700,DIC="^DIE(",DIC(0)="AEQ",DIC("W")="W ?40,""FILE #"",$P(^(0),U,4) W:$D(^(""ROU"")) ?60,^(""ROU"")" D ^DIC Q:'$D(^DIE(+Y,"DR")) DNM W !,"NAME OF ROUTINE TO BE CREATED: " I $D(^("ROUOLD")) W ^("ROUOLD"),"// " R X S:X=""&$T X=^("ROUOLD") I X'?1U.NU&(X'?1"%"1U.NU)!($L(X)>8)!($L(X)<3)!(X?1"DI".E) W *7,!?3,"USE A VALID MUMPS ROUTINE NAME OF FROM 3 TO 8 CHARACTERS" G DNM I $D(^("OS",^DD("OS"),18)) X ^(18) I W *7,!,"'",X,"' IS ALREADY IN YOUR ROUTINE DIRECTORY!" W !,"IS EVERYTHING OK" S %=0 D YN^DICN Q:%-1 EN  ; W ! K ^UTILITY($J),DRN S DNM=X,DIEZ=+Y,DRN="",DRD=0,%X="^DIE(DIEZ,""DR"",",%Y="DR(",DP=$P(^DIE(DIEZ,0),U,4),DIE=^DIC(DP,0,"GL") I '$D(^DIE(DIEZ,"DR",1,DP)) S ^DIE(DIEZ,"DR",1,DP)=^DIE(DIEZ,"DR") D WAIT^DICD,%XY^%RCR,DT^DICRW S DR=DR(1,DP),DL=1 K ^DIE(DIEZ,"RD"),DOV D NEWROU F %=0:0 S %=$N(DR(99,%)) G ^DIEZ0:%<0 F %Y=0:0 S %Y=$N(DR(99,%,%Y)) Q:%Y<0 S F=0,Q=DR(99,%,%Y) D QFF^DIEZ2 S X=" S DR(99,"_%_","_%Y_")="_Q D L^DIEZ2 ; NEWROU K ^UTILITY($J,0) S DQ=0,T=99,L=2,^UTILITY($J,0,1)=DNM_DRN_" ; GENERATED FROM '"_$P(^DIE(DIEZ,0),U,1)_"' TEMPLATE ; "_$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3),^(2)=" D DE S DNM="""_DNM_DRN_""",DQ=1" $L(X)<3)!(X?1"DI".E) W *7,!?3,"USE A VALID MUMPS ROUTINE NAME OF FROM 3 TO 8 CHARACTERS" G DNM I $D(^("OS",^DD("OS"),18)) X ^(18) I W *7,!,"'",X,"' IS ALREADY IN YOUR ROUTINE DIRECTORY!" W !,"IS EVERYTHING OK" S %=0 D YN^DICN Q:%-1 EN DIEZ0 ;GFT/SF ; 31AUG83 19:40 S X=" S D0=DA,DIEZ="_DIEZ_",U=""^""" D L DL S DQ=0,DK=0,DQFF=0 MR S DK=DK+1,DH=$P(DR,";",DK),DI=$P(DH,":",1),DPR="" I +DI'=DI G PB:DI'["//",MR:'$D(^DD(DP,+DI)) S DPR=$P(DH,"//",2,9),(DI,DM)=+DI G S S DM=$P(DH,":",2),DM=$S(DM:DM,1:DI) I DI,$D(^DD(DP,DI)) G S NX S DI=$N(^DD(DP,DI)) G MR:DI'>0,MR:DI>DM S S Y=^DD(DP,DI,0),X=$P(Y,U,1),DV=$P(Y,U,2)_$E("#",Y["DINUM"),DW=$P(Y,U,4) G NX:$A(DW)=32 I T>DMAX D SVROU G S W "." S DQ=DQ+1,DU=$P(Y,U,3),%=" S " I DV["O",$D(^(2)) D O^DIEZ2 I DV S Y=X,X=DQ_" S D=0 ;"_DI D L,DRN G MUL^DIEZ2 I DQFF S %=" D:$D(DG) F^DIE9,DE S DQ="_DQ_%,DQFF=0 S ^UTILITY($J,U,$P(DW,";",1),$P(DW,";",2))=DQ,T=T+35,X=DQ_%_"DW="""_DW_""",DV="""_DV_""",DLB="""_X_""" ;"_DI D L,XREF^DIEZ2:$N(^DD(DP,DI,1,0))>0,PR S %=$P(Y,U,5,99),X=$F(%,"%DT=""") I X,DPR?1"/".E S Y=$F(%,"E",X) I Y S %=$E(%,1,Y-2)_$E(%,Y,999) D AF S X="X"_DQ_" " I "Q"[% S X=X_"Q" D L G NX S X=X_% D L I DV["F" S X=" I $D(X),X'?.ANP K X" D L S X=" Q" D L S X=" ;" D L G NX ; PB I DH="" S:'$D(DOV) DOV=0 S DOV=$N(DR(DL,DP,DOV)) G UP:DOV<0 S DR=DR(DL,DP,DOV),DK=0 K DR(DL,DP,DOV) G MR S DQ=DQ+1,X=DQ_" D:$D(DG) F^DIE9,DE S Y=U,DQ="_DQ I "Q"[DH S X=X_" G A" E S X=X_" D X"_DQ_" G A:Y=U S X=Y,DIC(0)=""F"",DW=DQ G OUT^DIE9" D L S X="X"_DQ_" "_DH D L S X=" Q" D L G MR ; UP S DQ=DQ+1,X=DQ_" G "_(DL>1)_"^DIE9" D L,^DIEZ1 S Y=0 LV S Y=$N(DRN(Y)) I Y<0 G ^DIEZ2 S X=DRN(Y) G LV:X=U S DRN=Y,DP=+X,DL=$P(X,U,2),DIE=U_$P(X,U,3,9),DR=DR(DL,DP),DRN(Y)=U D N S:+DR=.01!(DR?1"0:".E) ^(2)=^(2)_"+D G B" G DL ; PR ; D DU^DIEZ2:DU]"" S X=" G RE" I DW="0;1",DL>1,DQ=1 S X=X_":'D S DQ=2 G 2" D PR^DIEZ2:DPR]"" L S L=L+1,^UTILITY($J,0,L)=X,T=T+$L(X) Q ; AF S ^UTILITY($J,"AF",DP,DI,DIEZ)=DQ_U_DNM_DRN,DRD=DRD+1,^DIE(DIEZ,"RD",DRD,0)=DP_";"_DI Q ; SVROU D DRN S X=DQ+1_" D:$D(DG) F^DIE9 G ^"_DNM_%,DQ=% D L,^DIEZ1 N G NEWROU^DIEZ ; DRN F %=DRN+1:1 Q:'$D(DRN(%)) 0 S DOV=$N(DR(DL,DP,DOV)) G UP:DOV<0 S DR=DR(DL,DP,DOV),DK=0 K DR(DL,DP,DOV) G MR S DQ=DQ+1,X=DQ_" D:$D(DG) F^DIE9,DE S Y=U,DQ="_DQ I "Q"[DH S X=X_" G A" E S X=X_" D X"_DQ_" G A:Y=U S X=Y,DIC(0)=""F"",DW=DQ G OUT^DIE9" D L S X="X"_DQ_" "_DH D L S X=" Q" D L G MR ; UP S DQ=DQ+1,X=DQ_" G "_(DL>1)_"^DIE9" D L,^DIEZ1 S Y=0 LV S Y=$N(DRN(Y)) I Y<0 G ^DIEZ2 S X=DRN(Y) G LV:X=U S DRN=Y,DP=+X,DL=$P(X,U,2),DIE=U_$P(X,U,3,9),DR=DR(DL,DP),DRN(Y)=U D N S:+DR=.01!(DR?1"0:".E) ^(2)=^(2)_"+D G B" G DL ; PR ; D DU^DIEZ2:DU]"" S X=" G RE" I DW="0;1",DL>1,DQ=1 S X=X_":'D S DQ=2 G 2" D PR^DIEZ2:DPR]"" L S L=L+1,^UTILITY($J,0,L)=X,T=T+$L(X) Q ; AF S ^UTILITY($J,"AF",DP,DI,DIEZ)=DQ_U_DNM_DRN,DRD=DRD+1,^DIE(DIEZ,"RD",DRD,0)=DP_";"_DI Q ; SVROU D DRN S X=DQ+1_" D:$D(DG) F^DIE9 G ^"_DDIEZ1 ; ; 06 NOV 83 5:19 PM S X=" ;" D L,QF^DIEZ2 S X="DE S DIE="_Q_",DIC=DIE,DP="_DP_",DL="_DL_",DU="""" K DG,DE,DB Q:$N("_DIE_"DA,-1))<0",DS=-1 D L S X="" DL S DS=$N(^UTILITY($J,U,DS)) I DS<0 K ^UTILITY($J,U) G CN S DSN=DS S:+DS'=DS DSN=""""_DSN_"""" S DPP=-1,X=X_" I $D(^("_DSN_"))" DP S DPP=$N(^UTILITY($J,U,DS,DPP)) I DPP<0 D L S X="" G DL S %=^(DPP) I $L(X)>200 D L S X=" I " I +DPP=DPP S X=X_" S %=$P(^("_DSN_"),""^"","_DPP_") S:%]"""" DE("_%_")=%" G DP S X=X_" S %=$E(^("_DSN_"),"_+$E(DPP,2,9)_","_+$P(DPP,",",2)_") S:%'?."" "" DE("_%_")=%" G DP ; CN F %=1:1 S X=$T(TEXT+%) Q:X="" D L SAVE S X=DNM_DRN X ^("OS",^DD("OS"),"ZS") W !,"'"_X_"' ROUTINE FILED" S DRN(+DRN)=U,T=0,DRN=DQ Q ; L S L=L+1,^UTILITY($J,0,L)=X Q ; TEXT ; Q ; O D W W Y W:$X>45 !?9 I $L(Y)>19,'DV,DV'["P",DV'["S" G RW^DIED W:Y]"" "// " R X Q W W !?DL+DL-2,DLB_": " Q ; A S DQ=DQ+1 B G @DQ RE G PR:$D(DE(DQ)) D W R X N I X="" G A:DV'["R",X:'DV,X:'D,A RD G QS:X?."?" I X["^" D D G ^DIE9 I X="@" D D G Z^DIE2 T G M^DIE9:DV,P:DV'["S" S %=$P($P(";"_DU,";"_X_":",2),";",1) I %]"" W:'$D(DB(DQ)) " "_% G V F %=1:1 S Y=$P(DU,";",%),DG=$F(Y,":"_X) G X:Y="" Q:DG W:'$D(DB(DQ)) $E(Y,DG,999) S X=$P(Y,":",1) P I DV["P" S DIC=U_DU,DIC(0)=$E("EN",$D(DB(DQ))+1)_"M"_$E("L",DV'["'") I DV'["*" D ^DIC S X=+Y,DIC=DIE G X:X<0 V D @("X"_DQ) I $D(X) S DG(DW)=X G A X W *7,"??" G QS:'$D(DB(DQ)) S Y=DQ Q Q ; QS D D,Q^DIE2 G B ; D S D=$P($T(@DQ)," ;",2),DQ(DQ)=DLB_U_DV_U_DU_U_DW Q ; Y I '$D(DE(DQ)) D O G A:X="@",RD:X]"" S X=Y G N PR S DG=DV,Y=DE(DQ),X=DU I $D(DQ(DQ,2)) X DQ(DQ,2) R I DG["P",@("$D(^"_X_"0))") S X=+$P(^(0),U,2) G RP:'$D(^(Y,0)) S Y=$P(^(0),U,1),X=$P(^DD(X,.01,0),U,3),DG=$P(^(0),U,2) G R X:DG["D" ^DD("DD") I DG["S" S %=$P($P(";"_X,";"_Y_":",2),";",1) S:%]"" Y=% RP D O I X="" S X=DE(DQ) G A:'DV,A:DC<2,N^DIE9 I I DV'["I",DV'["#" G RD D E^DIE0 G RD:$D(X),PR  " "_% G V F %=1:1 S Y=$P(DU,";",%),DG=$F(Y,":"_X) G X:Y="" Q:DG W:'$D(DB(DQ)) $E(Y,DG,999) S X=$P(Y,":",1) P I DV["P" S DIC=U_DU,DIC(0)=$E("EN",$D(DB(DQ))+1)_"M"_$E("L",DV'["'") I DV'["*" D ^DIC S X=+Y,DIC=DIE G X:X<0 V D @("X"_DQ) I $D(X) S DG(DW)=X G A X W *7,"??" G QS:'$D(DB(DQ)) S Y=DQ Q Q ; QS D D,Q^DIE2 G B ; D S D=$P($T(@DQ)," ;",2),DQ(DQ)=DLB_U_DV_U_DU_U_DW Q ; Y I '$D(DE(DQ)) D O G A:X="@",RD:X]"" S X=Y G N PR S DG=DV,Y=DE(DQ),X=DU I $D(DQ(DQ,2)) X DQ(DQ,2) R I DG["P",@("$D(^"_X_"0))") S X=+$P(^(0),U,2) G RP:'$D(^(Y,0)) S Y=$P(^(0),U,1),X=$P(^DD(X,.01,0),U,3),DG=$P(^(0),U,2) G R X:DG["D" ^DD("DD") I DG["S" S %=$P($P(";"_X,";"_Y_":",2)DIEZ2 ;GFT/SF ; 27NOV83 13:35 S ^DIE(DIEZ,"ROUOLD")=DNM,^("ROU")=U_DNM,%X="^UTILITY($J,""AF"",",%Y="^DIE(""AF""," D %XY^%RCR K ^UTILITY($J),Q,DPP,DPR,DM,DR,DU,T,F,DRN Q ; XREF ; S %=0,DQFF=1 F DW=1:1 S %=$N(^DD(DP,DI,1,%)) Q:%'>0 S X=^(%,0),DQFF=X["MUMPS"!(X?1"^".E) F X=1,2 S Q=^DD(DP,DI,1,%,X),F=0 D QFF S X=" S DE(DW,"_DW_","_X_")="_Q D L S X=" S DE(DW)="_DQ G L MUL ; S DNR=%,DW=$P(DW,";",1),X=$P(^DD(+DV,0),U,4)_U_DV_U_DW_U,DV=+DV_$P(^(.01,0),U,2) I DV["W" S X=" S Y="""_^(0)_""",DG="""_DW_""" D DIEN^DIWE G A" D L S X=" ;" D L,AF^DIEZ0 G NX^DIEZ0 S X=" S DGO=""^"_DNM_DNR_""",DC="""_X_""",DV="""_DV_""",DW=""0;1"",DOW="""_$P(^(0),U,1)_""",DLB=""Select ""_DOW",DPP=DV["M",DU=$P(^(0),U,3) D L,DU:DU]"" S X=$P(" G RE:D",U,DPP)_" I $D(DSC("_+DV_"))#2,$P(DSC("_+DV_"),""I $D(^UTILITY("",1)="""" X DSC("_+DV_") S D=$N(^(0)) G M"_DQ D L S:+DW'=DW DW=""""_DW_"""" S X=" S D=$S($D("_DIE_"DA,"_DW_",0)):$P(^(0),U,3,4),1:$N(^(0)))" D L S X="M"_DQ_" I D>0 S DC=DC_D I $D("_DIE_"DA,"_DW_",+D,0)) S DE("_DQ_")=$P(^(0),U,1)" D L D PR^DIEZ0 S X="R"_DQ_" D DE" D L S X=$S(DPP:" S D=1 G "_DQ_"+1",1:" G A") D L S X=" ;" D L,AF^DIEZ0 S %=DL+1,DRN(DNR)=+DV_U_%_DIE_"D"_(%-2)_","_DW_"," S:'$D(DR(%,+DV)) DR(%,+DV)="0:9999999" G NX^DIEZ0 ; DU S F=0,Q=DU D QFF S X=" S DU="_Q,DU="" L S L=L+1,^UTILITY($J,0,L)=X,T=T+$L(X) Q ; O S F=0,Q=^(2) D QFF S %=" S DQ("_DQ_",2)="_Q_"," Q ; PR F %=1,2,3 Q:$E(DPR,%)'="/" S X=$E(DPR,%,999),Q=X,F=0 D QFF S X=" "_$S(X?1"^".E:$E(X,2,999)_" S Y=X",1:"S Y="_Q) D L S X=" G Y" I %>1 S DPP=0,X=" S X=Y,DB(DQ)=1 G:X="""" N^DIE9:DV,A I $D(DE(DQ)),DV[""I""!(DV[""#"") D E^DIE0 G X:'$D(X)" D L S X=" G "_$P("V:X,",U,%=3)_"RD" Q ; QF S F=0,Q=DIE QFF S F=$F(Q,"""",F) I F S Q=$E(Q,1,F-1)_""""_$E(Q,F,999),F=F+1 G QFF S Q=""""_Q_"""" DIG ;GFT/SF ; 21MAY81 15:32 ;SCATTERGRAM S DG="^DOSV(0,IO(0)," GO S U="^",IO(0)=$I I @("'$D("_DG_"2))") W !,"NO SUB-SUB TOTALS WERE RUN" Q S C(1)=^("BY",1),C(2)=^(2),@("X=$N("_DG_"2,-1))"),(DXMIN,DXMAX)=X,(DYMIN,DYMAX)=$N(^(X,-1)),X=-1 F C=0:0 S @("X=$N("_DG_"2,X))") Q:X<0 S:X>DXMAX DXMAX=X S Y=$N(^(X,-1)),DY=Y S:Y9:"*",I:I,1:"") W ?DXS+14 I W "+",Y(Y) Q W "|" Q ; S S B=H-L,X=1 I B>1 F C=1:1 S X=X*10 Q:B'>X E S I=1 Q:'B F C=0:-1 Q:X/10'>B S X=X/10 S B=L-X\X*X F I=B:X/10 Q:I'H S T=I I S I=T-B/X*10 I I>N S X=X*2 G I S X=X/10,I=T-B/N .",! F Y=DYS:-1:0 D LINE W ! W ?13 D P W ! S X=DXI D X W !!?22,"X-AXIS: ",$P(C(1),U,3)," Y-AXIS: ",$P(C(2),U,3) I IOST?1"C".E W *7 R X Q ; P S L=-1 F X=0:1:DXS D C Q C I L9:"*",I:I,1:"") W ?DXS+14 I W "+",Y(YDIH ;GFT&JFW/SF ; 26JAN83 16:02 ; HISTOGRAM I $N(^DOSV(0,IO(0),0))'>0 W !,*7,"NO SUB-COUNTS WERE RUN" Q S U="^",(IO(0),J)=$I,DN="=$N(^DOSV(0,J," F X=0:1 Q:'$D(^DOSV(0,J,"BY",X+1)) G END:'X S A=^(1),DD=$P(A,U,3) I $D(^DD(+A,+$P(A,U,2),0)) S DD=^(0) S T=$P(DD,U,2),DP=$P(DD,U,3),DF=$S(T["S":1,T["P":2,T["D"!($P(A,U,7)["D"):3,1:0) S DMX=DN_X,DX="",F=X F S DMX=DMX_",D"_F,DX=DX_"S D"_F_"="""" F X=X:0 S D"_F_DMX_")) Q:D"_F_"=-1 "_$P("S X=X+1,DS(X)=0,DD(X)=0,DV(X)=D"_X_" ",U,F=X),F=F-1 G F:F S DX=DX_"S:$D(^(D1,F,""N"")) DD(X)=DD(X)+^(""N"") S:$D(^(""S"")) DS(X)=DS(X)+^(""S"")" K IOP D ^%ZIS G END:IO="" S F=-1,C="*",IOM=IOM-23,IOSL=IOSL-6 U IO W @IOF I S X=0,@("F"_DN_"""F"",F))") I F+1 S T=^(F),DS=1 X DX D MAX G I U IO(0) C:IO'=$I IO END K A,C,DD,DS,D1,D2,DN,T,DP,F,N,J,U,IOM,IOST,POP,IOPAR,DF,IOBS,IOF,IOT,X,Y,DX,DMX,DV,IOSL Q ; MAX S DMX=0 F N=1:1:X S:DD(N)>DMX DMX=DD(N) D LBL:DS=1&DF S DV(N)=$E(DV(N),1,14)  S X=1 F S=1:1 S X=X*2 Q:DMX'>X S D2=IOM,D1=DMX+X\X*X F S=D1:-X/2 Q:S'>DMX S D1=S XX S X=X\2,D2=D2\2 I X>4,$L(X)+7X S S=DD(N),DD(N)=DS(N),DS(N)=S I DS=2 S DS=3 F N=1:1 S DD(N)=$S(DS(N):DD(N)/DS(N),1:0) G MAX:N=X Q ; LBL I DF=1 S D1=$F(DP,DV(N)_":") S:D1 DV(N)=$P($E(DP,D1,99),";",1) Q I DF=2 S DV(N)=$P(@(U_DP_DV(N)_",0)"),U,1) Q S D1=$E(DV(N),6,7),D2=$E(DV(N),4,5),DV(N)=$P(+D2_"-",U,D2>0)_$P(+D1_"-",U,D1>0)_(DV(N)\10000+$S(D2:-200,1:1700)) Q ; HD U IO W:$Y+N+1>IOSL @IOF W !!?27,$P("COUNT^SUM^MEAN",U,DS),", " I $D(^DD(+T,0)) S Y=+$P(T,U,2) I Y>.01,$D(^(Y,0)) W $P(^(0),U,1),", " W "BY ",$P(DD,U,1),!! Q LN W ?15-$L(DV(X))-1,DV(X)," |" F Y=1:1:DD(X)/S W C W ! Q TR W ?15 F Y=0:1:IOM W $E("-+",Y#D1=0+1) W ! F Y=1:1:IOM I Y#D1=0 S D2=$J(Y*S,0,0) W ?Y+15-($L(D2)\2),D2 U IO(0) I IOST?1"C".E W *7 R Y U IO #-AJS@YuuJuu}ͦߦ*Pȧ(d'{AgXJv!)*^#V#^#Vw# ll!J ^#V̀:#!"(COPYRIGHT (C) 1982, DIGITAL RESEARCH 151282/…(+17Ȉ=} ӓ "y2;!":2=2:=;!~;4#.{2!""9"2!;y3]K!Ƃo\b!,_^#V* Ó*"r*r"ÿ<:g:!͐*f}D! ~6t!rͷօO(^ƅƅƅ  :Function = File = !,!"h!9"f! ͉:2t™:!=Hgo:O*;*͂:A2=/::0! dگ61#d ڸïp#:w#6 !6:6 *#!)6.#)͂ O(BDOS > wM  2*7w#6?#7 .,:;[]=<>|!?]45#Ra{i_p# l s sX=DD(N) D LBL:DS=1&DF S DV(N)=$E(DV(N),1,14) S X=1 F S=1:1 S X=X*2 Q:DMX'>X S D2=IOM,D1=DMX+X\X*X F S=D1:-X/2 Q:S'>DMX S D1=S XX S X=X\2,D2=D2\2 I X>4,$L(X)+7X S S=DD(N),DD(N)=DS(N),DS(N)=S I DS=2 S DS=3 F N=1:1 S DD(N)=$S(DS(N):DD(N)/DS(N),1:0) G MAX:N=X Q ; LBL I DF=1 S D1=$F(DP,DV(N)_":") S:D1 DV(N)=$P($E(DP,D1,99),";",1) Q I DF=2 S DV(N)=$P(@(U_DP_DV(N)_",0)"),U,1) Q S D1=$E(DV(N),6,7),D2=$E(DV(N),4,5),DV(N)=$P(+D2_"-",U,D2>0)_$P(+D1_"-",U,D1>0)_(DV(N)\10000+$S(D2:-200,1:1700)) Q ; HD U IO W:$Y+N+1>IOSL @IOF W !!?27,$P("COUNT^SUM^MEAN",U,DS),", " I $D(^DD(+T,0)) S Y=+$P(T,U,2) I Y>.01,$D(^(Y,0)) W $P(^(0),U,1),", " W "BY ",$P(DD,U,1),!! Q LN W ?15-$L(DV(X))-1,DV(X)," |" F Y=1:1:DD(X)/S W C W ! Q TR W ?15 F Y=0:1:IOM W $E("-+",Y#D1=0+1) W ! F Y=1:1:IO VOLUME 005 DESCRIPTION: MICRO MUMPS VERSION 4.02 - TWO OF THREE DISKS NUMBER SIZE NAME COMMENTS 005.1 4K %DT .MMP MICRO MUMPS VERSION 4.02 - RUNTIME ROUTINES 005.2 4K %DTC .MMP " " " " " " 005.3 2K %RCR .MMP " " " " " " 005.4 2K %ZIS .MMP " " " " " " 005.5 6K -EBMMUG .005 DISK NAME & CONTENTS OF EBMMUG.005 (JUL 5,'85) 005.6 2K DI .MMP MICRO MUMPS VERSION 4.02 - RUNTIME ROUTINES 005.7 4K DIA .MMP " " " " " " 005.8 4K DIA1 .MMP " " " " " " 005.9 2K DIA2 .MMP " " " " " " 005.10 2K DIA3 .MMP " " " " " " 005.11 2K DIB .MMP " " " " " " 005.12 2K DIBT .MMP " " " " " " 005.13 4K DIC .MMP " " " " " " 005.14 4K DIC1 .MMP " " " " " " 005.15 4K DICATT .MMP " " " " " " 005.16 2K DICATT0 .MMP " " " " " " 005.17 4K DICATT1 .MMP " " " " " " 005.18 2K DICATT2 .MMP " " " " " " 005.19 2K DICATT22.MMP " " " " " " 005.20 4K DICATT3 .MMP " " " " " " 005.21 2K DICATT4 .MMP " " " " " " 005.22 4K DICATT5 .MMP " " " " " " 005.23 2K DICATT6 .MMP " " " " " " 005.24 4K DICD .MMP " " " " " " 005.25 2K DICE .MMP " " " " " " 005.26 2K DICE0 .MMP " " " " " " 005.27 2K DICE1 .MMP " " " " " " 005.28 4K DICE2 .MMP " " " " " " 005.29 2K DICE3 .MMP " " " " " " 005.30 4K DICE4 .MMP " " " " " " 005.31 2K DICE7 .MMP " " " " " " 005.32 4K DICM .MMP " " " " " " 005.33 4K DICM1 .MMP " " " " " " 005.34 4K DICN .MMP " " " " " " 005.35 2K DICN1 .MMP " " " " " " 005.36 4K DICOMP .MMP " " " " " " 005.37 4K DICOMP0 .MMP " " " " " " 005.38 4K DICOMP1 .MMP " " " " " " 005.39 4K DICOMPX .MMP " " " " " " 005.40 4K DICOMPY .MMP " " " " " " 005.41 2K DICOMPZ .MMP " " " " " " 005.42 4K DICQ .MMP " " " " " " 005.43 2K DICR .MMP " " " " " " 005.44 2K DICRW .MMP " " " " " " 005.45 4K DID .MMP " " " " " " 005.46 4K DID1 .MMP " " " " " " 005.47 2K DID2 .MMP " " " " " " 005.48 4K DIDH .MMP " " " " " " 005.49 2K DIDX .MMP " " " " " " 005.50 4K DIE .MMP " " " " " " 005.51 2K DIE0 .MMP " " " " " " 005.52 4K DIE1 .MMP " " " " " " 005.53 4K DIE2 .MMP " " " " " " 005.54 4K DIE9 .MMP " " " " " " 005.55 4K DIED .MMP " " " " " " 005.56 2K DIEZ .MMP " " " " " " 005.57 4K DIEZ0 .MMP " " " " " " 005.58 4K DIEZ1 .MMP " " " " " " 005.59 2K DIEZ2 .MMP " " " " " " 005.60 4K DIG .MMP " " " " " " 005.61 4K DIH .MMP " " " " " " 005.62 4K DII .MMP " " " " " " 005.63 2K DIK .MMP " " " " " " 005.64 2K DIK1 .MMP " " " " " " 005.65 4K DIL .MMP " " " " " " 005.66 4K DIL0 .MMP " " " " " " 005.67 4K DIL1 .MMP " " " " " " 005.68 4K DIL2 .MMP " " " " " " 005.69 2K DILL .MMP " " " " " " 005.70 2K DIM .MMP " " " " " " 005.71 2K DIM1 .MMP " " " " " " 005.72 4K DIM2 .MMP " " " " " " 005.73 4K DIM3 .MMP " " " " " " 005.74 4K DIM4 .MMP " " " " " " 005.75 2K DIO .MMP " " " " " " 005.76 2K DIO0 .MMP " " " " " " 005.77 4K DIO1 .MMP " " " " " " 005.78 2K DIO2 .MMP " " " " " " 005.79 4K DIO3 .MMP " " " " " " 005.80 2K DIO4 .MMP " " " " " " 005.81 4K DIOS .MMP " " " " " " 005.82 4K DIP .MMP " " " " " " 005.83 4K DIP0 .MMP " " " " " " 005.84 4K DIP1 .MMP " " " " " " 005.85 4K DIP2 .MMP " " " " " " 005.86 2K DIP22 .MMP " " " " " " 005.87 4K DIP3 .MMP " " " " " " 005.88 2K DIP4 .MMP " " " " " " 005.89 2K DIP5 .MMP " " " " " " 005.90 4K DIQ .MMP " " " " " " 005.91 4K DIQQ .MMP " " " " " " 005.92 2K DIQQQ .MMP " " " " " " 005.93 4K DIS .MMP " " " " " " 005.94 4K DIS0 .MMP " " " " " " 005.95 4K DIS1 .MMP " " " " " " 005.96 4K DIT .MMP " " " " " " 005.97 2K DIT0 .MMP " " " " " " 005.98 2K DIT1 .MMP " " " " " " 005.99 2K DIT2 .MMP " " " " " " 005.100 2K DITP .MMP " " " " " " 005.101 4K DITR .MMP " " " " " " 005.102 2K DITR1 .MMP " " " " " " 005.103 4K DIU .MMP " " " " " " 005.104 4K DIU1 .MMP " " " " " " 005.105 4K DIU2 .MMP " " " " " " 005.106 2K DIU3 .MMP " " " " " " 005.107 2K DIV .MMP " " " " " " DII ;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 S X=$P(Y(0),U,2,99) K Y D @X W !!! G NOKL ;ENTER OR EDIT FILE ENTRIES^^DIB ;PRINT FILE ENTRIES^^DIP ;SEARCH FILE ENTRIES^^DIS ;MODIFY FILE ATTRIBUTES^^DICATT ;INQUIRE TO FILE ENTRIES^INQ^DII ;UTILITY FUNCTIONS^^DIU ;STATISTICS^^DIX ;LIST FILE ATTRIBUTES^^DID ;TRANSFER ENTRIES^^DIT ; INQ ; W !! D ^DICRW Q:'$D(DIC) S DI=DIC,DPP(1)=+Y_"^^^@",DK=+Y B K ^DD(U,$J),DIC S DIC=DI,DIC(0)="AEQM",DIK=0 R D ^DIC I Y>0 S DIK=DIK+1,^DD(U,$J,DIK,+Y)="",DIC("A")="ANOTHER ONE: " G R S G Q^DIP:'DIK I DIK>3 R !,"STORE THESE ENTRY ID'S IN TEMPLATE: ",X I X]"" D DIBT1 G:Y<0 Q^DIP:X=U,S F X=1:1:DIK S ^DIBT(+Y,1,$N(^DD(U,$J,X,0)))="" O K DIC S DIC=DI,%=1 W !,"STANDARD CAPTIONED OUTPUT" D YN^DICN G Q^DIP:%<0 I '% W !,"ANSWER 'N' IF YOU WANT TO USE A COLUMNAR DISPLAY, AS IN OPTION 2" G O I %=2 S L=1,C=",",Q="""",DPP=1,DPP(1,"IX")="^DD(U,$J,"_DI_"^2" G N^DIP1 S IOP=$I D ^%ZIS,1^DICRW F DIK=1:1:DIK S DA=$N(^DD(U,$J,DIK,0)),DD=DK,E="N<0",N=-1,DD=+DPP(1) D GUY^DIQ W !! G B ; P S DUZ(0)="@" G DII ; DIBT1 S DIBT1=1 DIBT K DIC S DIC="^DIBT(",DLAYGO=0,DIC(0)="QEL",DIC("S")="I $P(^(0),U,4)=DK,$P(^(0),U,5)=DUZ!'$P(^(0),U,5)" D ^DIC K DIC,DLAYGO D ALR:$N(^DIBT(+Y,0))+1 S:Y>0 ^DIBT(+Y,0)=$P(Y,U,2)_U_DT_U_DUZ(0)_U_DK_U_DUZ K DIBT1 Q ALR W *7,!,"DATA ALREADY STORED THERE ...OK TO PURGE" S %=2 D YN^DICN I %=1 K ^DIBT(+Y) Q S %Y=-1 I $N(^(1,0))'>0!(%-2)!'$D(DIBT1) S Y=-1 Q F %=0:0 S %=$N(^(%)),%Y=%Y+1 Q:%'>0 W !,"WANT TO MERGE THESE ENTRIES",!,"WITH THE ",%Y," ALREADY IN '",$P(Y,U,2),"' TEMPLATE" S %=2 D YN^DICN S:%-1 Y=-1 W ! F YOU WANT TO USE A COLUMNAR DISPLAY, AS IN OPTION 2" G O I %=2 S L=1,C=",",Q="""",DPP=1,DPP(1,"IX")="^DD(U,$J,"_DI_"^2" G N^DIP1 S IOP=$I D ^%ZIS,1^DICRW F DIK=1:1:DIK S DA=$N(^DD(U,$J,DIK,0)),DD=DK,E="N<0",N=-1,DD=+DPP(1) D GUY^DIQ W !! G B ; P S DUZ(0)="@" G DII ; DIBT1 S DIBT1=1 DIBT K DIC S DIC="^DIBT(",DLAYGO=0,DIC(0)="QEL",DIC("S")="I $P(^(0),U,4)=DK,$P(^(0),U,5)=DUZ!'$P(^(0),U,5)" D ^DIC K DIC,DLAYGO D ALR:$N(^DIBT(+Y,0))+1 S:Y>0 ^DIBT(+Y,0)=$P(Y,U,2)_U_DT_U_DUZ(0)_U_DK_U_DUZ K DIBT1 Q ALR W *7,!,"DATA ALREADY STORED THERE ...OK TO PURGE" S %=2 D YN^DICN I %=1 K ^DIBT(+Y) Q S %Y=-1 I $N(^(1,0))'>0!(%-2)!'$D(DIBT1) S Y=-1 Q F %=0:0 S %=$N(^(%)),%Y=%Y+1 Q:%'>0 W !,"WANT TO MERGE THESE ENTRIES",!,"WITH THE ",%Y," ALREADY IN '",$P(Y,U,2),"' TEMPLATE" S %=DIK ; S X=2 D DD G ^DIK1 ; DD K DIKS,DIN,DH,DU,DV,DW S U="^",@("DH=+$P("_DIK_"0),U,2)"),DH(1)=DH,DV=0 D D E S DV=$N(^DD(DH,"SB",DV)) I DV>0 S DU=$N(^(DV,0)),DW=$P($P(^DD(DH,DU,0),U,4),";",1) S:+DW'=DW DW=""""_DW_"""" S DV(DH,DU)=DW,DV(DH,DU,0)=DV,DU(DV)="" G E DH S DH=$N(DU(DH)) G:DH>0 DH:$D(DV(DH)),E F DH=DH(1):0 S DH=$N(DU(DH)) Q:DH<0 D D S DH=DH(1),DU=1 DV I $N(^UTILITY("DIK",$J,DH))>DH S DH=$N(DV(DH)) G DV:DH>0 Q K K DV(DH) S DH=$N(DV(DH)) G K:DH>0 Q ; DW I $N(^UTILITY("DIK",$J,DH,DV,0))<0 K ^UTILITY("DIK",$J,DH,DV) D S DV=$N(^DD(DH,"IX",DV)) Q:DV<0 S DW=$P(^DD(DH,DV,0),U,4),^UTILITY("DIK",$J,DH,DV)=$P(DW,";",1),DW=$P(DW,";",2) S ^UTILITY("DIK",$J,DH,DV,0)=$S(DW:"S X=$P(^(X),U,"_DW_")",1:"S X=$E(^(X),"_+$E(DW,2,9)_","_$P(DW,",",2)_")"),DW=0 I S DW=$N(^DD(DH,DV,1,DW)) G DW:DW<0,I:"Q"[^(DW,X) I ^(0)'["TRIGG" S ^UTILITY("DIK",$J,DH,DV,DW)=^(X) G I S %=^(X),^UTILITY("DIK",$J,DH,DV,DW)="D RCR",^(DW,0)=% G I ; IX1 ; S X=1 D DD G 1^DIK1 ; IXALL ; S (DA,DCNT)=0,X=1 D DD G CNT^DIK1 (DH,DU)=DW,DV(DH,DU,0)=DV,DU(DV)="" G E DH S DH=$N(DU(DH)) G:DH>0 DH:$D(DV(DH)),E F DH=DH(1):0 S DH=$N(DU(DH)) Q:DH<0 D D S DH=DH(1),DU=1 DV I $N(^UTILITY("DIK",$J,DH))>DH S DH=$N(DV(DH)) G DV:DH>0 Q K K DV(DH) S DH=$N(DV(DH)) G K:DH>0 Q ; DW I $N(^UTILITY("DIK",$J,DH,DV,0))<0 K ^UTILITY("DIK",$J,DH,DV) D S DV=$N(^DD(DH,"IX",DV)) Q:DV<0 S DW=$P(^DD(DH,DV,0),U,4),^UTILITY("DIK",$J,DH,DV)=$P(DW,";",1),DW=$P(DW,";",2) S ^UTILITY("DIK",$J,DH,DV,0)=$S(DW:"S X=$P(^(X),U,"_DW_")",1:"S X=$E(^(X),"_+$E(DW,2,9)_","_$P(DW,",",2)_")"),DW=0 I S DW=$N(^DD(DH,DV,1,DW)) G DW:DW<0,I:"Q"[^(DW,X) I ^(0)'["TRIGG" S ^UTILITY("DIK",$J,DH,DV,DW)=^(X) G I S %=^(X),^UTILITY("DIK",$J,DH,DV,DW)="D RCDIK1 ;GFT/SF ; 25APR83 17:58 D DI K @(DIK_"DA)") G Q:'$D(^(0)) S Y=^(0),DH=$S($N(^(0))'>0:0,1:$P(Y,U,4)-1),X=$P($P(Y,U,3),U,DH>0) D 3:X=DA S ^(0)=$P(Y,U,1,2)_U_X_U_DH Q K ^UTILITY("DIK",$J),DIKS,DIN,DH,DU,DV,DW Q ; 3 S DV=1 F X=X:1 S X=X+DV,DV=DV+1 I $N(^(X))'>0 S DU=X-2,DV=1 Q L S X=$N(^(DU)) Q:X>0 S DU=DU-DV,DV=DV+1 S:DU<0 DU=0 G L ; DI S (DIC,DIN)=DIK,DH=DH(DU) DIN F DV=.01:0 S DV=$N(^UTILITY("DIK",$J,DH,DV)) Q:DV<0 D R DVA S DV=$N(DV(DH,DV)) I DV<0 S DV=.01 D R:$D(^UTILITY("DIK",$J,DH,DV)) Q S X=DIN_DA_","_DV(DH,DV) I @("'$D("_X_"))") G DVA S DU(DU)=DIN,DIN=X_",",DH(DU)=DH,DH=DV(DH,DV,0),DV(DU)=DV,DU=DU+1 F X=DU:-1:1 I $D(DA(X)) S DA(X+1)=DA(X) S DA(1)=DA,DA=0 DA S @("DA=$N("_DIN_"DA))") I DA>0 D DIN G DA S DU=DU-1,DIN=DU(DU),DH=DH(DU),DV=DV(DU),DA=DA(1) K DA(1) F X=2:1 G DVA:'$D(DA(X)) S DA(X-1)=DA(X) K DA(X) ; R S X=^UTILITY("DIK",$J,DH,DV),%=^(DV,0) I @("$D("_DIN_DA_",X))[0") Q X % Q:X?." " S DIKS=X,DW=0 XEC S DW=$N(^UTILITY("DIK",$J,DH,DV,DW)) Q:DW<0 X ^(DW) S X=DIKS G XEC ; RCR K Y,%RCR F %="DIKS","DIK","DW","DH","DIN","DU","DV","X" S %RCR(%)="" S %RCR="RR^DIK1",Y=^UTILITY("DIK",$J,DH,DV,DW,0) G STORLIST^%RCR ; RR X Y Q ; 1 ; D DI G Q ; CNT ; I @("$N("_DIK_"DA))'>0") S ^(0)=$P(^(0),U,1,2)_U_DA_U_DCNT K DCNT G Q S DA=$N(^(DA)),DU=1,DCNT=DCNT+1 D DI G CNT  G DVA S DU(DU)=DIN,DIN=X_",",DH(DU)=DH,DH=DV(DH,DV,0),DV(DU)=DV,DU=DU+1 F X=DU:-1:1 I $D(DA(X)) S DA(X+1)=DA(X) S DA(1)=DA,DA=0 DA S @("DA=$N("_DIN_"DA))") I DA>0 D DIN G DA S DU=DU-1,DIN=DU(DU),DH=DH(DU),DV=DV(DU),DA=DA(1) K DA(1) F X=2:1 G DVA:'$D(DA(X)) S DA(X-1)=DA(X) K DA(X) ; R S X=^UTILITY("DIK",$J,DH,DV),%=^(DV,0) I @("$D("_DIL ; ; 22DEC83 12:21 F DD=1:1 S W=$P(R,$C(126),DD) G Q:W="" S:DIWL DIWL=9 D DM I DTOT]"" S DN=-8,W=DTOT,DTOT="" D DM:W'=1 ; DM I DM G UP:$P(W,F,1)]"" S W=$P(W,F,2,999) I W[";Y" S DE="" D W:DG S M=+$P(W,";Y",2),DG=0,Y=DE_" F Y=0:0 Q:$Y>"_(M-2)_" W !" D PX S O=999 G L:$A(W)=34,DOWN^DIL0:W?.NP1",".E&W,^DIL1:$P(W,";",1)'=+W!'W K DPQ(DP,+W) D DE,^DIL0 G T:DU=DN I $P(X,U,2)["C" S DN=-2 G PX S DN=DU,Y=" S X=$S($D("_DK_DI_C_DN_")):^("_DN_"),1:"""")"_Y PX ; I DHT F %=2:1 I '$D(^UTILITY($J,%)) S ^(%)=$E(Y,2,999),Y="" G Q F DX=DX+1:1 I '$D(DX(DX)) S DX(DX)=$E(Y,2,999) Q I DM S Y=F(DM-1) D IF S DX(Y)=DX(Y)_$S($T:",DX(",1:" X DX(")_DX_")" I $T,$L(DX(Y))>130 F O=500:1 I '$D(DX(O)) S ^(Y)=$S($D(^UTILITY($J,99,Y)):^(Y),1:"")_$E(DX(Y),1,$L(DX(Y))-1-$L(DX))_O_")",F(DM-1)=O,DX(O)="X DX("_DX_")",DX(Y)="" Q S O=0 I $S<1800 F Y=0:0 S Y=$N(DX(Y)) Q:Y<0 I DX(Y)]"" D IF E S ^(Y)=$S($D(^UTILITY($J,99,Y)):^(Y),1:"")_DX(Y),DX(Y)="",O=$L(^(Y)) Q Q ; DE S DE="" I W[";S" D W:DG S DE=DE_" W:$X ! W !"_$E("!!!!!!!!!!!!!!!!!!!!!!!!!!!!",2,$P(W,";S",2)),DG=0,M=M+$L(DE)-10 I $P(W,";C",2) D W:$P(W,";C",2)"_DG_" !" I DN=-4 S DE=DE_" W:$X>"_DG_" !" S DE=DE_" W ?"_DG Q Z ; D DE G T ; W ; I $D(DIWR) S DE=" D ^DIWW"_DE K:'DM DIWR A ; S M=M+1 I DHD,$D(V)>9 F I=$N(V(0)):1:99 S Z="W !" D B K ^UTILITY($J,0),V Q B F V=-1:0 S V=$N(^UTILITY($J,0,V)) Q:V<0 I $D(^(V,I)) S %=^($N(^(0))-I+99) D C,U:$L(Z)+$L(%)>245 S Z=Z_",?"_V_","""_%_"""" U S ^UTILITY($J,DHD)=Z,DHD=DHD+1,Z="W """"" Q C I %?1" ".E S V=V+1,%=$E(%,2,999) G C Q ; D ; D PX:'DHT S F(DM)=DX,R(DX)="",F=F_W_C,DM=DM+1,DX=900,DD=DD-1 Q ; UP I $D(DIWR),DIWR S Y=" D ^DIWW" D PX S DM=DM-1,DP=DP(DM),DN=-4,DX=$S(DM:F(DM),1:0),F=$P(F,C,1,DM)_$E(C,DM>0),DY="D"_DM,DI=$P(DI,C,1,DM*2+1) G DM ; L S Y=" W """_$P(W,"""",2)_"""",W=$P(W,"""",3,9),DLN=0,X="",DRJ=0,%=$L(Y)-5 D:W[";" W^DILL S:'DLN DLN=% S:DRJ Y=" W ?"_(DG+DLN-%)_Y O ; D DE,DN^DIL0 T ; G PX:'$D(DX(DX))!DTOT,PX:$L(DX(DX))+$L(Y)+O>240 S DX(DX)=DX(DX)_Y Q ; IF I DX(Y)?.E1"DX(".N1")" DIWR) S DE=" D ^DIWW"_DE K:'DM DIWR A ; S M=M+1 I DHD,$D(V)>9 F I=$N(V(0)):1:99 S Z="W !" D B K ^UTILITY($J,0),V Q B F V=-1:0 S V=$N(^UTILITY($J,0,V)) Q:V<0 I $D(^(V,I)) S %=^($N(^(0))-I+99) D C,U:$L(Z)+$L(%)>245 S Z=Z_",?"_V_","""_%_"""" U S ^UTILITY($J,DHD)=Z,DHD=DHD+1,Z="W """"" Q C I %?1" ".E S V=V+1,%=$E(%,2,999) G C Q ; D ; D PX:'DHT S F(DM)=DX,R(DX)="",F=F_W_C,DM=DM+1,DX=900,DD=DD-1 Q ; UP I $D(DIWR),DIWR S Y=" D ^DIWW" D PX S DM=DM-1,DP=DP(DM),DN=-4,DX=$S(DM:F(DM),1:0),F=$P(F,C,1,DM)_$E(C,DM>0),DY="D"_DM,DI=$P(DI,C,1,DM*2DIL0 ;GFT/SF ; 22DEC83 11:54 D XDUY S %=$P(X,U,2) I %["W" D WR S DIWR=0,DTOT=$P(F,C,1,DM-1)_$E(C,DM>1)_"D 0^DIWW;X",Y=Y_" D ^DIWP" S:DE[" W:$X ! W !" X=F(DM-1),DX(X)=$E(DE,2,999)_" "_$P(DX(X)," W:$X>",1) Q I %["m" S D1=" S DICMX=""D "_$E("L",%'["w")_"^DIWP"" "_$P(X,U,5,99) D WR S Y=DE_Y_D1 Q G STATS^DIL1:$D(DCL(DP_U_+W)) I W[";W" S Z=$D(DNP),DNP=1 D ^DILL K:'Z DNP S D1=$S(%["C":Y,1:$P(" S Y=",U,Y'?1" ".E)_Y_" S X=Y") D W S Y=Y_D1_" D ^DIWP" Q D ^DILL DN ; I W[";X" S:$A(Y)-32 Y=" W ?0"_Y Q S V=$P(X,U,1),Z=99,I=$P(W,";""",2) I I]"" S V=$P(I,"""",1) PX S I=$P(V," ",1) I $L(I)>DLN S DLN=$L(I) XD S V=$P(V," ",2,99),D=$P(V," ",1) I D]"",$L(I)+$L(D)IOM,DE'["!" K ^UTILITY($J,0,DG) S DG='%*DM*2+2,DG=$S(DG+DLN'>IOM:DG,DLN>IOM:0,1:IOM-DLN),DE=" W:$X ! W ?"_DG D W^DIL G DN S DG=2+DLN+DG Q:$D(DNP) I $L(DE)+$L(Y)>250 S %=Y,Y=DE,DE=% D PX^DIL S Y=DE Q S Y=DE_Y Q ; XDUY ; I '$D(^DD(DP,+W,0)) S X="",DU=0,Y=0 Q S X=^(0),DU=$P(X,U,4),Y=$P(DU,";",2),DU=$P(DU,";",1) I W[";T",$D(^(.1)) S X=^(.1)_U_$P(X,U,2,99) S:+DU'=DU DU=""""_DU_"""" I Y S Y="$P(X,U,"_Y_")" Q I Y="" S Y="D"_DM Q S Y=$E(Y,2,9) S:$P(Y,",",2)=+Y Y=+Y S Y="$E(X,"_Y_")" Q ; WR K DLN D W^DILL W ; S DRJ=0,DIWL=DIWL+1 I '$D(DLN) S %=IOM-DG,DLN=$S(%>20:%,1:IOM)-2 D DN S %=$P(DE,"W ?",2)+1,Y=DLN+%-1,DTOT=$P(F,C,1,DM)_$E(C,DM>0)_"D 0^DIWW;X",Y=" S DIWL="_%_",DIWR="_Y,DIWR=1 Q ; DOWN ; D XDUY S W=$P(W,C,1),DY="D"_(DM+1),DI=DI_C_DU_C_DY,%=":0 Q:$N("_DK_DI_"))'>0 ",DN=-2,DP(DM)=DP,DP=+$P(X,U,2),D=$P("""""",U,+DU'=DU),D=" S I("_(DM+1)_")="_D_DU_D_",J("_(DM+1)_")="_DP,Y=" S "_DY_"=$N(^("_DY_"))" F X=1:1 G P:X>DPP,DPP:+DPP(X)=DP!$D(DPP(X,DP)) DPP S %=%_" X:$D(DSC("_DP_")) DSC("_DP_")",Y=Y_" Q:"_DY_"'>0" I "@"[$P(DPP(X),U,4),$P(DPP(X),U,2)=0 S DPP(X,U)="" G R:$D(DPP(X,"F")) S Y=Y_" " P S Y=D_" F "_DY_"=0"_%_Y G S R S V=DPP(X,"T"),Y=D_" F "_DY_"="_DPP(X,"F")_%_Y_$S(V:"!("_DY_">"_V_") ",1:" ") S S %=":$X>"_DG,Y=Y_$S($D(DIWR):" D"_%_" NX^DIWW",1:" W"_%_" !") I DHT F %=2:1 I '$D(^UTILITY($J,%)) S ^(%)="I "_DY_"'>0 S "_DY_"=0 "_$P(Y," ",2,9) Q G D^DIL  ; WR K DLN D W^DILL W ; S DRJ=0,DIWL=DIWL+1 I '$D(DLN) S %=IOM-DG,DLN=$S(%>20:%,1:IOM)-2 D DN S %=$P(DE,"W ?",2)+1,Y=DLN+%-1,DTOT=$P(F,C,1,DM)_$E(C,DM>0)_"D 0^DIWW;X",Y=" S DIWL="_%_",DIWR="_Y,DIWR=1 Q ; DOWN ; D XDUY S W=$P(W,C,1),DY="D"_(DM+1),DI=DI_C_DU_C_DY,%=":0 Q:$N("_DK_DI_"))'>0 ",DN=-2,DP(DM)=DP,DP=+$P(X,U,2),D=$P("""""",U,+DU'=DU),D=" S I("_(DM+1)_")="_D_DU_D_",J("_(DM+1)_")="_DP,Y=" S "_DY_"=$N(^("_DY_"))" F X=1:1 G P:X>DPP,DPP:+DPP(X)=DP!$D(DPP(X,DP)) DPP S %=%_" X:$D(DSC("_DP_")) DSC("_DP_")",Y=Y_" Q:"_DY_"'>0" I "@"[$P(DPP(X),U,4),$P(DPP(X),U,2)=0 DIL1 ; ; 19DEC83 12:58 S:DN<0 O=999 S X="",DRJ=0 I W?1"0".E K DPQ(DP,0) S Y="D"_DM,X=$S($D(^DD(DP,.001,0)):^(0),1:"NUMBER^^^^$L(X)>9") G 0:$D(DCL(DP_U_0)) D ^DILL G O^DIL S DN=$E(W,$L(W)),X=$P(W,";",1),Y=" "_X,DLN=9,X="^^^^"_X S V=$S(X?.E1" W X K Y":8,X?.E1" D DT K Y":"9D",1:0),X=$E(X,1,$L(X)-V) I V,$F(W,";R")!$F(W,";D")!$F(W,";L") D CLC^DILL G G D W^DILL G S %=DN,DN=-3 I W[";m" D W S X="D "_$E("L",W'["w")_"^DIWP",V=$F(Y,"D ^DIWP"),Y=$S(V:$E(Y,1,V-8)_X_$E(Y,V,999),1:" S DICMX="""_X_""""_Y) G T^DIL I W[";W" D W S Y=Y_" D ^DIWP" G T^DIL G O^DIL:"+#&!*"'[% S X="^C"_V_"^^^"_$E(Y,2,999),W=-1_";"_$P(W,";",2,9),DCL(DP_U_-1)=% 0 D DE^DIL,STATS G Z^DIL ; W K DLN D DE^DIL,WR^DIL0 S Y=DE_Y_" "_$E(X,5,999) Q ; STATS ; I DG<10!(DG>900) S DG=10 D DE^DIL I DE'["!" S DE=" W:$X>8 !"_DE S V=DP_U_+W,I=DCL(V),D=+I S:'D (D,DCL)=DCL+1,DCL(V)=D_I S DXS=$S(I["*":"C",I["#":"S",I["&":"A",I["+":"P",1:1),I=$P(X,U,2),V=I,%=":Y"_$S(I["C":"'?.""*""",Y["$E":"'?."" """,1:"]""""") I DXS S DSUM=" S"_%_" N("_D_")=N("_D_")+1",N(D)=0 G E G @DXS ; C S CP(D)="" S S Q(D)=0,L(D)=9999999999,H(D)=-L(D),DLN=$P($P(W,";I",2),";",1) I DLN="",$P(I,"I",2) S DLN=+$P(I,"I",2) P S N(D)=0 A S (S(D),DRJ)=0,DSUM=",C="_D_" D "_DXS_% E I I["C" D V^DILL S Y=Y_" S Y=X"_DSUM,DXS=$S($D(^DD(DP,+W,9.02)):^(9.02),1:0) G UTIL DILL S DXS=DSUM,Y=" S Y="_Y_DXS,I="",DXS="Y" D V^DILL UTIL K DSUM S ^UTILITY($J,"T",DG)=DLN_U_D_U_DRJ_U_$P(X,U,2)_U_I I DXS?1E G DN^DIL0 S ^(DG)=^(DG)_U_DXS,DN=^DD(DP,+W,9.01),DOP=$D(DNP),DNP="",DOP(1)=DLN,DOP(2)=X I 'DOP S Y=DE_Y LOOP S DE="",V=$P(DN,";",1),W=$P(V,U,2),DN=$P(DN,";",2,99) G Q:V="",LOOP:$D(DCL(V)) D PX^DIL,XDUY^DIL0,^DILL I $P(X,U,2)'["C" S Y=",X=$S($D("_DK_DI_C_DU_")):^("_DU_"),1:"""")"_$P(",Y=",U,Y'[" S Y=")_Y E S Y=Y_" S Y=X" S (D,DCL)=DCL+1,S(D)=0,DCL(DP_U_+W)=D,Y=" S C="_D_Y_" D A" G LOOP ; Q S DLN=DOP(1),X=DOP(2) K:'DOP DNP K DOP G DN^DIL0 ")+1",N(D)=0 G E G @DXS ; C S CP(D)="" S S Q(D)=0,L(D)=9999999999,H(D)=-L(D),DLN=$P($P(W,";I",2),";",1) I DLN="",$P(I,"I",2) S DLN=+$P(I,"I",2) P S N(D)=0 A S (S(D),DRJ)=0,DSUM=",C="_D_" D "_DXS_% E I I["C" D V^DILL S Y=Y_" S Y=X"_DSUM,DXS=$S($D(^DD(DP,+W,9.02)):^(9.02),1:0) G UTIL DILL S DXS=DSUM,Y=" S Y="_Y_DXS,I="",DXS="Y" D V^DILL UTIL K DSUM S ^UTILITY($J,"T",DG)=DLN_U_D_U_DRJ_U_$P(X,U,2)_U_I I DXS?1E G DN^DIL0 S ^(DG)=^(DG)_U_DXS,DN=^DD(DP,+W,9.01),DOP=$D(DNP),DNP="",DOP(1)=DLN,DOP(2)=X I 'DOP S Y=DE_Y LOOP S DE="",V=$P(DN,";",1),W=$P(V,U,2),DN=$P(DN,";",2,99) G Q:V="",LOOP:$D(DCL(V)) D PX^DIL,XDUY^DIL0,^DILL I $P(X,U,2)'["C" S Y=",X=$S($D("_DK_DI_C_DU_")):^("_DU_"),1:"""")"_$P(",Y=",U,Y'[" S Y=")_Y E S Y=Y_" S Y=X" S (D,DCL)=DCL+1,S(D)=0,DCL(DP_U_+W)=D,Y=" S DIL2 ; ; 29DEC83 16:02 I DM,$D(DIWR) S Y=" D ^DIWW" D PX^DIL F DG=-1:0 S DG=$N(^UTILITY($J,"T",DG)) Q:DG<0 S Z="""",I=$P(^(DG),U,6,99) I I]"" F W=2:1 Q:$P(I,Z,W,99)="" S V=$P(I,Z,W) I V]"",$D(DCL(V)) S I=$P(I,Z,1,W-1)_+DCL(V)_$P(I,Z,W+1,99),W=W-1,^(DG)=$P(^(DG),U,1,5)_U_I F X=0:0 S X=$N(R(X)) Q:X<0 S DX(X)=DX(X)_" X DX(0)" I X<500,$N(DX(X))>499 S DX=X S DL=DHD?1"-".E D A^DIL I 'DHD G HT:DHD?.P1"[".E1"]",0:DHD?1"W ".E,0:IOST?1"C".E S DX(0)="Q" G G S X="" F V=2:1:$S(IOM<244:IOM,1:244) S X=X_"-" S ^UTILITY($J,DHD)="W !,"""_X_""",!!" H S O="F DE=2:1:"_DHD_" X ^UTILITY($J,DE)" S:'DL ^(1)=^(1)_" "_O 0 S DX(0)="I $Y>"_(IOSL-M-2)_"!(DC["","") X "_$P("DX(DX):DC,",U,DL>0)_"^UTILITY("_$J_",1)" G S DPQ=$P(DPP(1),U,4)["-"!$D(DPP(1,"CM")) F R=2:1:DPP S:'$D(DPP(R,U)) DPQ=1 K ^UTILITY($J,0) S:$P(DPP(1),U,5)[";L" DPQ=1 I $D(DPP(1,"IX")) S DJ=DPP(1,"IX") G DIO S DJ=DK_DK_U_1 I $N(DPP(1,-1))>0!$P(DPP(1),U,2) S DPQ=1 S:'DPQ DPP(1,"IX")="" DIO K R S Y=-1 K:$D(DCL)>9 ^DOSV(0,IO(0)) F Z=0:1 S Y=$N(DCL(Y)) Q:Y=-1 S V=DCL(Y),^DOSV(0,IO(0),"F",+V)=Y_U_$S($D(^DD(+Y,+$P(Y,U,2),0)):$P(^(0),U,1,2),1:"") S X=$S($D(DNP):"",$D(DIWR):" D ^DIWW",1:" W:$X !")_" K DIWF"_$S($D(CP):" D CP",1:"")_$P(" S DJ=DJ+1",U,$D(DIS)>9&L)_$S($D(DHIT):" "_DHIT,1:"")_$S($D(DISV):" "_DISV,1:""),DX=DX+1,DX(DX)=$E(X,2,999) S:DL DX=DX+2,DX(DX-1)="F %=0:0 W ! Q:$Y>"_(IOSL-DL-1),DX(DX)=O G ^DIO ; HT S DLP=DX,DCC=M D INIT^DIP5 F %=0:0 S %=$N(^DIPT("B",$P($P(DHD,"[",2),"]",1),%)) G 0:%<0 I $D(^DIPT(%,0)),$P(^(0),U,4)=""!($P(^(0),U,4)=DP) Q F V=0:0 S V=$N(^DIPT(%,"X",V)) Q:V'>0 F I=0:0 S I=$N(^DIPT(%,"X",V,I)) Q:I'>0 S R=^(I) D X S ^UTILITY($J,V,I)=R S DX=-1,DHD="^DIPT("_%_",""F"",DHT)" F DHT=0:0 S DHT=$N(@DHD) Q:DHT'>0 S R=^(DHT) D X,^DIL I $L(Y)>1 D PX^DIL S DX=DLP F DHD=2:1 Q:'$D(^UTILITY($J,DHD+1))#2 I DL S DL=M,M=M+DCC G H S M=DCC G H ; X S W=$F(R,"X DXS("),Y=+$E(R,W,999),X=+$E(R,$F(R,C,W),999) I W,X,Y S R=$E(R,1,W-5)_"^UTILITY($J,"_Y_C_X_$E(R,W+$L(X)+$L(Y)+1,999) G X ")_" K DIWF"_$S($D(CP):" D CP",1:"")_$P(" S DJ=DJ+1",U,$D(DIS)>9&L)_$S($D(DHIT):" "_DHIT,1:"")_$S($D(DISV):" "_DISV,1:""),DX=DX+1,DX(DX)=$E(X,2,999) S:DL DX=DX+2,DX(DX-1)="F %=0:0 W ! Q:$Y>"_(IOSL-DL-1),DX(DX)=O G ^DIO ; HT S DLP=DX,DCC=M D INIT^DIP5 F %=0:0 S %=$N(^DIPT("B",$P($P(DHD,"[",2),"]",1),%)) G 0:%<0 I $D(^DIPT(%,0)),$P(^(0),U,4)=""!($P(^(0),U,4)=DP) Q F V=0:0 S V=$N(^DIPT(%,"X",V)) Q:V'>0 F I=0:0 S I=$N(^DIPT(%,"X",V,I)) Q:I'>0 S R=^(I) D X S ^UTILITY($J,V,I)=R S DX=-1,DHD="^DIPT("_%_",""F"",DHT)" F DHT=0:0 S DHT=$N(@DHD) Q:DHT'>0 S R=^(DHT) D X,^DIL I $L(Y)>1 D PX^DIL S DX=DLP F DHD=2:1 Q:'$D(^UTILITY($J,DHD+1))#2 I DL S DL=M,M=M+DCC G H S M=DCC G HDILL ;GFT/SF ; 20 OCT 83 12:53 PM S DXS=1 V S V=$P(X,U,2),DRJ=$F(V,"P") I V["O",$D(^(2)) S Y=Y_" "_^(2),DTOT=1,D1="",DLN=30,DRJ=0 D SY G J G CLC:V["C",D:'DRJ S V=+$E(V,DRJ,99),D1=$P(X,U,3) I 'V S DRJ=0,@("V=$D(^"_D1_"0))") G D:'V S V=+$P(^(0),U,2) D Y S Y=Y_" S Y=$S(Y="""":Y,$D(^"_D1_"Y,0))#2:$P(^(0),U,1),1:Y)" I $D(^DD(V,.01,0)) S X=$P(X,U,1)_U_$P(^(0),U,2,9) G V D I V["D" S DLN=$S($P($P(X,"%DT=""",2),"""",1)["T":18,1:11) D W S D1=" D DT" S:DLN>11&DRJ D1=" W ?("_DLN_"-$S(Y#1:18,1:11)+$X)"_D1 G SY I $P(X,"X>",2) S DLN=$L(+$P(X,"X>",2))+3,DRJ=1 G J S DLN=+$P(X,"$L(X)>",2) I V'["S" S:'DLN DLN=30 G J D W S D1=$P(X,U,3) F V=1:1 Q:'$D(DXS(V)) S I D1]"",'$D(DNP) S D2=$P(D1,";",1),D1=$P(D1,";",2,99),D3=$P(D2,":",1),D2=$P(D2,":",2) S:$L(D2)>DLN&'$P(W,";L",2)&'$P(W,";R",2) DLN=$L(D2) S DXS(V,D3)=$E(D2,1,DLN) G S D K S D1="$S($D(DXS("_V_",Y)):DXS("_V_",Y),1:Y)" S:DRJ D1="$J("_D1_","_DLN_")" S D1=" W:Y]"""" "_D1 SY D Y S Y=Y_$S($D(DNP):"",1:D1) K D1 Q ; Y I DXS S Y=" S Y="_Y,DXS="Y" Q Q ; W ; F I=";W",";L" I W[I S DRJ=0 S:$P(W,I,2) DLN=+$P(W,I,2),I="" G Q I $P(X,U,2)["J" S I=$P($P(X,U,2),"J",2),W=W_";R"_$P(I+1,U,I>0) I $P(X,U,2)'["O",I["," S W=W_";D"_+$P(I,",",2) I W[";R" S DRJ=1 S:$P(W,";R",2) DLN=+$P(W,";R",2) S I=$P($P(W,";D",2),";",1) S:I]"" DRJ=1,I=","_+I Q ; CLC ; S Y=" "_$P(X,U,5,99)_" K Y",DXS="X" I V["D" S Y=Y_" S Y=X" G D I V'?.E1"J"1N.E S W=W_";R8" E I W'[";R",V'["," S W=W_";L"_+$P(V,"J",2) J D W Q:V["m"!$D(DNP) S D2="" I 'DRJ S V="E(",D3="1,"_DLN E S V="J(",D3=DLN_I I I]"" D Y S D2=":Y]""""" I DXS="X" S D2=":X'?.""*""" S Y=$S(DXS:",$"_V_Y,1:Y_" W"_D2_" $"_V_DXS)_","_D3_")" K K D2,D3  D K S D1="$S($D(DXS("_V_",Y)):DXS("_V_",Y),1:Y)" S:DRJ D1="$J("_D1_","_DLN_")" S D1=" W:Y]"""" "_D1 SY D Y S Y=Y_$SDIM ;JFW&GFT/SF ; 15MAY81 15:34 ; MUMPS SYNTAX CHECK (XECUTABLE STRING IN 'X') S %X=X,%ERR=0 GC G ER:%ERR,END:";"[$E(%X,1),ER:"BCDEFGHIKLOQRSUVWXZ"'[$E(%X,1) D SEP S %COM=$P(%ARG,":",1),%=$P(%ARG,":",2,99),%COM(1)=% I %ARG[":",%="" G ER I $L(%COM)>1 G ER:";BREAK;CLOSE;DO;ELSE;FOR;GOTO;HALT;HANG;IF;KILL;LOCK;OPEN;QUIT;READ;SET;USE;VIEW;WRITE;XECUTE;"'[(";"_%COM_";")&(%COM'?1"Z"1U.U) S %COM=$E(%COM,1) D ^DIM1:%]"",SEP G ER:("CDFGORSUVWXZ"[%COM)&(%ARG="")!%ERR,@%COM B G GC:%ARG=""&(%COM(1)=""),BK^DIM4 C G CL^DIM4 D G DG^DIM3 E G GC:%ARG=""&(%COM(1)=""),ER F G ER:%COM(1)]"",FR^DIM3 G G DG^DIM3 H G GC:%ARG=""&(%COM(1)=""),HN^DIM3 Q I G ER:%COM(1)]"",IX^DIM4 K G GC:%ARG=""&(%COM(1)=""),KL^DIM3 L G LK^DIM3 O G OP^DIM3 Q G ER:%ARG]"",GC:%ARG=""&(%COM(1)=""),BK^DIM4 R G RD^DIM4 S G ST^DIM4 U G OP^DIM3 V G GC W G WR^DIM4 X G IX^DIM4 Z G GC SEP F %I=1:1 S %C=$E(%X,%I) D QUOTE:%C="""" Q:" "[%C S %ARG=$E(%X,1,%I-1),%I=%I+1,%X=$E(%X,%I,999) Q QUOTE S %I=%I+1,%C=$E(%X,%I) I %C="" S %ERR=1 Q G QUOTE:%C'="""" S %I=%I+1,%C=$E(%X,%I) G:%C="""" QUOTE Q ER K X END K %ERR,%ARG,%C1,%C,%COM,%H,%I,%X,%A,%A1,%A2,%Z,%L,%,%P Q TE;"'[(";"_%COM_";")&(%COM'?1"Z"1U.U) S %COM=$E(%COM,1) D ^DIM1:%]"",SEP G ER:("CDFGORSUVWXZ"[%COM)&(%ARG="")!%ERR,@%COM B G GC:%ARG=""&(%COM(1)=""),BK^DIM4 C G CL^DIM4 D G DG^DIM3 E G GC:%ARG=""&(%COM(1)=""),ER F G ER:%COM(1)]"",FR^DIM3 G G DG^DIM3 H G GC:%ARG=""&(%COM(1)=""),HN^DIM3 Q I G ER:%COM(1)]"",IX^DIM4 K G GC:%ARG=""&(%COM(1)=""),KL^DIM3 L G LK^DIM3 O G OP^DIM3 Q G ER:%ARG]"",GC:%ARG=""&(%COM(1)=""),BK^DIM4 R G RD^DIM4 S G ST^DIM4 U G OP^DIM3 V G GC W G WR^DIM4 X G IX^DIM4 Z G GC SEDIM1 ;JFW&GFT/SF ; 11DEC81 15:28 Q:%ERR S (%I,%N,%ERR,%(-1,2),%(-1,3))=0 GG D %INC G:%C="" FINISH^DIM2 I %C="%" F %C=%I+1:1 S %J=$E(%,%C) I %J'?1NU G GG:%J="",E:"""^%"[%J,GG G E:%C=";"!($A(%C)>95)!($A(%C)<33),QUOTE:%C="""",FUNC:%C="$",SUB^DIM2:%C="(",UP^DIM2:%C=")",AR^DIM2:%C=",",SEL^DIM2:%C=":",GLO^DIM2:%C="^" I %C="E",(($E(%,%I-1)?1N)!($E(%,%I-1)=".")) S %L1=$E(%,%I+1) I %L1?1N!("+-"[%L1) F %I=%I+2:1 S %C=$E(%,%I) I %C'?1N S %I=%I-1 G GG I %C?1U D VAR^DIM2 G E:%ERR,GG:%C="",PAT^DIM2:%C="?",BINOP^DIM2:"=[]<>&!"[%C,MTHOP^DIM2:"/\*#_"[%C G UNOP^DIM2:"'+-"[%C,IND^DIM2:%C="@" I %C="." D %INC S %L1=$E(%,%I-2) G E:((%C'?1N)&("':=+-\/<>[],)*&!_#"'[%C))!(("':=+-\/<>[],(_*#!&"'[%L1)&(%L1'?1N))!(%C'?1N&(%L1'?1N)) I %C?1N,$E(%,%I+1)]"" G E:$E(%,%I+1)'?1NP GG1 I %C]"","$(),:"""[%C S %I=%I-1 G GG QUOTE F %J=0:0 D %INC Q:%C=""!(%C="""") G E:%C=""!("[]()><\/+-=&!_#*,;:'"""'[$E(%,%I+1)),GG FUNC D %INC G E:%C'?1U,SPV:$E(%,%I,999)'?.U1"(".E,E:"ACDEFJLNOPRSTVZ"'[%C!(%C=""),FUNC1:$E(%,%I+1)="("!(%C="Z") S %T=$T(FNC) G E:%T'[(","_$E(%,%I,$F(%,"(",%I)-1)_"^") FUNC1 S %F1=$P($T(FNC),",",$F("ACDEFJLNOPRSTVZ",%C)) S %I=$F(%,"(",%I)-1,%(%N,0)="1^"_$P(%F1,"^",2),%(%N,1)=0,%(%N,2)=0,%(%N,3)=0,%N=%N+1 S:$E(%F1,1)="S" %(%N-1,2)=1 G DATA^DIM2:"DNO"[$E(%F1,1),GG SPV I $E(%,%I+1)?1U S %I=%I+1,%C=%C_$E(%,%I) G SPV I "HIJSTXYZ"[%C&(%C?1U)!(%C?1"Z".U)!(",HOROLOG,IO,JOB,STORAGE,TEXT,"[(","_%C_",")),"[],)><=_&#!'+-*\/?"[$E(%,%I+1) G GG E G ERR^DIM2 %INC S %I=%I+1,%C=$E(%,%I) Q FNC ;,ASCII^1;2,CHAR^1;999,DATA^1;1,EXTRACT^1;3,FIND^2;3,JUSTIFY^2;3,LENGTH^1;2,NEXT^1;1,ORDER^1;1,PIECE^2;4,RANDOM^1;1,SELECT^1;999,TEXT^1;1,VIEW^1;999,ZFUNC^1;999 TE F %J=0:0 D %INC Q:%C=""!(%C="""") G E:%C=""!("[]()><\/+-=&!_#*,;:'"""'[$E(%,%I+1)),GG FUNC D %INC G E:%C'?1U,SDIM2 ;JFW&GFT/SF ; 30DEC81 16:34 SUB F %J=%I-1:-1 S %C1=$E(%,%J) Q:%C1'?1UN S %C1=$E(%,%J+1,%I-1) G ERR:%C1]""&(%C1'?1U.UN)&($E(%,%J,%I-1)'?1"%".UN) S %(%N,0)=$S(%C1]""!($E(%,%J)="^"):"V^",1:"0^"),%(%N,1)=0,%(%N,2)=0,%(%N,3)=0,%N=%N+1 G 1 UP G ERR:%N=0!($E(%,%I-1)="(")!($E(%,%I+1)]""&("<>_[]:/\?'+-=!&#*),"""'[$E(%,%I+1))) S %N=%N-1,%(%N,1)=%(%N,1)+1,%F=$P(%(%N,0),"^",1) G:'%F UP1 S %F=$P(%(%N,0),"^",2) S %F1=%(%N,1) G ERR:(%F1<+%F)!(%F1>$P(%F,";",2))!(%(%N,2)&'(%(%N,3))) UP1 K %(%N+1) G ERR:'%F&(%F'["V")&(%(%N,1)>1),1 AR G ERR:%N<1!("(,"[$E(%,%I-1))!('%(%N-1,3)&%(%N-1,2)) S %(%N-1,1)=%(%N-1,1)+1,%(%N-1,3)=0 G 1 SEL S %(%N-1,3)=%(%N-1,3)+1 G ERR:'%(%N-1,2)!(%(%N-1,3)>1),1 GLO D %INC G ERR:$E(%,%I,999)'?1U.UN.P.E&("%("'[%C) G ERR:"=+-\/<>(,#!&*':@[]_"'[$E(%,%I-2) B S %I=%I-1 G 1 PAT S %L1=1 G ERR:%I=1 C D %INC I %C?.N G:%C="" ERR:'$D(%L1),FINISH:'%L1,ERR K %L1 G C I %C="." G ERR:'$D(%L1) K %L1 D %INC G P I %C'?1U,%C'="""" G ERR:'$D(%L1),ERR:%L1,B P G ERR:$D(%L1) S %L1=0 I %C="""" D QUOTE G C P1 I "AULPCNE"[%C S %L1=%C D %INC G P1:%C]"" I %L1?.A S %I=%I-1 G C ERR S %ERR=1,%N=0 FINISH G ERR:%N'=0 K %C,%,%F,%F1,%I,%J,%L1,%L2,%N,%T,%Z1,%Z2 Q BINOP S %Z1=""")%'" G OP MTHOP S %Z1=""")%" G OP UNOP S %Z1=""":<>+-'\/()%@#&!*=_][,",%Z2="""($+-=&!^%.@'" S:%C="'" %Z2=%Z2_"<>?[]" G OPCHK OP S %Z2="""($+-^%@'." G OPCHK IND S %Z1="@(%+-=\/#*!&'_<>[]:,",%Z2="(+^-'$@%""" OPCHK S %L1=$E(%,%I-1),%L2=$E(%,%I+1) S:"[]&!<>="[%C&(%L1="'") %L1=$E(%,%I-2) I %Z1'[%L1,%L1'?1UN G ERR I (%Z2'[%L2)&(%L2'?1UN)!(%L2="") G ERR G ERR:%L2=""!(("+-'@"'[%C)&(%L1=""))!(%C="'"&(%L1?1UN)&("[]?=<>"'[%L2)) 1 G GG^DIM1 ; DATA D %INC G ERR:%C="",DATA:"^@"[%C D %INC:%C="%",VAR G ERR:%ERR!("()"'[%C),GG1^DIM1 QUOTE D %INC I %C="" S %ERR=1 Q G QUOTE:%C'="""" Q:$E(%,%I+1)'=%C S %I=%I+1 G QUOTE VAR F %J=%I:1 S %C=$E(%,%J) Q:",<>?/\[]+-=_()*&#!':"[%C S:%C'?1UN %ERR=1 Q:%ERR S %F=$E(%,%I,%J-1) S:%F]""&(%F'?1U.UN)&($E(%,%I-1,%J-1)'?1"%".UN)!(%F="^"&($E(%,%J)'="(")) %ERR=1 S %I=%J Q %INC S %I=%I+1,%C=$E(%,%I) ,%Z1,%Z2 Q BINOP S %Z1=""")%'" G OP MTHOP S %Z1=""")%" G OP UNOP S %Z1=""":<>+-'\/()%@#&!*=_][,",%Z2="""($+-=&!^%.@'" S:%C="'" %Z2=%Z2_"<>?[]" G OPCHK OP S %Z2="""($+-^%@'." G OPCHK IND S %Z1="@(%+-=\/#*!&'_<>[]:,",%Z2="(+^-'$@%""" OPCHK S %L1=$E(%,%I-1),%L2=$E(%,%I+1) S:"[]&!<>="[%C&(%L1="'") %L1=$E(%,%I-2) I %Z1'[%L1,%L1'?1UN G ERR I (%Z2'[%L2)&(%L2'?1UN)!(%L2="") G ERR G ERR:%L2=""!(("+-'@"'[%C)&(%L1=""))!(%C="'"&(%L1?1UN)&("[]?=<>"'[%L2)) 1 G GG^DIM1 ; DATA D %INC G ERR:%C="",DATA:"^@"[%C D %INC:%C="%",VAR G ERR:%ERR!("()"'[%C),GG1^DIM1 QUOTE D %INC I %C="" S %ERR=1 Q G QUOTE:%C'="""" Q:$E(%,%I+1)'=%C S %I=%I+1 G QUOTE VAR F %J=%I:1 S %C=$E(%,%J) Q:",<>?/\[]+-=_()*&#!':"[%C DIM3 ;JFW/SF ; DG G GC^DIM:%ARG=""!%ERR D PARS S %L=":" D PARS1 I %C=%L S %=%A1 D ^DIM1 G ER^DIM:%A1=""!%ERR I %A["@^" S %=%A D ^DIM1 G DG G ER^DIM:%A["("&(%A'["@") S %L="^" D PARS1 I %C=%L G ER^DIM:%A1="" S %=%A1 D VV,^DIM1 S %=%A D VV:%A'=+%A,^DIM1 G DG KL D PARS G ER^DIM:%ERR!(%A=""&(%C=",")) I %A?1"(".E1")" S %A=$E(%A,2,$L(%A)-1) S:%ARG]"" %ARG=%A_","_%ARG S:%ARG="" %ARG=%A G KL S %=%A D VV,^DIM1 G GC^DIM:%ARG=""!%ERR,KL LK S %A=%ARG,%L=":" D PARS1 I %C=%L G ER^DIM:%A1="" S %=%A1 D ^DIM1 S %ARG=%A G GC^DIM:%A="",KL HN S %=%ARG D ^DIM1 G GC^DIM OP G GC^DIM:%ARG=""!%ERR D PARS G ER^DIM:%ERR!(%C=","&(%A="")) G US:%COM="U" S %L=":" D PARS1 S %A2=%A,%A=%A1 S:%C=%L&(%A="") %ERR=1 D PARS1 G ER^DIM:%ERR!(%C=%L&(%A1="")) F %L="%A1","%A2" S %=@%L D ^DIM1 G OP:%ERR G OP US S %L=":" D PARS1 G ER^DIM:%C=%L&(%A1="") S %=%A D ^DIM1 S %A=%A1 D PARS1 G ER^DIM:%C]"",OP FR S %L="=",%A=%ARG D PARS1 G ER^DIM:%ERR!%A1=""!(%A="") S %ARG=%A1 S %=%A G ER^DIM:%A?1"^".E D VV,^DIM1 FR1 G GC^DIM:%ARG=""!%ERR D PARS S %L=":" F %A=%A,%A1 D PARS1 G ER^DIM:%ERR!(%A=""&(%C=%L)) S %=%A D ^DIM1 S %=%A1 D ^DIM1 G FR1 PARS S (%A,%C)="" Q:%ERR S (%ERR,%I)=0 INC D %INC D QT:%C="""",PARAN:%C="(" Q:%ERR G OUT:","[%C,INC QT D %INC Q:%C="""" G QT:%C]"" S %ERR=1 Q PARAN S %P=1 F %J=0:0 D %INC D QT:%C="""" S %P=%P+$S(%C="(":1,%C=")":-1,1:0) Q:'%P I %C="" S %ERR=1 Q Q OUT S %A=$E(%ARG,1,%I-1),%ARG=$E(%ARG,%I+1,999) Q %INC S %I=%I+1,%C=$E(%ARG,%I) Q ; PARS1 S (%A1,%C)="" Q:%ERR S (%ERR,%I)=0 INCR D %INC1 D QT1:%C="""",PARAN1:%C="(" Q:%ERR=1 G OUT1:%L[%C,INCR OUT1 S %A1=$E(%A,%I+1,999),%A=$E(%A,1,%I-1) Q QT1 D %INC1 Q:%C="""" G QT1:%C]"" S %ERR=1 Q PARAN1 S %P=1 F %J=0:0 D %INC1 D QT1:%C="""" S %P=%P+$S(%C="(":1,%C=")":-1,1:0) Q:'%P I %C="" S %ERR=1 Q Q %INC1 S %I=%I+1,%C=$E(%A,%I) Q ; VV I '%ERR,%]"",%'["@",%'?1U.UN,%'?1U.UN1"(".E1")",%'?1"%".UN1"(".E1")",%'?1"%".UN,%'?1"^"1U.UN1"(".E1")",%'?1"^%".UN1"(".E1")",%'?1"^(".E1")",%'?1"^"1U.UN S %ERR=1 (%A,%C)="" Q:%ERR S (%ERR,%I)=0 INC D %INC D QT:%C="""",PARAN:%C="(" Q:%ERR G OUT:","[%C,INC QT D %INC Q:%C="""" G QT:%C]"" S %ERR=1 Q PARAN S %P=1 F %J=0:0 D %INC D QT:%C="""" S %P=%P+$S(%C="(":1,%C=")":-1,1:0) Q:'%P I %C="" S %ERR=1 Q Q OUT S %A=$E(%ARG,1,%I-1),%ARG=$E(%ARG,%I+1,999) Q %INC S %I=%I+1,%C=$E(%ARG,%I) Q ; PARS1 S (%A1,%C)="" Q:%ERR S (%ERR,%I)=0 INCR D %INC1 D QT1:%C="""",PARAN1:%C="(" Q:%ERR=1 G OUT1:%L[%C,INCR OUT1 S %A1=$E(%A,%I+1,999),%A=$E(%A,1,%I-1) Q QT1 D %INC1 Q:%C="""" G QT1:%C]"" S %ERR=1 Q PARAN1 S %P=1 F %J=0:0 D %INC1 D QT1:%C="""" S %P=%P+$S(%C="(":1,%C=")":-1,1:0) Q:'%P I %C="" S %ERR=1 Q Q %INC1 S %I=%I+1,%C=$E(%A,%I) Q ; VV I '%ERR,DIM4 ;JFW/SF ; 04JUL81 15:50 BK G ER^DIM:%ERR I %ARG]"" S %=%ARG D ^DIM1 G ER^DIM:%ERR G GC^DIM CL G ER^DIM:%ERR I %ARG]"" F %Z=0:0 D S S %=%A D ^DIM1 G:%ARG=""!%ERR GC^DIM IX G GC^DIM:%ARG=""!%ERR D S S %L=":" D S1 I %C=%L S %=%A1 D ^DIM1 G ER^DIM:%A1=""!%ERR S %=%A D ^DIM1 G IX ST G GC^DIM:%ARG=""!%ERR D S G ER^DIM:%ERR!(%A=""&(%C=",")) I %A?1"@".E S %=%A D ^DIM1 G ST S %L="=" D S1 S %=%A1 D ^DIM1 G ER^DIM:%ERR!(%A="")!(%A1="") I %A?1"(".E1")" S %A=$E(%A,2,$L(%A)-1) G STM S %=%A D VV,^DIM1 G ST STM G ST:%ERR!(%A="") S %L="," D S1 G ER^DIM:%ERR!(%C=%L&(%A1="")) S %=%A D VV,^DIM1 S %A=%A1 G STM RD G GC^DIM:%ARG=""!%ERR D S G ER^DIM:%ERR!(%C=","&(%A="")) I "!#?"[$E(%A,1) S %I=0 D FRM G RD I %A?1"""".E S %=%A D ^DIM1 G RD I %A?1"*".E S %A=$E(%A,2,999) G ER^DIM:%A?1"^".E S %L=":" D S1 G ER^DIM:%ERR!(%C=%L&(%A1=""))!(%A="") S %=%A D VV,^DIM1 S %=%A1 D ^DIM1 G RD WR  G GC^DIM:%ARG=""!%ERR D S G ER^DIM:%ERR!(%A=""&(%C=",")) I "!#?"[$E(%A,1) S %I=0 D FRM G WR S:%A?1"*".E %A=$E(%A,2,999) S %=%A D ^DIM1 G WR FRM S %I=%I+1,%C=$E(%A,%I) Q:%C="" I "!#?"'[%C S %ERR=1 Q G FRM:"!#"[%C S %=$E(%A,%I+1,999) D ^DIM1 Q S S (%A,%C)="" Q:%ERR S (%ERR,%I)=0 INC D %INC D QT:%C="""",P:%C="(" Q:%ERR G OUT:","[%C,INC QT D %INC Q:%C="""" G QT:%C]"" S %ERR=1 Q P S %P=1 F %J=0:0 D %INC D QT:%C="""" S %P=%P+$S(%C="(":1,%C=")":-1,1:0) Q:'%P I %C="" S %ERR=1 Q Q OUT S %A=$E(%ARG,1,%I-1),%ARG=$E(%ARG,%I+1,999) Q %INC S %I=%I+1,%C=$E(%ARG,%I) Q ; S1 S (%A1,%C)="" Q:%ERR S (%ERR,%I)=0 INCR D %INC1 D QT1:%C="""",P1:%C="(" Q:%ERR G OUT1:%L[%C,INCR OUT1 S %A1=$E(%A,%I+1,999),%A=$E(%A,1,%I-1) Q QT1 D %INC1 Q:%C="""" G QT1:%C]"" S %ERR=1 Q P1 S %P=1 F %J=0:0 D %INC1 D QT1:%C="""" S %P=%P+$S(%C="(":1,%C=")":-1,1:0) Q:'%P I %C="" S %ERR=1 Q Q %INC1 S %I=%I+1,%C=$E(%A,%I) Q VV  I '%ERR,%]"",%'["@",%'?1U.UN,%'?1U.UN1"(".E1")",%'?1"%".UN1"(".E1")",%'?1"%".UN,%'?1"^"1U.UN1"(".E1")",%'?1"^%".UN1"(".E1")",%'?1"^(".E1")",%'?1"^"1U.UN,%'?1"$"1U!(%COM'="S") S %ERR=1 ,%I+1,999) D ^DIM1 Q S S (%A,%C)="" Q:%ERR S (%ERR,%I)=0 INC D %INC D QT:%C="""",P:%C="(" Q:%ERR G OUT:","[%C,INC QT D %INC Q:%C="""" G QT:%C]"" S %ERR=1 Q P S %P=1 F %J=0:0 D %INC D QT:%C="""" S %P=%P+$S(%C="(":1,%C=")":-1,1:0) Q:'%P I %C="" S %ERR=1 Q Q OUT S %A=$E(%ARG,1,%I-1),%ARG=$E(%ARG,%I+1,999) Q %INC S %I=%I+1,%C=$E(%ARG,%I) Q ; S1 S (%A1,%C)="" Q:%ERR S (%ERR,%I)=0 INCR D %INC1 D QT1:%C="""",P1:%C="(" Q:%ERR G OUT1:%L[%C,INCR OUT1 S %A1=$E(%A,%I+1,999),%A=$E(%A,1,%I-1) Q QT1 D %INC1 Q:%C="""" G QT1:%C]"" S %ERR=1 Q P1 S %P=1 F %J=0:0 D %INC1 D QT1:%C="""" S %P=%P+$S(%C="(":1,%C=")":-1,1:0) Q:'%P I %C="" S %ERR=1 Q Q %INC1 S %I=%I+1,%C=$E(%A,%I) Q VV DIO ;GFT/SF ; 29DEC83 15:57 GO K DOP,DISV,DHD,DD,DE,DG,DI,DIC,DK,DL,DN,DM,DU,DV,DW,DY,POP,D,O,X,Y,V,DICS,TO,%X,%Y,DQ,% S DCC=U_$P(DJ,U,3),@("DP=+$P("_DCC_"0),U,2)") S DD=$P(DJ,U,4),DL="D0",DN=DL,DI=U_$P(DJ,U,2),A=1 F Z=DD-1:-1:1 S @DL=-1,DL="D"_DL,DN=DL_C_DN S @DL=$S($D(DPP(1,"F"))&$D(DPP(1,"IX")):DPP(1,"F"),DD>1:-1,1:0),Z=0 D ^DIO0 I DPQ G ^DIOS E I $D(DPP(1,"IX")),$N(DX(99))>99,DPP(1)-DP,'$D(DSC) S X="I $D("_$P(DPP(1,"IX"),U,1,2)_DN F %=1:1 S X=X_",D"_% I %+1=DD S DSC(+DPP(1))=X_"))" Q I $D(CP) S C="",CP=0 F X=0:0 S C=$N(CP(C)),A="" Q:C<0 K CP(C) S CP(C,C)=0 F Y=0:0 S A=$N(CP(A)) Q:A=C S CP(C,A)=0 K DPP,DPQ,DCL,DJ,F,M I $N(^UTILITY($J,99,0))>0 F X=-1:0 S X=$N(DX(X)) Q:X<0 S ^(X)=$S($D(^(X)):^(X),1:"")_DX(X),DX(X)="X ^UTILITY("_$J_",99,"_X_")" I $D(DIWL),DIWL=1 S DX(1)="S DIWF=""W"" "_DX(1) D 2 G ^DIO4 ; 2 ; K DLN,DL,F,I,J,V,W,X,Y,Z,DE,DRJ S I(0)=DCC,J(0)=DP,DI=99,DN=1,(DJ,DE,DTOT)=0,X=1 W:L ! X ^DD("FUNC",18,1) G ^DIO2  S DCC=U_$P(DJ,U,3),@("DP=+$P("_DCC_"0),U,2)") S DD=$P(DJ,U,4),DL="D0",DN=DL,DI=U_$P(DJ,U,2),A=1 F Z=DD-1:-1:1 S @DL=-1,DL="D"_DL,DN=DL_C_DN S @DL=$S($D(DPP(1,"F"))&$D(DPP(1,"IX")):DPP(1,"F"),DD>1:-1,1:0),Z=0 D ^DIO0 I DPQ G ^DIOS E I $D(DPP(1,"IX")),$N(DX(99))>99,DPP(1)-DP,'$D(DSC) S X="I $D("_$P(DPP(1,"IX"),U,1,2)_DN F %=1:1 S X=X_",D"_% I %+1=DD S DSC(+DPP(1))=X_"))" Q I $D(CP) S C="",CP=0 F X=0:0 S C=$N(CP(C)),A="" Q:C<0 K CP(C) S CP(C,C)=0 F Y=0:0 S A=$N(CP(A)) Q:A=C S CP(C,A)=0 K DPP,DPQ,DCL,DJ,F,M I $N(^UTILITY($J,99,0))>0 F X=-1:0 S X=$N(DX(X)) Q:X<0 S ^(X)=$S($D(^(X)):^(X),1:"")_DX(X),DX(X)="X ^UTILITY("_$J_",99,"_X_")" I $D(DIWL),DIWL=1 S DX(1)="S DIWF=""W"" "_DX(1) D 2 G ^DIO4 ; 2 ; K DLN,DL,F,I,J,V,W,X,Y,Z,DE,DRJ S I(0)=DCC,J(0)=DP,DI=99,DN=1,(DJ,DE,DTOT)DIO0 ;GFT/SF ; 04DEC83 10:16 S Z=Z+1,DE=$P(DN,C,Z)_"=$N("_DI_$P(DN,C,1,Z)_")),DN="_(Z+1) I 'DPQ,$D(DPP(Z)) D H S X=DE_" I "_$P(DN,C,Z)_$S(DCC=DI:"'>0",1:"=-1") I Z=1,$D(DPP(1,"T")),$D(DPP(1,"IX")) S Y=DPP(1,"T"),X=X_"!("_$P(DN,C,Z)_$S(+Y=Y:">"_Y,1:"]"""_Y_"""")_")" S X=X_" S DN="_(Z-1),Y=Z-1 I 'DPQ,$D(DPP(Y)) S:$P(DPP(Y),U,4)["!" X="DRK=DRK+1,"_X_",DRK=0",DRK=0 D SUB S DY(Z)="S "_X G DIO0:Z
1:"SEARCH",1:"O"),Y=Z,X="" I 'DPQ,$D(DPP(Y)),$P(DPP(Y),U,2)=0 D SUB I S DY(Z+1)=DY(Z+1)_" S "_$E(X,2,99) Q:A=1 S X=C F W=1:1:A-1 S ^DOSV(0,IO(0),"BY",W)=DPP(A(W)),X=X_$P(DN,C,A(W))_C,A(W)="Q" S A(W)="S ^DOSV(0,IO(0)"_C_W_X_"V,DE)=Y" Q ; SUB I $D(DPP(Y)),$P(DPP(Y),U,4)["+" S A(A)=Y,X=X_",A="_A_" D ^DIO3",A=A+1 Q ; H S DOP=0 I $D(DNP) F W=1:1 G Q:'$D(DPP(W)) I DPP(W)["+" K DNP S DOP=1 Q S Y=$P(DN,C,Z),F=$P(DPP(Z),U,5),W=$P(DPP(Z),U,4),X=$P(W,"""",2),V=+$P(DPP(Z),U,2) S:W["-" Y="(999999999-"_Y_")" I F'[""""&'$D(DPQ(+DPP(Z),V+X))&'DOP!(W["@")!(W["'") S (Y,V)="" G F:F]"",U S X=$S($D(^DD(+DPP(Z),V,0)):^(0),1:$P(DPP(Z),U,6,9)) I $P(X,U,2)["D" S Y=" S Y="_Y_" D DT" E I $P(X,U,2)["O"!($P(X,U,4)?.P) S Y=C_Y E D ^DILL S V=$P(F,";C",2),V="?"_$S(V:V-1,1:Z*3+5) F I F[";S" S %=$P(F,";S",2) S:'% %=1 S V=$E("!!!!!!!!!!!!!!!!!!!!!!!!!!!!",1,%)_V,M=M+% S F=$P(F,";""",2),%=$S(F]"":$P(F,"""",1),Y]"":$P($P(DPP(Z),U,3),"""",1)_": ",1:""),Y=V_$S(%_Y]"":$E(",",V]"")_""""_%_"""",1:"")_Y I Y]"" S Y=" W "_Y U S W=W'["#" I W,Y="",$D(DPP(Z+1)) G E S ^UTILITY($J,"H",Z)="X ^UTILITY($J,1)"_$P(":$Y>"_(IOSL-M-2-DD+Z)_"!(DC["","")",U,W)_Y,Y="D H:DI"_Z_" DI="_Z) S:DX(0)'[Y DX(0)=Y_DX(0) E I DOP S DNP="" Q K DOP DIO1 ;GFT/SF ; 05OCT82 16:45 ;SORT F DJ=0:1:7 F DX=-1:0 S DX=$N(Y(DJ,DX)),X=0 Q:DX<0 D A S Z=" S:$T ^UTILITY("_$J_",0" F X=1:1:DPP S Z=Z_C_$S($P(DPP(X),U,4)["'":1,1:D(X)) S Z=Z_",D0",W="" F V=1:1:DPP S %=1,F="",X=DPP(V)-DP I V=DPP&(W="")!X D U:X S:% W=W_Z_F_")=""""" Q ; U S (DL,F)=","_V,DE=DP,X=0 UU S X=X+1,DE=$N(DPP(V,DE)) I DE'>0 S DE=+DPP(V) S %='$D(DX(DE,U)),F=F_",D"_X,DL=DL_",D"_X S:% DX(DE,U)=DL S:$D(D(DE)) F=F_"("_DE_")" Q:$T G UU ; A S X=$N(Y(DJ,DX,X)) Q:X<0 D B G A ; B S D2="",DL=Y(DJ,DX,X),(W,V)="X("_DL_")",DTOT="=""""" G C:X S Y="I 1",W="D"_V(DX) I $D(DPP(DL,"CM")) S Y=DPP(DL,"CM"),W=V G S S DTOT="<0" G S ; C S V=$P(^DD(DX,+X,0),U,4),Z=$P(V,";",2),V=$P(V,";",1) S:+V'=V V=Q_V_Q D F S DN=$P(^(0),U,2) I DN?.E1"J".N1","1N.E!(DN["N") S D2=">" I Z S DN="$P(",Z="),U,"_Z_")" E G CAL:$A(Z)-69 S DN="$E(",Z="),"_$E(Z,2,9)_")",DTOT="?."" """  S Y="S "_W_"=$S($D("_F_C_V_")):"_DN_"^("_V_Z_",1:"""")" I $D(^(2)),$P(^(0),U,2)'["D" S Y=Y_",Y="_W_" "_^(2)_" S "_W_"=Y" S S Z="",F="'"_DTOT G SY:'$D(DPP(DL,"F")) S DLN=DPP(DL,"F"),%=+DLN=DLN,D2=$E("]>",%+1),F=$E(Q,'%) S:DLN[Q DLN="""""z" S F=D2_F_DLN_F,D1=$E("]>",+DPP(DL,"T")=DPP(DL,"T")+1) I $C(63,122)=DPP(DL,"F") S D2=D1,Z=1,F="" I $C(122)=DPP(DL,"T") G SY:'Z S DLN=" I 1" G SX I DPP(DL,"T")="@" S Z=Z+2,F=F_"!("_W_DTOT_")" S:Z=3 F=DTOT G SY S:'Z F=F_C_W S F=F_"'"_D1_Q_DPP(DL,"T")_Q SY S DLN=" I "_W_F SX S F=$S($P(DPP(DL),U,4)["-":"999999999-",D2=">":"+",1:"")_$S($D(DE(DL)):"$E("_W_",1,"_DE(DL)_")",1:W) I Z S F="$S("_W_"'"_DTOT_":"_F_",1:"" EMPTY"")" I Z>2 S F=""" """ S D(DL)=F,D(DL,0)=DX,DSC(DX)=$S($D(DSC(DX)):DSC(DX)_" ",1:"") I DPP>2!($L(DSC(DX))+$L(Y)>125) F Z=1:1 I '$D(DSC(DX,Z)) S DSC(DX,Z)=Y,DSC(DX)=DSC(DX)_"X DSC("_DX_C_Z_")"_$P(" I ",C,Y[" I ")_DLN Q E S DSC(DX)=DSC(DX)_Y_DLN S Y=DX Q ; F S F="",DE=DX F Y=V(DX):-1 S F="D"_Y_F Q:'Y S F=C_V(DE,1)_C_F,DE=V(DE,0) S F=DCC_F Q ; CAL S Y=$P(^(0),U,5,99)_" S "_W_"=X" G S 2_F_DLN_F,D1=$E("]>",+DPP(DL,"T")=DPP(DL,"T")+1) I $C(63,122)=DPP(DL,"F") S D2=D1,Z=1,F="" I $C(122)=DPP(DL,"T") G SY:'Z S DLN=" I 1" G SX I DPP(DL,"T")="@" S Z=Z+2,F=F_"!("_W_DTOT_")" S:Z=3 F=DTOT G SY S:'Z F=F_C_W S F=F_"'"_D1_Q_DPP(DL,"T")_Q SY S DLN=" I "_W_F SX S F=$S($P(DPP(DL),U,4)["-":"999999999-",D2=">":"+",1:"")_$S($D(DE(DL)):"$E("_W_",1,"_DE(DL)_")",1:W) I Z S F="$S("_W_"'"_DTOT_":"_F_",1:"" EMPTY"")" I Z>2 S F=""" """ S D(DL)=F,D(DL,0)=DX,DSC(DX)=$S($D(DSC(DX)):DSC(DX)_" ",1:"") I DPP>2!($L(DSC(DX))+$L(Y)>125) F Z=1:1 I '$D(DSC(DX,Z)) S DSC(DX,Z)=Y,DSC(DX)=DSC(DX)_"X DSC("_DX_C_Z_")"_$P(" I ",C,Y[" I ")_DLN Q E S DSC(DX)=DSC(DX)_Y_DLN S Y=DX Q DIO2 ;GFT/SF ; 20 OCT 83 8:11 PM X DY(DN) G DIO2:DN,Q ; SEARCH S DTOT=1,DE=0 I $D(DIS(0)) X DIS(0) Q:'$T G O:'$D(DIS(1)) OR S DE=DE+1 Q:'$D(DIS(DE)) X DIS(DE) E G OR O F DLP=0:1:DX X DX(DLP) Q ; C S DQ(C)=Y S S Q(C)=Y*Y+Q(C) S:L(C)>Y L(C)=Y S:H(C)IOSL X ^UTILITY($J,1) F I=0:0 S I=$N(X(I)),X=-1 Q:I<0 W:$X ! W $P("SUB",U,A>0),$P($T(@I),";",2)," " F %=0:0 S X=$N(X(I,X)) Q:X<0 W ?X,X(I,X) W ! K K Z,X,I,V,C,Y Q ; U F I=1:1:6 S DE=$P($T(@I),";",3),Y=DE_"(V)" I $D(@Y)#2 S Y=@Y,C=$P(Z,U,5) D @I I '$D(DNP),$D(X)>9 W ?%X F I=1:1:Z W "-" Q 1 ;TOTAL;S I $P(Z,U,6)]"" X $P(Z,U,6,99) S S(V)=Y S ^(DE)=$S($S(A:$D(^UTILITY($J,"SV",A,V,DE)),1:$D(^DOSV(0,IO(0),0,V,DE))):^(DE),1:0)+Y Q:Z["D" Q:Z["F"&(Y=0) O I C]""!$P(Z,U,3) S @("Y=$J(Y,+Z"_C_")") S X(I,%X)=Y Q 2 ;COUNT;N S ^(DE)=$S($S(A:$D(^UTILITY($J,"SV",A,V,DE)),1:$D(^DOSV(0,IO(0),0,V,DE))):^(DE),1:0)+Y I A,'$D(DNP),Y<2 S Y=0 Q S C=$P(",0",U,C]"") G O 3 ;MEAN;N Q:Z["D"!'Y!$L($P(Z,U,6))!'$D(S(V)) Q:Z["F"!A&(S(V)=0) S Y=$J(S(V)/Y,0,2) G O 4 ;MINIMUM;L S ^(DE)=$S('$D(^(DE)):Y,^(DE)>Y:Y,1:^(DE)),L(V)=99999999 G M 5 ;MAXIMUM;H S ^(DE)=$S('$D(^(DE)):Y,^(DE)0 L S %=Y,Y=DE/%+%/2 G L:Y<%,O ; DT D D:Y W Y Q D S Y=$P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC",U,$E(Y,4,5))_" "_$S(Y#100:$J(Y#100\1,2)_",",1:"")_(Y\10000+1700)_$S(Y#1:" "_$E(Y_0,9,10)_":"_$E(Y_"000",11,12),1:"") Y=0) O I C]""!$P(Z,U,3) S @("Y=$J(Y,+Z"_C_")") S X(I,%X)=Y Q 2 ;COUNT;N S ^(DE)=$S($S(A:$D(^UTILITY($J,"SV",A,V,DE)),1:$D(^DOSV(0,IO(0),0,V,DE))):^(DE),1:0)+Y I A,'$D(DNP),Y<2 S Y=0 Q S C=$P(",0",U,C]"") G O 3 ;MEAN;N Q:Z["D"!'Y!$L($P(Z,U,6))!'$D(S(V)) Q:Z["F"!A&(S(V)=0) S Y=$J(S(V)/Y,0,2) G O 4 ;MINIMUM;L S ^(DE)=$S('$D(^(DE)):Y,^(DE)>Y:Y,1:^(DE)),L(V)=99999999 G M 5 ;MAXIMUM;H S ^(DE)=$S('$D(^(DE)):Y,^(DE)0 L S %=Y,Y=DE/%+%/2 G L:Y<%,O ; DT D D:Y W Y Q D S Y=$P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC",U,$E(Y,4,5))_" "_$S(Y#100:$J(Y#100\1,2)DIO4 ;GFT/SF ; 31 OCT 83 6:27 PM K DXS,DSC,DIS,DX,DY,DRK I $D(^UTILITY($J,"T")) S A=0 D ^DIO3 I L,DTOT W !!!?25,DJ," MATCH",$P("ES",U,DJ'=1)," FOUND." I $D(CP) S X=-1,^DOSV(0,IO(0),"CP")=CP F I=0:0 S X=$N(CP(X)),Z=-1 Q:X=Z F N=0:0 S Z=$N(CP(X,Z)),^DOSV(0,IO(0),"CP",X,Z)=CP(X,Z) Q:X=Z W:IOST?1"P".E&L @IOF I $D(DCOPIES),$D(^("OS",^DD("OS"),"SDPEND")) D SDP X:$D(DIOEND) DIOEND K DIOEND I $D(IOST(0))#2,$D(^%ZIS(2,IOST(0),3)) X ^(3) I $D(IOT),IOT="TRM" O IO::0 I IO(0)'=IO O IO(0)::1 H:'$T S X=IO X ^DD("FUNC",7,1) U IO(0) K ^UTILITY($J),A,N,V,E,Q,S,FR,CP,H,L,DXS,DCC,DQ,DJ,DD,C,I,J,DTOT,X,Y,Z,DL,DN,DI,DE,D5,D4,D3,D2,D1,D0,DD0,DDD0,DDDD0,DDDDD0,DNP,DC,DLP,IOM,IOSL,IOP,IOBS,IOF,IOT,IOPAR,DHIT,DCOPIES,DOUT,DHT,DICMX,DIWL,DIWR Q ; SDP Q:'DCOPIES W ! X ^("SDPEND") S I=IO,DLP=IOPAR,IOP=DOUT,A=IO(0) D ^%ZIS S IO(0)=A Q:IO="" F A=1:1:DCOPIES X ^("OS",^DD("OS"),"SDP") U IO I IO'=IO(0) S X=IO X ^DD("FUNC",7,1)  S IO=$P(I,":",1) !!?25,DJ," MATCH",$P("ES",U,DJ'=1)," FOUND." I $D(CP) S X=-1,^DOSV(0,IO(0),"CP")=CP F I=0:0 S X=$N(CP(X)),Z=-1 Q:X=Z F N=0:0 S Z=$N(CP(X,Z)),^DOSV(0,IO(0),"CP",X,Z)=CP(X,Z) Q:X=Z W:IOST?1"P".E&L @IOF I $D(DCOPIES),$D(^("OS",^DD("OS"),"SDPEND")) D SDP X:$D(DIOEND) DIOEND K DIOEND I $D(IOST(0))#2,$D(^%ZIS(2,IOST(0),3)) X ^(3) I $D(IOT),IOT="TRM" O IO::0 I IO(0)'=IO O IO(0)::1 H:'$T S X=IO X ^DD("FUNC",7,1) U IO(0) K ^UTILITY($J),A,N,V,E,Q,S,FR,CP,H,L,DXS,DCC,DQ,DJ,DD,C,I,J,DTOT,X,Y,Z,DL,DN,DI,DE,D5,D4,D3,D2,D1,D0,DD0,DDD0,DDDD0,DDDDD0,DNP,DC,DLP,IOM,IOSL,IOP,IOBS,IOF,IOT,IOPAR,DHIT,DCOPIES,DOUT,DHT,DICMX,DIWL,DIWR Q ; SDP Q:'DCOPIES W ! X ^("SDPEND") S I=IO,DLP=IOPAR,IOP=DOUT,A=IO(0) D ^%ZIS S IO(0)=A Q:IO="" F A=1:1:DCOPIES X ^("OS",^DD("OS"),"SDP") U IO I IO'=IO(0) S X=IO X ^DD("FUNC",7,1) DIOS ;GFT/SF ; 22SEP83 14:43 S:'$D(L) L=1 D WAIT^DICD:IO=IO(0)&(L'=0) S DPQ=0,Q="""",^UTILITY($J,"DX")=DX,^("F")="^UTILITY($J,0,"_DCC_U_(DPP+1),DE=DPP*8-$S($D(^DD("SUB")):^("SUB"),1:63)+23,%=0 F DL=1:1:DPP S X=-1,DX=+DPP(DL),V(DX,2)=1 F DJ=0:1 S X=$N(DPP(DL,X)) D A I S Y(DJ,DX,$E($P(DPP(DL),U,2,3),1,30))=DL D L Q I DE>0,% F DL=1:1:DPP I $D(DE(DL))=1 S DE(DL)=DE(DL)-(DE\%) S:DE(DL)<4 DE(DL)=4 F X=-1:0 S X=$N(DX(X)) Q:X<0 S ^UTILITY($J,"DX",X)=DX(X) K DX S V=$N(V(DP)) V S Z=X,X=$N(V(X)) I X<0 D ^DIO1,Z,2^DIO G B S DX=X,DX(X)=$S($D(V(X,2)):" X DSC("_X_")",1:"") G V:X=DP D F^DIO1 S W="D"_V(X),DX(X)="F "_W_"="_W_":0"_DX(X),D2="",D1="" I V(X,0)-Z S %="D"_V(V),D2=%_"("_V_")="_%_C,D1=" S "_%_"="_%_"("_V_")",D(V)="",V=X S DX(Z)=DX(Z)_" S "_D2_W_"=$N("_$E(F,1,$L(F)-2)_"0)) X"_$S($D(V(Z,2)):":$T",1:"")_" DX("_X_")"_D1 G V ; B K DSC,D,Y,DIS,V S V="I $D(^UTILITY($J,0" F X=1:1:DPP+1 K DPP(X,"F"),DPP(X,"T") S V=V_$E(",DDDDDDDDDDD",1,DPP+3-X)_0 F X=-1:0 S X=$N(DX(X)) Q:X<0 S:$D(DX(X,U)) DSC(X)=V_DX(X,U)_"))" K DX S DX=^UTILITY($J,"DX"),DJ=^("F") F %=$N(^("DX",-1)):0 S DX(%)=^(%),%=$N(^(%)) I %<0 G GO^DIO ; L S X=$P(DPP(DL),U,2) S:X=0 X=.001 S W=+$P($P(DPP(DL),U,5),";L",2) I W S W=$S(W<64:W,1:63),DE(DL)=W,DE(DL,"SIC")=1 G SL I '$D(^DD(DX,+X,0)) S W=22 G DJ:$P(DPP(DL),U,7)["D",LL S %Y=$P(^(0),U,2),W=+$P(%Y,"J",2) G LL:W>8,DJ:W I %Y["C",%Y'["J" S W=22 G LL I %Y'["F" S DE=DE+5,W=13 G DJ S W=+$P(^(0),"$L(X)>",2) S:'W W=22 S:W>30 W=30 LL S:W>8 DE(DL)=W,%=%+1 SL S DE=DE+W-8 DJ I DJ S DE=DJ*4+DE I X=.001 S DE=DE+W Q ; A I X'>0,X'=0 S X=DX S V(X)=DJ S:DJ V(X,1)=V,V(X,0)=Z Q:$T S Z=X,V=DPP(DL,X) S:+V'=V V=Q_V_Q Q ; Z F X=-1:0 S X=$N(DX(X)),DX=X Q:X<0 S:$N(DX(X))<0 DX(X)=DX(X)_W_$P(",DJ=DJ+1",U,$D(DIS)>9) I DP-X D F^DIO1 S DX(X)=DX(X)_" S D"_V(X)_"=$N("_F_")) Q:D"_V(X)_"'>0"  S V=DX(DP) K DX(DP) S:$A(V)=32 V=$E(V,2,999) S DX(0)=V,DX=0 TY($J,"DX"),DJ=^("F") F %=$N(^("DX",-1)):0 S DX(%)=^(%),%=$N(^(%)) I %<0 G GO^DIO ; L S X=$P(DPP(DL),U,2) S:X=0 X=.001 S W=+$P($P(DPP(DL),U,5),";L",2) I W S W=$S(W<64:W,1:63),DE(DL)=W,DE(DL,"SIC")=1 G SL I '$D(^DD(DX,+X,0)) S W=22 G DJ:$P(DPP(DL),U,7)["D",LL S %Y=$P(^(0),U,2),W=+$P(%Y,"J",2) G LL:W>8,DJ:W I %Y["C",%Y'["J" S W=22 G LL I %Y'["F" S DE=DE+5,W=13 G DJ S W=+$P(^(0),"$L(X)>",2) S:'W W=22 S:W>30 W=30 LL S:W>8 DE(DL)=W,%=%+1 SL S DE=DE+W-8 DJ I DJ S DE=DJ*4+DE I X=.001 S DE=DE+W Q ; A I X'>0,X'=0 S X=DX S V(X)=DJ S:DJ V(X,1)=V,V(X,0)=Z Q:$T S Z=X,V=DPP(DL,X) S:+V'=V V=Q_V_Q Q ; Z F X=-1:0 S X=$N(DX(X)),DX=X Q:X<0 S:$N(DX(X))<0 DX(X)=DX(X)_W_$P(",DJ=DJ+1",U,$D(DIS)>9) I DP-X D F^DIO1 S DX(X)=DX(X)_" S D"_V(X)_"=$N("_F_")) Q:D"_V(X)_"'>0" DIP ; ; 03DEC83 16:29 K BY,FLDS,DX,DIS,DISV,DHIT D ^DICRW G EN:$D(DIC) Q K DIOEND,DI,DICS,DJ,BY QQ K DSC,DCL,DPQ,DPP,DIC,DU,DQI,DY,S,DC,DL,DV,DE,DA,DK,Y,R,C,D,I,J,Q,M,P Q EN ; S L=1 EN1 S DJ=1,U="^",DI=DIC,DNP="" D QQ I $D(BY),BY="@" S DNP=BY K BY I S Q="""",C=",",DC=0,DE=$S(L=0!L:"SORT",1:L),@("S=+$P("_DI_"0),U,2)") DJ K DL,I,J S I(0)=DI,(DL,J(0))=S,J=0 G 2:DJ>1 K DPP S DU=0,Y=.01 D XR:$P(^DD(DL,.01,0),U,2)'["P" I 'DU S Y=S,DV=$S($D(^DD(DL,.001,0)):$P(^(0),U,1),1:"NUMBER") S DPP(1)=Y_U_DU_U_DV_U,DV=DE_" BY: "_DV_"// " D L G ^DIP1:X="" D K DPP(DJ,"IX") S R=U,P=DNP Y D ^DIC G G:Y>0,Q:X=U,TEM^DIP1:X?1"[".E,B:X="" F D="-","#","+","!","@","'" S Y=$F(X,D) I Y-1=$L(X)!(Y=2) S P=P_D,X=$E(X,1,Y-2)_$E(X,Y,999) G Y I X[";" S R=X,X=$P(X,";",1),R=U_$P(R,X,2,9) G Y S D="NUMBER",Y=0_U_D I $P(D,X,1)="" W $P(D,X,2) G S S P=P_Q,DPP=$P(X,U,1) C S DM=X,DQI="Y(",DA="DPP("_DJ_",""OVFLO""," D ^DICOMP I '$D(X) G B:'$D(BY) S X=DM I BY]"" S X=X_C_BY,BY="" G C F %=0:0 S %=$N(X(%)) Q:%<0 S @(DA_"%)=X(%)") D B^DIP0:Y["B" S:Y["D" R=R_"^^D" S Y=U_DPP,DPP(DJ,"CM")=X_" I D"_(J\3)_">0 S X("_DJ_")=X" G S ; B W *7,"??" G DJ G S X=$P(Y(0),U,2),D=$P($P(Y(0),U,4),";",1) I X S J=J+3,DPP(DJ,DL)=D,I(J\3)=$S(+D=D:D,1:Q_D_Q),(DL,J(J\3))=+X,Y=.01_U_$P(^DD(DL,.01,0),U,1) I $N(^($N(^DD(DL,0))))>0!$S($D(BY):BY?1U.E1" ".E,1:0) S DV=$J("",DJ*2-2)_$P(^(0),U,1)_": " D L G Y D B^DIP0:X["B" I X["P" S P=P_Q_+Y,I=$P(Y,U,2),DPP(DJ)=DL_U_Y_U_P D DPQ^DIP1 S X=I,DPP=I G C I +Y=.001 S Y=0_U_$P(Y,U,2),R=R_U_U_X S S X=DL_U_+Y,DPP(DJ)=DL_U_Y_U_P_R I P'["-",$P(Y,U,3)="" D XR D DJ^DIP1 Q:'$D(DJ) S DJ=DJ+1 G DJ ; 2 S DV=$J("",DJ*2-2)_"WITHIN "_$P(DPP(DJ-1),U,3)_", "_DE_" BY: " D L G D:X]"",DUP^DIP1 ; L K DIC S DIC="^DD(DL," I $D(BY) S DIC(0)="Z",X=$P(BY,C,1),BY=$P(BY,C,2,99) Q S DIC("S")="S %=$P(^(0),U,2) I %'[""m"",$S('%:1,1:$P(^DD(+%,.01,0),U,2)'[""W"")"_$S($D(DICS):" "_DICS,1:""),DIC("W")="W:$P(^(0),U,2) "" (multiple)""",DIC(0)="ZE" W !,DV R X Q:X'?1"?"."?" D ^DIC,DIP^DIQQ G L ; XR F P=0:0 S P=$N(^DD(DL,+Y,1,P)) Q:P'>0 I +^(P,0)=S S X=$P(^(0),U,2,9) I X?1A.A S DPP(DJ,"IX")=DI_Q_X_Q_C_DI_U_2,Y=$N(^DD(S,0,"IX",X,-1)),DU=$N(^(Y,-1)),DV=$P(^DD(Y,DU,0),U,1) Q N(^($N(^DD(DL,0))))>0!$S($D(BY):BY?1U.E1" ".E,1:0) S DV=$J("",DJ*2-2)_$P(^(0),U,1)_": " D L G Y D B^DIP0:X["B" I X["P" S P=P_Q_+Y,I=$P(Y,U,2),DPP(DJ)=DL_U_Y_U_P D DPQ^DIP1 S X=I,DPP=I G C I +Y=.001 S Y=0_U_$P(Y,U,2),R=R_U_U_X S S X=DL_U_+Y,DPP(DJ)=DL_U_Y_U_P_R I P'["-",$P(Y,U,3)="" D XR D DJ^DIP1 Q:'$D(DJ) S DJ=DJ+1 G DJ ; 2 S DV=$J("",DJ*2-2)_"WITHIN "_$P(DPP(DJ-1),U,3)_", "_DE_" BY: " D L G D:X]"",DUP^DIP1 ; L K DIC S DIC="^DD(DL," I $D(BY) S DIC(0)="Z",X=$P(BY,C,1),BY=$P(BY,C,2,99) Q S DIC("S")="S %=$P(^(0),U,2) I %'[""m"",$S('%:1,1:$P(^DD(+%,.01DIP0 ;GFT/SF ; 22SEP83 20:54 D DIPT S X=$P($E(X,2,99),"]",1),DIC(0)=$E("E",''L)_"QZ",DIC("S")="I $D(^(""F"")) "_DIC("S") D ^DIC K DIC G:Y<0 ^DIP2:L,Q^DIP I +Y=.01 K DPQ(DK) I L,Y'<1 D W:DUZ(0)'="@" I S %=2 W !,"WANT TO EDIT '",$P(Y,U,2),"' TEMPLATE" D YN^DICN G ED:%=1 K:'$D(^("DNP")) DNP S DALL=1,DHD=$S($D(DHD)=1:DHD,$D(^("H")):^("H"),1:""),DC(0)=+Y S R=$N(^("F",-1)),DE=^(R) I DE[U S DJ(1)=DE,DE="" F X=2:1 S R=$N(^(R)) Q:R<0 S DJ(X)=^(R) F X=0:0 S R=$N(^DIPT(+Y,"DCL",R)) Q:R<0 F D=1:1 Q:D>$L(^(R)) S Z=$E(^(R),D) I Z?1P S DCL(R)=$S($D(DCL(R)):DCL(R)_Z,1:Z) F X=0:0 S X=$N(^DIPT(+Y,"DXS",X)) Q:$N(^(X,0))<0 F %=0:0 S %=$N(^(%)) Q:%<0 S DXS(X,%)=^(%) G H^DIP3 ; ED S DRK=DK,DIE="^DIPT(",DA=+Y,DR=".01;3;6" D ^DIE S DC=0,DI=I(0) I $D(DA) S D9="",DC(0)=DA,DC(1)=-1 D ^DIP22 G DIP2^DIP1 ; B S DPP(DJ,"F")=0,DPP(DJ,"T")=1,P=P_"@B",R=R_";L1" K DATE Q ; PUT ; R !,"STORE PRINT LOGIC IN TEMPLATE: ",X D DIPT S DIC(0)="ELZQ",DIC("S")="I Y'<1 "_DIC("S"),Y=-1,X=$P(X,"]",1),X=$P(X,"[",1)_$P(X,"[",2),DLAYGO=0 D ^DIC:X]"" K DIC,DLAYGO G:Y<0 PAGE^DIP3:X="",PUT:X'[U,Q^DIP S S=$N(^(0))+1 I S W *7,!,"TEMPLATE ALREADY STORED THERE...." D W:DUZ(0)'="@" G PUT:'$T W " OK TO REPLACE" S %=0 D YN^DICN W ! G PUT:%-1 K ^DIPT(+Y) S ^DIPT(+Y,0)=$P(Y,U,2)_U_DT_U_$S('S:DUZ(0),1:$P(Y(0),U,3))_U_J(0)_U_DUZ_U_$S('S:DUZ(0),1:$P(Y(0),U,6)) S:DHD]"" ^("H")=DHD S:$D(DNP) ^("DNP")=1 S X=$D(^("DCL",0)) F S=0:0 S X=$N(DCL(X)) Q:X<0 S ^(X)=DCL(X) F S=0:0 S S=$N(DXS(S)) Q:S<0 F %=0:0 S %=$N(DXS(S,%)) Q:%<0 S ^DIPT(+Y,"DXS",S,%)=DXS(S,%) I '$D(^DIPT(+Y,"F",0)) F S=1:1 S X=$N(DJ(X)) Q:X<0 S ^(S)=DJ(X) S:DE]"" ^(S)=DE G PAGE^DIP3 ; W S %=$P(^(0),U,6) F X=1:1:$L(%) I DUZ(0)[$E(%,X) Q Q ; DIPT K DIC S DIC="^DIPT(",DIC("S")="I $P(^(0),U,4)\1=(DK\1)!($P(^(0),U,4)="""")" I L,DUZ(0)'="@" S DIC("S")=DIC("S")_" F DW=1:1:$L($P(^(0),U,3)) I DUZ(0)[$E($P(^(0),U,3),DW) Q" 2),DLAYGO=0 D ^DIC:X]"" K DIC,DLAYGO G:Y<0 PAGE^DIP3:X="",PUT:X'[U,Q^DIP S S=$N(^(0))+1 I S W *7,!,"TEMPLATE ALREADY STORED THERE...." D W:DUZ(0)'="@" G PUT:'$T W " OK TO REPLACE" S %=0 D YN^DICN W ! G PUT:%-1 K ^DIPT(+Y) S ^DIPT(+Y,0)=$P(Y,U,2)_U_DT_U_$S('S:DUZ(0),1:$P(Y(0),U,3))_U_J(0)_U_DUZ_U_$S('S:DUZ(0),1:$P(Y(0),U,6)) S:DHD]"" ^("H")=DHD S:$D(DNP) ^("DNP")=1 S X=$D(^("DCL",0)) F S=0:0 S X=$N(DCL(X)) Q:X<0 S ^(X)=DCL(X) F S=0:0 S S=$N(DXS(S)) Q:S<0 F %=0:0 S %=$N(DXS(S,%)) Q:%<0 S ^DIPT(+Y,"DXS",S,%)=DXS(S,%) I '$D(^DIPT(+Y,"F",0)) F S=1:1 S X=$N(DJ(X)) Q:X<0 S ^(S)=DJ(X) S:DE]"" ^(S)=DE G PAGE^DIP3 ; W S %=$P(^(0),U,6) F X=1:1:$L(%) I DUZ(0)[$E(%,X) Q Q ; DIPT K DIC S DIC="^DIPT(",DIC("S")="I $P(^(0),U,4)\1=(DK\1)!($P(^(0),U,4)="""")" I L,DUZ(0)'="@" S DIC("S")=DIC("S")_" F DIP1 ; ; 16JAN84 11:17 D DJ Q:'$D(DJ) DUP D DPQ G DIP1^DIQQQ:$D(A(1)) I L,$D(DPP(2,"T"))!$D(DPP(3)) S DK=S G S^DIBT N S DC=0 DIP2 ; K DXS,A,P,I,J S I(0)=DI,(DE,DINS,DV,DNP)="",(DXS,DL)=1,R=1,DCL=0,@("DK=+$P("_DI_"0),U,2)"),J(0)=DK G ^DIP2 ; DPQ K A F X=1:1 Q:$D(DPP(X))#2=0 S Y=$E($P(DPP(X),U,1,3),1,30),(A($D(A(Y))),A(Y))=0,DPP=X,Y=$P(DPP(X),U,4) I Y'["@",Y'["'" S DPQ(+DPP(X),$P(Y,"""",2)+$P(DPP(X),U,2))="" K DPP(X) Q ; DJ Q:$D(DPP(DJ,"F")) J S R=$P(DPP(DJ),U,2)+$P($P(DPP(DJ),U,4),"""",2),DC=$S($D(^DD(+DPP(DJ),$S(R:R,1:.001),0)):$P(^(0),U,2,3),1:$P(DPP(DJ),U,7,8)),R=$P(DPP(DJ),U,3) K DIC S I 'L,$D(FR)#2 S %=FR D Z E W !?DJ+DJ-2,"START WITH ",R,": FIRST// " R X Q:X="" I X["?" D DIP1F^DIQQ G S D CK G Q:X[U,S:Y<0 I +Y=Y S Y=Y-$S(Y:.00001,DC]"":1,1:0) E S Y=$E(Y,1,30),%=$A(Y,$L(Y)),Y=$E(Y,1,$L(Y)-1)_$C(%-(%>32))_$C(122) G S:Y?.C S (A,DPP(DJ,"F"))=Y T S Y=$C(122) I 'L,$D(TO)#2 S %=TO D Z E W !?DJ+DJ-2,"GO TO ",R,": LAST// " R X I X["?" D DIP1T^DIQQ G T D:X]"" CK I X'[U G T:Y<0 S:$P(DC,U,1)["D"&+$E(Y,6,7)&(Y'[".") Y=Y_.9999 S DPP(DJ,"T")=Y Q:A="?z"!(Y="@") G S:+Y=Y&(A>Y)!(+A'=A&(A]Y)) Q Q G Q^DIP ; CK G QQ:X["""" I X="@" S Y=X K DPP(DJ,"IX") Q S M=$P(DC,U,1) I M["D" S %DT="T"_$E("E",L) D ^%DT K %DT Q I M["S" G QQ:X[":"!(X[";") F Y=1:1 S D=$P($P(DC,U,2),";",Y),DA=$P(D,":",1),D=$P(D,":",2) Q:DA=X!'$L(D) I $P(D,X,1)="" W:L $P(D,X,2,9) S X=DA Q I +X=X!(M'["N") S Y=X Q QQ W *7,"??" S Y=-1 Q ; TEM ; G B^DIP:DJ-1 K DPP,DIC S X=$P($E(X,2,99),"]",1),DIC("S")="I $P(^(0),U,4)=DL",DIC(0)="ZQ"_$E("E",''L),DIC="^DIBT(" D ^DIC G I^DIP:Y<0 S DPP(1)=DL_"^^'"_$P(Y,U,2)_"' NUMBER^@'"_P,X=+Y,D=DIC_X_C,Y=1 I '$D(FLDS),$D(^("DIPT")),^("DIPT")]"" S FLDS="["_^("DIPT")_"]" S:L L=0 I $D(^(1)) S DIC=D_1_C F DY=1:1 S Y=$N(^(Y,-1)) S:$N(^(Y))>0 Y=$N(^(Y)) I $D(^(Y))<9 S DPP(DJ,"IX")=DIC_DI_U_DY,DJ=2 Q G I^DIP:'$D(^DIBT(X,2)) S %Y="DPP(",%X=D_2_C D %XY^%RCR F D=0:0 S D=$N(^DIBT(X,3,D)) Q:D<0 S DSC(D)=^(D) F DJ=1:1 Q:'$D(DPP(DJ)) I $D(DPP(DJ,"ASK")) K DPP(DJ,"F"),DPP(DJ,"T"),FR,TO D J G Q:'$D(DJ) D DPQ G N ; Z S X=$P(%,C,DJ) I X'="?" T"_$E("E",L) D ^%DT K %DT Q I M["S" G QQ:X[":"!(X[";") F Y=1:1 S D=$P($P(DC,U,2),";",Y),DA=$P(D,":",1),D=$P(D,":",2) Q:DA=X!'$L(D) I $P(D,X,1)="" W:L $P(D,X,2,9) S X=DA Q I +X=X!(M'["N") S Y=X Q QQ W *7,"??" S Y=-1 Q ; TEM ; G B^DIP:DJ-1 K DPP,DIC S X=$P($E(X,2,99),"]",1),DIC("S")="I $P(^(0),U,4)=DL",DIC(0)="ZQ"_$E("E",''L),DIC="^DIBT(" D ^DIC G I^DIP:Y<0 S DPP(1)=DL_"^^'"_$P(Y,U,2)_"' NUMBER^@'"_P,X=+Y,D=DIC_X_C,Y=1 I '$D(FLDS),$D(^("DIPT")),^("DIPT")]"" S FLDS="["_^("DIPT")_"]" S:L L=0 I $D(^(1)) S DIC=D_1_C F DY=1:1 S Y=$N(^(Y,-1)) S:$N(^(Y))>0 Y=$N(^(Y)) DIP2 ; F S (P,S)="" 1 I DL>1,$N(^($N(^DD(DK,0))))'>0,$P(^(.01,0),U,2)["W"!'DC S:DC DC=DC-2 S Y=.01 D P G N S DU=^DD(DK,0) K DIC,DALL,Y I 'L,$D(FLDS) S X=$P(FLDS,C,R),R=R+1 G LIT D ^DIP22:'$D(DC(DC))&DC W !?DL+DL-2,$S(DE]""!($D(DJ)>9):"THEN",1:"FIRST")_" PRINT "_$P(DU,U,1),": " I DC W DC(DC),"// " R X S DINS=X?1"^"1E.E,X=$S(DINS:$E(X,2,999),X="":DC(DC),1:X) G LIT R X LIT I X?1"""".E1"""".E,$P($P(X,Q,3),";",1)="" S S=X G S S DIC="^DD(DK,",DIC(0)=$E("ZE",1,L+1),DIC("W")="S %=$P(^(0),U,2) I % W $S($P(^DD(+%,.01,0),U,2)[""W"":"" (word-processing)"",1:"" (multiple)"")" S:$D(DICS) DIC("S")=DICS DIC D ^DIC G GF:Y>0,UP:X="",^DIP0:X?1"[".E&(DE="") S %=$L(X) F D="+","#","*","&","!" S Y=$S($E(X,1)=D:$E(X,2,999),$E(X,%)=D:$E(X,1,%-1),1:"") I Y]"" S P=D,X=Y G DIC I X[";" S S=";"_$P(X,";",2,99)_S,X=$P(X,";",1) G DIC I DC,X="@" D DC G F G DIP2^DIQQ:X?."?",Q^DIP:X=U,N:X="ALL" I $P("NUMBER",X,1)="" W $P("NUMBER",X,2) S S=0_S G S  S DIC(0)="EYZ",D="GR" D IX^DIC I Y<0 S DM=X,DQI="Y(",DA="DXS("_DXS_C,DICMX="D ^DIWP" D ^DICOMP G QQ:'$D(X)&'$D(FLDS) D FLY^DIP22,DJ G F I 'Y F Y=0:0 S Y=$N(Y(Y)) G F:Y<0 S X=^DD(DK,Y,0) D Y GF I $P(Y(0),U,2) D D,DC:DC S X=$P($P(Y(0),U,4),";",1),I(DL-1)=$S(+X=X:X,1:Q_X_Q),J(DL-1)=DK G 1 I +Y=.001 S Y=0 S S=+Y_S I P]"",$D(DCL(DK_U_+Y)) G QQ S D DJ G F ; D S DL(DL)=DK,DK=+$P(^(0),U,2),DL=DL+1,DV=DV_+Y_C,Y=0 Q ; U S DL=DL-1,DV=$P(DV,C,1,DL-1)_$E(C,DL>1),DK=DL(DL) K I(DL),J(DL) Q ; DC I 'DINS K:DC>1 DC(DC) S DC=DC+1 Q ; QQ W *7,"??" G F ; Y S S=Y_S DJ I $L(DE)+$L(S)>150 F DJ=0:1 I '$D(DJ(DJ)) S DJ(DJ)=DE,DE="" Q S DE=DE_DV_S_$C(126),S="" D DC:DC P I P="" K DNP Q I P="*" S DCL=DCL+1 S DCL(DK_U_+Y)=$S($T:DCL_P,1:P) Q ; N S I=DL S:I=1 DALL=1 NN S Y=.001 I $D(^DD(DK,Y)) S Y=0 D Y S Y=.001 A S Y=$N(^DD(DK,Y)) I $D(^(Y,8)),$D(DICS) X DICS E G A I Y'>0 G UP:I'
1 D U,DC:DC G F I DE="",$D(DJ)<9,'$D(DHIT),'$D(DIS) G F G ^DIP3 0),U,4),";",1),I(DL-1)=$S(+X=X:X,1:Q_X_Q),J(DL-1)=DK G 1 I +Y=.001 S Y=0 S S=+Y_S I P]"",$D(DCL(DK_U_+Y)) G QQ S D DJ G F ; D S DL(DL)=DK,DK=+$P(^(0),U,2),DL=DL+1,DV=DV_+Y_C,Y=0 Q ; U S DL=DL-1,DV=$P(DV,C,1,DL-1)_$E(C,DL>1),DK=DL(DL) K I(DL),J(DL) Q ; DC I 'DINS K:DC>1 DC(DC) S DC=DC+1 Q ; QQ W *7,"??" G F ; Y S S=Y_S DJ I $L(DE)+$L(S)>150 F DJ=0:1 I '$D(DJ(DJ)) S DJ(DJ)=DE,DE="" Q S DE=DE_DV_S_$C(126),S="" D DC:DC P I P="" K DNP Q I P="*" S DCL=DCL+1 S DCL(DK_U_+Y)=$S($T:DCL_P,1:P) Q ; N S I=DL S:I=1 DALL=1 NN S Y=.001 I $D(^DD(DK,Y)) S Y=0 D Y S Y=.001 A S Y=$N(^DD(DK,Y)) I $D(^DIP22 ;GFT/SF ; 21 OCT 83 9:32 PM S DC(1)=$N(^DIPT(DC(0),"F",DC(1))),DC=0 Q:DC(1)<0 S DC=2,DY=^(DC(1)),Y=2 Y ; S X=$P(DY,$C(126),1),DY=$P(DY,$C(126),2,99) Q:X="" I $P(X,D9,1)]"" F %=2:1 S DC(Y)="",Y=Y+1 I $P(D9,C,%,99)="" S D9="",DRK=J(0) Q I D9]"" S X=$P(X,D9,2,99) R I X[C S DA=$P(X,C,1) I +DA=DA G Y:'$D(^DD(DRK,DA,0)) S X=$P(X,C,2,99),DC(Y)=$P(^(0),U,1),%=+X,D=+$P(^(0),U,2) G Y:'$D(^DD(D,.01,0)),W:$P(^(0),U,2)["W" S DRK=D,Y=Y+1,D9=D9_DA_C G R I 'X S:X?1"0".E X="NUMBER"_$E(X,2,999) S %=$F(X,";Z;""") G P:'% S %=%-$L($P(X,";",1)),X=";"_$P(X,";",2,99) F D=%:0 S D=$F(X,Q,D) I ";"[$E(X,D) S X=$E(X,%,D-2)_$E(X,1,%-5)_$E(X,D,999) G P S %=+X,D=DRK_U_% I $D(^DIPT(DC(0),"DCL",D)) S X=X_$E(^(D),$L(^(D))) G Y:'$D(^DD(DRK,%,0)) W S X=$P(^(0),U,1)_$E(X,$L(%)+1,999) P S DC(Y)=X,Y=Y+1 G Y ; FLY ; S:'$D(X) X=DM S %=Y["D" S:P=""&(Y'["X") X=X_$S(%:" S Y=X D DT",1:" W X")_" K Y" S S=S_";Z;"""_DM_Q I %,S'[";R",S'[";L" S S=S_";L18" I Y["W",S'[";X" S S=S_";X" I Y["m" S:S'[";m" S=S_";m" I Y["w",S'[";w" S S=S_";w" I $L(X)+$L(S)>225 S X(9)=X,X="X DXS("_DXS_",9)" S S=X_S S:P]"" S=S_";"_P DXS F %=0:0 S %=$N(X(%)) Q:%<0 S @(DA_"%)=X(%)") S Y=-1,DXS=$D(X)>1+DXS K DATE,DIM,X ,C,2,99),DC(Y)=$P(^(0),U,1),%=+X,D=+$P(^(0),U,2) G Y:'$D(^DD(D,.01,0)),W:$P(^(0),U,2)["W" S DRK=D,Y=Y+1,D9=D9_DA_C G R I 'X S:X?1"0".E X="NUMBER"_$E(X,2,999) S %=$F(X,";Z;""") G P:'% S %=%-$L($P(X,";",1)),X=";"_$P(X,";",2,99) F D=%:0 S D=$F(X,Q,D) I ";"[$E(X,D) S X=$E(X,%,D-2)_$E(X,1,%-5)_$E(X,D,999) G P S %=+X,D=DRK_U_% I $D(^DIPT(DC(0),"DCL",D)) S X=X_$E(^(D),$L(^(D))) G Y:'$D(^DD(DRK,%,0)) W S X=$P(^(0),U,1)_$E(X,$L(%)+1,999) P S DC(Y)=X,Y=Y+1 G Y ; FLY ; S:'$D(X) X=DM S %=Y["D" S:P=""&(Y'["X") X=X_$S(%:" S Y=X D DT",1:" W X")_" K Y" S S=S_";Z;"""_DM_Q I %,SDIP3 ; ; 24JAN84 17:54 I $D(DJ(0)),DE]"" S DJ(99)=DE,DE="" H G PAGE:'L D HD W !,"HEADING: " I $L(X)>19 S Y=X W Y D RW^DIED S DHD=Y G Q W X,"// " R DHD I DHD="" S DHD=X G G Q I DHD="?" W !,"FOR NO HEADING AT ALL, TYPE '@'",!,"TO USE A PRINT TEMPLATE FOR HEADING, TYPE '[TEMPLATE NAME]'",! G H I DHD?.P1"["1E.E F DC=1,2 D DIPT^DIP0 S DIC(0)="E",X=$P($P(DHD,"[",DC+1),"]",1) D ^DIC I Y>0 S DHD=$P(DHD,"[",1,DC)_"["_$P(Y,U,2)_"]"_$P(DHD,"]",DC+1,9) G G:DC=2 I DHD?1"W ".E G G:DUZ(0)="@" F %=1:2 G G:$P(DHD,Q,%,999)="" I $P($E(DHD,3,999),Q,%)[" " G H G H:DHD[Q G I DHD'=U G PUT^DIP0:$L(DE)>13!($D(DJ)>9)&'$D(DALL),PAGE X W *7,!,"TRY LATER" G Q^DIP ; PAGE ; K DA,ION,IO("C") S DC="," S:$D(DOUT)#2 DA=DOUT I 'L,$D(PG) S DC=C_(PG-1) K PG E I L,DHD'="@" F X=1:1:DPP I $D(DPP(X,"F")) R !,"START AT PAGE: 1// ",X Q:X="" G DIP3^DIQQQ:X["?",X:X[U,DIP3:X\1'=X S DC=C_(X-1) Q I $D(%IS)[0,$D(^%ZTSCH("RUN")),$D(^%ZOSF("UCI")),$D(^("OS",^DD("OS"),8)) S %IS="QM",%IS("B")="" D ^%ZIS G X:IO="" I $D(IOT),IOT="SDP",$D(^("OS",^DD("OS"),"SDP")) G SDP G FREE ; SDP S O=IO,W=IOPAR,R=IOST I '$D(DCOPIES) R !,"NUMBER OF COPIES: ",F G X:F[U,SDP:F\1'=F S DCOPIES=F O K IOP,%IS W !,"OUTPUT COPIES TO" D ^%ZIS G X:IO="",O:IO=O S DOUT=$S($D(ION):ION_";"_IOM_";"_IOST,1:IO),DA=IO,IO=O,IOPAR=W,IOST=R FREE S:'$D(IO(0)) IO(0)=$I S F=IOST["K",W=IOST["SINGLE" I IO(0)'=IO,'$D(IO("Q")),'$D(IOP)!$D(IOFREE),'W!F,IO(0)=$I,$S($D(DA):DA'=$I,1:1),$S($D(%IS)[0:1,1:%IS'["F"),$P(^("OS",^DD("OS"),0),U,5) S %=2 W !,"WANT TO FREE UP THIS TERMINAL" D YN^DICN G X:%<0,DIP3^DIQQ:'% I %=1 I $T!$D(IO("C")) W !,"THIS TERMINAL IS NOW FREE",!!,"EXIT",! S IO("C")=1,DK=$D(DIOEND)#2,X=$I,DM="H" X ^DD("FUNC",7,1) S:DK DIOEND(9)=DIOEND,DM="X DIOEND(9) H" S DIOEND=DM S X=$S($D(DHD):DHD,1:"") D HD:X="" S DHD=X,X=DC K DC,S,N,Q,H,DA,FR,TO,BY,DM,J,T,V,CP,DIC,DIE,DRK,DBOOL,DINS,DALL,%IS,IOS,ION S O=0,DK=DI,DC=X,R=DE,C="," G ^DIP5:'$D(IO("Q")),^DIP4 ; HD S @("X=$P("_DI_"0),U,1)"),X=X_$S($D(DCL)>9:" STATISTICS",$D(DIS)>9:" SEARCH",1:" LIST") I $D(DC(0)),$D(^DIPT(DC(0),"H")) S X=^("H") PIES=F O K IOP,%IS W !,"OUTPUT COPIES TO" D ^%ZIS G X:IO="",O:IO=O S DOUT=$S($D(ION):ION_";"_IOM_";"_IOST,1:IO),DA=IO,IO=O,IOPAR=W,IOST=R FREE S:'$D(IO(0)) IO(0)=$I S F=IOST["K",W=IOST["SINGLE" I IO(0)'=IO,'$D(IO("Q")),'$D(IOP)!$D(IOFREE),'W!F,IO(0)=$I,$S($D(DA):DA'=$I,1:1),$S($D(%IS)[0:1,1:%IS'["F"),$P(^("OS",^DD("OS"),0),U,5) S %=2 W !,"WANT TO FREE UP THIS TERMINAL" D YN^DICN G X:%<0,DIP3^DIQQ:'% I %=1 I $T!$D(IO("C")) W !,"THIS TERMINAL IS NOW FREE",!!,"EXIT",! S IO("C")=1,DK=$D(DIOEND)#2,X=$I,DM="H" X ^DD("FUNC",7,1) S:DK DIOEND(9)=DIOEND,DM="X DIOEND(9) H" S DIOEND=DM S X=$S($D(DHD):DHD,1:"") D HD:X="" S DHD=X,X=DC K DC,S,N,Q,H,DA,FR,TO,BY,DM,J,T,V,CP,DIC,DIE,DRK,DBOOL,DINS,DALL,%IS,IOS,ION S O=0,DK=DI,DC=DIP4 ;GFT/SF ; 25NOV83 17:52 K IO("Q") S %DT="TEX",X="" I $D(DQTIME)#2 S X=DQTIME,%DT="XT" W R:'$D(IOP)&'$D(DQTIME) !,"REQUESTED TIME TO PRINT: NOW// ",X S Y=$H I $P("NOW",X,1)]"" S:X'["@" X="T@"_X S %DT(0)=0 D ^%DT K %DT(0) G:Y<1 X^DIP3:X[U!$D(DQTIME),W S X=+Y D H^%DTC S Y=Y_"000",Y=%H_","_($E(Y,9,10)*60+$E(Y,11,12)*60) W ! S DX=Y X ^%ZOSF("UCI") L ^%ZTSK S (^%ZTSK(0),ZTSK)=^%ZTSK(0)+1 L S ^%ZTSK(ZTSK,0)="ZTSK^DIP4^"_DUZ_U_Y_U_$H_U_DX_U,X="^%ZTSK("_ZTSK_"," X ^("OS",^DD("OS"),8) K @(X_"""DT"")") S J=IO I $D(IOT),IOT="SPL" C IO S J="" S ^%ZTSCH(DX,ZTSK)=J W "REQUEST QUEUED!",! G Q^DIP ; ZTSK ; D 0^DICRW S Y="%" F Z=0:0 S Y=$N(^%ZTSK(ZTSK,Y)),%=$D(^(Y)) Q:'% S:%#2 @(Y_"=^(Y)") I %>9 S %X="^%ZTSK(ZTSK,Y,",%Y=Y_"(" D %XY^%RCR K ^%ZTSK(ZTSK) S IOP=$S($D(ION):ION,1:IO)_";"_$S($D(IO("DOC")):IO("DOC"),1:IOM)_";"_IOST D ^%ZIS G ^DIP5 DIP5 ;GFT/SF ; 04DEC83 10:20 S %H=$H D YMD^%DTC S DT=X K %H,^UTILITY($J) U IO S Z=IOM-33,^UTILITY($J,1)=$P("W:DC?.N *7 R:DC?.N Y ",U,IOST?1"C".E)_"S DC=$P(DC,"","",2)+DC+1 W:$Y "_IOF_$P(",#",U,IOF'["#"),M=DHD?1"W ".E I W S ^(1)=^(1)_",*7"_$S(F:"",1:" U """_IO(0)_"""")_" R Y"_$S(F:"",1:" U IO")_" W """"" I M S ^(1)=^(1)_" X ^(1.5)",^(1.5)=DHD G GO I DHD'?.P1"[".E1"]",DHD'="@" S M=$P($H,C,2)\60,^(2)=","_$E("!",$L(DHD)+2>Z)_"?"_Z_" S Y="_(M#60/100+(M\60)/100+DT)_" D DT W "" PAGE "",DC",M="W """_DHD_"""" S:$L(M)+$L(^(2))>252 ^(2.5)=DHD,M="W ^(2.5)" S ^(2)=M_^(2),DHD=3 GO D INIT F Y=1:1:DPP I $P(DPP(Y),U,4)["!" S (X,W)="",Y=",DRK",DRJ=0,DLN=3 D O^DIL Q DIL D ^DIL S W=$N(DJ(-1)) G ^DIL2:W<0 S R=DJ(W) K DJ(W) G DIL ; INIT ; S M=1,DN=-2,(DIWL,DM,DG,DX,DHT)=0,(DY,DI)="D0",@("DP=+$P("_DK_"0),U,2)"),(F,DTOT)="" K DIWR DIQ ;GFT/SF ; 25NOV83 17:30 G INQ^DII ; GUY S:'$D(IOM) IOM=80 S D0=DA,D=DIC_DA_",",S=3,DL=1 I '$D(DIQS) W ! E S Z=0 F A=0:0 S @("Z=$N("_DIQS_"Z))") Q:Z<0 S @(DIQS_"Z)=""""") I $D(DX(0))#2=0 S DX(0)="Q" I $D(IOST),IOST?1"C".E S DX(0)="S S=S+1 I S>22 R ""'^' TO HALT: "",W W $C(13),$J("""",20),$C(13) S S=W'?1P" 1 I $D(DIQS) S Z=0 F A=0:0 S @("Z=$N("_DIQS_"Z))"),A=$N(^DD(DD,"B",Z,0)) Q:Z<0 I $D(^DD(DD,A,0)) S C=$P(^(0),U,2) I C["C" D COM S @(DIQS_"Z)=X") I N<0,$D(^DD(DD,.001,0)) S W=.001,A=-1,Y=@("D"_(DL\2)) G W N S @("N=$N("_D_"N))") I DL=1,@E D LF G Q I $D(^(N))#2 S Z=^(N),A=-1 G NS I N<0 S DL=DL-1 G B I DL#2 S Z=$N(^DD(DD,"GL",N,0,0)) G N:Z<0 S O=0,X=+$P(^DD(DD,Z,0),"^",2) X:$D(DICS) DICS E G N E G N:N'>0 S X=DD,O=-1,@("D"_(DL\2)_"=N") D LF Q:'S I $D(DSC(X)) X DSC(X) E G N S DD(DL)=DD,D(DL)=D,N(DL)=N,DL=DL+1 S:+N'=N N=""""_N_"""" S D=D_N_",",N=O,DD=X G 1:DL#2,N ; B S N=N(DL),D=D(DL),DD=DD(DL) D LF Q:'S G N ; DIQS S @(DIQS_"O)=Y") NS S A=$N(^DD(DD,"GL",N,A)) G N:A<0 S W=$N(^(A,0)) I A S Y=$P(Z,"^",A) G W:Y]"",NS S Y=$E(Z,+$E(A,2,9),$P(A,",",2)) G NS:Y?." " W S O=$P(^DD(DD,W,0),"^",1),C=$P(^(0),"^",2) I $D(DICS) X DICS E G NS I C["W",'$D(DIQS) D DIQ^DIWW S DL=DL-2 G B D Y I $D(DIQS) G @("DIQS:$D("_DIQS_"O))"),NS:'$D(^(W)) S O=W G DIQS I $X+$L(O)+$L(Y)+2>IOM S O=$E(O,1,253-$L(Y)) S O=O_": "_Y I D LF Q:'S W " " W O W:$X+8"_O_")",1:O_""")") D GUY S DA=D0 Q K C,O,W,N,E,Z,D,DD,IOP Q ; COM X $P(^(0),U,5,99) S C=$P($P(C,"J",2),",",2) I C?1N.E,X S X=$J(X,0,C) ,0)) S Y=$P(^(0),U,1) I $D(^DD(+C,.01,0)) S C=$P(^(0),U,2) G S Q:C'["D" D S %=$E(Y,4,5)*3,Y=$E("JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC",%-2,%)_" "_$S($E(Y,6,7):$J(+$E(Y,6,7),2)_", ",1:"")_($E(Y,1,3)+1700)_$S(Y[".":" "_$E(Y_0,9,10)_":"_$E(Y_"DIQQ ;GFT/SF ; 04JAN84 20:33 ; DICQ I $S($D(DLAYGO):DO(2)\1-DLAYGO,1:1),$D(^DIC(+DO(2),0,"LAYGO")),DUZ(0)'="@" F X=1:1 S Y=$E(^("LAYGO"),X) I DUZ(0)[Y G RCR:Y="" Q W:$X>3 ! W ?3,"YOU MAY ENTER A NEW ",$P(DO,U,1),", IF YOU WISH" W:$D(^DD(+DO(2),.01,3)) !?6,^(3) X:$D(^(4)) ^(4) RCR I DO(2)["P",'$D(DZ(1)) D P^DICQ K DO S DZ(0)=DIC(0),DIC(0)=$E("L",$P(^(0),U,2)'["'"),DZ(1)=DIC,DIC=DIY D DQ^DICQ S DIC=DZ(1),DIC(0)=DZ(0) K DO Q Q DIP ; W !?9,"TYPE '+' IN FRONT OF FIELD NAME TO GET SUBTOTALS BY THAT FIELD," W !?9,"TYPE '-' IN FRONT OF NUMERIC-VALUED FIELD TO SORT FROM HI TO LO" W !?9,"TYPE '#' IN FRONT OF FIELD NAME TO PAGE-FEED ON EACH FIELD VALUE" W !?9,"TYPE '!' TO GET RANKING NUMBER, '@' TO SUPPRESS SUB-HEADER" W:DJ=1 !?9,"TYPE [RECORD SET NAME] IN BRACKETS TO SORT BY PREVIOUS SEARCH RESULTS" Q ; DIP3 W !,"SINCE YOU ARE CALLING FOR OUTPUT ON DEVICE '",IO,"', YOU MAY USE ",!,"THE TERMINAL YOU ARE NOW TYPING ON FOR SOMETHING ELSE, BY ANSWERING 'Y'",!! G FREE^DIP3 ; DIP1F W !,"TO ",DE," IN SEQUENCE, STARTING FROM" G 1 DIP1T W !,"TO ",DE," ONLY UP TO" 1 W " A CERTAIN ",R,",",!?5,"TYPE THAT ",R W:$P(DC,U,1)'["R"&$L(DC) !?5,"'@' MEANS 'INCLUDE NULL ",R," FIELDS'" Q ; DICATT3 W ?J,"TYPE FIELD NAMES, OPERATORS(+-\/*), DIGITS, OR FUNCTIONS",!,"FOR FUNCTIONS," S D="B",DZ="??",DIC("W")="W:$D(^(9)) "" ("",^(9),"")""",DIC="^DD(""FUNC"",",DIC(0)="" D DQ^DICQ G 6^DICATT3 ; DICATT31 W !?J+2,"ENTER THE NUMBER OF DIGITS THAT SHOULD NORMALLY APPEAR TO THE" W !?J+2,"RIGHT OF THE DECIMAL POINT WHEN '",F,"' IS DISPLAYED" G DEC^DICATT3 ; DIP2 ; W:$P(DU,U,4)>1 !?5,"TYPE 'ALL' TO PRINT EVERY ",$P(DU,U,1) W !?5,"TYPE '&' IN FRONT OF FIELD NAME TO GET TOTAL FOR THAT FIELD,",!?8,"'!' TO GET COUNT, '+' TO GET TOTAL & COUNT, '#' TO GET MAX & MIN" W:DE="" !?5,"TYPE '[TEMPLATE NAME]' IN BRACKETS TO PRINT BY TEMPLATE" W !?5,"YOU CAN FOLLOW FIELD NAME WITH ';' AND FORMAT SPECIFICATION(S)" G ^DIP2 ; DICE2 ; W !!,"YOU MAY USE '@' TO INDICATE THAT '",DNEW,"' IS TO BE DELETED",!,"IF YOU SIMPLY WANT TO MOVE THE VALUE OF '",DOLD,"' OVER,",!," JUST ENTER '",DOLD,"'" G C^DICE2 " S D="B",DZ="??",DIC("W")="W:$D(^(9)) "" ("",^(9),"")""",DIC="^DD(""FUNC"",",DIC(0)="" D DQ^DICQ G 6^DICATT3 ; DICATT31 W !?J+2,"ENTER THE NUMBER OF DIGITS THAT SHOULD NORMALLY APPEAR TO THE" W !?J+2,"RIGHT OF THE DECIMAL POINT WHEN '",F,"' IS DISPLAYED" G DEC^DICATT3 ; DIP2 ; W:$P(DU,U,4)>1 !?5,"TYPE 'ALL' TO PRINT EVERY ",$P(DU,U,1) W !?5,"TYPE '&' IN FRONT OF FIELD NAME TO GET TOTAL FOR THAT FIELD,",!?8,"'!' TO GET COUNT, '+' TO GET TOTAL & COUNT, '#' TO GET MAX & MIN" W:DE="" !?5,"TYPE '[TEMPLATE NAME]' IN BRACKETS TO PRINT BY TEMPLATE" W !?5,"YOU CANDIQQQ ;GFT/SF ; 12SEP83 14:29 ; DICATT W !?J,"IF YOU WANT THE SAME ANSWER ALLOWED FOR ",F,!?J,"AS FOR " Q ; DICATT1 W !?J,"ENTER GLOBAL SUBSCRIPT NAME AT WHICH ",F," WILL BE STORED" W !?J," ALREADY ASSIGNED: " S Y=-1 F T=0:0 S Y=$N(^DD(A,"GL",Y)) G SUB^DICATT1:Y<0 W $J(Y,9) W:$X>66 !?J ; DIS W !," ENTER WHAT WOULD FOLLOW THE '?' OPERATOR (FOR EXAMPLE, '1A2E.E')" G F^DIS ; DISC W !,"YOU CAN NEGATE ANY OF THESE CONDITIONS BY PRECEDING THEM WITH ""'"" OR ""-""" W !,"SO THAT ""'NULL'"" MEANS ""NOT NULL""",! G C^DIS ; DIP1 W *7,!,"YOU HAVE ASKED TO SORT ON THE SAME FIELD TWICE; THAT DOESN'T MAKE SENSE!" G Q^DIP ; DIP3 W !,"IF YOU WANT PAGE NUMBERING TO START AT A NUMBER HIGHER THAN 1, TYPE THAT NUMBER" G ^DIP3 NT, '#' TO GET MAX & MIN" W:DE="" !?5,"TYPE '[TEMPLATE NAME]' IN BRACKETS TO PRINT BY TEMPLATE" W !?5,"YOU CANDIRCR ;**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:'%CDIS ;GFT/SF ; 14DEC83 15:53 K ^UTILITY($J),DIS,DJS,O D ^DICRW G Q:'$D(DIC) S (DI,I(0))=DIC,DL=1,C=",",DC=1,(DJS,DJS(1))="0^0" GO S Q="""",DV="",@("DK=+$P("_DI_"0),U,2)"),R=$P(^(0),U,1),J(DL-1*3)=DK F W ! K DIC,DIWR D W S DIC(0)="EZ",DIC="^DD("_DK_C,DIC("W")="S %=$P(^(0),U,2) W:% $S($P(^DD(+%,.01,0),U,2)[""W"":"" (word-processing)"",1:"" (multiple)"")",DIC("S")="I $P(^(0),U,2)'[""m"""_$S($D(DICS):" "_DICS,1:"") W "SEARCH FOR "_R_" "_$P(^DD(DK,0),U,1),": " R X G TEM^DIS1:X?1"[".E D ^DIC K P,DIC I Y>0 S DE=Y(0),O(DC)=$P(DE,U,1),DU=DV_+Y,Z=$P(DE,U,3),E=$P(DE,U,2) G G G F:$F("???",X)>1,Q:X=U,^DIS0:X="" COMP S DQI="Y(",DA="DIS("""_$C(DC+64)_""",",O(DC)=X D ^DICOMP I '$D(X) W *7,"??" G F F %=0:0 S %=$N(X(%)) Q:%<0 S @(DA_%_")=X(%)") S DA(DC)=X,DU=DV_-DC,E=$E("B",Y["B")_$E("D",Y["D") K X G S DIC="^DOPT(""DIS"",",DIC(0)="QEZ" I E["B" S X="" G OK I E S DL(DL)=DK,DK=+E,DV=DV_+Y_C,Y=.01,J(DL)=DK,X=$P($P(DE,U,4),";",1),I(DL)=$S(+X=X:X,1:Q_X_Q),Y(0)=^DD(DK,Y,0),DL=DL+1,DJS(DL)=DJS G F:$P(Y(0),U,2)'["W" S DIC("S")="I Y<3",DIWR=1 I E["P" S P=+Y_U_Y(0),X=$P(Y(0),U,1)_":.01" G COMP C D W R "CONDITION: ",X S DN=$S("'-"[$E(X,1):"'",1:""),X=$E(X,DN]""+1,99) D ^DIC G:Y<0 Q:X[U,B:X="",DISC^DIQQQ:X["?",C I +Y=1 S X=DN_"?."" """,O(DC)=O(DC)_DN_" NULL" G OK S DQ=Y D W W $P("NOT ",U,DN]"")_$P(DQ,U,2) I E["D",Y-3 R " DATE: ",X S %DT="TE" D ^%DT G GOT:Y>1,X PT I $D(P),+DQ=5 K DIC S DIC=U_$P(P,U,4),DIC(0)="EMQ",DU=DV_+P W " ",@("$P("_DIC_"0),U,1)"),": " R X D ^DIC G GOT:Y>0,X:U[X,PT R ": ",Y G X:Y[U!'$L(Y) I +DQ=3 S X="I X?"_Y D ^DIM G DIS^DIQQQ:'$D(X) G T:E'["S" I +DQ=5 S Y=":"_Y F X=1:1 S D=$P(Z,";",X) G X:D="" I D[Y W $P(D,Y,2) S Y=$P(D,":",1) G T S %="(WILL APPLY TO THE VALUES" W *7,!?7 F X=1:1 S D=$P(Z,";",X),DE=$P(D,":",2) Q:D="" W % W:X>1 "," W " " S %="'"_DE_"'",DIS(U,DC,$P(D,":",1))=DE W:$X+$L(%)>73 !?7 W "AND ",%,")" T I DQ["THAN",+Y'=Y G X I DQ#3=2 G X:Y[Q I +Y'=Y S Y=Q_Y_Q GOT S I=DN_$E(" [?<=>",DQ),X=I_Y X:E["D" ^DD("DD") S O(DC)=O(DC)_I_Y OK S DC(DC)=DU_U_X S:DJS DCC(DC)=DJS_U_J(+DJS) F I=DJS+2:1:DL S DJS(I)=I-1_U_DC I DL>1 S %=$N(^DD(DK,0,"NM",0)) S:O(DC)'[% O(DC)=%_" "_O(DC) S DC=DC+1 S:DL-1>DJS DJS=DJS(DL) B G ^DIS0:$D(DIWR),F ; Q G Q^DIS1 ; X W *7,"??",!! G B ; W W !?DL*2,"-"_$C(DC+64)_"- " EMQ",DU=DV_+P W " ",@("$P("_DIC_"0),U,1)"),": " R X D ^DIC G GOT:Y>0,X:U[X,PT R ": ",Y G X:Y[U!'$L(Y) I +DQ=3 S X="I X?"_Y D ^DIM G DIS^DIQQQ:'$D(X) G T:E'["S" I +DQ=5 S Y=":"_Y F X=1:1 S D=$P(Z,";",X) G X:D="" I D[Y W $P(D,Y,2) S Y=$P(D,":",1) G T S %="(WILL APPLY TO THE VALUES" W *7,!?7 F X=1:1 S D=$P(Z,";",X),DE=$P(D,":",2) Q:D="" W % W:X>1 "," W " " S %="'"_DE_"'",DIS(U,DC,$P(D,":",1))=DE W:$X+$L(%)>73 !?7 W "AND ",%,")" T I DQ["THAN",+Y'=Y G X I DQ#3DIS0 ;GFT/SF ; 05JAN84 16:59 K DIC G Q^DIS1:DC<2,IF:DL=1 UP S DL=DL-1,DV=$P(DV,C,1,DL-1)_$E(C,DL>1),DK=DL(DL),DJS=DJS(DL) K I(DL),J(DL) G F^DIS ; IF W ! K DL,DE,DJS S O=0,E=$D(DC(2)),N="IF: A// ",DE=$S(E:"IF: ",1:N),DL=0 R W !,DE R X G Q^DIS1:X[U I X="" S DQ="'^' TO EXIT" G SHFL:DL,BAD:E S DL=1,(DL(1),Y)="^1^" S:DC(1)["^'"&($P(DC(1),U,1)[C) DE(1)=1 G L S Y=U,P=0,DU="" P S P=P+1,DQ=$E(X,P) G A:DQ]"",BAD:Y=U S DL=DL+1,DL(DL)=Y,DE="OR: ",P=0 DJS S P=$N(DJS(DL,P)),%=1 G L:P'>0 I Y'[(U_DJS(DL,P)) K DJS(DL,P) G DJS W !?8,"CONDITION -"_$C(P+64)_"- WILL APPLY TO THE SAME MULTIPLE AS CONDITION -"_$C(DJS(DL,P)+64)_"-",!?8,"...OK" D YN^DICN G Q^DIS1:%<0 K:%=2 DJS(DL,P),DE(DL) G DJS ; A I DQ?.A S DV=$A(DQ)-64 I $D(DC(DV)) S:$P(DC(DV),U,1)[C DE(DL+1)=DC(DV)["^'" G CHK G P:"&+ "[DQ I DU="","'-"[DQ S DU="'" G P BAD W *7," <",DQ,">??" K DJS(DL+1) G R ; CHK S %=$F(Y,U_DV) I % S %=$P($E(Y,%),U,1)'=DU,DQ=""""_DQ_""" AND """_$E("'",%)_DQ_""" IS "_$P("REDUNDANT^CONTRADICTORY",U,%+1) G BAD S Y=Y_DV_DU_U,DU="" S:$D(DCC(DV)) DJS(DL+1,DV)=+DCC(DV) G P ; L S P=O F %=2:1 S X=$P(Y,U,%) Q:X="" S O=O+1,^UTILITY($J,O,0)=$S(%>2:$S($D(DJS(DL,+X)):" together with ",1:" and "),O=1:"",1:" Or ")_$E("'",X["'")_O(+X) HOW W:$X>18 ! W " " F %=P+1:1 Q:'$D(^UTILITY($J,%,0)) S X=^(0) W:$L(X)+$X>77 !?13 W " "_X G G:'$D(DE(DL)) W !?4,"DO YOU WANT THIS SPECIFICATION TO BE CONSIDERED TRUE:",!?8,"1) WHEN AT LEAST ONE OF THE MULTIPLES SATIFIES IT" W !?8,"2) WHEN ALL OF THE MULTIPLES SATISFY IT" S X=2 I Y["'"!DE(DL) W !?8,"3) WHEN ALL OF THE MULTIPLES SATISFY IT, OR WHEN THERE ARE NO MULTIPLES" S X=3 W !?4,"CHOOSE 1-"_X R ": 1// ",%,! S:%="" %=1 G Q^DIS1:%=U,HOW:%>X!'% S DE(DL)=% I %>1 S O=O+1,^UTILITY($J,O,0)=" for all multiples" E K DE(DL) G G R:E SHFL S DL(0)="" W ! G 1:$D(DE)>1!$D(DJS) I DL=1 S DL(0)=DL(1),DL=0 K DL(1) E F P=2:1 S Y=$P(DL(1),U,P) Q:Y="" S Y=U_Y_U,X=2 D 2 F X=1:1 Q:'$D(DL(X)) F Y=X+1:1 Q:'$D(DL(Y)) I DL(X)=DL(Y)!(DL(Y)?.P) S DL=DL-1 K DL(Y) F P=Y:1:DL S DL(P)=DL(P+1) K DL(P+1) 1 K O,DCC G ^DIS1 ; 2 I X'>DL Q:DL(X)'[Y S X=X+1 G 2 S DL(0)=U_$P(Y,U,2)_DL(0) 22 S X=X-1,DQ=$F(DL(X),Y),DL(X)=$E(DL(X),1,DQ-$L(Y))_$E(DL(X),DQ,999) Q:X=1 G 22 )) S X=^(0) W:$L(X)+$X>77 !?13 W " "_X G G:'$D(DE(DL)) W !?4,"DO YOU WANT THIS SPECIFICATION TO BE CONSIDERED TRUE:",!?8,"1) WHEN AT LEAST ONE OF THE MULTIPLES SATIFIES IT" W !?8,"2) WHEN ALL OF THE MULTIPLES SATISFY IT" S X=2 I Y["'"!DE(DL) W !?8,"3) WHEN ALL OF THE MULTIPLES SATISFY IT, OR WHEN THERE ARE NO MULTIPLES" S X=3 W !?4,"CHOOSE 1-"_X R ": 1// ",%,! S:%="" %=1 G Q^DIS1:%=U,HOW:%>X!'% S DE(DL)=% I %>1 S O=O+1,^UTILITY($J,O,0)=" for all multiples" E K DE(DL) G G R:E SHFL S DL(0)="" W ! G 1:$D(DE)>1!$D(DJS) I DL=1 S DL(0)=DL(1),DL=0 K DL(1) E F P=2:1 S Y=$DIS1 ; ; 14DEC83 18:09 S DK(0)=DK,Z="D0," F DQ=0:1:DL S M=0,X=0,DQ(0)=DQ D MAKE DISV I DUZ R !,"STORE RESULTS OF SEARCH IN TEMPLATE: ",X I X]"" D DIBT1^DII G:Y<0 Q:X=U,DISV S DISV="S ^DIBT("_+Y_",1,D0)=""""",Z=-1,%X="DIS(",%Y="^DIBT(+Y,P,",P="DIS" D %XY^%RCR S %X="^UTILITY($J,",P="O",@(%X_"0)=U_.4011") D %XY^%RCR W ! K DIC S DIC=DI D Q G EN1^DIP:$D(SF),EN^DIP ; TEM ; K DIC S X=$P($E(X,2,99),"]",1),DIC="^DIBT(",DIC(0)="E",DIC("S")="I $P(^(0),U,4)=DK,$P(^(0),U,5)=DUZ!'$P(^(0),U,5),$D(^(""DIS""))" S DIC("W")="X ""F %=1:1 Q:'$D(^DIBT(Y,""""O"""",%,0)) W ?22 S I=^(0) W:$L(I)+$X>79 !?3 W I""" D ^DIC K DIC G F^DIS:Y<0 S P="DIS",Z=-1,%X="^DIBT(+Y,P,",%Y="DIS(" D %XY^%RCR S %Y="^UTILITY($J,",P="O" D %XY^%RCR G DISV ; Q K DCC,O,D,DC,DI,DK,DL,DQ,DU,DV,E,DE,DJS,N,P,Z Q ; C S Y=Y_$S(DV="'":" I 'X",1:" I X"_DV),M=0 D SD MAKE S DQ=+DQ,X=X+1,Y=$P(DL(DQ),U,X+1) Q:Y="" S S=+Y,DN=$E("'",Y["'"),Y=DC(S),DV=$P(Y,U,2),D=+$S($D(DJS(DQ,S)):DJS(DQ,S),1:0),DQ=DQ(D),Z=$P(Z,C,1,D+D+1)_C,DU=$P($P(Y,U,1),C,D+1,99),DIC=DK(D),DV=DN_DV,DN=$S($D(DE(DQ)):DE(DQ),1:0) S:DV?1"''".E DV=$E(DV,3,999) LEV I DU<0 S Y=DA(-DU) K DA(-DU) G C S N=$P(^DD(DIC,+DU,0),U,4),DE=$P(N,";",1),Y=$P(N,";",2) I Y="" S Y="D"_D G M I $P(^(0),U,2)["C" S Y=$P(^(0),U,5,99) G C S:+DE'=DE DE=""""_DE_"""" S Z=Z_DE,E="$S($D("_DI_Z_")):$" I Y S Y=E_"P(^("_DE_"),U,"_Y_"),1:"""")" G M I Y'=0 S Y=$E(Y,2,99) S:$P(Y,",",2)=+Y Y=+Y S Y=E_"E(^("_DE_"),"_Y_"),1:"""")" G M F Y=65:1 S M=DQ_$C(Y) Q:'$D(DIS(M)) S D=D+1,Y="S D"_D_"=$N("_DI_Z_",0)) X DIS("""_M_""") I $T" D SD S DQ=M,DIS(DQ)="F E=0:0 X DIS("""_DQ_"A"") X:D"_D_"'>0 ""IF "_(DN=3)_""" Q:"_$E("'",DN>0)_"$T S D"_D_"=$N("_DI_Z_",D"_D_")) Q:D"_D_"'>0",DN=0 S DQ=DQ_"A",DQ(D)=DQ I +DU=DU S DIS(DQ)="I $S($D(^(D"_D_",0)):$P(^(0),U,1),1:"""")"_DV G MAKE S DIC=+$P(^(0),U,2),DK(D)=DIC,DU=$P(DU,C,2,99),Z=Z_",D"_D_C G LEV  ; M I $D(^(2)),$P(^(0),U,2)'["D" S M=0,Y="S Y="_Y_" "_^(2)_" I Y" G E I $D(DIS(U,S)) S Y="S Y="_Y_" I $S(Y="""":"""",$D(DIS(U,"_S_",Y)):DIS(U,"_S_",Y),1:"""")" G E I Y=M S DIS(DQ)=DIS(DQ)_C_Y_DV G MAKE S M=Y,Y="I "_Y E S Y=Y_DV D SD G MAKE ; SD I '$D(DIS(DQ)) S DIS(DQ)=Y Q I $L(DIS(DQ))+$L(Y)>180 F %Y=1:1 S %=DQ_"@"_%Y I '$D(DIS(%)) S DIS(%)=Y,Y="X DIS("""_%_""") I $T" Q S DIS(DQ)=DIS(DQ)_" "_Y ) S:$P(Y,",",2)=+Y Y=+Y S Y=E_"E(^("_DE_"),"_Y_"),1:"""")" G M F Y=65:1 S M=DQ_$C(Y) Q:'$D(DIS(M)) S D=D+1,Y="S D"_D_"=$N("_DI_Z_",0)) X DIS("""_M_""") I $T" D SD S DQ=M,DIS(DQ)="F E=0:0 X DIS("""_DQ_"A"") X:D"_D_"'>0 ""IF "_(DN=3)_""" Q:"_$E("'",DN>0)_"$T S D"_D_"=$N("_DI_Z_",D"_D_")) Q:D"_D_"'>0",DN=0 S DQ=DQ_"A",DQ(D)=DQ I +DU=DU S DIS(DQ)="I $S($D(^(D"_D_",0)):$P(^(0),U,1),1:"""")"_DV G MAKE S DIC=+$P(^(0),U,2),DK(D)=DIC,DU=$P(DU,C,2,99),Z=Z_",D"_D_C G LEV DIT ;GFT/SF ; 21MAR83 9:54 D Q S DLAYGO=1 D W^DICRW Q:Y<0 S DFL=$P(Y,U,2)_": " I '$D(DIC) D DIE^DIB Q:'$D(DG) S L=DG,Y=DLAYGO K DG,DIE,DQ G FROM S DIC("B")=+Y,L=DIC FROM S DMRG=1,DKP=1,(DDF(1),DDT(0))=+Y,DIC=1,DIC(0)="EQAZ",DIC("A")="TRANSFER FROM FILE: " I DUZ(0)'="@" S DIC("S")="I 1 Q:'$D(^(0,""RD"")) F Z=1:1:$L(^(""RD"")) I DUZ(0)[$E(^(""RD""),Z) Q" D ^DIC K DIC G Q:Y<0,Q:'$D(^(0,"GL")) S DTO=^("GL") I DUZ(0)'="@",$D(^("DEL")) F X=1:1 G Q:X>$L(^("DEL")) Q:DUZ(0)[$E(^("DEL"),X) D PTS I +Y=DDF(1) G ^DIT0 TWO S (DTO(0),F)=L,L(+Y)=DDT(0),L=0,DDF(1)=+Y,DFR(1)=DTO_"D0,",DHIT=DLAYGO-(Y#1),%=0 W !! K ^DD(U,$J),A I DLAYGO-1 W "DO YOU WANT TO TRANSFER THE '",$P(Y,U,2),"'",!,"DATA DICTIONARY INTO YOUR NEW FILE" D YN^DICN G Q:%<1 D ^DIT1:%=1 K Y,B W ! L K L(L) S L=$N(L(0)) I L'<0 F Y=0:0 S Y=$N(^DD(L,Y)) G L:'$D(^(Y,0)) S %=^(0) I $P(%,U,2)'["C" S DIC=$P(%,U,1),X=$N(^DD(L(L),"B",DIC,0)) I X>0,$P(^DD(L(L),X,0),U,2)'["C" D T I '$D(B) W *7,"FILES DON'T MATCH!" G Q W:$X>40 ! W:'$D(A) " WILL BE TRANSFERRED",!! S %=2,DMRG=0 I @("$N("_DTO(0)_"0))>0") W !,"WANT TO MERGE TRANSFERRED ENTRIES WITH ONES ALREADY THERE" D YN^DICN G Q:%<1 I %=1 S DMRG=1 S (DIK,DIC)=DTO,DTO=B,L="TRANSFER ENTRIES",FLDS="",DHD="@",%IS="F",DIOEND="S DIK=DTO(0) D KL^DIT,IXALL^DIK,Q^DIT" D S %=0 W !,"WANT EACH ENTRY TO BE DELETED AS IT'S TRANSFERRED" D YN^DICN S DHIT="S DI=99 D F^DITR"_$P(",^DIK",%,%=1) G Q:%<0 I '% D F G D G EN1^DIP ; T S Z=$P(^(0),U,4),V=$P($P(^(0),U,2),U,Z[";0"),^DD(U,$J,L,Y)=$P(Z,";",2)_U_$P(Z,";",1) S:V ^(Y)=^(Y)_U_V,L(+$P(%,U,2))=+V I Z="0;1",DDF(1)=L S B=$P(%,U,4),B=$P(B,";",2)_U_$P(B,";",1) Q:$D(A) W:$X ", " W:$L(DIC)+$X>66 ! W "'"_DIC_"' FIELDS" Q ; Q K ^UTILITY("DIT",$J),DIT,DIC,DA,DFR,DIK,L,FLDS,DHIT KL K DLAYGO,DFN,DMRG,DTO,DTN,DDF,DTL,DFL,DDT,A,B,DKP,W,X,FLDS,Y,Z Q ; PTS ; S DL=0 F X=0:0 S X=$N(^DD(+Y,0,"PT",X)) Q:X'>0 F Z=.001:0 S Z=$N(^DD(+Y,0,"PT",X,Z)) Q:Z'>0 I $D(^DD(X,Z,0)),U_$P(^(0),U,3)=DTO,$P(^(0),U,2)'["I" S DL=DL+1,^UTILITY("DIT",$J,0,DL)=X_U_Z Q ; F W !?7,"(TYPE '^' TO FORGET THE WHOLE THING!)",! C)=DTO,DTO=B,L="TRANSFER ENTRIES",FLDS="",DHD="@",%IS="F",DIOEND="S DIK=DTO(0) D KL^DIT,IXALL^DIK,Q^DIT" D S %=0 W !,"WANT EACH ENTRY TO BE DELETED AS IT'S TRANSFERRED" D YN^DICN S DHIT="S DI=99 D F^DITR"_$P(",^DIK",%,%=1) G Q:%<0 I '% D F G D G EN1^DIP ; T S Z=$P(^(0),U,4),V=$P($P(^(0),U,2),U,Z[";0"),^DD(U,$J,L,Y)=$P(Z,";",2)_U_$P(Z,";",1) S:V ^(Y)=^(Y)_U_V,L(+$P(%,U,2))=+V I Z="0;1",DDF(1)=L S B=$P(%,U,4),B=$P(B,";",2)_U_$P(B,";",1) Q:$D(A) W:$X ", " W:$L(DIC)+$X>66 ! W "'"_DIC_"' FIELDS" Q ; Q K ^UTILITY("DIT",$J),DIT,DIC,DA,DFR,DIK,L,FLDS,DHIT KL K DLAYGO,DFN,DMRG,DTO,DTN,DDF,DTL,DFL,DDT,A,B,DKP,W,X,FLDS,Y,Z Q ; PTS ; S DL=0 F X=0:0 S X=$N(^DD(+Y,0,"PT",X)) Q:X'>0 F ZDIT0 ;GFT/SF ; 20MAY83 10:36 K Y,DIC S DIT=DDF(1),DIC=L,DIC(0)="EQLAM",X="DATA INTO WHICH " D LK G Q:Y<0 S DFR=+Y,DTO(1)=DIC_+Y_",",DIC(0)="EQAM",X="FROM ",DIC("S")="I Y-"_+Y D LK G Q:Y<0 S S %=2 W !," WANT TO DELETE THIS ENTRY AFTER IT'S TRANSFERRED" D YN^DICN G Q:%<0 S DH=2-% I '% D F^DIT G S S ^UTILITY("DIT",$J,+Y)=DFR S DTO=0,DA=+Y,DIK=DIC,DFR(1)=DIC_DA_"," K DIC D WAIT^DICD,GO^DITR S DIT=DH D KL^DIT,^DIK:DH S DA=DFR K DFR D IX1^DIK S DH=DIT D ASK^DITP,PTS^DITP:%=1 Q G Q^DIT ; LK S DIC("A")="TRANSFER "_X_DFL G ^DIC ^(Y)_U_V,L(+$P(%,U,2))=+V I Z="0;1",DDF(1)=L S B=$P(%,U,4),B=$P(B,";",2)_U_$P(B,";",1) Q:$D(A) W:$X ", " W:$L(DIC)+$X>66 ! W "'"_DIC_"' FIELDS" Q ; Q K ^UTILITY("DIT",$J),DIT,DIC,DA,DFR,DIK,L,FLDS,DHIT KL K DLAYGO,DFN,DMRG,DTO,DTN,DDF,DTL,DFL,DDT,A,B,DKP,W,X,FLDS,Y,Z Q ; PTS ; S DL=0 F X=0:0 S X=$N(^DD(+Y,0,"PT",X)) Q:X'>0 F Z DIT1 ; ; 29DEC82 12:19 W ! D WAIT^DICD F A="^DIE(","^DIPT(" F V=0:0 S @("V=$N("_A_"V))") Q:V'>0 I $D(^(V,0)),$P(^(0),U,4)-Y=0 S ^DD(U,$J,A,V)=$P(^(0),U,1) S A="F B=0:0 Q:F=DTO!'$F(W,DTO) S W=$P(W,DTO,1)_F_$P(W,DTO,2,9)",C="F B=0:0 S B=$F(W,""^DD("",B) Q:'B S DTL=+$E(W,B,999),%=B+$L(DTL) S:$D(L(DTL)) W=$E(W,1,B-1)_(DTL#1+DHIT)_$E(W,%,999) S B=%" G GO:$N(^DD(U,$J,-1))<0 W !,"DO YOU WANT TO COPY '",$P(Y,U,2),"' TEMPLATES",!,"INTO YOUR NEW FILE" D YN^DICN W ! I %=1 F DIK="^DIE(","^DIPT(" S @("V=$P("_DIK_"0),U,3)"),%X=DIK_"Z,",%Y=DIK_"V," D ^DIT2,IXALL^DIK GO S V=-1 K %A,%B,%C,%Z ID S V=$N(^DD(+Y,0,"ID",V)) I V'<0 S ^DD(DLAYGO,0,"ID",V)=^(V) G ID S Y=DLAYGO K ^DD(U,$J),^DD(Y,"B"),^(.01),^("IX"),^("RQ"),^(0,"IX") S @("V=$P("_DTO_"0),U,2)"),@("^(0)=$P("_DTO(0)_"0),U,1,2)_$P(V,DDF(1),2)_U_U") DD W ! S L=$N(L(L)),Y=L#1+DHIT Q:L<0 S B=0,V=$N(^DD(L,0,"NM",0)),^DD(Y,0)=^DD(L,0) I V+1,$N(^(0,"NM",0))<0 S ^(V)="" F V=0:0 S V=$N(^DD(L,V)) Q:V'>0 S Z=0,W=^(V,0),D=$P(W,U,2) W "." D Z S DA(1)=Y,DIK="^DD("_Y_"," D IXALL^DIK G DD ; Z I D S L(+D)=D#1+DHIT,W=$P(W,U,1)_U_L(+D)_$P(D,+D,2,9)_U_$P(W,U,3,99) XD X A,C S ^DD(Y,V,Z)=W D S Z=$N(^DD(L,V,Z)) Q:Z<0 I $D(^DD(L,V,Z))<9 S W=^(Z) G XD S:$D(^(Z,0)) ^DD(Y,V,Z,0)=^(0) F D=0:0 S D=$N(^DD(L,V,Z,D)) G D:'$D(^(D,0)) S ^DD(Y,V,Z,D,0)=^(0),I=0 S:^(0)\1=(L\1)&(Z=1) ^(0)=^(0)#1+DHIT_U_$P(^(0),U,2,9) F W=0:0 S I=$N(^DD(L,V,1,D,I)) Q:I<0 S W=^(I) X A,C S ^DD(Y,V,1,D,I)=W  V=$N(^DD(+Y,0,"ID",V)) I V'<0 S ^DD(DLAYGO,0,"ID",V)=^(V) G ID S Y=DLAYGO K ^DD(U,$J),^DD(Y,"B"),^(.01),^("IX"),^("RQ"),^(0,"IX") S @("V=$P("_DTO_"0),U,2)"),@("^(0)=$P("_DTO(0)_"0),U,1,2)_$P(V,DDF(1),2)_U_U") DD W ! S L=$N(L(L)),Y=L#1+DHIT Q:L<0 S B=0,V=$N(^DD(L,0,"NM",0)),^DD(Y,0)=^DD(L,0) I V+1,$N(^(0,"NM",0))<0 S ^(V)="" F V=0:0 S V=$N(^DD(L,V)DIT2 ; TEM F Z=0:0 W "." S Z=$N(^DD(U,$J,DIK,Z)) Q:Z<0 F V=V:1 I @("$N("_%Y_"0))<0") D %XY S @("^(0)=$P("_%Y_"0),U,1,3)_U_DDT(0)_U_$P(^(0),U,5,99)") Q Q %XY ; S %Z=0,%A="",%C(-1)=0 S S %B=-1 N S @("%B=$N("_%X_%A_"%B))"),%C(%Z)=%C(%Z-1) I %B=-1 Q:'%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") S W=^(%B) X A,C S @(%Y_%A_"%B)=W") G DCL:%A="""DCL""," I %A?1"""DR"",".E K ^(%B) S %=$E(%A,6,99)_%B,@(%Y_"""DR"","_+%_","_($P(%,",",2)#1+DHIT)_$P(","_$P(%,",",3,9),U,%Z>2)_")=W") I @("$D("_%X_%A_"%B))<9") G N S:+%B'=%B %B=""""_%B_"""" S %A=%A_%B_",",%Z=%Z+1 G S ; DCL S ^(%B#1+DHIT_U_$P(%B,U,2))=^(%B) K ^(%B) G N L#1+DHIT Q:L<0 S B=0,V=$N(^DD(L,0,"NM",0)),^DD(Y,0)=^DD(L,0) I V+1,$N(^(0,"NM",0))<0 S ^(V)="" F V=0:0 S V=$N(^DD(L,V)DITP ;GFT/SF ; 22JAN84 13:04 ;TRANSFER POINTERS D ASK Q:%-1 G PTS ; ASK ; I '$D(^UTILITY("DIT",$J,0,1)) S %=2 Q S %=$N(^(1)),%Y=+^(1) U I $D(^DD(%Y,0,"UP")) S %Y=^("UP") G U W !,"SINCE THE "_$P("TRANSFERRED^DELETED",U,DH+1)_" ENTRY MAY HAVE BEEN 'POINTED TO'" W !,"BY ENTRIES IN THE '"_$P(^DIC(+%Y,0),U,1)_"' FILE," W:%>1 " ETC.," Q W !,"DO YOU WANT THOSE POINTERS UPDATED (WHICH COULD TAKE QUITE A WHILE)" S %=2 D YN^DICN Q:% W !?4,"ANSWER 'YES' IF YOU THINK THAT THE ENTRY WHICH YOU HAVE JUST "_$P("MOVED^DELETED",U,DH+1),!?4,"MAY BE 'POINTED TO' BY SOME POINTER-TYPE FIELD VALUE SOMEWHERE",! G Q ; PTS ; D WAIT^DICD K IOP P K DR,D,DL,X S (BY,FR,TO)="",X=$N(^UTILITY("DIT",$J,0,0)) I X<0 K ^UTILITY("DIT",$J),DIA,DHD,DR,BY,TO,FR,FLDS,L Q S Y=^(X),L=$P(Y,U,2),DL=1,DL(1)=L_"////^S X=$S('$D(DE(DQ)):"""",$D(^UTILITY(""DIT"",$J,+DE(DQ)))-1:"""",^(+DE(DQ)):^(+DE(DQ)),1:""@"")" K ^(X) S L=$P (^DD(+Y,L,0),U,4),%=$P(L,";",2),L=""""_$P(L,";",1)_"""",DHD=$P(^(0),U,1) I % S %="$P(^("_L_"),U,"_% E S %="$E(^("_L_"),"_+$E(%,2,9)_","_$P(%,",",2) S L=L_")):"""","_%_")?."" "":"""",'$D(^UTILITY(""DIT"",$J,+"_%_"))):"""",1:D" UP S (D(DL),%)=+Y I $D(^DD(%,0,"UP")) S DL=DL+1,Y=^("UP"),(DL(DL),%)=$N(^DD(Y,"SB",%,0))_"///",X(DL)=""""_$P($P(^DD(Y,+%,0),U,4),";",1)_"""",BY=+%_","_BY G UP S DHD=$N(^("NM",0))_" ENTRIES WHOSE '"_DHD_"' POINTERS HAVE BEEN CHANGED",DIC=^DIC(%,0,"GL"),Y="S X=$S('$D("_DIC_"D0," F X=0:1:DL-1 S DR(X+1,D(DL-X))=DL(DL-X) S:X Y=Y_X(DL+1-X)_",D"_X_"," S BY=BY_Y_L_X_")",DHIT="G LOOP^DIA2",DIA("P")=%,L=0,FLDS="",%IS="" D EN1^DIP S IOP=IO G P ="",X=$N(^UTILITY("DIT",$J,0,0)) I X<0 K ^UTILITY("DIT",$J),DIA,DHD,DR,BY,TO,FR,FLDS,L Q S Y=^(X),L=$P(Y,U,2),DL=1,DL(1)=L_"////^S X=$S('$D(DE(DQ)):"""",$D(^UTILITY(""DIT"",$J,+DE(DQ)))-1:"""",^(+DE(DQ)):^(+DE(DQ)),1:""@"")" K ^(X) S L=$PDITR ;GFT/SF ; 22JAN84 12:57 S (DFL,DTL)=DFL-1 Q:'$D(DFN(DFL)) N S @("DFN(DFL)=$N("_DFR(DFL)_"DFN(DFL)))") I $D(^(DFN(DFL)))#2 S Z=^(DFN(DFL)),A=-1 G NS G DITR:DFN(DFL)<0,1:DFL#2,DITR:$D(^(DFN(DFL),0))-1 S Z=^(0),X="D"_(DFL\2),@X=DFN(DFL) I DTO,$D(DSC(DDF(DFL+1))) X DSC(DDF(DFL+1)) E G N D ID G N:A D D NS S A=$N(^DD(DDF(DFL),"GL",DFN(DFL),A)) G N:A<0 S W=$N(^(A,0)) I A S Y=$P(Z,U,A) G NS:Y="" E S Y=$E(Z,+$E(A,2,9),$P(A,",",2)) F %=$L(Y):-1 Q:" "'[$E(Y,%) G NS:'% S Y=$E(Y,1,%-1) I DTO G NS:'$D(^DD(U,$J,DDF(DFL),W)) S B=^(W),DTN(DTL)=$P(B,U,2) E S B=A,DTN(DTL)=DFN(DFL) S X="" I @("$D("_DTO(DTL)_"DTN(DTL)))#2") S X=^(DTN(DTL)) I 'B S W=$E(B,2,9),B=$P(B,",",2) G NS:$E(X,+W,B)'?." "&DKP S %=$E(X,B+1,999),V=W-$L(X)-1,^(DTN(DTL))=$E(X,0,W-1)_$J("",$S(V>0:V,1:0))_Y S:%'?." " ^(DTN(DTL))=^(DTN(DTL))_$J("",B+1-W-$L(Y))_% G NS I DKP,$P(X,U,B)]"" G NS P I $P(X,U,B-1,99)="" S X=X_U G P S W=$P(X,U,B+1,999),^(DTN(DTL))=$P(X,U,1,B-1)_$E(U,B>1)_Y_$S(W]"":U_W,1:"") G NS ; ID S W=DMRG,X=$P(Z,U,1) I X="" S A=1 Q I ^DD(DDT(DTL),.01,0)["DINUM" S V=X X $P(^(0),U,5,99) S X=V I $D(DINUM) S Y=DINUM,W=1 G ON I $P(^(0),U,2)["W" S @("V=$N("_DTO(DTL)_"0))") X:V'>0!'DKP "K "_$E(DTO(DTL),1,$L(DTO(DTL))-1)_") S:$D("_DFR(DFL)_"0)) "_DTO(DTL)_"0)=^(0) F V=0:0 S V=$N("_DFR(DFL)_"V)) Q:V'>0 S:$D(^(V,0)) "_DTO(DTL)_"V,0)=^(0)" S A=1,(DFL,DTL)=DFL-1 Q S Y=@("D"_(DFL\2)) I $D(^DD(DDT(DTL),.001,0)) G ON I @("'$D("_DTO(DTL)_"""B""))") S V=0 F A=1:1 S @("V=$N("_DTO(DTL)_"V))") G NEW:A>20!(V'>0) I $D(^(V,0)),$P(^(0),U,1)=X S Y=V G ON S V=$N(^("B",X,0)) I V>0,@("$D("_DTO(DTL)_"V,0))") S Y=V G ^DITR1:$D(^DD(DDT(DTL),0,"ID")),ON NEW S W=0 ON I @("$D("_DTO(DTL)_"Y))") G OLD:W S Y=Y+1 G ON S @("V="_DTO(DTL)_"0)"),^(0)=$P(V,U,1,2)_U_Y_U_($P(V,U,4)+1),^(Y,0)=X OLD S DTO(DTL+1)=DTO(DTL)_Y_",",DTN(DTL+1)=0,A=0 Q ; 1 G N:$N(^(DFN(DFL),0))'>0 S Z=$N(^DD(DDF(DFL),"GL",DFN(DFL),0,0)) G N:Z'>0 I DTO G N:'$D(^DD(U,$J,DDF(DFL),Z)) S B=^(Z) D D S Y=$P(^DD(DDF(DFL-1),Z,0),U,2),DDF(DFL+1)=+Y I DTO S Y=$P(B,U,3),X=""""_$P(B,U,2)_"""," S DDT(DTL)=+Y,DTO(DTL)=DTO(DTL-1)_X I @("'$D("_DTO(DTL)_"0))") S ^(0)=U_Y G N ; D S DTL=DFL+1 S X=""""_DFN(DFL)_""",",DFR(DFL+1)=DFR(DFL)_X,DFL=DFL+1,DFN(DFL)=0 Q ; F ; S @("Z="_DIK_"D0,0)") W !,$P(^(0),U,1) S:DTO Z=$P(^($P(DTO,U,2)),U,+DTO) I ; S DFL=0,DTL=0,DA=D0 D ID Q:A GO ; S DFL=1,DTL=1,DFN(1)=-1 D N I $D(^(V,0)),$P(^(0),U,1)=X S Y=V G ON S V=$N(^("B",X,0)) I V>0,@("$D("_DTO(DTL)_"V,0))") S Y=V G ^DITR1:$D(^DD(DDT(DTL),0,"ID")),ON NEW S W=0 ON I @("$D("_DTO(DTL)_"Y))") G OLD:W S Y=Y+1 G ON S @("V="_DTO(DTL)_"0)"),^(0)=$P(V,U,1,2)_U_Y_U_($P(V,U,4)+1),^(Y,0)=X OLD S DTO(DTL+1)=DTO(DTL)_Y_",",DTN(DTL+1)=0,A=0 Q ; 1 G N:$N(^(DFN(DFL!DITR1 ;GFT/SF ; 14JAN84 21:05 S V=0 V S V=$N(^DD(DDT(DTL),0,"ID",V)) G OLD^DITR:V'>0,V:'$D(^DD(DDT(DTL),V,0)) K B D P G V:W="" S B=W I DTO S A=$P(A,";",2)_U_$P(A,";",1) F %=0:0 S %=$N(^DD(U,$J,DDF(DFL+1),%)) G V:%'>0 Q:^(%)=A E S %=V G V:'$D(^DD(DDF(DFL+1),%,0)) D P G V:W="",V:W=B S W=0 G ON^DITR ; P S A=$P(^(0),U,4),%=$P(A,";",2),W=$P(A,";",1) I @("'$D("_$S('$D(B):DTO(DTL)_"Y,",DFL:DFR(DFL)_"DFN(DFL),",1:DFR(1))_"W))") S W="" Q I % S W=$P(^(W),U,%) Q S W=$E(^(W),+$E(W,2,9),$P(W,",",2)) I $D(^(V,0)),$P(^(0),U,1)=X S Y=V G ON S V=$N(^("B",X,0)) I V>0,@("$D("_DTO(DTL)_"V,0))") S Y=V G ^DITR1:$D(^DD(DDT(DTL),0,"ID")),ON NEW S W=0 ON I @("$D("_DTO(DTL)_"Y))") G OLD:W S Y=Y+1 G ON S @("V="_DTO(DTL)_"0)"),^(0)=$P(V,U,1,2)_U_Y_U_($P(V,U,4)+1),^(Y,0)=X OLD S DTO(DTL+1)=DTO(DTL)_Y_",",DTN(DTL+1)=0,A=0 Q ; 1 G N:$N(^(DFN(DFLDIU ;GFT/SF ; 30NOV83 15:02 D D^DICRW Q:Y<0 I '$D(DIC) D DIE^DIB Q:'$D(DG) S DIC=DG S DIU=DIC K DICS 0 S DIC="^DOPT(""DIU""," G OPT:$D(^DOPT("DIU",9)) S ^(0)="UTILITY OPTION^1" K ^("B") F X=1:1:9 S ^DOPT("DIU",X,0)=$P("VERIFY FIELDS^CROSS-REFERENCE A FIELD^IDENTIFIER^RE-INDEX FILE^INPUT TRANSFORM (SYNTAX)^EDIT FILE^OUTPUT TRANSFORM^SORT TEMPLATE EDIT^UNEDITABLE DATA",U,X) S DIK=DIC D IXALL^DIK S ^DOPT("DICR",0)="TYPE OF INDEXING^1" F X=1:1:7 S ^DOPT("DICR",X,0)=$P("REGULAR^KWIC^MNEMONIC^MUMPS^SOUNDEX^TRIGGER^BULLETIN",U,X) S DIK="^DOPT(""DICR""," D IXALL^DIK G 0 OPT S DIC(0)="AEQZ" S:DUZ(0)'="@" DIC("S")="I Y-5" D ^DIC I Y>0 K DIC,I,J S N=0,@("DI=+$P("_DIU_"0),U,2)"),J(0)=DI,I(0)=DIU D @+Y W !! Q K DI,DG,DGG,DIC,DIU,DJJ,DIM,DIK,DI,DA,I,J,X,Y Q ; 1 G ^DIV ; 2 S X="C" D DI Q:Y<.002 G ^DICD ; 3 S X="CW.01" D DI Q:Y<0 G 3^DIU1 ; 4 G 4^DIU1 ; 5 S X="W" D DI Q:Y<0 G 5^DIU2 ; 6 G 6^DIU2 ; 7 S X="CW" D DI Q:Y<0 S DIU=1,DJJ=+Y W !,$P(Y,U,2)," OUTPUT TRANSFORM: " I '$D(^(2)) R X E S (DIU,Y)=^(2) S:$D(^(2.1)) Y=^(2.1) W Y D RW^DIED I X="@" W !?9,"DELETED!" K ^(2),^(2.1) S ^(0)=$P(^(0),U,1)_U_$P($P(^(0),U,2),"O",1)_$P($P(^(0),U,2),"O",2)_U_$P(^(0),U,3,99) Q Q:X="" K ^(2) S DICOMPX(1,DI,DJJ)="Y(0)" D DICOMP I $D(X) S ^DD(DI,DJJ,2)="S Y(0)=Y "_X_$P(" S Y=X",U,Y'["X"),^(2.1)=DGG S:$P(^(0),U,2)'["O" ^(0)=$P(^(0),U,1,2)_"O^"_$P(^(0),U,3,99) Q S:'DIU ^DD(DI,DJJ,2)=DIU X W *7,"??" Q ; 8 G 1^DIBT ; 9 S X="WC" D DI Q:Y<0 G 9^DIU3 ; DICOMP S DA=DIC_DJJ_",2,",DGG=X,DQI="Y(" D ^DICOMP K DQI,DBOOL,DICOMPX F %=9.2:.1 Q:'$D(X(%)) S @(DA_"%)=X(%)") Q ; DI S DIC(0)="ZQEA" D ; S DIC="^DD("_DI_",",DIC("W")="S %=$P(^(0),U,2) I % W $S($P(^DD(+%,.01,0),U,2)[""W"":"" (word-processing)"",1:"" (multiple)"")" S DIC("S")="S %=$P(^(0),U,2) I 1"_$P(",%'[""C""",U,X["C")_$P(",$P(^DD(+%,.01,0),U,2)'[""W""",9,X["W")_$P(",Y>.01",U,X[.01) D ^DIC K DIC("S") I Y>0,$P(Y(0),U,2) S N=N+1,X=$P($P(Y(0),U,4),";",1),DI=$E("""",+X'=X),I(N)=DI_X_DI,(DI,J(N))=+$P(Y(0),U,2) G DI ) S DICOMPX(1,DI,DJJ)="Y(0)" D DICOMP I $D(X) S ^DD(DI,DJJ,2)="S Y(0)=Y "_X_$P(" S Y=X",U,Y'["X"),^(2.1)=DGG S:$P(^(0),U,2)'["O" ^(0)=$P(^(0),U,1,2)_"O^"_$P(^(0),U,3,99) Q S:'DIU ^DD(DI,DJJ,2)=DIU X W *7,"??" Q ; 8 G 1^DIBT ; 9 S X="WC" D DI Q:Y<0 G 9^DIU3 ; DICOMP S DA=DIC_DJJ_",2,",DGG=X,DQI="Y(" D ^DICOMP K DQI,DBOOL,DICOMPX F %=9.2:.1 Q:'$D(X(%)) S @(DA_"%)=X(%)") Q ; DI S DIC(0)="ZQEA" D ; S DIC="^DD("_DI_",",DIC("W")="S %=$P(^(0),U,2) I % W $S($P(^DD(+%,.01,0),U,2)[""W"":"" (word-processing)"",1:"" (multiple)"")" S D!DIU1 ;GFT/SF ; 20DEC83 11:34 X W *7,"??" Q ; 3 S %=2,X="W """"" I $D(^DD(DI,0,"ID",+Y)) W !,"'",$P(Y,U,2),"' IS ALREADY AN IDENTIFIER; WANT TO DELETE IT" D YN^DICN K:%=1 ^DD(DI,0,"ID",+Y) Q W !,"WANT TO MAKE '",$P(Y,U,2),"' AN IDENTIFIER" D YN^DICN Q:%-1 S %=$N(^DD(DI,0,"NM",0)) W !,"WANT TO DISPLAY "_$P(Y,U,2)_" WHENEVER A LOOKUP",!," IS DONE ON A"_$E("N","AEIOU"[$E(%,1))_" '"_%_"' ENTRY" S %=1 D YN^DICN G X:%<1,S:%=2 S X=$P(Y(0),U,4),%="(^("""_$P(X,";",1)_""")",%Y=$P(X,";",2),X="$"_$S(%Y:"P"_%_",U,"_%Y,1:"E"_%_","_+$E(%Y,2,9)_","_$P(%Y,",",2))_")" I $P(Y(0),U,2)["D" S X="$E("_X_",4,5)_""-""_$E("_X_",6,7)_""-""_$E("_X_",2,3)" I $P(Y(0),U,2)["P" S X="$S($D(^"_$P(Y(0),U,3)_"+"_X_",0))#2:$P(^(0),U,1),1:""""),@(""$E(""_DIC_""Y,0),0)"")" S X="W:$D"_%_") "" "","_X S S ^DD(DI,0,"ID",+Y)=X,X=DIU I N S V=N,W="0;1",P=$N(^DD(J(N-1),"SB",DI,0)),X="^DD(J(N-1),P," S @("X="_X_"0)"),%=$P(X,U,2) I %'["I" S ^(0)=$P(X,U,1)_U_%_"I"_U_$P(X,U,3,99) I N D WAIT^DICD,0^DIVR S:DE?.E1" " DE=$E(DE,1,$L(DE)-2) X DE K DE,DA,X,W Q ; 4 W !! S DIK=DIU,X=0 D DD^DIK S DW=0,DDD=DI DW S %=0,DW=$N(^UTILITY("DIK",$J,DW)),DV=0 I DW>0 F DU=0:0 S DV=$N(^UTILITY("DIK",$J,DW,DV)),DH=0 G DW:DV<0 F Y=0:0 S DH=$N(^UTILITY("DIK",$J,DW,DV,DH)) Q:DH<0 S Y=^(DH) S:Y?.E1"^"1E.E&Y X=X+1,X(X)=Y K ^UTILITY("DIK",$J) G DD:'X W "FIRST, ARE YOU SURE YOU WANT TO KILL OFF THE EXISTING ",$S(X=1:$P(^DD(+X(1),$N(^($N(^DD(+X(1),0,"IX",$P(X(1),U,2),0)),0)),0),U,1)_" INDEX",1:X_" INDICES") D YN^DICN Q:%-1 W !,"DO YOU THEN WANT TO 'RE-CROSS-REFERENCE'" D YN^DICN Q:%<1 S N=%=1 D WAIT^DICD F X=X:-1:1 I +X(X)=DI K @(DIK_"$P(X(X),U,2))"),X(X) I $N(X(0))>-1 S X=2,(DA,DCNT)=0 D DD^DIK,CNT^DIK1 K X Q:'N W !,*7,"FILE WILL NOW BE 'RE-CROSS-REFERENCED'..." H 5 D DD S DIK=^DIC(DDD,0,"GL") G IXALL^DIK ; DD S DIK="^DD(DI,",DA(1)=DI K ^DD(DI,"B"),^("GL"),^("IX"),^("RQ"),^("GR"),^("SB") W "." D IXALL^DIK:$D(^(0))#2 S DI=$N(^DD(DI)) I DI>0,DI<$N(^DIC(DDD)) G DD  ; 4 W !! S DIK=DIU,X=0 D DD^DIK S DW=0,DDD=DI DW S %=0,DW=$N(^UTILITY("DIK",$J,DW)),DV=0 I DW>0 F DU=0:0 S DV=$N(^UTILITY("DIK",$J,DW,DV)),DH=0 G DW:DV<0 F Y=0:0 S DH=$N(^UTILITY("DIK",$J,DW,DV,DH)) Q:DH<0 S Y=^(DH) S:Y?.E1"^"1E.E&Y X=X+1,X(X)=Y K ^UTILITY("DIK",$J) G DD:'X W "FIRST, ARE YOU SURE YOU WANT TO KILL OFF THE EXISTING ",$S(X=1:$P(^DD(+X(1),$N(^($N(^DD(+X(1),0,"IX",$P(X(1),U,2),0)),0)),0),U,1)_" INDEX",1:X_" INDICES") D YN^DICN Q:%-1 W !,"DO YOU THEN WANT TO 'RE-CROSS-REFERENCE'" D YN^DICN Q:%<1 S N=%=1 D WAIT^DICD F X=X:-1:1 I +X(X)=DI K @(DIK_"$P(X(X),U,2))"),X(X) I $N(X(0))>-1 S X=2,(DA,DCNT)=0 D DD^DIK,CNT^DIK1 K X Q:'N W !,*7,"FILE WILL NOW BE 'RE-CROSS-REFERENCED'..." H 5 D DD S DIK=^DIC(DDD,0,"GL") G IXALL^DIK ; DD S DIK="^DD(DI,",DA(1)=DI K ^DD(DI,"B"),^("GL"),^("IX"),^("RQ"),^("GR"),^("S"DIU2 ;GFT/SF ; 22JAN84 11:58 5 W !,$P(Y,U,2) S DA=+Y,Y=$P(Y(0),U,5,99) W " INPUT TRANSFORM: ",Y D RW^DIED Q:X="" D ^DIM I $D(X) S ^(0)=$P(Y(0),U,1,2)_$E("X",$P(Y(0),U,2)'["X")_U_$P(Y(0),U,3,4)_U_X,DR="3:4",DIE=DIC Q:$P(Y(0),U,2)["C" D DIEZ G ^DIE X W *7,"??" Q ; DIEZ ; S %=$N(^DIE("AF",DI,DA,0)) I %>0 K ^(%),^DIE(%,"ROU") G DIEZ S:$S($D(^DIC(J(0),0,"DT")):^("DT"),1:0)-DT ^DD(DI,DA,"DT")=DT Q ; 6 S DIE=1,DR=".01:10",(A,DA)=DI D ^DIE G Q:$D(Y),N:$D(DA) S Y=$L(DIU),Y=$E(DIU,1,Y-1)_$E(")",$E(DIU,Y)=","),DQ(A)=0,%=0 I '$P(Y,"^DIC(",2) W !," OK TO DELETE THE '",Y,"' GLOBAL" D YN^DICN K:%=1 @Y D WAIT^DICD,KDD^DICATT F DIK="^DIE(","^DIPT(","^DIBT(" F DA=.9:0 S @("DA=$N("_DIK_"DA))") Q:DA'>0 S %=$P(^(DA,0),U,4) I %,'$D(^DD(%)) W "." D ^DIK Q N S X=$P(^DIC(DA,0),U,1),@("D="_DIU_"0)"),^(0)=X_U_$P(D,U,2,9) K ^DD(+$P(D,U,2),0,"NM") S ^("NM",X)="" I DUZ(0)]"" F DR=1:1:5 S D=$P("DD^RD^WR^DEL^LAYGO",U,DR),Y=$S($D(^DIC(DA,0,D)):^(D),1:"") D RW S @("DR="_DIU_"0)"),D=$P(DR,U,2),%=D'["O"+1 W !,"ASK 'OK' WHEN LOOKING UP AN ENTRY" D YN^DICN I %>0 S ^(0)=$P(DR,U,1)_U_$P(D,"O",1)_$E("O",%)_$P(D,"O",2)_U_$P(DR,U,3,99) Q Q ; K S %=2,@("DG="_DIU_"0)") I $P(DG,U,4)>1 W *7,!,"DO YOU WANT JUST TO DELETE THE ",$P(DG,U,4)," FILE ENTRIES,",!?9,"& KEEP THE FILE DEFINITION" D YN^DICN I %=1 G KL Q KL K % S %=$L(DIU),%=$E(DIU,1,%-1)_$E(")",$E(DIU,%)=","),%Y="%(",%X=DIU_"0," D %XY^%RCR K @% S @(DIU_"0)=$P(DG,U,1,2)_U"),^DIC(DA,0,"GL")=DIU,%X="%(",%Y=DIU_"0," D %XY^%RCR K % I 1 Q ; RW W !,$P("DATA DICTIONARY^READ^WRITE^DELETE^LAYGO",U,DR)," ACCESS: " G R:Y="" W Y I DUZ(0)'="@" F X=1:1:$L(Y) G Q:DUZ(0)'[$E(Y,X) W "// " R R X Q:X="" I X["@" G V:Y="" W *7," PROTECTION ERASED!" K ^(D) Q I X[U S DR=9 Q I X["?" W !,"ENTER CODE(S) TO RESTRICT USER'S ACCESS TO THIS FILE" G RW V I DUZ(0)'="@" F Z=1:1:$L(X) I DUZ(0)'[$E(X,Z) D X G RW S ^(D)=X Q K' WHEN LOOKING UP AN ENTRY" D YN^DICN I %>0 S ^(0)=$P(DR,U,1)_U_$P(D,"O",1)_$E("O",%)_$P(D,"O",2)_U_$P(DR,U,3,99) Q Q ; K S %=2,@("DG="_DIU_"0)") I $P(DG,U,4)>1 W *7,!,"DO YOU WANT JUST TO DELETE THE ",$P(DG,U,4)," FILE ENTRIES,",!?9,"& KEEP THE FILE DEFINITION" D YN^DICN I %=1 G KL Q KL K % S %=$L(DIU),%=$E(DIU,1,%-1)_$E(")",$E(DIU,%)=","),%Y="%(",%X=DIU_"0," D %XY^%RCR K @% S @(DIU_"0)=$P(DG,U,1,2)_U"),^DIC(DA,0,"GL")=DIU,%X="%(",%Y=DIU_"0," D %XY^%RCR K % I 1 Q ; RW W !,$P("DATA DICTIONARY^READ^WRITE^DELETE^LAYGO",U,DR)," ACCESS: " G R:Y="" W Y I DUZ(0)'="@" F X=1:1:$L(Y) G Q:DUZ(0)'[$E(Y,X) W "// " R R X Q:X="" I X["@" G V:Y="" W *7," PROTECTION ERASED!" K ^(D) Q I X[U S DR=9 Q I X["?" W !,"ENTER CODE(S) TO RESTRICT USER'S ACCESS TO THIS FILE" G RW V I DUZ(0)'="@" F Z=1:1:$L(X) I DUZDIU3 ;GFT/SF ; 26JAN83 18:40 9 S %=2 I $P(Y(0),U,2)["I" W !,*7,"FIELD IS ALREADY UNEDITABLE",!,"DO YOU WANT TO ALLOW EDITING AGAIN" D YN^DICN Q:%-1 S X=$P(^(0),U,2),^(0)=$P(^(0),U,1)_U_$P(X,"I",1)_$P(X,"I",2)_$P(X,"I",3)_U_$P(^(0),U,3,99) W " ..OK" Q W !,"WANT TO PREVENT ALL USERS FROM CHANGING OR DELETING DATA VALUES",! W "THAT ARE ENTERED FOR THE '"_$P(Y,U,2)_"' FIELD" D YN^DICN Q:%-1 S ^(0)=$P(^(0),U,1,2)_"I^"_$P(^(0),U,3,99) W *7,!?9,"...FIELD IS NOW UNEDITABLE!" Q  ; RW W !,$P("DATA DICTIONARY^READ^WRITE^DELETE^LAYGO",U,DR)," ACCESS: " G R:Y="" W Y I DUZ(0)'="@" F X=1:1:$L(Y) G Q:DUZ(0)'[$E(Y,X) W "// " R R X Q:X="" I X["@" G V:Y="" W *7," PROTECTION ERASED!" K ^(D) Q I X[U S DR=9 Q I X["?" W !,"ENTER CODE(S) TO RESTRICT USER'S ACCESS TO THIS FILE" G RW V I DUZ(0)'="@" F Z=1:1:$L(X) I DUZ"DIV ;GFT/SF ; 27SEP83 20:38 K J S Q="""",S=";",V=0,P=0,I(0)=DIU,@("(A,J(0))=+$P("_DIU_"0),U,2)") I $N(^(0))'>0 W *7," NO ENTRIES ON FILE!" Q DIC S DIC="^DD(A,",DIC(0)="EZ",DIC("S")="S %=$P(^(0),U,2) I %'[""C"",$S('%:1,1:$P(^DD(+%,.01,0),U,2)'[""W"")",DIC("W")="W:$P(^(0),U,2) "" (multiple)""" W !,"VERIFY WHICH "_$P(^DD(A,0),U,1)_": " R X Q:U[X D ^DIC K DQI,^DD(U,$J) I Y<0 G DIC:X'="ALL" F DQI=0:0 S DQI=$N(^DD(A,DQI)) G Q^DIVR:DQI'>0 S P=0,Y=DQI,Y(0)=^(Y,0),DR=$P(Y(0),U,2) I 'DR,DR'["C" W !!!,"--",$P(Y(0),U,1)," FIELD--" D 1 S DR=$P(Y(0),U,2) I DR S J(V)=A,P=+Y,V=V+1,A=+DR,I(V)=$P($P(Y(0),U,4),S,1) S:+I(V)'=I(V) I(V)=Q_I(V)_Q G DIC 1 F T="N","D","P","S","F" Q:DR[T K DA S Z=$P(Y(0),U,3),W=$P(Y(0),U,4),C=$P(Y(0),U,5,99),DA=+Y G ^DIVR =9 Q I X["?" W !,"ENTER CODE(S) TO RESTRICT USER'S ACCESS TO THIS FILE" G RW V I DUZ(0)'="@" F Z=1:1:$L(X) I DUZDIVR ; ; 30APR83 19:49 W ! S T=$E(T,1) G E:'$D(^($N(^DD(A,DA,1,0)),1)) I $P(^(0),U,2,9)?1A.A,^(2)?1"K ^".E1")",^(1)?1"S ^".E W "(CHECKING" S DG="I $D("_$E(^(2),3,99)_"),"_$E(^(1),3,99),E=T,T="IX" E W *7,"(CANNOT CHECK" W " CROSS-REFERENCE)",! E S D001=$D(^DD(A,.001)),Y=$F(C,"%DT=""E") S:Y C=$E(C,1,Y-2)_$E(C,Y,999) I DR["P" S C="Q" I $D(^(DA,12.1)) X ^(12.1) I $D(DIC("S")) S C(1)=DIC("S"),C="X C(1) E K X" D 0 S X=$P(W,S,1),Y=$P(W,S,2) I +X'=X S X=Q_X_Q I Y="" S DE=DE_"S X=DA D R" G XEC S M="S X=$S($D(^(DA,"_X_")):$"_$S(Y:"P(^("_X_"),U,"_Y,1:"E(^("_X_"),"_$E(Y,2,9))_"),1:"""") D R" I $L(M)+$L(DE)>250 S DE=DE_"X DE(1)",DE(1)=M E S DE=DE_M XEC K DIC,M,Y X DE Q:$D(DQI) W:'$D(M) *7,!,$P("NO PROBLEMS^ALL OK^NO INCONSISTENCIES^EVERYTHING HUNKY-DORY^ALL DATA CHECKS OUT",U,$R(5)+1) Q S M=$N(^DD(U,$J,0)),E=$N(^(M)),DK=J(0) I E>0 R !,"STORE THESE ENTRY ID'S IN TEMPLATE: ",X I U'[X D DIBT1^DII G Q:Y<0 F C=0:0 S C=$N(^DD(U,$J,C)) Q:C<0 S ^DIBT(+Y,1,C)="" K DQI,DK,D001,DA,DG,DQ,DE,T,P,E,M,DR,W,C Q ; R I X?." " Q:DR'["R" S M="MISSING" G X G @T ; P I @("$D(^"_Z_"X,0))") S Y=X,X=$P(^(0),U,1) G F S M="NO '"_X_"' IN POINTED-TO FILE!" G X ; S Q:S_Z[(S_X_":") S M=Q_X_Q G X ; D S Y=X,X=$E(Y,1,3)+1700,%=$E(Y,6,7) S:% X=%_"-"_X S:$E(Y,4,5) X=+$E(Y,4,5)_"-"_X S:Y["." X=X_"@"_$E(Y_"000",9,12) N ; F S DQ=X I X'?.ANP S M="NON-PRINTING CHARACTER" G X X C Q:$D(X) S M=Q_DQ_Q X W !,*7 S X=$S(V:DA(V),1:DA),^DD(U,$J,X)="" I D001 W X," " S X=V I @(I(0)_"0)") DA I 'X W:W'="0;1" $S($D(^(DA,0)):$P(^(0),U,1),1:DA),": " W M Q W $P(^(DA(X),0),U,1)," " S X=X-1,@("Y=^("_I(V-X)_",0)") G DA ; 0 ; S Y=I(0),DE="",X=V L S DA="DA" S:X DA=DA_"("_X_")" S Y=Y_DA,DE=DE_"F "_DA_"=0:0 S "_DA_"=$N("_Y_")) Q:"_DA_"'>0 " I X=1,W="0;1" S DE=DE_"X P:$D(^(DA(1),"_I(V)_",0)) ",P=$P(^DD(J(V#-1),P,0),U,2) S X=X-1 I X+1 S Y=Y_","_I(V-X)_"," G L S P="S ^(0)=$P(^(0),U,1)_U_"""_P_"""_U_$P(^(0),U,3,99)" Q ; IX X DG I G @E S M=Q_X_Q_" NOT PROPERLY CROSS-REFERENCED" G X TO FILE!" G X ; S Q:S_Z[(S_X_":") S M=Q_X_Q G X ; D S Y=X,X=$E(Y,1,3)+1700,%=$E(Y,6,7) S:% X=%_"-"_X S:$E(Y,4,5) X=+$E(Y,4,5)_"-"_X S:Y["." X=X_"@"_$E(Y_"000",9,12) N ; F S DQ=X I X'?.ANP S M="NON-PRINTING CHARACTER" G X X C Q:$D(X) S M=Q_DQ_Q X W !,*7 S X=$S(V:DA(V),1:DA),^DD(U,$J,X)="" I D001 W X," " S X=V I @(I(0)_"0)") DA I 'X W:W'="0;1" $S($D(^(DA,0)):$P(^(0),U,1),1:DA),": " W M Q W $P(^(DA(X),0),U,1)," " S X=X-1,@("Y=^("_I(V-X)_",0)") G DA ; 0 ; S Y=I(0),DE="",X=V L S DA="DA" S:X DA=DA_"("_X_")" S Y=Y_DA,DE=DE_"F "_DA_"=0:0 S "_DA_"=$N("_Y_")) Q:"_DA_"'>0 " I X=1,W="0;1" S DE=DE_"X P:$D(^(DA(1),"_I(V)_",0)) ",P=$P(^DD(J(VDIWE ;RWF/SLC,GFT/SF ; 29NOV83 11:10 O $I U $I S DWPK=0,DIC=$S($D(DIC)[0:"^TX(%T1,%T2,",DIC["%T1,%T2,":DIC,1:DIC_"%T1,%T2,") WHO D NAME Q:%T1="" WHAT D TX Q:%T2="" D EN L G WHAT ; EN D A L @(DIC_"0)"):1 E W !,"FILE IS IN USE BY ANOTHER TERMINAL" G Q GO I $D(DT)[0 S X="T",%DT="" D ^%DT S DT=Y S @(DIC_"0)")=DWLC G ^DIWE1:DWLC D ^DIWE2 S (DWL,DWLC)=DWI G GO:DWL,X ; DIEN ; S DH=$P(Y,U,1),DV=DG,DWPK="FM",(DIC,Y)=DIE_DA_",DV",DWO="ABCDEIJLMPRST"_$E("Y",DUZ(0)="@") D A G W:'$D(DE(1,0)) S X=DE(1,0),DWI=X?1"/".E S:DWI X=$E(X,2,999) I X?1"+".E S X=$E(X,2,999) E G W:'DWI&DWLC K:DWLC @(Y_")") S DWLC=0 Q:X="@" I X?1"^".E S DW=DIC,DICMX="S DWLC=DWLC+1,"_DW_",DWLC,0)=X" X $E(X,2,999) S DIC=DW,X="" K DICMX S:X]"" DWLC=DWLC+1,@(DIC_"DWLC,0)=X") G X:DWI W W !?DL+DL-2,DH_":" G GO ; A S:$E(DIC,$L(DIC))'="," DIC=DIC_"," S:'$D(DWO) DWO="ABCDEIJLMPRSTYFT" S @("J=$N("_DIC_"0))>0") I '$D(^(0))!'J S ^(0)="" K DWL S U="^",DWHD=^(0)_U,DWLC=+$P(DWHD,U,3),DWLW=$S($D(DWLW):DWLW,1:75) I J D REPACK:DWLC-$P(DWHD,U,4)!'DWLC!'$D(^(DWLC)) S DWPK=$S($D(DWPK):DWPK,1:2),DWLR=256,DWLC=$S('DWLC:+DWHD,1:DWLC) Q ; REPACK K ^UTILITY($J,"W") S J=0 F I=0:0 S @("J=$N("_DIC_"J))") Q:J'>0 S:$D(^(J,0)) I=I+1,^UTILITY($J,"W",I)=^(0) W "." K @($E(DIC,1,$L(DIC)-1)_")") F J=1:1:I S @(DIC_"J,0)=^UTILITY($J,""W"",J)") W "." K ^UTILITY($J,"W") S DWLC=I Q ; NAME R !!!,"PLEASE ENTER YOUR INITIALS: ",%T1 Q:%T1="" I %T1'?1A.A D WL^DIWE5 G NAME S DW=$P(DIC,",%T2",1) I '$D(@(DW_")")) R !,"CREATE NEW INITIALS? N//",X G NAME:X'?1"Y".E S @(DW_")")="" Q ; TX ; R !!,"ENTER YOUR TEXT NAME: ",%T2 Q:%T2="" S DW=$E(DIC,1,$L(DIC)-1) I %T2'?1AN.E D NL^DIWE5 G TX I '$D(@(DW_")")) R !,"IS THIS TO BE A NEW TEXT FILE? N//",X G TX:X'?1"Y".E Q ; X ; I @("$N("_DIC_"0))'>0") K @($E(DIC,1,$L(DIC)-1)_")") G Q S ^(0)=$P(DWHD,U,1,2)_U_DWLC_U_DWLC_U_DT_U_$P(DWHD,U,6,9) Q K DW2,DWO,DWLR,DWHD,DWL,DWPK,DWI,DWJ,DWLC UTILITY($J,"W") S J=0 F I=0:0 S @("J=$N("_DIC_"J))") Q:J'>0 S:$D(^(J,0)) I=I+1,^UTILITY($J,"W",I)=^(0) W "." K @($E(DIC,1,$L(DIC)-1)_")") F J=1:1:I S @(DIC_"J,0)=^UTILITY($J,""W"",J)") W "." K ^UTILITY($J,"W") S DWLC=I Q ; NAME R !!!,"PLEASE ENTER YOUR INITIALS: ",%T1 Q:%T1="" I %T1'?1A.A D WL^DIWE5 G NAME S DW=$P(DIC,",%T2",1) I '$D(@(DW_")")) R !,"CREATE NEW INITIALS? N//",X G NAME:X'?1"Y".E S @(DW_")")="" Q ; TX ; R !!,"ENTER YOUR TEXT NAME: ",%T2 Q:%T2="" S DW=$E(DIC,1,$L(DIC)-1) I %T2'?1AN.E D NL^DIWE5 G TX I '$D(@(DW_")")) R !,"IS THIS TO BE A NEW TEXT FILE? N//",X G TX:X'?1"Y".E Q ; X ; I @("$N("_DIC_"0))'>0") K @($E(#DIWE1 ; ; 26JAN84 16:09 I '$D(DWL) S I=DWLC,J=$S(I<11:1,1:I-8) W:J>1 ?7,". . .",!?7,". . ." D LL 1 R !,"EDIT Option: ",X G X:U[X!(X=".") I X?1L S X=$C($A(X)-32) S J="^DOPT(""DIWE1""," I X?1U S I=$F(DWO,X)-1 I I>0 S ^DISV($I,J)=I G OPT I X=" ",$D(^DISV($I,J)) S I=^(J),X=$E(DWO,I) I X]"" W X G OPT I X?1N.N S I=5 D LN G E2:X W "OR" W !,"CHOOSE, BY FIRST LETTER, ONE OF THE FOLLOWING:" F I=1:1 S Y=$T(OPT+I),J=$E(Y,1) Q:J=" " I DWO[J W !?5,$P(Y,";",3) W !,"OR TYPE A LINE NUMBER TO EDIT THAT LINE" G 1 ; OPT S X=$P($T(OPT+I),";",2) W $E(X,'$X)_$E(X,2,99) G OPT+I A D ^DIWE2 S (DWL,DWLC)=DWI,@(DIC_"0)=DWLC") G 1:DWLC,X ;Add lines;ADD LINES TO END OF TEXT B D RD G B^DIWE4 ;Break line: ;BREAK A LINE IN TWO C G C^DIWE2 ;Change every: ;CHANGE EVERY STRING TO ANOTHER IN A RANGE OF LINES D D RD G D^DIWE3 ;Delete from line: ;DELETE LINE(S) E D RD G OPT:X="",1:X=U,E2 ;Edit line: ;EDIT A LINE (Replace __ With __) I D RD G I^DIWE2 ;Insert after line: ;INSERT LINE(S) AFTER AN EXISTING LINE J D RD G J^DIWE4 ;Join line: ;JOIN LINE TO THE ONE FOLLOWING L R X S:X="" X=1 D LN G LIST:X,1:X=U,L ;List line: 1//;LIST A RANGE OF LINES M D RD G M^DIWE3 ;Move line: ;MOVE LINES TO NEW LOCATION WITHIN TEXT P R X S:X="" X=1 D LN,^DIWE4:X G 1 ;Print from Line: 1//;PRINT LINES AS FORMATTED OUTPUT R D RD G R^DIWE3 ;Repeat line: ;REPEAT LINES AT A NEW LOCATION S G S^DIWE2 ;Search for: ;SEARCH FOR A STRING T D RD,Z^DIWE3 G DIWE1 ;Transfer incoming text after line: ;TRANSFER LINES FROM ANOTHER DOCUMENT Y G Y^DIWE4 ;Y;Y-PROGRAMMER EDIT F D F^DIWE5 G 1 ; E2 S Y=^(0) S:Y="" Y=" " W !,$J(DWL,3)_">"_Y,! D RW^DIED TAB I X[$C(9) S X=$P(X,$C(9),1)_$C(124)_"TAB"_$C(124)_$P(X,$C(9),2,999) G TAB S:X]"" ^(0)=X I X="@" S (DW1,DW2)=DWL W "DELETED..." D DEL^DIWE3 W ! S I=5 G OPT ; RD R X LN I U[X!(X=".") S X=U Q I "+- "[$E(X,1),X?1P.N,$D(DWL) S:X?1P X=X_1 S X=X+DWL W " "_X E S X=+X I @("I=6!(I=12)&(X=0)!$D("_DIC_"X,0))") S DWL=X Q S X="" G LNQ^DIWE5 ; X G X^DIWE ; LIST W " to: "_DWLC_"// " R I I I>DWLC!(I<1) S I=DWLC S J=X D LL G 1 LL X "F J=J:1:I W !,$J(J,3)_"">""_"_DIC_"J,0)"  AS FORMATTED OUTPUT R D RD G R^DIWE3 ;Repeat line: ;REPEAT LINES AT A NEW LOCATION S G S^DIWE2 ;Search for: ;SEARCH FOR A STRING T D RD,Z^DIWE3 G DIWE1 ;Transfer incoming text after line: ;TRANSFER LINES FROM ANOTHER DOCUMENT Y G Y^DIWE4 ;Y;Y-PROGRAMMER EDIT F D F^DIWE5 G 1 ; E2 S Y=^(0) S:Y="" Y=" " W !,$J(DWL,3)_">"_Y,! D RW^DIED TAB I X[$C(9) S X=$P(X,$C(9),1)_$C(124)_"TAB"_$C(124)_$P(X,$C(9),2,999) G TAB S:X]"" ^(0)=X I X="@" S (DW1,DW2)=DWL W "DELETED..." D DEL^DIWE3 W ! S I=5 G OPT ; RD R X LN I U[X!(X=".") S X=U Q I "+- "[$$DIWE2 ;RWF/SLC,GFT/SF ; 20DEC83 12:30 S DWI=DWLC,DWJ=0,DWLR=DWLW NEWL W !,$J(DWJ+DWI+1,3),">" R X:$S($D(DTIME)#2:DTIME,1:600) Q:U[X I X?."?" D IQ^DIWE5 G NEWL TAB I X[$C(9) S X=$P(X,$C(9),1)_$C(124)_"TAB"_$C(124)_$P(X,$C(9),2,999) G TAB:X[$C(9),NW G NW:'DWPK,NW:X?." "!($A(X)=124) S:DWI Y=@(DIC_DWI_",0)") S J=$L(X) I J+DWLRDWLW S J=$F(X," ",DWLW-7) I J>1 S DWI=DWI+1,@(DIC_"DWI,0)")=$E(X,1,J-1),X=$E(X,J,256),DWLR=J G NL S:$L(X) DWI=DWI+1,@(DIC_"DWI,0)")=X,DWLR=$L(X) G NEWL NW S:$L(X) DWI=DWI+1,@(DIC_"DWI,0)")=X,DWLR=DWLW G NEWL ; I ;INSERT G 1:X=U,OPT^DIWE1:X="" S DWJ=X W:X !,$J(DWJ,3),">",^(0) K ^UTILITY($J,"W") S DWI=0,DIC(1)=DIC,DIC="^UTILITY($J,""W"",",@(DIC_"0)")="",DWLR=DWLW D NEWL W !,DWI_" line"_$E("s",DWI'=1)_" inserted.." X "F DWL=DWI+DWLC:-1:DWJ+DWI+1 S "_DIC(1)_"DWL,0)="_DIC(1)_"DWL-DWI,0) W "".""" X "F DWL=DWI:-1:1 S "_DIC(1)_"DWJ+DWL,0)="_DIC_"DWL,0) W "".""" S DWLC=DWLC+DWI,DIC=DIC(1) K ^UTILITY($J,"W"),DIC(1) 1 G ^DIWE1 ; S ;SEARCH R X I X]"" W " ...",! X "F I=1:1:DWLC I "_DIC_"I,0)[X W $J(I,3)_"">""_^(0),! S DWL=I" G 1^DIWE1 ; C ;CHANGE R DWI G 1:DWI="" R " to: ",DWJ W !,"Ask 'OK' for each line found" S %=2 D YN^DICN G 1:%<1 FR R !,"From line: 1// ",X I X="" S J=1 G TO D LN^DIWE1 G FR:X="",1:X=U S J=X TO W " to line: "_DWLC_"// " R I I I="" S I=DWLC I IDWLC S I=DWLC W " ("_I_")" W " ...",! X "F J=J\1:1:I I "_DIC_"J,0)[DWI D C1" G 1 C1 S Y=0,DWL=^(0) I %=1 W $J(J,3)_">"_DWL R !,"OK to change? YES// ",X,! Q:"YESyes"'[X C2 S Y=$F(DWL,DWI,Y) I Y S DWL=$E(DWL,1,Y-$L(DWI)-1)_DWJ_$E(DWL,Y,999),Y=Y-$L(DWI)+$L(DWJ) G C2 W $J(J,3)_">"_DWL,! S ^(0)=DWL,DWL=J ".""" X "F DWL=DWI:-1:1 S "_DIC(1)_"DWJ+DWL,0)="_DIC_"DWL,0) W "".""" S DWLC=DWLC+DWI,DIC=DIC(1) K ^UTILITY($J,"W"),DIC(1) 1 G ^DIWE1 ; S ;SEARCH R X I X]"" W " ...",! X "F I=1:1:DWLC I "_DIC_"I,0)[X W $J(I,3)_"">""_^(0),! S DWL=I" G 1^DIWE1 ; C ;CHANGE R DWI G 1:DWI="" R " to: ",DWJ W !,"Ask 'OK' for each line found" S %=2 D YN^DICN G 1:%<1 FR R !,"From line: 1// ",X I X="" S J=1 G TO D LN^DIWE1 G FR:X="",1:X=U S J=X TO W " to line: "_DWLC_"// " R I I I="" S I=DWLC I IDWLC S I=DWLC W " ("_I_")" W " ...",! X "F J=J\1:1:I I "_DIC_"J,0)[DWI D C1" G 1 C1 S Y=0,DWL=^(0) I %=1 W $J(J,3)_">"_DWL R !,"OK to change? YES// ",X,! Q:"YESyes"'[X C2 S Y=$F(DWL,DWI,Y) I Y S DWL=$E(DWL,1,Y-$L(DWI)-1)_DWJ_$E(DWL,DIWE3 ;RWF/SLC, GFT/SF ; 09 DEC 83 2:00 PM M ;MOVE S DWAFT=1 G 1:X=U,OPT:'X D MOVE S:DW1>DW3 DW1=DW1+I,DW2=DW2+I D DEL:DW1 1 G ^DIWE1 ; OPT W ! G OPT^DIWE1 ; R ;REPEAT S DWAFT=1 G 1:X=U,OPT:'X D MOVE G 1 ; D ;DELETE S DW1=X G 1:X=U,OPT:'X R " thru: ",DW2 I DW1>DW2 W *7,"??" G OPT I DW2>DWLC S DW2=DWLC W " ("_DW2_")" S X=DW2-DW1+1,%=2 W !,"OK TO REMOVE "_X_" LINE"_$E("S",X>1) D YN^DICN I %-1 W " " G 1 S %=2 I DW1=1,DW2=DWLC W !,*7,"ARE YOU SURE YOU WANT TO DELETE THIS ENTIRE TEXT" D YN^DICN G 1:%-1 D DEL K DWL G 1 ; F R !,"From line: ",DWL G Q:'DWL MOVE R " thru: ",DW2 S DW1=DWL I 'DW2 S DW2=DW1 W " (",DW1,")" S %=2 G YN:'DWAFT R " after line: ",DW3 I DW1-1DW3 G Q I DW1<1!(DW2>DWLC)!(DW1>DW2)!(DW3<0)!(DW3>DWLC)!(+DW3'=DW3) G Q YN W !,"ARE YOU SURE" D YN^DICN G Q:%-1 K ^UTILITY($J,"W") S I=0 $ I DWAFT?.N X "F J=DW1-.1:0 S J=$N("_DIC_"J)) Q:J>DW2!(J'>0) I $D(^(J,0)) S X=^(0) D O" D MR:'DWAFT G DN S DICMX=DWAFT X X S DIC=DWI DN X "F J=DWLC:-1:DW3+1 S "_DIC_"J+I,0)="_DIC_"J,0)" X "F J=1:1:I S "_DIC_"DW3+J,0)=^UTILITY($J,""W"",J,0) W "".""" K ^UTILITY($J,"W"),DWL,X,DICMX S DWLC=DWLC+I,@(DIC_"0)")=DWLC Q ; DEL S I=+DW1 X "F J=DW2+1:1:DWLC S "_DIC_"I,0)="_DIC_"J,0),I=I+1 W "".""" S I=DW2-DW1 X "F J=DWLC-I:1:DWLC K "_DIC_"J) W "".""" S DWLC=DWLC-I-1 Q ; Z ; S DWAFT=0,DW3=X Q:X[U!(X>DWLC) G:'$D(DIA("P")) T:DIC["%T1,%T2",Q R !,"From what text: ",X G Q:U[X K I,J S DWI=DIC,DWAFT=$S($D(DA)#2:DA,1:0),DICMX="D O:D'DW2)",DQI="Y(",DA="X(",I(0)=DIA,J(0)=DIA("P") D ^DICOMP S DIC=DWI,DA=DWAFT,DWAFT=U I $D(X),Y["w" G F Q W " ",*7 S DW1=0 Q O S I=I+1,^UTILITY($J,"W",I,0)=X Q ; T S @(DIC_"0)")=DWLC,%DW1=%T1,%DW2=%T2 W !,"FROM TEXT UNDER INITIALS: "_%T1_"// " R X S:X="" X=%T1 I @("'$D("_$P(DIC,",%T2",1)_"))") G Q S %T1=X D TX^DIWE I %T2="" D Q G MR S DWLC=@(DIC_"0)") G F MR S %T1=%DW1,%T2=%DW2,DWLC=@(DIC_"0)") L @(DIC_"0)"):0 K %DW1,%DW2 ,""W"",J,0) W "".""" K ^UTILITY($J,"W"),DWL,X,DICMX S DWLC=DWLC+I,@(DIC_"0)")=DWLC Q ; DEL S I=+DW1 X "F J=DW2+1:1:DWLC S "_DIC_"I,0)="_DIC_"J,0),I=I+1 W "".""" S I=DW2-DW1 X "F J=DWLC-I:1:DWLC K "_DIC_"J) W "".""" S DWLC=DWLC-I-1 Q ; Z ; S DWAFT=0,DW3=X Q:X[U!(X>DWLC) G:'$D(DIA("P")) T:DIC["%T1,%T2",Q R !,"From what text: ",X G Q:U[X K I,J S DWI=DIC,DWAFT=$S($D(DA)#2:DA,1:0),DICMX="D O:D'DW2)",DQI="Y(",DA="X(",I(0)=DIA,J(0)=DIA("P") D ^DICOMP S DIC=DWI,DA=DWAFT,DWAFT=U I $D(X),Y["w" G F Q W " ",*7 S DW1=0 Q O S I=I+1,^UTILITY($J,"W",I,0)=X Q ; T S @(DIC_"0)")=DWLC,%DW1=%T1,%DW2=%T2 W !,"FDIWE4 ; ; 29NOV83 16:15 W " to Line: "_DWLC_"// " R DW2 S:DW2="" DW2=DWLC Q:DW2>DWLC!(DW2DW2)!(DW2>DWLC)!(DW1<1) G 1 F I=DW1:1:DW2 S X=@(DIC_"I,0)") K Y X DW I $D(Y)=1 S @(DIC_"I,0)")=Y W !,$J(I,3)_">"_Y S DWL=I G 1 ; B ;BREAK G 1:X=U,OPT:'X BA R !," after character(s): ",X G 1:X="" S DW=^(0) I DW'[X W *7,"??" G BA S DWLC=DWLC+1 X "F I=DWLC:-1:DWL+1 S "_DIC_"I,0)="_DIC_"I-1,0) W "".""" S @(DIC_"0)")=DWLC,Y=$F(DW,X)-1,@(DIC_"DWL,0)")=$E(DW,1,Y),@(DIC_"DWL+1,0)")=$E(DW,Y+1,999) W !,$J(DWL,3)_">",@(DIC_"DWL,0)"),!,$J(DWL+1,3)_">",@(DIC_"DWL+1,0)") 1 G ^DIWE1 ; OPT W ! G OPT^DIWE1 ; J ;JOIN G 1:X=U,OPT:'X I X=DWLC W *7,"??" G OPT S @("Y="_DIC_"X+1,0)"),@("J="_DIC_"X,0)") I $L(Y)+$L(J)>250 W *7," TOO LONG" G 1 S ^(0)=J_" "_Y W !,$J(X,3)_">"_^(0),! F I=X+1:1:DWLC-1 S @(DIC_"I,0)="_DIC_"I+1,0)") W "." S DWLC=D%WLC-1 G 1 WLC IF (DW1>DW2)!(DW2>DWLC)!(DW1<1) G 1 F I=DW1:1:DW2 S X=@(DIC_"I,0)") K Y X DW I $D(Y)=1 S @(DIC_"I,0)")=Y W !,$J(I,3)_">"_Y S DWL=I G 1 ; B ;BREAK G 1:X=U,OPT:'X BA R !," after character(s): ",X G 1:X="" S DW=^(0) I DW'[X W *7,"??" G BA S DWLC=DWLC+1 X "F I=DWLC:-1:DWL+1 S "_DIC_"I,0)="_DIC_"I-1,0) W "".""" S @(DIC_"0)")=DWLC,Y=$F(DW,X)-1,@(DIC_"DWL,0)")=$E(DW,1,Y),@(DIC_"DWL+1,0)")=$E(DW,Y+1,999) W !,$J(DWL,3)_">",@(DIC_"DWL,0)"),!,$J(DWL+1,3)_">",@(DIC_"DWL+1,0)") 1 G ^DIWE1 ; OPT W ! G OPT^DIWE1 ; J ;JOIN G 1:X=U,OPT:'X I X=DWLC W *7,"??" G OPT S @("Y="_DIC_"X+1,0)"),@("J="_DIC_"X,0)") I $L(Y)+$L(J)>250 W *7," TOO LONG" G 1 S ^(0)=J_" "_Y W !,$J(X,3)_">"_^(0),! F I=X+1:1:DWLC-1 S @(DIC_"I,0)="_DIC_"I+1,0)") W "." S DWLC=DDIWE5 ; GFT/SF ; 13 NOV 83 1:14 PM ; LNQ ; W !,"ANSWER WITH A LINE NUMBER ("_(I'=6)_$P("-"_DWLC,U,DWLC>1)_")" I $D(DWL) W !?9,"OR A SPACE TO MEAN THE CURRENT LINE ("_DWL_")" W:DWL>2 !?9,"OR '-' TO MEAN LINE ",DWL-1,", '-2' TO MEAN ",DWL-2,", ",$P("'+' TO MEAN "_(DWL+1)_", ",U,DWL255:DWLW,1:X\1) W !,"PACK ",$S(DWPK:"ON",1:"OFF"),"//" R X S DWPK=$S(X="ON":1,1:0) Q ; IQ ; I $D(DC) W:$D(^DD(+$P(DC,U,2),.01,3)) !?4,^(3),! X:$D(^(4)) ^(4) W !,"YOU ARE READY TO ENTER A LINE OF TEXT",!,"IF YOU HAVE NO TEXT TO ENTER, JUST HIT 'RETURN'",! W "TYPE 'CONTROL-I' (OR 'TAB' KEY) TO INSERT TABS",! W "WHEN TEXT IS OUTPUT, THESE FORMATTING RULES WILL APPLY:" W !?5,"LINES CONTAINING ONLY PUNCTUATION CHARACTERS, OR LINES CONTAINING TABS,",!?8,"WILL STAND BY THEMSELVES (NO WRAP-AROUND)" W !?5,"LINES BEGINNING WITH SPACES WILL START ON A NEW LINE" W !?5,"EXPRESSIONS BETWEEN '|' CHARACTERS WILL BE EVALUATED AS" W !?8,"'COMPUTED-FIELD EXPRESSIONS' AND THEN PRINTED AS EVALUATED" W !?8,"THUS '|NAME|' WOULD CAUSE THE CURRENT NAME TO BE INSERTED IN THE TEXT" W !?5,"SPECIAL FORMATTING INCLUDES: " W !," |TOP|",?25,"FORCE NEW PAGE AT THIS POINT IN TEXT" FN F %=15:0 S %=$N(^DD("FUNC",%)) Q:%>97 I $D(^(%,10)) W !," |"_$P(^(0),U,1)_$P("(ARGUMENT)",U,$S('$D(^(3)):1,1:^(3)'=0))_"|",?25 W:$D(^(9)) ^(9) EADY TO ENTER A LINE OF TEXT",!,"IF YOU HAVE NO TEXT TO ENTER, JUST HIT 'RETURN'",! W "TYPE 'CONTROL-I' (OR 'TAB' KEY) DIWP ; ; 19JAN84 9:34 S DIWTC=X[($C(124)_"TAB") LN S:'$D(DIWF) DIWF="" S DIWX=X,DIW=$C(124),I=$P(DIWF,"C",2) I I S DIWR=DIWL+I-1 I '$D(^UTILITY($J,"W",DIWL)) S ^(DIWL)=1 D DIWI S:'$D(DIWT) DIWT="5,10,15,20,25" G 124 S I=^(DIWL),DIWI=^(DIWL,I,0) I DIWI="" D DIWI E D NEW:DIWTC S Z=X?.P!DIWTC I X?1" ".E!Z S DIWTC=1 D NEW:DIWI]"" S DIWTC=Z 124 I DIWX="" D PUT,PRE:DIWTC Q S X=$P(DIWX,DIW,1),DIWX=$P(DIWX,DIW,2,99) D C G 124:DIWX="" S X=$P(DIWX,DIW,1) I $P(X,"TAB",1)="" D TAB G N I X="TOP" D PUT S ^("X")="X:$D(^UTILITY($J,1)) ^(1)" D NEW G N G STIT:DIWF[DIW K %RCR S %RCR="RCR^DIWW" F Y="DIWX","DICMX","DIC","D","D0","D1","D2","D3","D4","D5","D6","Y" S %RCR(Y)="" D PUT,STORLIST^%RCR G N:$D(X) STIT S X=$P(DIWX,DIW,1),X=DIW_X_DIW D C N K X S DIWX=$P(DIWX,DIW,2,99) G 124 ; L ; S DIWTC=1 G LN ; TAB I X="" S X=DIW G C S J=$P(DIWT,",",DIWTC),DIWTC=DIWTC+1 I X?3A1%P.P1N.E S J=+$E(X,5,9) I J<0 S %=$P(DIWX,DIW,2) Q:%="" S J=1-$L(%)-J S J=J-1-$L(DIWI) Q:J<1 S X=$J("",J) C I DIWTC S DIWI=DIWI_X Q WORD S Z=$P(X," ",1),X=$P(X," ",2,999) I $L(DIWI)+$L(Z)+DIWL>DIWR,$L(DIWI) D PUT,NEW S DIWI=DIWI_Z_" " G WORD:X]"" S:Z?.E1AN1"." DIWI=DIWI_" " Q Q ; NEW D DIWI PRE S I=^UTILITY($J,"W",DIWL),^(DIWL)=I+1,^(DIWL,I+1,0)="" I DIWF["D" S ^(0)=" ",^UTILITY($J,"W",DIWL)=I+2,^(DIWL,I+2,0)="" G P:DIWF'["R"!DIWTC K % Q:'$D(^UTILITY($J,"W",DIWL,I,0)) S Y=^(0),%=$L(Y) F %=%:-1 Q:$A(Y,%)-32 S Y=$E(Y,1,%),J=DIWR-DIWL-%+1,%X=0 G P:J<1 F %=1:1 S %(%)=$P(Y," ",1),Y=$P(Y," ",2,999) G:Y="" PAD:%-1,P I $E(%(%),$L(%(%)))?.P S:%=1&(%(%)="") %=0,%X=%X+1 S:%&J J=J-1,%(%)=%(%)_" " PAD I J F Y=%\2+1:1:%-1,%\2:-1 S %(Y)=%(Y)_" ",J=J-1 G PAD:Y=1!'J S Y=%(%) F %=%-1:-1:1 S Y=%(%)_" "_Y S ^(0)=$J("",%X)_Y K % P G NX^DIWW:DIWF["W" Q ; DIWI S DIWI=$S(DIWF["L"&$D(D):$E(D_" ",1,4),1:"")_$J("",+$P(DIWF,"I",2)) Q ; PUT S I=^UTILITY($J,"W",DIWL),^(DIWL,I,0)=DIWI  I DIWTC S DIWI=DIWI_X Q WORD S Z=$P(X," ",1),X=$P(X," ",2,999) I $L(DIWI)+$L(Z)+DIWL>DIWR,$L(DIWI) D PUT,NEW S DIWI=DIWI_Z_" " G WORD:X]"" S:Z?.E1AN1"." DIWI=DIWI_" " Q Q ; NEW D DIWI PRE S I=^UTILITY($J,"W",DIWL),^(DIWL)=I+1,^(DIWL,I+1,0)="" I DIWF["D" S ^(0)=" ",^UTILITY($J,"W",DIWL)=I+2,^(DIWL,I+2,0)="" G P:DIWF'["R"!DIWTC K % Q:'$D(^UTILITY($J,"W",DIWL,I,0)) S Y=^(0),%=$L(Y) F %=%:-1 Q:$A(Y,%)-32 S Y=$E(Y,1,%),J=DIWR-DIWL-%+1,%X=0 G P:J<1 F %=1:1 S %(%)=$P(Y," ",1),Y=$P(Y," ",2,999) G:Y="" PAD:%-1,P I $E(%(%),$L(%(%)))?.P S:%=1&(%(%)="") %=0,%X=%X+1 S:%&J J=J-1,%(%)=%(%)_" " PAD I J F Y=%\2+1:1:%-1,%\2:-1 S %(Y)=%(Y)_" ",J=J-1 G PAD:Y=1!'J S Y=%(%) F %=%-1:-1:1 S Y=%(%)_" "_Y S ^(0)=$J("",%X)_Y K % P G NX^DIWW:DIWF["W" Q ; DIWI S DIWI=$S(DIWF["L"&$D(D):$E(D_DIWW ;GFT/SF ; 06JAN84 11:12 F I=0:1 Q:'$D(^UTILITY($J,"W")) W:$X ! D B W:$X ! Q ; NX ; I $X+1>DIWL W ! B I $D(DX(0)) X DX(0) I $P(DIWF,"B",2),$P(DIWF,"B",2)>($S($D(IOSL):IOSL,1:24)-$Y),$D(^UTILITY($J,1)) X ^(1) F I=$Y+2:1:+$P(DIWF,"T",2) W ! 0 ; S I=999999 F %=0:0 S %=$N(^UTILITY($J,"W",%)) Q:%'>0 S:$N(^(%,-1))0 I $D(^(%,I)) D W I $D(^UTILITY($J,"W",%))<9 K ^(%) I $N(^(-1))=-1 K DIWI,DIWX,DIWTC ; W I ^(I,0)]"" W:$X+1>% ! W ?%-1,^(0) I $D(^("X")) X ^("X") K ^UTILITY($J,"W",%,I) Q Q ; RCR ; S DICOMPX="",DQI="Y(",DA="X(",DICMX="D ^DIWP" D ^DICOMP Q:'$D(X) I Y["m" S DICMX="D "_$E("L",Y'["w")_"^DIWP" X X S X="" Q S DICMX=Y["D" X X I DICMX S Y=X X ^DD("DD") S X=Y D C^DIWP:X]"" S X="" K DICMX Q ; DIQ ; S DIWF="W|",DIWL=2,DIWR=IOM,X=O_": " K ^UTILITY($J,"W") X "F W=0:0 D ^DIWP S W=$N("_D(DL-1)_"W)) Q:W'>0 S X=^(W,0)" G DIWW ; H G H^DIO2 DT G DT^DIO2 ) X ^(1) F I=$Y+2:1:+$P(DIWF,"T",2) W ! 0 ; S I=999999 F %=0:0 S %=$N(^UTILITY($J,"W",%)) Q:%'>0 S:$N(^(%,-1))0 I $D(^(%,I)) D W I $D(^UTILITY($J,"W",%))<9 K ^(%) I $N(^(-1))=-1 K DIWI,DIWX,DIWTC ; W I ^(I,0)]"" W:$X+1>% ! W ?%-1,^(0) I $D(^("X")) X ^("X") K ^UTILITY($J,"W",%,I) Q Q ; RCR ; S DICOMPX="",DQI="Y(",DA="X(",DICMX="D ^DIWP" D ^DICOMP Q:'$D(X) I Y["m" S DICMX="D "_$E("L",Y'["w")_"^DIWP" X X S X="" Q S DICMX=Y["D" X X I DICMX S Y=X X ^DD("DD") S X=Y D C^DIWP:X]"" S X="" K DICMX Q ; DIQ ; S DIWF="W|",DIWL=2,DIWR=IOM,X=O_": " K ^UTILITY(&DIX ;GFT/SF ; 27JUL83 19:37 D 1^DICRW S DIK="^DOPT(""DIX"",",IO(0)=$I G F:$D(^DOPT("DIX",3)) S ^(0)="STATISTICAL ROUTINE^1N^" F I=1:1:3 S ^DOPT("DIX",I,0)=$E($T(F+I),3,99) D IXALL^DIK F S DIC=DIK,DIC(0)="AEQZ" D ^DIC Q:Y<0 D @($P(Y(0),U,2,3)) W !!!! G DIX ;DESCRIPTIVE STATISTICS^D^DIXC ;SCATTERGRAM^^DIG ;HISTOGRAM^^DIH ; DHDR ; S U="^" D:'$D(IOF)!'$D(IOM) ^%ZIS U IO S:+DHDR'=0 IOM=+DHDR S:'$D(DHDR) DHDR="" I DHDR="" G HDR SITE W:$D(^DD("SITE"))&(DHDR["S") !,$P(^("SITE"),U,2),"(",$P(^("SITE"),U,1),")" I $D(DIC) I DHDR["F",@("$D("_DIC_"0))") W " ",$P(^(0),U,1)," FILE" I $D(DUZ)#2,DHDR["U",$D(^DIC(3,+DUZ,0)) W " USER: ",$P(^(0),U,1)," " W ?(IOM-(DHDR["T"*10)-($D(PG)*10)-8) I DHDR["T" D INT W %TIM W " " K %TIM I '$D(DT) S X="T" D ^%DT S DT=Y W $E(DT,4,5),"/",DT#100,"/",$E(DT,2,3) I $D(PG) W " PAGE ",PG S PG=PG+1 HDR F J=1:1 Q:'$D(DHDR(J)) W !?(DHDR["C"*(IOM-$L(DHDR(J))\2)),$E(DHDR(J),1,IOM) W ! Q:DHDR'["L" LINE F %=1:1:IOM W "-" W ! Q INT S %M=$P($H,",",2)\60 20 S %N=" AM" S:%M'<720 %M=%M-720,%N=" PM" S:%M<60 %M=%M+720 25 S %I=%M\600 S:'%I %I=" " S %TIM=%I_(%M\60#10)_":"_(%M#60\10)_(%M#10)_%N 30 K %M,%N,%I TOGRAM^^DIH ; DHDR ; S U="^" D:'$D(IOF)!'$D(IOM) ^%ZIS U IO S:+DHDR'=0 IOM=+DHDR S:'$D(DHDR) DHDR="" I DHDR="" G HDR SITE W:$D(^DD("SITE"))&(DHDR["S") !,$P(^("SITE"),U,2),"(",$P(^("SITE"),U,1),")" I $D(DIC) I DHDR["F",@("$D("_DIC_"0))") W " ",$P(^(0),U,1)," FILE" I $D(DUZ)#2,DHDR["U",$D(^DIC(3,+DUZ,0)) W " USER: ",$P(^(0),U,1)," " W ?(IOM-(DHDR["T"*10)-($D(PG)*10)-8) I DHDR["T" D INT W %TIM W " " K %TIM I '$D(DT) S X="T" D ^%DT S DT=Y W $E(DT,4,5),"/",DT#100,"/",$E(DT,2,3) I $D(PG) W " PAGE ",PG S PG=PG+1 HDR F J=1:1 Q:'$D(DHDR(J)) W !?(DHDR["C"*(IOM-$LDIXC ;BC&THM/LL,GFT/SF ; 24MAY81 20:11 ; DESCRIPTIVE STATS, CORRELATION MATRIX D D DESC G DESCX C D CORR G CORRX ; SQR S Y=0 Q:X'>0 S Y=1+X/2 L S T=Y,Y=X/T+T/2 G L:Y0 W !!,"***** AT LEAST TWO VARIABLES MUST BE DEFINED *****" S ERR=1 Q D DLCOR ;F I=1:1:SZ I ^DOSV(0,IO(0),"BY",I,"H")=^("L") W *7,!,"CAN'T COMPUTE CORRELATION MATRIX--",DN(I+100)," IS SINGLE-VALUED" S ERR=1 G KL F I=2:1:SZ S N=^DOSV(0,DJ,0,I,"N"),S=^("S"),C=^DOSV(0,DJ,"CP",I,I) F J=1:1:I-1 I $D(^DOSV(0,DJ,"CP",I,J)) D C1 G KL C1 S X=N*C-(S*S)*(N*^DOSV(0,DJ,"CP",J,J))-(^DOSV(0,DJ,0,J,"S")*^("S")) D SQR S (^UTILITY($J,J,I),^UTILITY($J,I,J))=(N*^DOSV(0,DJ,"CP",I,J))-(S*^DOSV(0,DJ,0,J,"S"))/Y Q CORRX ;OUTPUT THE CORRELATION MATRIX G:$D(ERR) KL K DHDR S DHDR="72TSU",DHDR(1)="CORRELATION MATRIX",DHDR(2)="" D DHDR^DIX F I=1:1:SZ S ^UTILITY($J,I,I)=1 I $D(^UTILITY($J,I,I)) W ?I*10-2,$J(DN(I),10) F I=1:1:SZ I $D(^UTILITY($J,I,I)) W !,DN(I) F J=1:1:I I $D(^UTILITY($J,I,J)) W ?J*10,$J(^UTILITY($J,I,J),8,4) W !! KL C:IO(0)'=IO IO U IO(0) K C,DHDR,I,II,IO,IOBS,IOF,IOM,IOPAR,IOSL,IOST,IOT,J,JJ,N,POP,S,X,Y,Z VARIABLES MUST BE DEFINED *****" S ERR=1 Q D DLCOR ;F I=1:1:SZ I ^DOSV(0,IO(0),"BY",I,"H")=^("L") W *7,!,"CAN'T COMPUTE CORRELATION MATRIX--",DN(I+100)," IS SINGLE-VALUED" S ERR=1 G KL F I=2:1:SZ S N=^DOSV(0,DJ,0,I,"N"),S=^("S"),C=^DOSV(0,DJ,"CP",I,I) F J=1:1:I-1 I $D(^DOSV(0,DJ,"CP",I,J)) D C1 G KL C1 S X=N*C-(S*S)*(N*^DOSV(0,DJ,"CP",J,J))-(^DOSV(0,DJ,0,J,"S")*^("S")) D SQR S (^UTILITY($J,J,I),^UTILITY($J,I,J))=(N*^DOSV(0,DJ,"CP",I,J))-(S*^DOSV(0,DJ,0,J,"S"))/Y Q CORRX ;OUTPUT THE CORRELATION MATRIX G:$D(ERR) KL K DHDR S DHDR="72TSU",DHDR(1)="CORRELATION MATRIX",DHDR(2)="" D DHDR^DIX F I=1:1:SZ S ^UTILITY($J,I,I)=1 I $D(^UTILITY($J,I,I)) W ?I*10-2,$J(DN(I),10) F I=1:1:SZ I $D(^UTILITY($J,I,I)) W !,DN(I) F J=1:1:I I $D(^UTILITY($J,I,J)) W ?J*10,$J(^UTILITY($J,I,J),8,4) W !! KL C:IO(0)'&%ZIS ; I $D(IOP)#2 S IO=IOP G PARAMS S IO=$I ;READ "DEVICE: ",IO ;INSERT DEVICE SELECTION HERE PARAMS S IOM=80,IOSL=24,IOF="#",IOST="C",IOPAR=""  ;READ "DEVICE: ",IO ;INSERT DEVICE SELECTION HERE PARAMS S IOM=80,IOSL=24,IOF="#",IOST="C",IOPAR="" #",IOST="C",IOPAR=""  ;READ "DEVICE: ",IO ;INSERT DEVICE SELECTION HERE PARAMS S IOM=80,IOSL=24,IOF="#",ISV(0,DJ,"CP",I,I) F J=1:1:I-1 I $D(^DOSV(0,DJ,"CP",I,J)) D C1 G KL C1 S X=N*C-(S*S)*(N*^DOSV(0,DJ,"CP",J,J))-(^DOSV(0,DJ,0,J,"S")*^("S")) D SQR S (^UTILITY($J,J,I),^UTILITY($J,I,J))=(N*^DOSV(0,DJ,"CP",I,J))-(S*^DOSV(0,DJ,0,J,"S"))/Y Q CORRX ;OUTPUT THE CORRELATION MATRIX G:$D(ERR) KL K DHDR S DHDR="72TSU",DHDR(1)="CORRELATION MATRIX",DHDR(2)="" D DHDR^DIX F I=1:1:SZ S ^UTILITY($J,I,I)=1 I $D(^UTILITY($J,I,I)) W ?I*10-2,$J(DN(I),10) F I=1:1:SZ I $D(^UTILITY($J,I,I)) W !,DN(I) F J=1:1:I I $D(^UTILITY($J,I,J)) W ?J*10,$J(^UTILITY($J,I,J),8,4) W !! KL C:IO(0)' VOLUME 005 DESCRIPTION: MICRO MUMPS VERSION 4.02 - TWO OF THREE DISKS NUMBER SIZE NAME COMMENTS 005.1 4K %DT .MMP MICRO MUMPS VERSION 4.02 - RUNTIME ROUTINES 005.2 4K %DTC .MMP " " " " " " 005.3 2K %RCR .MMP " " " " " " 005.4 2K %ZIS .MMP " " " " " " 005.5 6K -EBMMUG .005 DISK NAME & CONTENTS OF VOLUME 005 (JUL 5,'84) 005.6 2K DI .MMP MICRO MUMPS VERSION 4.02 - RUNTIME ROUTINES 005.7 4K DIA .MMP " " " " " " 005.8 4K DIA1 .MMP " " " " " " 005.9 2K DIA2 .MMP " " " " " " 005.10 2K DIA3 .MMP " " " " " " 005.11 2K DIB .MMP " " " " " " 005.12 2K DIBT .MMP " " " " " " 005.13 4K DIC .MMP " " " " " " 005.14 4K DIC1 .MMP " " " " " " 005.15 4K DICATT .MMP " " " " " " 005.16 2K DICATT0 .MMP " " " " " " 005.17 4K DICATT1 .MMP " " " " " " 005.18 2K DICATT2 .MMP " " " " " " 005.19 2K DICATT22.MMP " " " " " " 005.20 4K DICATT3 .MMP " " " " " " 005.21 2K DICATT4 .MMP " " " " " " 005.22 4K DICATT5 .MMP " " " " " " 005.23 2K DICATT6 .MMP " " " " " " 005.24 4K DICD .MMP " " " " " " 005.25 2K DICE .MMP " " " " " " 005.26 2K DICE0 .MMP " " " " " " 005.27 2K DICE1 .MMP " " " " " " 005.28 4K DICE2 .MMP " " " " " " 005.29 2K DICE3 .MMP " " " " " " 005.30 4K DICE4 .MMP " " " " " " 005.31 2K DICE7 .MMP " " " " " " 005.32 4K DICM .MMP " " " " " " 005.33 4K DICM1 .MMP " " " " " " 005.34 4K DICN .MMP " " " " " " 005.35 2K DICN1 .MMP " " " " " " 005.36 4K DICOMP .MMP " " " " " " 005.37 4K DICOMP0 .MMP " " " " " " 005.38 4K DICOMP1 .MMP " " " " " " 005.39 4K DICOMPX .MMP " " " " " " 005.40 4K DICOMPY .MMP " " " " " " 005.41 2K DICOMPZ .MMP " " " " " " 005.42 4K DICQ .MMP " " " " " " 005.43 2K DICR .MMP " " " " " " 005.44 2K DICRW .MMP " " " " " " 005.45 4K DID .MMP " " " " " " 005.46 4K DID1 .MMP " " " " " " 005.47 2K DID2 .MMP " " " " " " 005.48 4K DIDH .MMP " " " " " " 005.49 2K DIDX .MMP " " " " " " 005.50 4K DIE .MMP " " " " " " 005.51 2K DIE0 .MMP " " " '" " " 005.52 4K DIE1 .MMP " " " " " " 005.53 4K DIE2 .MMP " " " " " " 005.54 4K DIE9 .MMP " " " " " " 005.55 4K DIED .MMP " " " " " " 005.56 2K DIEZ .MMP " " " " " " 005.57 4K DIEZ0 .MMP " " " " " " 005.58 4K DIEZ1 .MMP " " " " " " 005.59 2K DIEZ2 .MMP " " " " " " 005.60 4K DIG .MMP " " " " " " 005.61 4K DIH .MMP " " " " " " 005.62 4K DII .MMP " " " " " " 005.63 2K DIK .MMP " " " " " " 005.64 2K DIK1 .MMP " " " " " " 005.65 4K DIL .MMP " " " " " " 005.66 4K DIL0 .MMP " " " " " " 005.67 4K DIL1 .MMP " " " " " " 005.68 4K DIL2 .MMP " " " " " " 005.69 2K DILL .MMP " " " " " " 005.70 2K DIM .MMP " " " " " " 005.71 2K DIM1 .MMP " " " " " " 005.72 4K DIM2 .MMP " " " " " " 005.73 4K DIM3 .MMP " " " " " " 005.74 4K DIM4 .MMP " " " " " " 005.75 2K DIO .MMP " " " " " " 005.76 2K DIO0 .MMP " " " " " " 005.77 4K DIO1 .MMP " " " " " " 005.78 2K DIO2 .MMP " " " " " " 005.79 4K DIO3 .MMP " " " " " " 005.80 2K DIO4 .MMP " " " " " " 005.81 4K DIOS .MMP " " " " " " 005.82 4K DIP .MMP " " " " " " 005.83 4K DIP0 .MMP " " " " " " 005.84 4K DIP1 .MMP " " " " " " 005.85 4K DIP2 .MMP " " " " " " 005.86 2K DIP22 .MMP " " " " " " 005.87 4K DIP3 .MMP " " " " " " 005.88 2K DIP4 .MMP " " " " " " 005.89 2K DIP5 .MMP " " " " " " 005.90 4K DIQ .MMP " " " " " " 005.91 4K DIQQ .MMP " " " " " " 005.92 2K DIQQQ .MMP " " " " " " 005.93 4K DIS .MMP " " " " " " 005.94 4K DIS0 .MMP " " " " " " 005.95 4K DIS1 .MMP " " " " " " 005.96 4K DIT .MMP " " " " " " 005.97 2K DIT0 .MMP " " " " " " 005.98 2K DIT1 .MMP " " " " " " 005.99 2K DIT2 .MMP " " " " " " 005.100 2K DITP .MMP " " " " " " 005.101 4K DITR .MMP " " " " " " 005.102 2K DITR1 .MMP " " " " " " 005.103 4K DIU .MMP " " " " " " 005.104 4K DIU1 .MMP " " " " " " 005.105 4K DIU2 .MMP " " " " " " 005.106 2K DIU3 .MMP " " " " " " 005.107 2K DIV .MMP " " " " " "  Files: 119 space used: 380k (6k free) %DT .MMP 4k : DICE7 .MMP 2k : DIH .MMP 4k : DIQQ .MMP 4k %DTC .MMP 4k : DICM .MMP 4k : DII .MMP 4k : DIQQQ .MMP 2k %RCR .MMP 2k : DICM1 .MMP 4k : DIK .MMP 2k : DIS .MMP 4k %ZIS .MMP 2k : DICN .MMP 4k : DIK1 .MMP 2k : DIS0 .MMP 4k -EBMMUG .005 6k : DICN1 .MMP 2k : DIL .MMP 4k : DIS1 .MMP 4k DI .MMP 2k : DICOMP .MMP 4k : DIL0 .MMP 4k : DIT .MMP 4k DIA .MMP 4k : DICOMP0 .MMP 4k : DIL1 .MMP 4k : DIT0 .MMP 2k DIA1 .MMP 4k : DICOMP1 .MMP 4k : DIL2 .MMP 4k : DIT1 .MMP 2k DIA2 .MMP 2k : DICOMPX .MMP 4k : DILL .MMP 2k : DIT2 .MMP 2k DIA3 .MMP 2k : DICOMPY .MMP 4k : DIM .MMP 2k : DITP .MMP 2k DIB .MMP 2k : DICOMPZ .MMP 2k : DIM1 .MMP 2k : DITR .MMP 4k DIBT .MMP 2k : DICQ .MMP 4k : DIM2 .MMP 4k : DITR1 .MMP 2k DIC .MMP 4k : DICR .MMP 2k : DIM3 .MMP 4k : DIU .MMP 4k DIC1 .MMP 4k : DICRW .MMP 2k : DIM4 .MMP 4k : DIU1 .MMP 4k DICATT .MMP 4k : DID .MMP 4k : DIO .MMP 2k : DIU2 .MMP 4k DICATT0 .MMP 2k : DID1 .MMP 4k : DIO0 .MMP 2k : DIU3 .MMP 2k DICATT1 .MMP 4k : DID2 .MMP 2k : DIO1 .MMP 4k : DIV .MMP 2k DICATT2 .MMP 2k : DIDH .MMP 4k : DIO2 .MMP 2k : DIVR .MMP 4k DICATT22.MMP 2k : DIDX .MMP 2k : DIO3 .MMP 4k : DIWE .MMP 4k DICATT3 .MMP 4k : DIE .MMP 4k : DIO4 .MMP 2k : DIWE1 .MMP 4k DICATT4 .MMP 2k : DIE0 .MMP 2k : DIOS .MMP 4k : DIWE2 .MMP 4k DICATT6 .MMP 2k : DIE2 .MMP 4k : DIP0 .MMP 4k : DIWE4 .MMP 4k DICD .MMP 4k : DIE9 .MMP 4k : DIP1 .MMP 4k : DIWE5 .MMP 2k DICE .MMP 2k : DIED .MMP 4k : DIP2 .MMP 4k : DIWP .MMP 4k DICE0 .MMP 2k : DIEZ .MMP 2k : DIP22 .MMP 2k : DIWW .MMP 2k DICE1 .MMP 2k : DIEZ0 .MMP 4k : DIP3 .MMP 4k : DIX .MMP 2k DICE2 .MMP 4k : DIEZ1 .MMP 4k : DIP4 .MMP 2k : DIXC .MMP 4k DICE3 .MMP 2k : DIEZ2 .MMP 2k : DIP5 .MMP 2k : EBMDIR05.TXT 4k DICE4 .MMP 4k : DIG .MMP 4k : DIQ .MMP 4k : k : .MMP 4k : DIWE .MMP 4k B0: DICATT3 .MMP 4k : DIE .MMP 4k : DIO4 .MMP 2k : DIWE1 .MMP 4k B0: DICATT4 .MMP 2k : DIE0 .MMP 2k : DIOS .MMP 4k : DIWE2 .MMP 4k [more] B0: DICATT5 .MMP 4k : DIE1 .MMP 4k : DIP .MMP 4k : DIWE3 .MMP 4k B0: DICATT6 .MMP 2k : DIE2 .MMP 4k : DIP0 .MMP 4k : DIWE4 .MMP 4k B0: DICD .MMP 4k : DIE9 .MMP 4k : DIP1 .MMP 4k : DIWE5 .MMP 2k B0: DICE .MMP 2k : DIED .MMP 4k : DIP2 .MMP 4k : DIWP ' DIO4 .MMP " " " " " " 005.81 4K DIOS .MMP " " " " " " 005.82 4K DIP .MMP " " " " " " 005.83 4K DIP0 .MMP " " " " " " 005.84 4K DIP1 .MMP " " " " " " 005.85 4K DIP2 .MMP " " " " " " 005.86 2K DIP22 .MMP " " " " " " 005.87 4K DIP3 .MMP " " " " " " 005.88 2K DIP4 .MMP " " " " " " 005.89 2K DIP5 .MMP " " " " " " 005.90 4K DIQ .MMP " " " " " " 005.91 4K DIQQ .MMP " " " " " " 005.92 2K DIQQQ .MMP " " " " " " 005.93 4K DIS .MMP " " " " " " 005.94 4K DIS0 .MMP " " " " " " 005.95 4K DIS1 .MMP " " " " " " 005.96 4K DIT .MMP " " " " " " 005.97 2K DIT0 .MMP " " " " " " 005.98 2K DIT1 .MMP " " " " " " 005.99 2K DIT2 .MMP " " " " " " 005.100 2K DITP .MMP " " " " " " 005.101 4K DITR .MMP " " " " " " 005.102 2K DITR1 .MMP " " " " " " 005.103 4K DIU .MMP " " " " " " 005.104 4K DIU1 .MMP " " " " " " 005.105 4K DIU2 .MMP " " " " " " 005.106 2K DIU3 .MMP " " " " " " 005.107 2K DIV .MMP " " " " " " 005.108 4K D005.108 4K DIVR .MMP " " " " " " 005.109 4K DIWE .MMP " " " " " " 005.110 4K DIWE1 .MMP " " " " " " 005.111 4K DIWE2 .MMP " " " " " " 005.112 4K DIWE3 .MMP " " " " " " 005.113 4K DIWE4 .MMP " " " " " " 005.114 2K DIWE5 .MMP " " " " " " 005.115 4K DIWP .MMP " " " " " " 005.116 2K DIWW .MMP " " " " " " 005.117 2K DIX .MMP " " " " " " 005.118 4K DIXC .MMP " " " " " " 005.119 4K EBMDIR05.TXT DIRECTORY OF THIS DISK 4 4K DIS0 .MMP " " " " " " 005.95 4K DIS1 .MMP " " " " " " 005.96 4K DIT .MMP " " " " " " 005.97 2K DIT0 .MMP " " " " " " 005.98 2K DIT1 .MMP " " " " " " 005.99 2K DIT2 .MMP " " " " " " 005.100 2K DITP .MMP " " " " " " 005.101 4K DITR .MMP " " " " " " 005.102 2K DITR1 .MMP " " " " " " 005.103 4K DIU .MMP " " " " " " 005.104 4K DIU1 .MMP " " " " " " 005.105 4K DIU2 .MMP " " " " " " 005.106 2K DIU3 .MMP " " " " " " 005.107 2K DIV .MMP " " " " " " 005.108 4K DIVR .MMP " " " " " " 005.109 4K DIWE .MMP " " " " " " 005.110 4K DIWE1 .MMP " " " " " " 005.111 4K DIWE2 .MMP " " " " " " 005.112 4K DIWE3 .MMP " " " " " " 005.113 4K DIWE4 .MMP " " " " " " 005.114 2K DIWE5 .MMP " " " " " " 005.115 4K DIWP .MMP " " " " " " 005.116 2K DIWW .MMP " " " " " " 005.117 2K DIX .MMP " " " " " " 005.118 4K DIXC .MMP " " " " " " 005.119 4K EBMDIR05.TXT DIRECTORY OF THIS DISK 4 4K DIS0 .MMP " " " " " " 005.95 4K DIS1 .MMP " " " " " " 005.96 4K DIT .MMP " " " " " " 005.97 2K DIT0 .MMP " " " " " " 005.98 2K DIT1 .MMP " " " " " " 005.99 2K DIT2 .MMP " " " " " " 005.100 2K DITP .MMP " " " " " " 005.101 4K DITR .MMP " " " " " " 005.102 2K DITR1 .MMP " " " " " " 005.103 4K DIU .MMP " " " " " " 005.104 4K DIU1 .MMP " " " " " " 005.105 4K DIU2 .MMP " " " " " " 005.106 2K DIU3 .MMP " " " " " " 005.107 2K DIV .MMP " " " " " "