| 1 | DIETED ;SFISC/GFT SCREEN-EDIT AN INPUT TEMPLATE ;07:04 PM 15 Jul 2002
|
---|
| 2 | ;;22.0;VA FileMan;**111**;Mar 30, 1999
|
---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
| 4 | N DIC,DIET,DRK,DIETED,I,J,DDSCHG
|
---|
| 5 | S DIC=.402,DIC(0)="AEQ" D ^DIC Q:Y<1
|
---|
| 6 | S DIET=+Y D E
|
---|
| 7 | D PUT
|
---|
| 8 | K K ^UTILITY("DIETEDIAB",$J),^UTILITY("DIETED",$J)
|
---|
| 9 | Q
|
---|
| 10 | ;
|
---|
| 11 | EDIT(DIET) ; Edit Template using Screen Editor
|
---|
| 12 | N DRK,DIETED,I,J
|
---|
| 13 | E N DUOUT,DTOUT,DP,DI,D0,DIETROW,DIETEDER,DIETH,DR,F,L,DB
|
---|
| 14 | X ^%ZOSF("EON")
|
---|
| 15 | I '$D(^DIE(DIET,0)) W !,"NO TEMPLATE SELECTED",! Q
|
---|
| 16 | S DIETED="Input Template """_$P(^(0),U)_""""
|
---|
| 17 | W "..."
|
---|
| 18 | D GET("^TMP(""DIETED"",$J)")
|
---|
| 19 | S DIETH="Editing "_DIETED,DIETROW=1,DRK=$P(^DIE(DIET,0),U,4)
|
---|
| 20 | DDW D EDIT^DDW("^TMP(""DIETED"",$J)","M",DIETH,"(File "_DRK_")",DIETROW)
|
---|
| 21 | I $D(DUOUT)!$D(DTOUT) K DR G KL
|
---|
| 22 | D K K I,J
|
---|
| 23 | D PROCESS("^TMP(""DIETED"",$J)")
|
---|
| 24 | X ^%ZOSF("EON")
|
---|
| 25 | S DIETROW=$O(DIETEDER(0)) I DIETROW S DIETH="ERROR! Re-editing "_DIETED K DIETEDER G DDW
|
---|
| 26 | S DDSCHG=1
|
---|
| 27 | KL K ^TMP("DIETED",$J)
|
---|
| 28 | I '$D(DR) W $C(7),$$EZBLD^DIALOG(8077) Q
|
---|
| 29 | M ^UTILITY("DIETED",$J)=DR
|
---|
| 30 | Q
|
---|
| 31 | ;
|
---|
| 32 | GET(DIETA) ;put displayable template into @DIETA
|
---|
| 33 | N DIAO,DIETREL,DIETAD,DB,DIAT,I,J,L
|
---|
| 34 | K @DIETA
|
---|
| 35 | S DR="",(DIETAD,L,DIAO,DB)=0,F=-1
|
---|
| 36 | S (DI,J(0))=$P(^DIE(DIET,0),U,4)
|
---|
| 37 | M DI=^("DIAB")
|
---|
| 38 | D DOWN
|
---|
| 39 | 1 S Y=$P(DIAT,";",DB) I "Q"[Y G NDB:Y="" S DB=DB+1 G 1
|
---|
| 40 | S %=+Y I Y?.NP,$P(Y,":",2),Y'["/" S Y=+Y_"-"_$P(Y,":",2),%=""
|
---|
| 41 | S DIETREL="" I $D(DI(DB,F,DI,DIAO)) S:Y?1"^".E DIETREL=Y S Y=DI(DB,F,DI,DIAO),%=+Y
|
---|
| 42 | I Y?1"]".E S Y=$E(Y,2,999)
|
---|
| 43 | I %,$D(^DD(DI,%,0)) S Y=$P(^(0),U)_$P(Y,%,2,999)
|
---|
| 44 | S DB=DB+1,DIETAD=DIETAD+1,@DIETA@(DIETAD)=$J("",F*3)_Y I DIETREL]"" D G 1
|
---|
| 45 | .S L=L\100+1*100,(J(L),DI)=$P(DIETREL,U,2) D DOWN
|
---|
| 46 | I % S %=+$P($G(^DD(DI,%,0)),U,2) I %,$P($G(^DD(%,.01,0)),U,2)'["W" S L=L+1,(J(L),DI)=% D DOWN
|
---|
| 47 | I Y="ALL" G UP
|
---|
| 48 | G 1
|
---|
| 49 | DOWN S F=F+1,DB(F)=DB,DB=1,DIAO(F)=DIAO,DIAO=0
|
---|
| 50 | DIAT S DIAT=$G(^DIE(DIET,"DR",F+1,DI),"ALL") Q
|
---|
| 51 | ;
|
---|
| 52 | NDB I DIAO'<0 S DIAO=DIAO+1 I $D(^DIE(DIET,"DR",F+1,DI,DIAO)) S DIAT=^(DIAO),DB=1 G 1
|
---|
| 53 | S DIAO=-1
|
---|
| 54 | UP Q:'F K I(L),J(L) S L=$O(J(L),-1)
|
---|
| 55 | S DB=DB(F),DIAO=DIAO(F),DI=J(L),DIAT=$S(DIAO<0:"",DIAO:^DIE(DIET,"DR",F,J(L),DIAO),1:$G(^DIE(DIET,"DR",F,DI))),F=F-1 G 1
|
---|
| 56 | ;
|
---|
| 57 | PROCESS(DIETA) ;puts nodes into ^UTILITY("DIETED")
|
---|
| 58 | N DIAB,LINE,DXS,L,DIAP,DIETSL,DQI,DIETSAVE,DIETAB,ERR
|
---|
| 59 | K DR S F=0,(DI,J(0))=DRK,I(0)=^DIC(J(0),0,"GL"),DIAP="",(L,DIETAB)=0,DXS=1
|
---|
| 60 | F LINE=1:1 Q:'$D(@DIETA@(LINE)) K ERR S X=^(LINE) D
|
---|
| 61 | .I X?1"^".E S LINE=999999999 K DR Q
|
---|
| 62 | .D LINE(X)
|
---|
| 63 | .I $D(ERR) W "LINE ",LINE S DIETEDER(LINE)=ERR,LINE=-LINE Q ;stop if we find one error
|
---|
| 64 | I LINE<0 W " ERROR!"
|
---|
| 65 | Q
|
---|
| 66 | LINE(X) ;Process one LINE from the screen
|
---|
| 67 | N D,DIC,DICMX,DV,DATE,Y,DICOMPX,DICOMP
|
---|
| 68 | F D=$L(X):-1:1 Q:$A(X,D)>32 S X=$E(X,1,D-1)
|
---|
| 69 | F D=0:1 Q:$A(X)-32 S X=$E(X,2,999) ;strip off 'D' leading spaces
|
---|
| 70 | Q:X=""
|
---|
| 71 | I D<DIETAB,L K I(L),J(L) S L=$O(J(L),-1),DIAP=DIAP(F),F=F-1,DI=J(L) ;out-dentation means go up a level
|
---|
| 72 | S DIETAB=D
|
---|
| 73 | I X?1"@"1.N S Y=X G DR
|
---|
| 74 | D DICS^DIA I X="ALL" D Q
|
---|
| 75 | .N D,DA,DG S ^UTILITY("DIETEDIAB",$J,1,F,DI,DIAP\1000)=X,%=DI D A^DIA1 ; 'ALL' fields
|
---|
| 76 | S DV="",J=$P(X,"-",2) I +J=J,$P(X,"-")=+X,J>X D G X:Y="",DR
|
---|
| 77 | .N D,DA,DG S D(F)=J D RANGE^DIA1 S Y=DA
|
---|
| 78 | SEMIC I X[";" S Y=X,X=$P(X,";") D G X:'$D(Y) S DIAB=Y
|
---|
| 79 | .F %=2:1:$L(Y,";") S D=$P(Y,";",%),D=$S(D="DUP":"d",D="REQ":"R","""R""d"""[D:"",$A(D)=34:$E(D,2,$F(D,"""",2)-2),1:D),DV=D_$C(126)_DV I $A(D)>45&($A(D)<58)!(D[":")!(D="") K Y Q
|
---|
| 80 | DIC S DIC(0)="OZ",DIC="^DD(DI," D ^DIC
|
---|
| 81 | I Y>0 S Y=+Y_DV D DR S %=+$P(Y(0),U,2) D:% Q
|
---|
| 82 | .I $P($G(^DD(+%,.01,0)),U,2)["W" Q
|
---|
| 83 | .S L=L+1,(DI,J(L))=+%,I(L)=""""_$P($P(Y(0),U,4),";")_"""" D D
|
---|
| 84 | S (Y,DIETSAVE)=X I DUZ(0)="@",X'?.E1":" S X=$S(X["//^":$P(X,"//^",2),1:X),X=$S(X[";":$P(X,";"),1:X) D ^DIM G:$D(X) DR:X=DIETSAVE I DIETSAVE["//^",'$D(X) G X
|
---|
| 85 | F DIETSL="///+","//+","///","//" I DIETSAVE[DIETSL S DP=$P(DIETSAVE,DIETSL,2,9) I DP'?1"/".E&(DP'?1"^".E)!(DUZ(0)="@") G DEF
|
---|
| 86 | I DIETSAVE?.E1":" S:'$D(DIAB) DIAB=DIETSAVE K X S X=DIETSAVE,DICOMP=L_"WE",DQI="Y(",DA="DR(99,"_DXS_",",DICMX=1 D ^DICOMPW G L:$D(X) ;as in E^DIA3
|
---|
| 87 | X S ERR=1 Q
|
---|
| 88 | ;
|
---|
| 89 | L I $D(X)>1 M DR(99,DXS)=X S DXS=DXS+1
|
---|
| 90 | S %=-1,L=$S(Y>L:+Y,1:L\100+1*100),Y=U_DP_U_U_X_" S X=$S(D(0)>0:D(0),1:"""")" K X
|
---|
| 91 | D DR,D
|
---|
| 92 | S DI=+DP Q
|
---|
| 93 | ;
|
---|
| 94 | D S F=F+1,DIAP(F)=DIAP,DIAP=0 Q
|
---|
| 95 | ;
|
---|
| 96 | DEF S X=DIETSAVE D S X=$P(DIETSAVE,DIETSL),DV=DV_DIETSL_DP G X:DV[";",DIC ;as in DEF^DIA3
|
---|
| 97 | .S X="DA,DV,DWLC,0)=X" F J=L:-1 Q:I(J)[U S X="DA("_(L-J+1)_"),"_I(J)_","_X
|
---|
| 98 | .S DICMX="S DWLC=DWLC+1,"_I(J)_X,DA="DR(99,"_DXS_",",X=DP,DQI="X(",DICOMP=L_"T"
|
---|
| 99 | .D EN^DICOMP,DICS^DIA
|
---|
| 100 | XEC .I $D(X),Y["m" S DIC("S")="S %=$P(^(0),U,2) I %,$D(^DD(+%,.01,0)),$P(^(0),U,2)[""W"",$D(^DD(DI,Y,0)) "_DIC("S") ;as in XEC^DIA3
|
---|
| 101 | .S Y=0 F S Y=$O(X(Y)) Q:Y="" S @(DA_"Y)=X(Y)")
|
---|
| 102 | .S Y=-1 I $D(X) S Y="Q",DXS=DXS+1,DP=U_X D
|
---|
| 103 | ..D S:'$D(DIAB) DIAB=DIETSAVE ;assume "YOU MEAN as a VARIABLE"
|
---|
| 104 | ...N DIAB D DR
|
---|
| 105 | .I DP="@",DIETSL="//" S DA=U_U
|
---|
| 106 | .Q
|
---|
| 107 | ;
|
---|
| 108 | DR ;takes 'Y' and puts it into 'DR' array
|
---|
| 109 | N %,N,B
|
---|
| 110 | S (N,B)=$NA(DR(F+1,DI)),%=$O(@N@(""),-1)
|
---|
| 111 | I % S N=$NA(@N@(%))
|
---|
| 112 | I '$D(@N) S @N="",DIAP=0
|
---|
| 113 | I $L(Y)+$L(@N)>230 S N=$NA(@B@(%+1)),DIAP=DIAP\1000+1*1000,@N=""
|
---|
| 114 | S @N=@N_Y_";"
|
---|
| 115 | S DIAP=DIAP+1
|
---|
| 116 | DIAB I $D(DIAB) S ^UTILITY("DIETEDIAB",$J,DIAP#1000,F,DI,DIAP\1000)=DIAB K DIAB
|
---|
| 117 | Q
|
---|
| 118 | ;
|
---|
| 119 | PUT ;save template
|
---|
| 120 | I '$D(^UTILITY("DIETED",$J)) Q
|
---|
| 121 | N DIC
|
---|
| 122 | S DIC("B")=DIET
|
---|
| 123 | SAVEAS S DIC=.402,DIC("A")="Save revised "_DIETED_" as: ",DIC(0)="AEQL",DIC("S")="I $P(^(0),U,4)=DRK"
|
---|
| 124 | D ^DIC
|
---|
| 125 | Q:Y<0 I $O(^DIE(+Y,0))]"" W !,$C(7),"Are you sure you want to overwrite this '",$P(Y,U,2)," 'Template" S %=1 D YN^DICN I %-1 Q:%<2 K DIC("B") G SAVEAS
|
---|
| 126 | L +^DIE(+Y)
|
---|
| 127 | S ^DIE("F"_J(0),$P(Y,U,2),+Y)=1
|
---|
| 128 | S $P(^DIE(+Y,0),U,4)=J(0)
|
---|
| 129 | L -^DIE(+Y)
|
---|
| 130 | D SAVEFLDS(+Y)
|
---|
| 131 | Q
|
---|
| 132 | ;
|
---|
| 133 | SAVEFLDS(Y) ;
|
---|
| 134 | N X,DP,DMAX
|
---|
| 135 | Q:'$D(^UTILITY("DIETED",$J))!'$G(Y)
|
---|
| 136 | NOW D NOW^%DTC S $P(^DIE(Y,0),U,2)=+$J(%,0,4)
|
---|
| 137 | S $P(^DIE(Y,0),U,5)=$G(DUZ)
|
---|
| 138 | K ^DIE(Y,"DR") M ^DIE(+Y,"DR")=^UTILITY("DIETED",$J)
|
---|
| 139 | K ^DIE(Y,"DIAB") M ^DIE(+Y,"DIAB")=^UTILITY("DIETEDIAB",$J)
|
---|
| 140 | S X=$S('$D(^DIE(+Y,"ROU")):1,^("ROU")'[U:1,$D(^("ROUOLD")):^("ROUOLD"),1:1),DP=+$P(^(0),U,4),DMAX=^DD("ROU") I X'=1,$D(^DD("OS",DISYS,"ZS")) D EN^DIEZ
|
---|
| 141 | D K
|
---|
| 142 | Q
|
---|