DG474PST ;BIR/PTD-PATCH DG*5.3*474 POST INSTALLATION ROUTINE ;10/10/02
;;5.3;Registration;**474,1015**;Aug 13, 1993;Build 21
;
;Reference to TRIG^DICR supported by IA #3405
;
POST ;Post-init functions
;Recompile input templates
D COMPILE
;Update triggered fields
D TRIG
Q
;
COMPILE N GLOBAL,FIELD,CFIELD,NFIELD,TEMPLATP,TEMPLATN
D BMES^XPDUTL("Beginning to compile templates on the PATIENT (#2) file.")
;
S NFIELD=$P($T(AFIELDS),";;",2) ;get the fields that have new xref
;
F GLOBAL="^DIE","^DIPT" DO
.I GLOBAL="^DIE" D BMES^XPDUTL(" Compiling Input Templates")
.I GLOBAL="^DIPT" DO
. . D BMES^XPDUTL(" ")
. . D BMES^XPDUTL(" Compiling Print Templates")
.;
.S FIELD=0
.; go find templates on fields that have added cross-ref
.F S FIELD=$O(@GLOBAL@("AF",2,FIELD)) Q:'FIELD DO
. .;
. .S CFIELD=","_FIELD_","
. .;if we didn't add the cross reference, quit
. .I NFIELD'[CFIELD Q
. .;
. .S TEMPLATP=0
. .F S TEMPLATP=$O(@GLOBAL@("AF",2,FIELD,TEMPLATP)) Q:'TEMPLATP DO
. . . S TEMPLATN=$P($G(@GLOBAL@(TEMPLATP,0)),"^",1)
. . . I TEMPLATN="" DO Q
. . . . D BMES^XPDUTL("Could not compile template "_TEMPLATN_$C(13,10)_"Please review!")
. . . .;
. . . S X=$P($G(@GLOBAL@(TEMPLATP,"ROUOLD")),"^")
. . . I X=""&($D(@GLOBAL@(TEMPLATP,"ROU"))'=0) DO Q
. . . . D BMES^XPDUTL("Could not find routine for template "_TEMPLATN_$C(13,10)_"Please review!")
. . . I X=""&($D(@GLOBAL@(TEMPLATP,"ROU"))=0) Q
. . . I $D(FIELD(X)) Q ;already compiled
. . .;
. . . S FIELD(X)="" ; remember the template was compiled
. . . S Y=TEMPLATP ; set up the call for fman
. . . S DMAX=$$ROUSIZE^DILF
. . . I GLOBAL="^DIE" D EN^DIEZ Q
. . . I GLOBAL="^DIPT" D EN^DIPZ Q
.;
W !!!
S (X,Y)=""
D BMES^XPDUTL("The following routine namespace was compiled:")
F S X=$O(FIELD(X)) Q:X="" DO
. S Y=$G(Y)+1 S PRINT(Y)=" "_X_"*"
;
D MES^XPDUTL(.PRINT)
K X,Y,DMAX,PRINT
Q
;
;these are the fields that have a new cross-ref
AFIELDS ;;,.092,.093,
Q
;
TRIG ;Update trigger definitions
N DGFLD
D BMES^XPDUTL("Updating trigger field definitions...")
F DGFLD=.092,.093 S DGFLD(2,DGFLD)=""
D T1(.DGFLD)
Q
;
T1(DGFLD) ;Check/update triggering field definitions
;Input: DGFLD=array of fields to update
N DGOUT,DGFILE
D TRIG^DICR(.DGFLD,.DGOUT)
S DGFILE=0 F S DGFILE=$O(DGOUT(DGFILE)) Q:'DGFILE D
.S DGFLD=0 F S DGFLD=$O(DGOUT(DGFILE,DGFLD)) Q:'DGFLD D
..D MES^XPDUTL(" Field #"_DGFLD_" of file #"_DGFILE_" updated.")
..Q
.Q
Q
DG474PST ;BIR/PTD-PATCH DG*5.3*474 POST INSTALLATION ROUTINE ;10/10/02
+1 ;;5.3;Registration;**474,1015**;Aug 13, 1993;Build 21
+2 ;
+3 ;Reference to TRIG^DICR supported by IA #3405
+4 ;
POST ;Post-init functions
+1 ;Recompile input templates
+2 DO COMPILE
+3 ;Update triggered fields
+4 DO TRIG
+5 QUIT
+6 ;
COMPILE NEW GLOBAL,FIELD,CFIELD,NFIELD,TEMPLATP,TEMPLATN
+1 DO BMES^XPDUTL("Beginning to compile templates on the PATIENT (#2) file.")
+2 ;
+3 ;get the fields that have new xref
SET NFIELD=$PIECE($TEXT(AFIELDS),";;",2)
+4 ;
+5 FOR GLOBAL="^DIE","^DIPT"
Begin DoDot:1
+6 IF GLOBAL="^DIE"
DO BMES^XPDUTL(" Compiling Input Templates")
+7 IF GLOBAL="^DIPT"
Begin DoDot:2
+8 DO BMES^XPDUTL(" ")
+9 DO BMES^XPDUTL(" Compiling Print Templates")
End DoDot:2
+10 ;
+11 SET FIELD=0
+12 ; go find templates on fields that have added cross-ref
+13 FOR
SET FIELD=$ORDER(@GLOBAL@("AF",2,FIELD))
IF 'FIELD
QUIT
Begin DoDot:2
+14 ;
+15 SET CFIELD=","_FIELD_","
+16 ;if we didn't add the cross reference, quit
+17 IF NFIELD'[CFIELD
QUIT
+18 ;
+19 SET TEMPLATP=0
+20 FOR
SET TEMPLATP=$ORDER(@GLOBAL@("AF",2,FIELD,TEMPLATP))
IF 'TEMPLATP
QUIT
Begin DoDot:3
+21 SET TEMPLATN=$PIECE($GET(@GLOBAL@(TEMPLATP,0)),"^",1)
+22 IF TEMPLATN=""
Begin DoDot:4
+23 DO BMES^XPDUTL("Could not compile template "_TEMPLATN_$CHAR(13,10)_"Please review!")
+24 ;
End DoDot:4
QUIT
+25 SET X=$PIECE($GET(@GLOBAL@(TEMPLATP,"ROUOLD")),"^")
+26 IF X=""&($DATA(@GLOBAL@(TEMPLATP,"ROU"))'=0)
Begin DoDot:4
+27 DO BMES^XPDUTL("Could not find routine for template "_TEMPLATN_$CHAR(13,10)_"Please review!")
End DoDot:4
QUIT
+28 IF X=""&($DATA(@GLOBAL@(TEMPLATP,"ROU"))=0)
QUIT
+29 ;already compiled
IF $DATA(FIELD(X))
QUIT
+30 ;
+31 ; remember the template was compiled
SET FIELD(X)=""
+32 ; set up the call for fman
SET Y=TEMPLATP
+33 SET DMAX=$$ROUSIZE^DILF
+34 IF GLOBAL="^DIE"
DO EN^DIEZ
QUIT
+35 IF GLOBAL="^DIPT"
DO EN^DIPZ
QUIT
End DoDot:3
End DoDot:2
+36 ;
End DoDot:1
+37 WRITE !!!
+38 SET (X,Y)=""
+39 DO BMES^XPDUTL("The following routine namespace was compiled:")
+40 FOR
SET X=$ORDER(FIELD(X))
IF X=""
QUIT
Begin DoDot:1
+41 SET Y=$GET(Y)+1
SET PRINT(Y)=" "_X_"*"
End DoDot:1
+42 ;
+43 DO MES^XPDUTL(.PRINT)
+44 KILL X,Y,DMAX,PRINT
+45 QUIT
+46 ;
+47 ;these are the fields that have a new cross-ref
AFIELDS ;;,.092,.093,
+1 QUIT
+2 ;
TRIG ;Update trigger definitions
+1 NEW DGFLD
+2 DO BMES^XPDUTL("Updating trigger field definitions...")
+3 FOR DGFLD=.092,.093
SET DGFLD(2,DGFLD)=""
+4 DO T1(.DGFLD)
+5 QUIT
+6 ;
T1(DGFLD) ;Check/update triggering field definitions
+1 ;Input: DGFLD=array of fields to update
+2 NEW DGOUT,DGFILE
+3 DO TRIG^DICR(.DGFLD,.DGOUT)
+4 SET DGFILE=0
FOR
SET DGFILE=$ORDER(DGOUT(DGFILE))
IF 'DGFILE
QUIT
Begin DoDot:1
+5 SET DGFLD=0
FOR
SET DGFLD=$ORDER(DGOUT(DGFILE,DGFLD))
IF 'DGFLD
QUIT
Begin DoDot:2
+6 DO MES^XPDUTL(" Field #"_DGFLD_" of file #"_DGFILE_" updated.")
+7 QUIT
End DoDot:2
+8 QUIT
End DoDot:1
+9 QUIT
