DG812P ;;ALB/DEP - POST-INSTALL DG*5.3*812 ; 2/5/13 5:09pm
;;5.3;REGISTRATION;**812**;Aug 13,1993;Build 19
;;Check for updated X-REFS (Field: .17) used in Input Templates
;;
Q
;;
POST ;Post init
N DGFLD,DGMFLD,DGOUT,DGFILE,DNM
D TEMPL
Q
;
TEMPL ;Determine templates on the FILE file to be compiled.
N GLOBAL,FIELD,FILE,CNT
D BMES^XPDUTL("Beginning to compile templates on the INDIVIDUAL ANNUAL INCOME (#408.21) file.")
;
S FIELD=".17",FILE=408.21
D LOOP(FIELD,FILE)
S (X,Y)=""
D BMES^XPDUTL("The following routine namespace compiled:")
F S X=$O(CFIELD(X)) Q:X="" S Y=$G(Y)+1 S PRINT(Y)=" "_X
;
D MES^XPDUTL(.PRINT)
K X,Y,PRINT,CFIELD
Q
LOOP(FIELD,FILE) ;Compile templates.
N GLOBAL,TEMPLATP,TEMPLATN,X,Y,DMAX,TYPE
F GLOBAL="^DIE","^DIPT" D
. S TYPE="Input" S:GLOBAL="^DIPT" TYPE="Print"
. I $D(@GLOBAL@("AF",FILE,FIELD)) D
.. S TEMPLATP=0
.. I GLOBAL="^DIE" D BMES^XPDUTL(" Compiling Input Templates")
.. I GLOBAL="^DIPT" D BMES^XPDUTL(" Compiling Print Template")
.. F S TEMPLATP=$O(@GLOBAL@("AF",FILE,FIELD,TEMPLATP)) Q:'TEMPLATP D
... S TEMPLATN=$P($G(@GLOBAL@(TEMPLATP,0)),"^",1)
... I TEMPLATN="" D BMES^XPDUTL("Could not compile template "_TEMPLATN_$C(13,10)_"Please review!") Q
... S X=$P($G(@GLOBAL@(TEMPLATP,"ROUOLD")),"^")
... I X=""&($D(@GLOBAL@(TEMPLATP,"ROU"))'=0) D BMES^XPDUTL("Could not find routine for template "_TEMPLATN_$C(13,10)_"Please review!") Q
... I X=""&($D(@GLOBAL@(TEMPLATP,"ROU"))=0) Q
... I $D(CFIELD(X)) Q ;already compiled
... S CFIELD(X)="" ; remember the template was compiled
... S Y=TEMPLATP ; set up the call for FileMan
... S DMAX=$$ROUSIZE^DILF
... I GLOBAL="^DIE" D EN^DIEZ Q
... I GLOBAL="^DIPT" D EN^DIPZ Q
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG812P 1753 printed Dec 13, 2024@02:40:44 Page 2
DG812P ;;ALB/DEP - POST-INSTALL DG*5.3*812 ; 2/5/13 5:09pm
+1 ;;5.3;REGISTRATION;**812**;Aug 13,1993;Build 19
+2 ;;Check for updated X-REFS (Field: .17) used in Input Templates
+3 ;;
+4 QUIT
+5 ;;
POST ;Post init
+1 NEW DGFLD,DGMFLD,DGOUT,DGFILE,DNM
+2 DO TEMPL
+3 QUIT
+4 ;
TEMPL ;Determine templates on the FILE file to be compiled.
+1 NEW GLOBAL,FIELD,FILE,CNT
+2 DO BMES^XPDUTL("Beginning to compile templates on the INDIVIDUAL ANNUAL INCOME (#408.21) file.")
+3 ;
+4 SET FIELD=".17"
SET FILE=408.21
+5 DO LOOP(FIELD,FILE)
+6 SET (X,Y)=""
+7 DO BMES^XPDUTL("The following routine namespace compiled:")
+8 FOR
SET X=$ORDER(CFIELD(X))
if X=""
QUIT
SET Y=$GET(Y)+1
SET PRINT(Y)=" "_X
+9 ;
+10 DO MES^XPDUTL(.PRINT)
+11 KILL X,Y,PRINT,CFIELD
+12 QUIT
LOOP(FIELD,FILE) ;Compile templates.
+1 NEW GLOBAL,TEMPLATP,TEMPLATN,X,Y,DMAX,TYPE
+2 FOR GLOBAL="^DIE","^DIPT"
Begin DoDot:1
+3 SET TYPE="Input"
if GLOBAL="^DIPT"
SET TYPE="Print"
+4 IF $DATA(@GLOBAL@("AF",FILE,FIELD))
Begin DoDot:2
+5 SET TEMPLATP=0
+6 IF GLOBAL="^DIE"
DO BMES^XPDUTL(" Compiling Input Templates")
+7 IF GLOBAL="^DIPT"
DO BMES^XPDUTL(" Compiling Print Template")
+8 FOR
SET TEMPLATP=$ORDER(@GLOBAL@("AF",FILE,FIELD,TEMPLATP))
if 'TEMPLATP
QUIT
Begin DoDot:3
+9 SET TEMPLATN=$PIECE($GET(@GLOBAL@(TEMPLATP,0)),"^",1)
+10 IF TEMPLATN=""
DO BMES^XPDUTL("Could not compile template "_TEMPLATN_$CHAR(13,10)_"Please review!")
QUIT
+11 SET X=$PIECE($GET(@GLOBAL@(TEMPLATP,"ROUOLD")),"^")
+12 IF X=""&($DATA(@GLOBAL@(TEMPLATP,"ROU"))'=0)
DO BMES^XPDUTL("Could not find routine for template "_TEMPLATN_$CHAR(13,10)_"Please review!")
QUIT
+13 IF X=""&($DATA(@GLOBAL@(TEMPLATP,"ROU"))=0)
QUIT
+14 ;already compiled
IF $DATA(CFIELD(X))
QUIT
+15 ; remember the template was compiled
SET CFIELD(X)=""
+16 ; set up the call for FileMan
SET Y=TEMPLATP
+17 SET DMAX=$$ROUSIZE^DILF
+18 IF GLOBAL="^DIE"
DO EN^DIEZ
QUIT
+19 IF GLOBAL="^DIPT"
DO EN^DIPZ
QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+20 QUIT
+21 ;
