- 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
