ACKQ316P ;ALB/BR-Compile Templates;
;;3.0;QUASAR;**16**;May 9, 2007;Build 37
;Per VHA Directive 2004-038, this routine SHOULD NOT be modified.
;This Post install routine will compile the templates for fields 40 and 45.
POST ;Post init
N DGFLD,DGMFLD,DGOUT,DGFILE
D TEMPL
Q
;
TEMPL ;Determine templates on the FILE file to be compiled.
N GLOBAL,FIELD,NFIELD,FILE,CNT
D BMES^XPDUTL("Beginning to compile templates on the A&SP CLINIC VISIT (#509850.6) file.")
;
S NFIELD="40,45",FILE=509850.6,FIELD="",CNT=1
F S FIELD=$P(NFIELD,",",CNT) Q:FIELD="" D LOOP(FIELD,FILE) S CNT=CNT+1
W !!
S (X,Y)=""
D BMES^XPDUTL("The following routine namespace was 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
F GLOBAL="^DIE","^DIPT" D
.I $D(@GLOBAL@("AF",FILE,FIELD)) D
..S TEMPLATP=0
..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
...;W !,"Field: "_FIELD,!
...;W !,"Template "_TEMPLATN_" needs to be compiled.",!
...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 BMES^XPDUTL(" "),BMES^XPDUTL(" Compiling Input Templates") D EN^DIEZ Q
...I GLOBAL="^DIPT" D BMES^XPDUTL(" "),BMES^XPDUTL(" Compiling Print Templates") D EN^DIPZ Q
Q
;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HACKQ316P 1886 printed Nov 22, 2024@17:41:31 Page 2
ACKQ316P ;ALB/BR-Compile Templates;
+1 ;;3.0;QUASAR;**16**;May 9, 2007;Build 37
+2 ;Per VHA Directive 2004-038, this routine SHOULD NOT be modified.
+3 ;This Post install routine will compile the templates for fields 40 and 45.
POST ;Post init
+1 NEW DGFLD,DGMFLD,DGOUT,DGFILE
+2 DO TEMPL
+3 QUIT
+4 ;
TEMPL ;Determine templates on the FILE file to be compiled.
+1 NEW GLOBAL,FIELD,NFIELD,FILE,CNT
+2 DO BMES^XPDUTL("Beginning to compile templates on the A&SP CLINIC VISIT (#509850.6) file.")
+3 ;
+4 SET NFIELD="40,45"
SET FILE=509850.6
SET FIELD=""
SET CNT=1
+5 FOR
SET FIELD=$PIECE(NFIELD,",",CNT)
if FIELD=""
QUIT
DO LOOP(FIELD,FILE)
SET CNT=CNT+1
+6 WRITE !!
+7 SET (X,Y)=""
+8 DO BMES^XPDUTL("The following routine namespace was compiled:")
+9 FOR
SET X=$ORDER(CFIELD(X))
if X=""
QUIT
SET Y=$GET(Y)+1
SET PRINT(Y)=" "_X_"*"
+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
+2 FOR GLOBAL="^DIE","^DIPT"
Begin DoDot:1
+3 IF $DATA(@GLOBAL@("AF",FILE,FIELD))
Begin DoDot:2
+4 SET TEMPLATP=0
+5 FOR
SET TEMPLATP=$ORDER(@GLOBAL@("AF",FILE,FIELD,TEMPLATP))
if 'TEMPLATP
QUIT
Begin DoDot:3
+6 SET TEMPLATN=$PIECE($GET(@GLOBAL@(TEMPLATP,0)),"^",1)
+7 IF TEMPLATN=""
DO BMES^XPDUTL("Could not compile template "_TEMPLATN_$CHAR(13,10)_"Please review!")
QUIT
+8 SET X=$PIECE($GET(@GLOBAL@(TEMPLATP,"ROUOLD")),"^")
+9 IF X=""&($DATA(@GLOBAL@(TEMPLATP,"ROU"))'=0)
DO BMES^XPDUTL("Could not find routine for template "_TEMPLATN_$CHAR(13,10)_"Please review!")
QUIT
+10 IF X=""&($DATA(@GLOBAL@(TEMPLATP,"ROU"))=0)
QUIT
+11 ;W !,"Field: "_FIELD,!
+12 ;W !,"Template "_TEMPLATN_" needs to be compiled.",!
+13 ;already compiled
IF $DATA(CFIELD(X))
QUIT
+14 ; remember the template was compiled
SET CFIELD(X)=""
+15 ; set up the call for FileMan
SET Y=TEMPLATP
+16 SET DMAX=$$ROUSIZE^DILF
+17 IF GLOBAL="^DIE"
DO BMES^XPDUTL(" ")
DO BMES^XPDUTL(" Compiling Input Templates")
DO EN^DIEZ
QUIT
+18 IF GLOBAL="^DIPT"
DO BMES^XPDUTL(" ")
DO BMES^XPDUTL(" Compiling Print Templates")
DO EN^DIPZ
QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+19 QUIT
+20 ;
+21 ;
