DG832P2 ;;ALB/RGB - POST-INSTALL DG*5.3*832 ; 6/24/10 6:42pm
;;5.3;Registration;**832**;Aug 13, 1993;Build 9
;;Check for updated X-REFS (Fields: .01,.04,.06,.14,.18) used in Input Templates
;;
; IA #2796 for use of calls to RGHLLOG in UPDBAI
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 PATIENT MOVEMENT (#405) file.")
;
S NFIELD=".01,.04,.06,.14,.18",FILE=405,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 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
.. F S TEMPLATP=$O(@GLOBAL@("AF",FILE,FIELD,TEMPLATP)) Q:'TEMPLATP DO
... 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 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[HDG832P2 1897 printed Dec 13, 2024@02:40:46 Page 2
DG832P2 ;;ALB/RGB - POST-INSTALL DG*5.3*832 ; 6/24/10 6:42pm
+1 ;;5.3;Registration;**832**;Aug 13, 1993;Build 9
+2 ;;Check for updated X-REFS (Fields: .01,.04,.06,.14,.18) used in Input Templates
+3 ;;
+4 ; IA #2796 for use of calls to RGHLLOG in UPDBAI
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 PATIENT MOVEMENT (#405) file.")
+3 ;
+4 SET NFIELD=".01,.04,.06,.14,.18"
SET FILE=405
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 compiled:")
+9 FOR
SET X=$ORDER(CFIELD(X))
if X=""
QUIT
SET Y=$GET(Y)+1
SET PRINT(Y)=" "_X_"*"
+10 ;
+11 DO MES^XPDUTL(.PRINT)
+12 KILL X,Y,PRINT,CFIELD
+13 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 FOR
SET TEMPLATP=$ORDER(@GLOBAL@("AF",FILE,FIELD,TEMPLATP))
if 'TEMPLATP
QUIT
Begin DoDot:3
+7 SET TEMPLATN=$PIECE($GET(@GLOBAL@(TEMPLATP,0)),"^",1)
+8 IF TEMPLATN=""
DO BMES^XPDUTL("Could not compile template "_TEMPLATN_$CHAR(13,10)_"Please review!")
QUIT
+9 SET X=$PIECE($GET(@GLOBAL@(TEMPLATP,"ROUOLD")),"^")
+10 IF X=""&($DATA(@GLOBAL@(TEMPLATP,"ROU"))'=0)
DO BMES^XPDUTL("Could not find routine for template "_TEMPLATN_$CHAR(13,10)_"Please review!")
QUIT
+11 IF X=""&($DATA(@GLOBAL@(TEMPLATP,"ROU"))=0)
QUIT
+12 ;already compiled
IF $DATA(CFIELD(X))
QUIT
+13 ; remember the template was compiled
SET CFIELD(X)=""
+14 ; set up the call for FileMan
SET Y=TEMPLATP
+15 SET DMAX=$$ROUSIZE^DILF
+16 IF GLOBAL="^DIE"
DO BMES^XPDUTL(" ")
DO BMES^XPDUTL(" Compiling Input Templates")
DO EN^DIEZ
QUIT
+17 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
+18 QUIT
+19 ;
+20 ;
