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 Apr 09, 2024@21:58:48 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
