- DG902PST ;BIR/JFW - PATCH DG*5.3*902 POST INSTALLATION ROUTINE ; 10/20/14 4:45pm
- ;;5.3;Registration;**902**;Aug 13, 1993;Build 2
- ;
- ; IA #4397 (Supported) for call to TURNON^DIAUTL
- POST ;Post init
- N DGI,DGFLDS
- ; Modifying the following field(s) in the PATIENT File #2:
- ; - .352 DEATH ENTERED BY
- ; - .353 SOURCE OF NOTIFICATION
- ; - .354 DATE OF DEATH LAST UPDATED
- ; - .355 LAST EDITED BY
- S DGFLDS=".352,.353,.354,.355"
- ;File cross references for the field(s) (TRIGGERS)
- F DGI=1:1:$L(DGFLDS,",") D XR(2,$P(DGFLDS,",",DGI))
- ;Re-Compile Templates for field(s) (if applicable)
- D TEMPL(2,DGFLDS,"PATIENT")
- ;Turning on AUDITING for field(s)
- F DGI=1:1:$L(DGFLDS,",") D AUDIT(2,$P(DGFLDS,",",DGI),"Patient")
- Q
- ;
- XR(DGFILE,DGFLD) ;File index type cross references
- ;
- N DGFDA,DGIEN,DGWP,DGERR,DGXR,DGVAL,DGOUT,DIERR
- ;Set up the cross-reference
- I '$D(DGXR) S DGXR=$S(DGFLD[".":"AVAFC"_$P(DGFLD,".",2),1:"AVAFC"_DGFLD)
- ;Check for existing cross-reference
- S DGVAL(1)=DGFILE,DGVAL(2)=DGXR
- D FIND^DIC(.11,"","@;IXIE","KP",.DGVAL,"","","","","DGOUT")
- I $D(DGOUT("DILIST",1)) D Q
- .D MES^XPDUTL(" >> Cross reference "_DGXR_" already exists, nothing filed.")
- .Q
- ;Create filer array
- S DGFDA(.11,"+1,",.01)=DGFILE ;FILE
- S DGFDA(.11,"+1,",.02)=DGXR ;NAME
- S DGFDA(.11,"+1,",.11)="This x-ref calls the DG FIELD MONITOR event point." ;SHORT DESCRIPTION
- S DGFDA(.11,"+1,",.2)="MU" ;TYPE
- S DGFDA(.11,"+1,",.4)="F" ;EXECUTION
- S DGFDA(.11,"+1,",.41)="I" ;ACTIVITY
- S DGFDA(.11,"+1,",.5)="I" ;ROOT TYPE
- S DGFDA(.11,"+1,",.51)=DGFILE ;ROOT FILE
- S DGFDA(.11,"+1,",.42)="A" ;USE
- S DGFDA(.11,"+1,",1.1)="D FC^DGFCPROT(.DA,"_DGFILE_","_DGFLD_",""SET"",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q" ;SET LOGIC
- S DGFDA(.11,"+1,",2.1)="D FC^DGFCPROT(.DA,"_DGFILE_","_DGFLD_",""KILL"",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q" ;KILL LOGIC
- ;CROSS REFERENCE VALUES
- S DGFDA(.114,"+2,+1,",.01)=1 ;ORDER NUMBER
- S DGFDA(.114,"+2,+1,",1)="F" ;TYPE OF VALUE
- S DGFDA(.114,"+2,+1,",2)=DGFILE ;FILE NUMBER
- S DGFDA(.114,"+2,+1,",3)=DGFLD ;FIELD NUMBER
- S DGFDA(.114,"+2,+1,",7)="F" ;COLLATION
- ;DESCRIPTION
- S DGWP(1)="This cross-reference activates the DG FIELD MONITOR event point."
- S DGWP(2)="Applications that wish to monitor edit activity related to this field may"
- S DGWP(3)="subscribe to that event point and take action as indicated by the changes"
- S DGWP(4)="that occur. Refer to the DG FIELD MONITOR protocol for a description of"
- S DGWP(5)="the information available at the time of the event."
- ;File INDEX record
- D UPDATE^DIE("","DGFDA","DGIEN","DGERR")
- I $D(DIERR) D Q
- .N DGI S DGI=""
- .D BMES^XPDUTL(" >> A problem has occurred during the filing of x-ref "_DGXR_"!")
- .D MES^XPDUTL(" Please contact Customer Support.")
- .F S DGI=$O(DGERR("DIERR",1,"TEXT",DGI)) Q:DGI="" D
- ..D MES^XPDUTL(DGERR("DIERR",1,"TEXT",DGI))
- ..Q
- .Q
- D MES^XPDUTL(" >> "_DGXR_" cross-reference filed.")
- ;File DESCRIPTION field
- D WP^DIE(.11,DGIEN(1)_",",.1,"","DGWP")
- Q
- ;
- TEMPL(DGFILE,DGFLDS,DGFNAME) ;Determine templates on the file to be compiled.
- N DGI
- D BMES^XPDUTL("Beginning to compile templates on the "_DGFNAME_" (#"_DGFILE_") file.")
- ;
- F DGI=1:1:$L(DGFLDS,",") D LOOP($P(DGFLDS,",",DGI),DGFILE)
- W !!
- S (X,Y)=""
- D:$D(CFIELD)
- .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)
- D:'$D(CFIELD)
- .D BMES^XPDUTL("No routine namespaces were needed to be compiled.")
- K X,Y,PRINT,CFIELD
- Q
- LOOP(FIELD,FILE) ;Compile templates.
- N GLOBAL,TEMPLATP,TEMPLATN,X,Y,DMAX
- F GLOBAL="^DIE","^DIPT" DO
- .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
- ;
- AUDIT(DGFILE,DGFLD,DGFNAME) ;Turn on Auditing for Field in File
- D TURNON^DIAUTL(DGFILE,DGFLD) W !,"Adding AUDIT to file "_DGFILE_" "_DGFNAME_", field #"_DGFLD
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG902PST 5049 printed Feb 19, 2025@00:06:54 Page 2
- DG902PST ;BIR/JFW - PATCH DG*5.3*902 POST INSTALLATION ROUTINE ; 10/20/14 4:45pm
- +1 ;;5.3;Registration;**902**;Aug 13, 1993;Build 2
- +2 ;
- +3 ; IA #4397 (Supported) for call to TURNON^DIAUTL
- POST ;Post init
- +1 NEW DGI,DGFLDS
- +2 ; Modifying the following field(s) in the PATIENT File #2:
- +3 ; - .352 DEATH ENTERED BY
- +4 ; - .353 SOURCE OF NOTIFICATION
- +5 ; - .354 DATE OF DEATH LAST UPDATED
- +6 ; - .355 LAST EDITED BY
- +7 SET DGFLDS=".352,.353,.354,.355"
- +8 ;File cross references for the field(s) (TRIGGERS)
- +9 FOR DGI=1:1:$LENGTH(DGFLDS,",")
- DO XR(2,$PIECE(DGFLDS,",",DGI))
- +10 ;Re-Compile Templates for field(s) (if applicable)
- +11 DO TEMPL(2,DGFLDS,"PATIENT")
- +12 ;Turning on AUDITING for field(s)
- +13 FOR DGI=1:1:$LENGTH(DGFLDS,",")
- DO AUDIT(2,$PIECE(DGFLDS,",",DGI),"Patient")
- +14 QUIT
- +15 ;
- XR(DGFILE,DGFLD) ;File index type cross references
- +1 ;
- +2 NEW DGFDA,DGIEN,DGWP,DGERR,DGXR,DGVAL,DGOUT,DIERR
- +3 ;Set up the cross-reference
- +4 IF '$DATA(DGXR)
- SET DGXR=$SELECT(DGFLD[".":"AVAFC"_$PIECE(DGFLD,".",2),1:"AVAFC"_DGFLD)
- +5 ;Check for existing cross-reference
- +6 SET DGVAL(1)=DGFILE
- SET DGVAL(2)=DGXR
- +7 DO FIND^DIC(.11,"","@;IXIE","KP",.DGVAL,"","","","","DGOUT")
- +8 IF $DATA(DGOUT("DILIST",1))
- Begin DoDot:1
- +9 DO MES^XPDUTL(" >> Cross reference "_DGXR_" already exists, nothing filed.")
- +10 QUIT
- End DoDot:1
- QUIT
- +11 ;Create filer array
- +12 ;FILE
- SET DGFDA(.11,"+1,",.01)=DGFILE
- +13 ;NAME
- SET DGFDA(.11,"+1,",.02)=DGXR
- +14 ;SHORT DESCRIPTION
- SET DGFDA(.11,"+1,",.11)="This x-ref calls the DG FIELD MONITOR event point."
- +15 ;TYPE
- SET DGFDA(.11,"+1,",.2)="MU"
- +16 ;EXECUTION
- SET DGFDA(.11,"+1,",.4)="F"
- +17 ;ACTIVITY
- SET DGFDA(.11,"+1,",.41)="I"
- +18 ;ROOT TYPE
- SET DGFDA(.11,"+1,",.5)="I"
- +19 ;ROOT FILE
- SET DGFDA(.11,"+1,",.51)=DGFILE
- +20 ;USE
- SET DGFDA(.11,"+1,",.42)="A"
- +21 ;SET LOGIC
- SET DGFDA(.11,"+1,",1.1)="D FC^DGFCPROT(.DA,"_DGFILE_","_DGFLD_",""SET"",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q"
- +22 ;KILL LOGIC
- SET DGFDA(.11,"+1,",2.1)="D FC^DGFCPROT(.DA,"_DGFILE_","_DGFLD_",""KILL"",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q"
- +23 ;CROSS REFERENCE VALUES
- +24 ;ORDER NUMBER
- SET DGFDA(.114,"+2,+1,",.01)=1
- +25 ;TYPE OF VALUE
- SET DGFDA(.114,"+2,+1,",1)="F"
- +26 ;FILE NUMBER
- SET DGFDA(.114,"+2,+1,",2)=DGFILE
- +27 ;FIELD NUMBER
- SET DGFDA(.114,"+2,+1,",3)=DGFLD
- +28 ;COLLATION
- SET DGFDA(.114,"+2,+1,",7)="F"
- +29 ;DESCRIPTION
- +30 SET DGWP(1)="This cross-reference activates the DG FIELD MONITOR event point."
- +31 SET DGWP(2)="Applications that wish to monitor edit activity related to this field may"
- +32 SET DGWP(3)="subscribe to that event point and take action as indicated by the changes"
- +33 SET DGWP(4)="that occur. Refer to the DG FIELD MONITOR protocol for a description of"
- +34 SET DGWP(5)="the information available at the time of the event."
- +35 ;File INDEX record
- +36 DO UPDATE^DIE("","DGFDA","DGIEN","DGERR")
- +37 IF $DATA(DIERR)
- Begin DoDot:1
- +38 NEW DGI
- SET DGI=""
- +39 DO BMES^XPDUTL(" >> A problem has occurred during the filing of x-ref "_DGXR_"!")
- +40 DO MES^XPDUTL(" Please contact Customer Support.")
- +41 FOR
- SET DGI=$ORDER(DGERR("DIERR",1,"TEXT",DGI))
- if DGI=""
- QUIT
- Begin DoDot:2
- +42 DO MES^XPDUTL(DGERR("DIERR",1,"TEXT",DGI))
- +43 QUIT
- End DoDot:2
- +44 QUIT
- End DoDot:1
- QUIT
- +45 DO MES^XPDUTL(" >> "_DGXR_" cross-reference filed.")
- +46 ;File DESCRIPTION field
- +47 DO WP^DIE(.11,DGIEN(1)_",",.1,"","DGWP")
- +48 QUIT
- +49 ;
- TEMPL(DGFILE,DGFLDS,DGFNAME) ;Determine templates on the file to be compiled.
- +1 NEW DGI
- +2 DO BMES^XPDUTL("Beginning to compile templates on the "_DGFNAME_" (#"_DGFILE_") file.")
- +3 ;
- +4 FOR DGI=1:1:$LENGTH(DGFLDS,",")
- DO LOOP($PIECE(DGFLDS,",",DGI),DGFILE)
- +5 WRITE !!
- +6 SET (X,Y)=""
- +7 if $DATA(CFIELD)
- Begin DoDot:1
- +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)
- End DoDot:1
- +11 if '$DATA(CFIELD)
- Begin DoDot:1
- +12 DO BMES^XPDUTL("No routine namespaces were needed to be compiled.")
- End DoDot:1
- +13 KILL X,Y,PRINT,CFIELD
- +14 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 ;already compiled
- IF $DATA(CFIELD(X))
- QUIT
- +12 ; remember the template was compiled
- SET CFIELD(X)=""
- +13 ; set up the call for FileMan
- SET Y=TEMPLATP
- +14 SET DMAX=$$ROUSIZE^DILF
- +15 IF GLOBAL="^DIE"
- DO BMES^XPDUTL(" ")
- DO BMES^XPDUTL(" Compiling Input Templates")
- DO EN^DIEZ
- QUIT
- +16 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
- +17 QUIT
- +18 ;
- AUDIT(DGFILE,DGFLD,DGFNAME) ;Turn on Auditing for Field in File
- +1 DO TURNON^DIAUTL(DGFILE,DGFLD)
- WRITE !,"Adding AUDIT to file "_DGFILE_" "_DGFNAME_", field #"_DGFLD
- +2 QUIT