Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed

  • WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DIETED.m

    r613 r623  
    1 DIETED  ;SFISC/GFT SCREEN-EDIT AN INPUT TEMPLATE ;22MAY2006
    2         ;;22.0;VA FileMan;**111,159**;Mar 30, 1999;Build 8
    3         ;Per VHA Directive 2004-038, 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,DIT)  ;put displayable template into @DIETA
    33         N DIAO,DIETREL,DIETAD,DB,DIAT,I,J,L,DIAR,DIAB
    34         K @DIETA
    35         I '$D(DIT) S DIT=$NA(^DIE(DIET))
    36         S (DR,DIAT)="",(DIETAD,L,DIAO,DB,DIAR)=0,F=-1
    37         S J(0)=$P(@DIT@(0),U,4)
    38         M DI=^("DIAB") S DI=J(0)
    39         D DOWN
    40 1       S Y=$P(DIAT,";",DB) I "Q"[Y G NDB:Y="" S DB=DB+1 G 1
    41         S %=+Y I Y?.NP,$P(Y,":",2),Y'["/" S Y=+Y_"-"_$P(Y,":",2),%=""
    42         I %_"T~"=Y!(%_"t~"=Y),$P($G(^DD(DI,%,0)),U,2) S Y=% ;HWH-1103-40934 -- ignore TITLE of MULTIPLE
    43         S DIETREL="",DIAB=$G(DI(DB,DIAR-1,DI,DIAO)) E  S:Y?1"^".E DIETREL=Y S:DIAB]"" Y=DIAB
    44         I Y?1"]".E S Y=$E(Y,2,999)
    45         I DIAB="",%,$D(^DD(DI,%,0)) S Y=$P(^(0),U)_$P(Y,%,2,999)
    46         S DB=DB+1,DIETAD=DIETAD+1,@DIETA@(DIETAD)=$J("",F*3)_Y I DIETREL]"" D  G 1 ;Put it in!
    47         .S L=L\100+1*100,(J(L),DI)=$P(DIETREL,U,2) D DOWN ;Relational jump
    48         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 ;Down to a multiple
    49         I Y="ALL" G UP
    50         G 1
    51         ;
    52 DOWN    S F=F+1,DIAR(F)=DIAR,DIAR=DIAR+1,%=$P(DIAT,";",DB) S:%?1"^"1.NP DB=DB+1,DIAR=$P(%,U,2)
    53         S DB(F)=DB,DB=1,DIAO(F)=DIAO,DIAO=0
    54 DIAT    S DIAT=$G(@DIT@("DR",DIAR,DI),"ALL") Q
    55         ;
    56 NDB     I DIAO'<0 S DIAO=DIAO+1 I $D(@DIT@("DR",DIAR,DI,DIAO)) S DIAT=^(DIAO),DB=1 G 1
    57         S DIAO=-1
    58 UP      Q:'F  K I(L),J(L) S L=$O(J(L),-1)
    59         S DIAR=DIAR(F),DB=DB(F),DIAO=DIAO(F),DI=J(L),DIAT=$S(DIAO<0:"",DIAO:@DIT@("DR",DIAR,J(L),DIAO),1:$G(@DIT@("DR",DIAR,DI))),F=F-1 G 1
    60         ;
    61         ;
    62         ;
    63         ;
    64 PROCESS(DIETA)  ;puts nodes into ^UTILITY("DIETED")
    65         N DIAB,LINE,DXS,L,DIAP,DIETSL,DQI,DIETSAVE,DIETAB,ERR,DIAR
    66         K DR S F=0,(DI,J(0))=DRK,I(0)=^DIC(J(0),0,"GL"),DIAP="",(L,DIETAB)=0,DXS=1,DIAR=1
    67         F LINE=1:1 Q:'$D(@DIETA@(LINE))  K ERR S X=^(LINE) D
    68         .I X?1"^".E S LINE=999999999 K DR Q
    69         .D LINE(X)
    70         .I $D(ERR) W "LINE ",LINE S DIETEDER(LINE)=ERR,LINE=-LINE Q  ;stop if we find one error
    71         I LINE<0 W " ERROR!"
    72         Q
    73         ;
    74 LINE(X) ;Process one LINE from the screen
    75         N D,DIC,DICMX,DV,DATE,Y,DICOMPX,DICOMP,DRR
    76         F D=$L(X):-1:1 Q:$A(X,D)>32  S X=$E(X,1,D-1)
    77         F D=0:1 Q:$A(X)-32  S X=$E(X,2,999) ;strip off 'D' leading spaces
    78         Q:X=""
    79 OUT     I D<DIETAB,L K I(L),J(L) S L=$O(J(L),-1),DIAP=DIAP(F),DIAR=DIAR(F),DIETAB=$G(DIETAB(F),D),F=F-1,DI=J(L) G OUT ;out-dentation means go up a level (or more)
    80         S DIETAB=D
    81         I X?1"@"1.N S Y=X G DR
    82 ALL     D DICS^DIA I X="ALL" D  Q
    83         .S ^UTILITY("DIETEDIAB",$J,1,DIAR-1,DI,DIAP\1000)=X
    84         .N D,DA,DG D RANGE^DIA1
    85         S DV="",J=$P(X,"-",2) I +J=J,$P(X,"-")=+X,J>X D  G X:Y="",DR
    86         .N D,DA,DG S D(F)=J D RANGE^DIA1 S Y=DA
    87 SEMIC   I X[";" S Y=X,X=$P(X,";") D  G X:'$D(Y) S DIAB=Y
    88         .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),D="T":D,1:""),DV=D_$C(126)_DV I $A(D)>45&($A(D)<58)!(D[":")!(D="") K Y Q
    89 DIC     S DIC(0)="OZ",DIC="^DD(DI," D ^DIC
    90         I Y>0 S Y=+Y_DV D DR S %=+$P(Y(0),U,2) D:%  Q
    91         .I $P($G(^DD(+%,.01,0)),U,2)["W" Q
    92         .S L=L+1,(DI,J(L))=+%,I(L)=""""_$P($P(Y(0),U,4),";")_"""" D D
    93         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
    94         F DIETSL="///+","//+","///","//" I DIETSAVE[DIETSL S DP=$P(DIETSAVE,DIETSL,2,9) I DP'?1"/".E&(DP'?1"^".E)!(DUZ(0)="@") G DEF
    95         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
    96 X       S ERR=1 Q
    97         ;
    98 L       I $D(X)>1  M DR(99,DXS)=X S DXS=DXS+1
    99         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
    100         D DR S DI=+DP D D
    101         Q
    102         ;
    103 D       N % S F=F+1,DIAR(F)=DIAR F %=F+1:.01 Q:'$D(DR(%,DI))
    104         S:%["." @DRR=@DRR_U_%_";",DIAP=DIAP+1 S DIAR=%
    105         S DIAP(F)=DIAP,DIAP=0,DIETAB(F)=DIETAB Q
    106         ;
    107 DEF     S X=DIETSAVE D  S X=$P(DIETSAVE,DIETSL),DV=DV_DIETSL_DP G X:DV[";",DIC ;as in DEF^DIA3
    108         .S X="DA,DV,DWLC,0)=X" F J=L:-1 Q:I(J)[U  S X="DA("_(L-J+1)_"),"_I(J)_","_X
    109         .S DICMX="S DWLC=DWLC+1,"_I(J)_X,DA="DR(99,"_DXS_",",X=DP,DQI="X(",DICOMP=L_"T"
    110         .D EN^DICOMP,DICS^DIA
    111 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
    112         .S Y=0 F  S Y=$O(X(Y)) Q:Y=""  S @(DA_"Y)=X(Y)")
    113         .S Y=-1 I $D(X) S Y="Q",DXS=DXS+1,DP=U_X D
    114         ..D  S:'$D(DIAB) DIAB=DIETSAVE ;assume "YOU MEAN as a VARIABLE"
    115         ...N DIAB D DR
    116         .I DP="@",DIETSL="//" S DA=U_U
    117         .Q
    118         ;
    119 DR      ;takes 'Y' and puts it into 'DR' array
    120         N %,B
    121         S (DRR,B)=$NA(DR(DIAR,DI)),%=$O(@DRR@(""),-1)
    122         I % S DRR=$NA(@DRR@(%))
    123         I '$D(@DRR) S @DRR="",DIAP=0
    124         I $L(Y)+$L(@DRR)>230 S DRR=$NA(@B@(%+1)),DIAP=DIAP\1000+1*1000,@DRR=""
    125         S @DRR=@DRR_Y_";"
    126         S DIAP=DIAP+1
    127 DIAB    I $D(DIAB) S ^UTILITY("DIETEDIAB",$J,DIAP#1000,DIAR-1,DI,DIAP\1000)=DIAB K DIAB
    128         Q
    129         ;
    130 PUT     ;save template
    131         I '$D(^UTILITY("DIETED",$J)) Q
    132         N DIC
    133         S DIC("B")=DIET
    134 SAVEAS  S DIC=.402,DIC("A")="Save revised "_DIETED_" as: ",DIC(0)="AEQL",DIC("S")="I $P(^(0),U,4)=DRK"
    135         D ^DIC
    136         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
    137         L +^DIE(+Y)
    138         S ^DIE("F"_J(0),$P(Y,U,2),+Y)=1
    139         S $P(^DIE(+Y,0),U,4)=J(0)
    140         L -^DIE(+Y)
    141         D SAVEFLDS(+Y)
    142         Q
    143         ;
    144 SAVEFLDS(Y)     ;
    145         N X,DP,DMAX
    146         Q:'$D(^UTILITY("DIETED",$J))!'$G(Y)
    147 NOW     D NOW^%DTC S $P(^DIE(Y,0),U,2)=+$J(%,0,4)
    148         S $P(^DIE(Y,0),U,5)=$G(DUZ)
    149         K ^DIE(Y,"DR") M ^DIE(+Y,"DR")=^UTILITY("DIETED",$J)
    150         K ^DIE(Y,"DIAB") M ^DIE(+Y,"DIAB")=^UTILITY("DIETEDIAB",$J)
    151         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
    152         D K
    153         Q
     1DIETED ;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
     8K K ^UTILITY("DIETEDIAB",$J),^UTILITY("DIETED",$J)
     9 Q
     10 ;
     11EDIT(DIET) ; Edit Template using Screen Editor
     12 N DRK,DIETED,I,J
     13E 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)
     20DDW 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
     27KL K ^TMP("DIETED",$J)
     28 I '$D(DR) W $C(7),$$EZBLD^DIALOG(8077) Q
     29 M ^UTILITY("DIETED",$J)=DR
     30 Q
     31 ;
     32GET(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
     391 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
     49DOWN S F=F+1,DB(F)=DB,DB=1,DIAO(F)=DIAO,DIAO=0
     50DIAT S DIAT=$G(^DIE(DIET,"DR",F+1,DI),"ALL") Q
     51 ;
     52NDB 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
     54UP 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 ;
     57PROCESS(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
     66LINE(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
     78SEMIC 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
     80DIC 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
     87X S ERR=1 Q
     88 ;
     89L 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 ;
     94D S F=F+1,DIAP(F)=DIAP,DIAP=0 Q
     95 ;
     96DEF 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
     100XEC .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 ;
     108DR ;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
     116DIAB I $D(DIAB) S ^UTILITY("DIETEDIAB",$J,DIAP#1000,F,DI,DIAP\1000)=DIAB K DIAB
     117 Q
     118 ;
     119PUT ;save template
     120 I '$D(^UTILITY("DIETED",$J)) Q
     121 N DIC
     122 S DIC("B")=DIET
     123SAVEAS 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 ;
     133SAVEFLDS(Y) ;
     134 N X,DP,DMAX
     135 Q:'$D(^UTILITY("DIETED",$J))!'$G(Y)
     136NOW 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
Note: See TracChangeset for help on using the changeset viewer.