DIEZ ;SFISC/GFT-COMPILE INPUT TEMPLATE ;19JAN2010
;;22.0;VA FileMan;**1,11,159,163**;Mar 30, 1999;Build 30
;Per VHA Directive 2004-038, this routine should not be modified.
I $G(DUZ(0))'="@" W $C(7),$$EZBLD^DIALOG(101) G K
EN1 D:'$D(DISYS) OS^DII I '$D(^DD("OS",DISYS,"ZS")) W $$EZBLD^DIALOG(820),$C(7) G K
S U="^" S:'$G(DTIME) DTIME=300 N L,DNM
D SIZ^DIPZ0(8033) G:$D(DTOUT)!($D(DUOUT))!('X) K S DMAX=X Q:$D(DIX)
TEM K DIC S DIC="^DIE(",DIC(0)="AEQ",DIC("W")="W ?40,""FILE #"",$P(^(0),U,4) W:$D(^(""ROU"")) ?60,^(""ROU"")",DIC("S")="I Y'<1" D ^DIC G:'$D(^DIE(+Y,"DR")) K S DIPZ=+Y
D RNM^DIPZ0(8033) G:$D(DTOUT)!($D(DUOUT))!(X="") K S DNM=X K DIC
W ! S DIR(0)="Y",DIR("A")=$$EZBLD^DIALOG(8020) D ^DIR K DIR G:'Y!($D(DIRUT)) K
S X=DNM,Y=DIPZ K DIPZ
EN ;
W:'$G(DIEZS) ! K ^UTILITY($J),DRN N L,DIEZQ,DIR S DMAX=DMAX-2150,DNM=X,DIEZ=+Y,DRN="",DRD=0,DIEZQ=0 D DELETROU(X)
S 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 DT^DICRW S X=-1
K T S T(1)=$P(^DIE(DIEZ,0),U),T(2)=$$EZBLD^DIALOG(8033),T(3)=DP D BLD^DIALOG(8024,.T,"","DIR") W:'$G(DIEZS) !,DIR K T
D UNCAF(DIEZ)
K DOV,^DIE(DIEZ,"RD"),DR S DR=^("DR",1,DP),(DIER,DL)=1,DIEZL=0,DIEZAB=U
D NEWROU F %=0:0 S %=$O(^DIE(DIEZ,"DR",99,%)) Q:%="" F %Y=0:0 S %Y=$O(^DIE(DIEZ,"DR",99,%,%Y)) Q:%Y="" S F=0,Q=^DIE(DIEZ,"DR",99,%,%Y) D QFF^DIEZ2 S X=" S DR(99,"_%_","_%Y_")="_Q D L^DIEZ2
S X=" N DIEZTMP,DIEZAR,DIEZRXR,DIIENS,DIXR K DIEFIRE,DIEBADK S DIEZTMP=$$GETTMP^DIKC1(""DIEZ"")" D L^DIEZ2
S X=" M DIEZAR=^DIE("_DIEZ_",""AR"") S DICRREC=""TRIG^DIE17""" D L^DIEZ2
N DIEZTMP S DIEZTMP=$$GETTMP^DIKC1("DIEZ")
S X=" S:$D(DTIME)[0 DTIME=300 S D0=DA,DIIENS=DA_"","",DIEZ="_DIEZ_",U=""^""" G ^DIEZ0
;
NEWROU ;
K ^UTILITY($J,0) S DQ=0,T=99,L=3
S ^UTILITY($J,0,1)=DNM_DRN_" ; "_$P("GENERATED FROM '"_$P(^DIE(DIEZ,0),U,1)_"' INPUT TEMPLATE(#"_DIEZ_"), FILE "_DP,U,DRN="")_";"_$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)
S ^UTILITY($J,0,2)=" D DE G BEGIN"
S ^UTILITY($J,0,3)="BEGIN S DNM="""_DNM_DRN_""",DQ=1"
I '$D(DRN(+DRN)) S DRN(+DRN)=U
Q
;
EN2(Y,DIEZFLGS,X,DMAX,DIEZRLA,DIEZZMSG) ;Silent or Talking with parameter passing
;and optionally return list of routines built and if successful
;IEN,FLAGS,ROUTINE,RTNMAXSIZE,RTNLISTARRAY,MSGARRAY
;Y=TEMPLATE IEN (required)
;FLAGS="T"alk (optional)
;X=ROUTINE NAME (required)
;DMAX=ROUTINE SIZE (optional)
;DIEZRLA=ROUTINE LIST ARRAY, by value (optional)
;DIEZZMSG=MESSAGE ARRAY (optional) (default ^TMP)
;*
;DIEZS will be used to indicate "silent" if set to 1
;Write statements are made conditional, if not "silent"
;*
N DIEZS,DNM,DIQUIET,DIEZRIEN,DIEZRLAZ,DIEZRLAF
N DIK,DIC,%I,DICS
S DIEZS=$G(DIEZFLGS)'["T"
S:DIEZS DIQUIET=1
I '$D(DIFM) N DIFM S DIFM=1 D
.N Y,DIEZFLGS,X,DMAX,DIEZRLA,DIEZS
.D INIZE^DIEFU
I $G(Y)'>0 D BLD^DIALOG(1700,"IEN for Edit Template missing or invalid") G EN2E
I '$D(^DIE(Y,0)) D BLD^DIALOG(1700,"No Edit Template on file with IEN="_Y) G EN2E
I $G(X)']"" D BLD^DIALOG(1700,"Routine name missing this Edit Template, IEN="_Y) G EN2E
I X'?1U.NU&(X'?1"%"1U.NU) D BLD^DIALOG(1700,"Routine name invalid") G EN2E
I $L(X)>7 D BLD^DIALOG(1700,"Routine name too long") G EN2E
S DIEZRLA=$G(DIEZRLA,"DIEZRLAZ"),DIEZRIEN=Y
S:DIEZRLA="" DIEZRLA="DIEZRLAZ" S:$G(DMAX)<2500!($G(DMAX)>^DD("ROU")) DMAX=^DD("ROU")
S DIEZRLAF=""
K @DIEZRLA
D EN
G:'DIEZS!(DIEZRLAF) EN2E
D BLD^DIALOG(1700,"Compiling Edit Template (IEN="_DIEZRIEN_")"_$S(DIEZRLAF=0:", routine name too long",1:""))
EN2E I 'DIEZS D MSG^DIALOG() Q
I $G(DIEZZMSG)]"" D CALLOUT^DIEFU(DIEZZMSG)
Q
;
RECOMP S DIX=1 D DIEZ Q:'$D(DIX) N DIMAX S DIMAX=DMAX
F DIX=0:0 S DIX=$O(^DIE(DIX)) Q:DIX'>0 I $D(^(DIX,0)),$D(^("ROU")) S %=$P(^(0),"^",1),X=$E(^("ROU"),2,99) I X]"" S Y=DIX,DMAX=DIMAX D EN
;
K K %,DDH,DIC,DIX,DIPZ,DMAX,DNM,DTOUT,DIRUT,DIROUT,DUOUT,X,Y Q
;DIALOG #101 'only those with programmer's access'
; #820 'no way to save routines on the system'
; #8020 'Should the compilation run now?'
; #8024 'Compiling template name Input template of file n'
; #8033 'Input template'
UNCAF(DIEZ) ;
; for one compiled input template (DIEZ), delete its "AF" entries
N %,X S X=""
F S X=$O(^DIE("AF",X)) Q:X="" K:'X ^(X,DIEZ) S %=0 F S %=$O(^DIE("AF",X,%)) Q:%'>0 K:$D(^(%,DIEZ)) ^(DIEZ)
Q
;
UNC(DIEZ,DIFLAGS) ;
; DBS: silent entry point to uncompile an input template
; DIEZ = IEN of input template to uncompile
; DIFLAGS = flags:
; D = compiled routines are also deleted
K ^DIE(DIEZ,"ROU")
D UNCAF(DIEZ)
I $G(DIFLAGS)["D" D
. N DINAME S DINAME=$G(^DIE(DIEZ,"ROUOLD")) Q:DINAME=""
. N DIROU,DISUF F DISUF="",1:1 D Q:DIROU=""
. . S DIROU=DINAME_DISUF I '$$ROUEXIST^DILIBF(DIROU) S DIROU="" Q
. . N X S X=DIROU X ^%ZOSF("DEL")
Q
;
;
DELETROU(DIEZNAME) ;DELETE THE ROUTINES NAMED 'DIEZNAME' CONCATENATED WITH NUMBER
Q:DIEZNAME="" Q:$L($T(+2^@DIEZNAME),";")>2 ;TRY TO KEEP FROM BLOWING AWAY A REAL ROUTINE!
N DIEZ,DIEZDEL,X,DIEZEXST,C
S C=0,DIEZEXST="I $L($T(^@X))",DIEZDEL=$G(^%ZOSF("DEL")) Q:DIEZDEL=""
F DIEZ=1:1:1000 D Q:C>20 ;STOP IF THERE IS A GAP OF 20
.S X=DIEZNAME_DIEZ X DIEZEXST I X DIEZDEL S C=0 Q
.S C=C+1
S X=DIEZNAME X DIEZEXST I X DIEZDEL
Q
DIEZ ;SFISC/GFT-COMPILE INPUT TEMPLATE ;19JAN2010
+1 ;;22.0;VA FileMan;**1,11,159,163**;Mar 30, 1999;Build 30
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 IF $GET(DUZ(0))'="@"
WRITE $CHAR(7),$$EZBLD^DIALOG(101)
GOTO K
EN1 IF '$DATA(DISYS)
DO OS^DII
IF '$DATA(^DD("OS",DISYS,"ZS"))
WRITE $$EZBLD^DIALOG(820),$CHAR(7)
GOTO K
+1 SET U="^"
IF '$GET(DTIME)
SET DTIME=300
NEW L,DNM
+2 DO SIZ^DIPZ0(8033)
IF $DATA(DTOUT)!($DATA(DUOUT))!('X)
GOTO K
SET DMAX=X
IF $DATA(DIX)
QUIT
TEM KILL DIC
SET DIC="^DIE("
SET DIC(0)="AEQ"
SET DIC("W")="W ?40,""FILE #"",$P(^(0),U,4) W:$D(^(""ROU"")) ?60,^(""ROU"")"
SET DIC("S")="I Y'<1"
DO ^DIC
IF '$DATA(^DIE(+Y,"DR"))
GOTO K
SET DIPZ=+Y
+1 DO RNM^DIPZ0(8033)
IF $DATA(DTOUT)!($DATA(DUOUT))!(X="")
GOTO K
SET DNM=X
KILL DIC
+2 WRITE !
SET DIR(0)="Y"
SET DIR("A")=$$EZBLD^DIALOG(8020)
DO ^DIR
KILL DIR
IF 'Y!($DATA(DIRUT))
GOTO K
+3 SET X=DNM
SET Y=DIPZ
KILL DIPZ
EN ;
+1 IF '$GET(DIEZS)
WRITE !
KILL ^UTILITY($JOB),DRN
NEW L,DIEZQ,DIR
SET DMAX=DMAX-2150
SET DNM=X
SET DIEZ=+Y
SET DRN=""
SET DRD=0
SET DIEZQ=0
DO DELETROU(X)
+2 SET DP=$PIECE(^DIE(DIEZ,0),U,4)
SET DIE=^DIC(DP,0,"GL")
+3 IF '$DATA(^DIE(DIEZ,"DR",1,DP))
SET ^DIE(DIEZ,"DR",1,DP)=^DIE(DIEZ,"DR")
+4 DO DT^DICRW
SET X=-1
+5 KILL T
SET T(1)=$PIECE(^DIE(DIEZ,0),U)
SET T(2)=$$EZBLD^DIALOG(8033)
SET T(3)=DP
DO BLD^DIALOG(8024,.T,"","DIR")
IF '$GET(DIEZS)
WRITE !,DIR
KILL T
+6 DO UNCAF(DIEZ)
+7 KILL DOV,^DIE(DIEZ,"RD"),DR
SET DR=^("DR",1,DP)
SET (DIER,DL)=1
SET DIEZL=0
SET DIEZAB=U
+8 DO NEWROU
FOR %=0:0
SET %=$ORDER(^DIE(DIEZ,"DR",99,%))
IF %=""
QUIT
FOR %Y=0:0
SET %Y=$ORDER(^DIE(DIEZ,"DR",99,%,%Y))
IF %Y=""
QUIT
SET F=0
SET Q=^DIE(DIEZ,"DR",99,%,%Y)
DO QFF^DIEZ2
SET X=" S DR(99,"_%_","_%Y_")="_Q
DO L^DIEZ2
+9 SET X=" N DIEZTMP,DIEZAR,DIEZRXR,DIIENS,DIXR K DIEFIRE,DIEBADK S DIEZTMP=$$GETTMP^DIKC1(""DIEZ"")"
DO L^DIEZ2
+10 SET X=" M DIEZAR=^DIE("_DIEZ_",""AR"") S DICRREC=""TRIG^DIE17"""
DO L^DIEZ2
+11 NEW DIEZTMP
SET DIEZTMP=$$GETTMP^DIKC1("DIEZ")
+12 SET X=" S:$D(DTIME)[0 DTIME=300 S D0=DA,DIIENS=DA_"","",DIEZ="_DIEZ_",U=""^"""
GOTO ^DIEZ0
+13 ;
NEWROU ;
+1 KILL ^UTILITY($JOB,0)
SET DQ=0
SET T=99
SET L=3
+2 SET ^UTILITY($JOB,0,1)=DNM_DRN_" ; "_$PIECE("GENERATED FROM '"_$PIECE(^DIE(DIEZ,0),U,1)_"' INPUT TEMPLATE(#"_DIEZ_"), FILE "_DP,U,DRN="")_";"_$EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_$EXTRACT(DT,2,3)
+3 SET ^UTILITY($JOB,0,2)=" D DE G BEGIN"
+4 SET ^UTILITY($JOB,0,3)="BEGIN S DNM="""_DNM_DRN_""",DQ=1"
+5 IF '$DATA(DRN(+DRN))
SET DRN(+DRN)=U
+6 QUIT
+7 ;
EN2(Y,DIEZFLGS,X,DMAX,DIEZRLA,DIEZZMSG) ;Silent or Talking with parameter passing
+1 ;and optionally return list of routines built and if successful
+2 ;IEN,FLAGS,ROUTINE,RTNMAXSIZE,RTNLISTARRAY,MSGARRAY
+3 ;Y=TEMPLATE IEN (required)
+4 ;FLAGS="T"alk (optional)
+5 ;X=ROUTINE NAME (required)
+6 ;DMAX=ROUTINE SIZE (optional)
+7 ;DIEZRLA=ROUTINE LIST ARRAY, by value (optional)
+8 ;DIEZZMSG=MESSAGE ARRAY (optional) (default ^TMP)
+9 ;*
+10 ;DIEZS will be used to indicate "silent" if set to 1
+11 ;Write statements are made conditional, if not "silent"
+12 ;*
+13 NEW DIEZS,DNM,DIQUIET,DIEZRIEN,DIEZRLAZ,DIEZRLAF
+14 NEW DIK,DIC,%I,DICS
+15 SET DIEZS=$GET(DIEZFLGS)'["T"
+16 IF DIEZS
SET DIQUIET=1
+17 IF '$DATA(DIFM)
NEW DIFM
SET DIFM=1
Begin DoDot:1
+18 NEW Y,DIEZFLGS,X,DMAX,DIEZRLA,DIEZS
+19 DO INIZE^DIEFU
End DoDot:1
+20 IF $GET(Y)'>0
DO BLD^DIALOG(1700,"IEN for Edit Template missing or invalid")
GOTO EN2E
+21 IF '$DATA(^DIE(Y,0))
DO BLD^DIALOG(1700,"No Edit Template on file with IEN="_Y)
GOTO EN2E
+22 IF $GET(X)']""
DO BLD^DIALOG(1700,"Routine name missing this Edit Template, IEN="_Y)
GOTO EN2E
+23 IF X'?1U.NU&(X'?1"%"1U.NU)
DO BLD^DIALOG(1700,"Routine name invalid")
GOTO EN2E
+24 IF $LENGTH(X)>7
DO BLD^DIALOG(1700,"Routine name too long")
GOTO EN2E
+25 SET DIEZRLA=$GET(DIEZRLA,"DIEZRLAZ")
SET DIEZRIEN=Y
+26 IF DIEZRLA=""
SET DIEZRLA="DIEZRLAZ"
IF $GET(DMAX)<2500!($GET(DMAX)>^DD("ROU"))
SET DMAX=^DD("ROU")
+27 SET DIEZRLAF=""
+28 KILL @DIEZRLA
+29 DO EN
+30 IF 'DIEZS!(DIEZRLAF)
GOTO EN2E
+31 DO BLD^DIALOG(1700,"Compiling Edit Template (IEN="_DIEZRIEN_")"_$SELECT(DIEZRLAF=0:", routine name too long",1:""))
EN2E IF 'DIEZS
DO MSG^DIALOG()
QUIT
+1 IF $GET(DIEZZMSG)]""
DO CALLOUT^DIEFU(DIEZZMSG)
+2 QUIT
+3 ;
RECOMP SET DIX=1
DO DIEZ
IF '$DATA(DIX)
QUIT
NEW DIMAX
SET DIMAX=DMAX
+1 FOR DIX=0:0
SET DIX=$ORDER(^DIE(DIX))
IF DIX'>0
QUIT
IF $DATA(^(DIX,0))
IF $DATA(^("ROU"))
SET %=$PIECE(^(0),"^",1)
SET X=$EXTRACT(^("ROU"),2,99)
IF X]""
SET Y=DIX
SET DMAX=DIMAX
DO EN
+2 ;
K KILL %,DDH,DIC,DIX,DIPZ,DMAX,DNM,DTOUT,DIRUT,DIROUT,DUOUT,X,Y
QUIT
+1 ;DIALOG #101 'only those with programmer's access'
+2 ; #820 'no way to save routines on the system'
+3 ; #8020 'Should the compilation run now?'
+4 ; #8024 'Compiling template name Input template of file n'
+5 ; #8033 'Input template'
UNCAF(DIEZ) ;
+1 ; for one compiled input template (DIEZ), delete its "AF" entries
+2 NEW %,X
SET X=""
+3 FOR
SET X=$ORDER(^DIE("AF",X))
IF X=""
QUIT
IF 'X
KILL ^(X,DIEZ)
SET %=0
FOR
SET %=$ORDER(^DIE("AF",X,%))
IF %'>0
QUIT
IF $DATA(^(%,DIEZ))
KILL ^(DIEZ)
+4 QUIT
+5 ;
UNC(DIEZ,DIFLAGS) ;
+1 ; DBS: silent entry point to uncompile an input template
+2 ; DIEZ = IEN of input template to uncompile
+3 ; DIFLAGS = flags:
+4 ; D = compiled routines are also deleted
+5 KILL ^DIE(DIEZ,"ROU")
+6 DO UNCAF(DIEZ)
+7 IF $GET(DIFLAGS)["D"
Begin DoDot:1
+8 NEW DINAME
SET DINAME=$GET(^DIE(DIEZ,"ROUOLD"))
IF DINAME=""
QUIT
+9 NEW DIROU,DISUF
FOR DISUF="",1:1
Begin DoDot:2
+10 SET DIROU=DINAME_DISUF
IF '$$ROUEXIST^DILIBF(DIROU)
SET DIROU=""
QUIT
+11 NEW X
SET X=DIROU
XECUTE ^%ZOSF("DEL")
End DoDot:2
IF DIROU=""
QUIT
End DoDot:1
+12 QUIT
+13 ;
+14 ;
DELETROU(DIEZNAME) ;DELETE THE ROUTINES NAMED 'DIEZNAME' CONCATENATED WITH NUMBER
+1 ;TRY TO KEEP FROM BLOWING AWAY A REAL ROUTINE!
IF DIEZNAME=""
QUIT
IF $LENGTH($TEXT(+2^@DIEZNAME),";")>2
QUIT
+2 NEW DIEZ,DIEZDEL,X,DIEZEXST,C
+3 SET C=0
SET DIEZEXST="I $L($T(^@X))"
SET DIEZDEL=$GET(^%ZOSF("DEL"))
IF DIEZDEL=""
QUIT
+4 ;STOP IF THERE IS A GAP OF 20
FOR DIEZ=1:1:1000
Begin DoDot:1
+5 SET X=DIEZNAME_DIEZ
XECUTE DIEZEXST
IF $TEST
XECUTE DIEZDEL
SET C=0
QUIT
+6 SET C=C+1
End DoDot:1
IF C>20
QUIT
+7 SET X=DIEZNAME
XECUTE DIEZEXST
IF $TEST
XECUTE DIEZDEL
+8 QUIT
