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

DG712PST.m

Go to the documentation of this file.
  1. DG712PST ;BIR/CMC/TKW,PTD-PATCH DG*5.3*712 POST INSTALLATION ROUTINE ;1/29/09 17:41
  1. ;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
  1. ;
  1. ; IA #2796 for use of calls to RGHLLOG in UPDBAI
  1. POST ;Post init
  1. N DGFLD,DGMFLD,DGOUT,DGFILE
  1. ;File cross references
  1. D XR(2,.121) ; BAD ADDRESS INDICATOR (#.121)
  1. D XR(2,.133) ; EMAIL ADDRESS (#.133)
  1. D XR(2,.134) ; PHONE NUMBER [CELLULAR] (#.134)
  1. D TEMPL
  1. ;TURNING ON AUDITING FOR ALIAS FIELD(S)
  1. D ALIAS
  1. ; Queue job to send A31 for patients with BAD ADDRESS INDICATOR
  1. D UPDBAI
  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. S DGFLD(DGFILE,DGFLD)="" ;Create list to recompile templates
  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 ;Determine templates on the PATIENT (#2) file to be compiled.
  1. N GLOBAL,FIELD,NFIELD,FILE,CNT
  1. D BMES^XPDUTL("Beginning to compile templates on the PATIENT (#2) file.")
  1. ;
  1. S NFIELD=".121,.133,.134",FILE=2,FIELD="",CNT=1
  1. F S FIELD=$P(NFIELD,",",CNT) Q:FIELD="" D LOOP(FIELD,FILE) S CNT=CNT+1
  1. W !!
  1. S (X,Y)=""
  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. ;
  1. D MES^XPDUTL(.PRINT)
  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. ALIAS ;TURNING ON ALIAS AUDITING
  1. N FLDNUM
  1. S FLDNUM=.01 D TURNON^DIAUTL(2.01,FLDNUM) W !,"Adding AUDIT to sub-file 2.01 Alias, field #",FLDNUM
  1. S FLDNUM=1 D TURNON^DIAUTL(2.01,FLDNUM) W !,"Adding AUDIT to sub-file 2.01 Alias, field #",FLDNUM
  1. Q
  1. ;
  1. UPDBAI ; Send A31 to update the BAD ADDRESS INDICATOR for all patients
  1. D BMES^XPDUTL(" "),BMES^XPDUTL(" Queuing job to update MPI for Patients with BAD ADDRESS INDICATOR.")
  1. N ZTIO,ZTSK,ZTRTN,ZTDESC,ZTSAVE,ZTDTH,Y
  1. S ZTIO="",ZTRTN="DQUPDBAI^DG712PST",ZTDTH=$H
  1. S ZTDESC="Send A31 update for patients with BAD ADDRESS INDICATOR-post init for DG*5.3*712."
  1. D ^%ZTLOAD
  1. I '$G(ZTSK) D MES^XPDUTL(" **** Queuing job failed!!!") Q
  1. D MES^XPDUTL(" Job number "_ZTSK_" was queued.")
  1. Q
  1. DQUPDBAI ; Entry point to queue job to update BAD ADDRESS INDICATOR for all patients
  1. N DGSITE,DGSNAME,DGDFN,DGBAI,DGICN,DGCNT,DGECNT,DGERR,R,X
  1. ; Get current station number and name
  1. S X=$$SITE^VASITE()
  1. S DGSNAME=$P(X,"^",2),DGSITE=$P(X,"^",3)
  1. S (DGCNT,DGECNT)=0
  1. ; Loop through patient file, if patient has a BAD ADDRESS INDICATOR, send A31
  1. F DGDFN=0:0 S DGDFN=$O(^DPT(DGDFN)) Q:'DGDFN D
  1. . ; Check for PATIENT having BAD ADDRESS INDICATOR
  1. . S DGBAI=$P($G(^DPT(DGDFN,.11)),U,16)
  1. . Q:'DGBAI
  1. . S DGICN=+$$GETICN^MPIF001(DGDFN)
  1. . ; Only update if station has a valid national ICN
  1. . Q:DGICN=-1
  1. . Q:$E(DGICN,1,($L(DGSITE)))=DGSITE
  1. . ; Send A31
  1. . S DGERR=$$A31^MPIFA31B(DGDFN)
  1. . I +DGERR<0 D Q
  1. .. D START^RGHLLOG()
  1. .. D EXC^RGHLLOG(208,"Error building A31 for BAD ADDRESS INDICATOR during post-init of DG*5.3*712, (DFN="_DGDFN_"), ERROR="_$P(DGERR,"^",2),DGDFN)
  1. .. D STOP^RGHLLOG()
  1. .. S DGECNT=DGECNT+1 Q
  1. . S DGCNT=DGCNT+1
  1. . Q
  1. ; Send email to person who ran the INIT, letting them know results
  1. N XMDUZ,XMTEXT,XMSUB,XMY,XMZ,XMDUN,X,R
  1. S R(1)="A31 messages to update the BAD ADDRESS INDICATOR for "_DGCNT_" Patients were sent."
  1. I DGECNT'>0 S R(2)=" ",R(3)="You can now delete the post-init routine ^DG712PST."
  1. I DGECNT>0 D
  1. . S R(2)=" "
  1. . S R(3)="*** Note: "_DGECNT_" errors occurred trying to update the BAD ADDRESS INDICATOR."
  1. . S R(4)="*** IMDQ can check the EXCEPTIONS LOG to see details for these errors."
  1. . S R(5)="*** See further instructions in the patch description for DG*5.3*712."
  1. . Q
  1. S XMTEXT="R(",XMSUB="Results from running patch DG*5.3*712"
  1. S XMDUZ=.5
  1. S XMY(DUZ)=""
  1. D ^XMD
  1. ; Send message to MPI developers on Outlook
  1. K XMDUZ,XMTEXT,XMSUB,XMY,XMZ,XMDUN,R
  1. S R(1)="Post-Init routine UPDBAI^DG712PST run at station: "_DGSITE_" - "_DGSNAME
  1. S R(2)=" "
  1. S R(3)="A31 messages to update the BAD ADDRESS INDICATOR for "_DGCNT_" Patients were sent."
  1. I DGECNT>0 D
  1. . S R(4)=" "
  1. . S R(5)="*** Note: "_DGECNT_" errors occurred trying to update the BAD ADDRESS INDICATOR."
  1. . S R(6)="*** IMDQ can check the EXCEPTIONS LOG to see details for these errors."
  1. . S R(7)="*** See further instructions in the patch description for DG*5.3*712."
  1. . Q
  1. S XMTEXT="R(",XMSUB="Results from running patch DG*5.3*712 at station: "_DGSITE
  1. S XMDUZ=DUZ
  1. S XMY("TAMI.WINN@VA.GOV")=""
  1. S XMY("CHRISTINE.LINK@VA.GOV")=""
  1. D ^XMD
  1. Q
  1. ;
  1. ;