Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DG902PST

DG902PST.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ; IA #4397 (Supported) for call to TURNON^DIAUTL
  1. POST ;Post init
  1. N DGI,DGFLDS
  1. ; Modifying the following field(s) in the PATIENT File #2:
  1. ; - .352 DEATH ENTERED BY
  1. ; - .353 SOURCE OF NOTIFICATION
  1. ; - .354 DATE OF DEATH LAST UPDATED
  1. ; - .355 LAST EDITED BY
  1. S DGFLDS=".352,.353,.354,.355"
  1. ;File cross references for the field(s) (TRIGGERS)
  1. F DGI=1:1:$L(DGFLDS,",") D XR(2,$P(DGFLDS,",",DGI))
  1. ;Re-Compile Templates for field(s) (if applicable)
  1. D TEMPL(2,DGFLDS,"PATIENT")
  1. ;Turning on AUDITING for field(s)
  1. F DGI=1:1:$L(DGFLDS,",") D AUDIT(2,$P(DGFLDS,",",DGI),"Patient")
  1. Q
  1. ;
  1. XR(DGFILE,DGFLD) ;File index type cross references
  1. ;
  1. N DGFDA,DGIEN,DGWP,DGERR,DGXR,DGVAL,DGOUT,DIERR
  1. ;Set up the cross-reference
  1. I '$D(DGXR) S DGXR=$S(DGFLD[".":"AVAFC"_$P(DGFLD,".",2),1:"AVAFC"_DGFLD)
  1. ;Check for existing cross-reference
  1. S DGVAL(1)=DGFILE,DGVAL(2)=DGXR
  1. D FIND^DIC(.11,"","@;IXIE","KP",.DGVAL,"","","","","DGOUT")
  1. I $D(DGOUT("DILIST",1)) D Q
  1. .D MES^XPDUTL(" >> Cross reference "_DGXR_" already exists, nothing filed.")
  1. .Q
  1. ;Create filer array
  1. S DGFDA(.11,"+1,",.01)=DGFILE ;FILE
  1. S DGFDA(.11,"+1,",.02)=DGXR ;NAME
  1. S DGFDA(.11,"+1,",.11)="This x-ref calls the DG FIELD MONITOR event point." ;SHORT DESCRIPTION
  1. S DGFDA(.11,"+1,",.2)="MU" ;TYPE
  1. S DGFDA(.11,"+1,",.4)="F" ;EXECUTION
  1. S DGFDA(.11,"+1,",.41)="I" ;ACTIVITY
  1. S DGFDA(.11,"+1,",.5)="I" ;ROOT TYPE
  1. S DGFDA(.11,"+1,",.51)=DGFILE ;ROOT FILE
  1. S DGFDA(.11,"+1,",.42)="A" ;USE
  1. S DGFDA(.11,"+1,",1.1)="D FC^DGFCPROT(.DA,"_DGFILE_","_DGFLD_",""SET"",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q" ;SET LOGIC
  1. S DGFDA(.11,"+1,",2.1)="D FC^DGFCPROT(.DA,"_DGFILE_","_DGFLD_",""KILL"",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q" ;KILL LOGIC
  1. ;CROSS REFERENCE VALUES
  1. S DGFDA(.114,"+2,+1,",.01)=1 ;ORDER NUMBER
  1. S DGFDA(.114,"+2,+1,",1)="F" ;TYPE OF VALUE
  1. S DGFDA(.114,"+2,+1,",2)=DGFILE ;FILE NUMBER
  1. S DGFDA(.114,"+2,+1,",3)=DGFLD ;FIELD NUMBER
  1. S DGFDA(.114,"+2,+1,",7)="F" ;COLLATION
  1. ;DESCRIPTION
  1. S DGWP(1)="This cross-reference activates the DG FIELD MONITOR event point."
  1. S DGWP(2)="Applications that wish to monitor edit activity related to this field may"
  1. S DGWP(3)="subscribe to that event point and take action as indicated by the changes"
  1. S DGWP(4)="that occur. Refer to the DG FIELD MONITOR protocol for a description of"
  1. S DGWP(5)="the information available at the time of the event."
  1. ;File INDEX record
  1. D UPDATE^DIE("","DGFDA","DGIEN","DGERR")
  1. I $D(DIERR) D Q
  1. .N DGI S DGI=""
  1. .D BMES^XPDUTL(" >> A problem has occurred during the filing of x-ref "_DGXR_"!")
  1. .D MES^XPDUTL(" Please contact Customer Support.")
  1. .F S DGI=$O(DGERR("DIERR",1,"TEXT",DGI)) Q:DGI="" D
  1. ..D MES^XPDUTL(DGERR("DIERR",1,"TEXT",DGI))
  1. ..Q
  1. .Q
  1. D MES^XPDUTL(" >> "_DGXR_" cross-reference filed.")
  1. ;File DESCRIPTION field
  1. D WP^DIE(.11,DGIEN(1)_",",.1,"","DGWP")
  1. Q
  1. ;
  1. TEMPL(DGFILE,DGFLDS,DGFNAME) ;Determine templates on the file to be compiled.
  1. N DGI
  1. D BMES^XPDUTL("Beginning to compile templates on the "_DGFNAME_" (#"_DGFILE_") file.")
  1. ;
  1. F DGI=1:1:$L(DGFLDS,",") D LOOP($P(DGFLDS,",",DGI),DGFILE)
  1. W !!
  1. S (X,Y)=""
  1. D:$D(CFIELD)
  1. .D BMES^XPDUTL("The following routine namespace was compiled:")
  1. .F S X=$O(CFIELD(X)) Q:X="" S Y=$G(Y)+1 S PRINT(Y)=" "_X_"*"
  1. .D MES^XPDUTL(.PRINT)
  1. D:'$D(CFIELD)
  1. .D BMES^XPDUTL("No routine namespaces were needed to be compiled.")
  1. K X,Y,PRINT,CFIELD
  1. Q
  1. LOOP(FIELD,FILE) ;Compile templates.
  1. N GLOBAL,TEMPLATP,TEMPLATN,X,Y,DMAX
  1. F GLOBAL="^DIE","^DIPT" DO
  1. .I $D(@GLOBAL@("AF",FILE,FIELD)) D
  1. ..S TEMPLATP=0
  1. ..F S TEMPLATP=$O(@GLOBAL@("AF",FILE,FIELD,TEMPLATP)) Q:'TEMPLATP DO
  1. ...S TEMPLATN=$P($G(@GLOBAL@(TEMPLATP,0)),"^",1)
  1. ...I TEMPLATN="" D BMES^XPDUTL("Could not compile template "_TEMPLATN_$C(13,10)_"Please review!") Q
  1. ...S X=$P($G(@GLOBAL@(TEMPLATP,"ROUOLD")),"^")
  1. ...I X=""&($D(@GLOBAL@(TEMPLATP,"ROU"))'=0) D BMES^XPDUTL("Could not find routine for template "_TEMPLATN_$C(13,10)_"Please review!") Q
  1. ...I X=""&($D(@GLOBAL@(TEMPLATP,"ROU"))=0) Q
  1. ...I $D(CFIELD(X)) Q ;already compiled
  1. ...S CFIELD(X)="" ; remember the template was compiled
  1. ...S Y=TEMPLATP ; set up the call for FileMan
  1. ...S DMAX=$$ROUSIZE^DILF
  1. ...I GLOBAL="^DIE" D BMES^XPDUTL(" "),BMES^XPDUTL(" Compiling Input Templates") D EN^DIEZ Q
  1. ...I GLOBAL="^DIPT" D BMES^XPDUTL(" "),BMES^XPDUTL(" Compiling Print Templates") D EN^DIPZ Q
  1. Q
  1. ;
  1. AUDIT(DGFILE,DGFLD,DGFNAME) ;Turn on Auditing for Field in File
  1. D TURNON^DIAUTL(DGFILE,DGFLD) W !,"Adding AUDIT to file "_DGFILE_" "_DGFNAME_", field #"_DGFLD
  1. Q