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

DG53807P.m

Go to the documentation of this file. 
  1. DG53807P ;ALB/LBD - PATCH DG*5.3*807 POST-INSTALL ROUTINE ; 4/2/09 4:15pm
  1.  ;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
  1.  ;
  1.  ; This routine will loop through the Patient file #2 and update
  1.  ; the country field in all Permanent, Temporary and Confidential
  1.  ; Addresses that have a valid US zip code with UNITED STATES.
  1.  ;
  1.  Q
  1. EN ;Entry point for DG*5.3*807 post-install
  1.  N ZTDTH,ZTIO,ZTDESC,ZTRTN,ZTSK
  1.  S ZTDESC="Update Addresses with United States"
  1.  S ZTRTN="ENQ^DG53807P",ZTDTH=$H,ZTIO=""
  1.  D ^%ZTLOAD
  1.  I $G(ZTSK) D  Q
  1.  .D BMES^XPDUTL("POST-INSTALL PROCESS HAS BEEN QUEUED AS TASK #"_ZTSK)
  1.  .D MES^XPDUTL("Old patient addresses will be updated with UNITED STATES")
  1.  D BMES^XPDUTL("ERROR: POST-INSTALL PROCESS COULD NOT BE QUEUED")
  1.  Q
  1.  ;
  1. ENQ ;Entry point for tasked job
  1.  N ERROR,PROG
  1.  S PROG="DG53807P"
  1.  S:'$D(^XTMP(PROG,0)) ^XTMP(PROG,0)=$$FMADD^XLFDT($$DT^XLFDT,180)_"^"_$$DT^XLFDT()_"^UPDATE OLD PATIENT ADDRESSES WITH UNITED STATES"
  1.  S ^XTMP(PROG,"TASK")=$G(ZTSK)
  1.  S ^XTMP(PROG,"START")=$$FMTE^XLFDT($$NOW^XLFDT) K ^XTMP(PROG,"END")
  1.  S ^XTMP(PROG,"TOTPAT")=0
  1.  D LOOP
  1.  S ^XTMP(PROG,"END")=$$FMTE^XLFDT($$NOW^XLFDT)
  1.  D SENDMSG
  1.  Q
  1. LOOP ; Loop through Patient file #2, starting with most recent DFNs.
  1.  N DFN,PAT,UPD,USA
  1.  S DFN="A"
  1.  ;Get IEN for UNITED STATES from COUNTRY CODE file #779.004
  1.  S USA=$O(^HL(779.004,"C","UNITED STATES",0))
  1.  I 'USA S ERROR="UNITED STATES MISSING FROM COUNTRY CODE FILE" Q
  1.  F  S DFN=$O(^DPT(DFN),-1) Q:DFN=""!($$TST)  I $D(^DPT(DFN,0)) D
  1.  .S ^XTMP(PROG,"TOTPAT")=$G(^XTMP(PROG,"TOTPAT"))+1
  1.  .S UPD=0
  1.  .L +^DPT(DFN):3 E  D FAIL Q
  1.  .S PAT(.11)=$G(^DPT(DFN,.11))    ;Permanent Address data
  1.  .S PAT(.121)=$G(^DPT(DFN,.121))  ;Temporary Address data
  1.  .S PAT(.122)=$G(^DPT(DFN,.122))  ;Temporary Address data
  1.  .S PAT(.141)=$G(^DPT(DFN,.141))  ;Confidential Address data
  1.  .;Check Permanent Address
  1.  .I $P(PAT(.11),"^",10)="" D
  1.  ..I $$USZIP($P(PAT(.11),"^",6)) S $P(^DPT(DFN,.11),"^",10)=USA,UPD=1
  1.  .;Check Temporary Address
  1.  .I $P(PAT(.122),"^",3)="" D
  1.  ..I $$USZIP($P(PAT(.121),"^",6)) S $P(^DPT(DFN,.122),"^",3)=USA,UPD=1
  1.  .;Check Confidential Address
  1.  .I $P(PAT(.141),"^",16)="" D
  1.  ..I $$USZIP($P(PAT(.141),"^",6)) S $P(^DPT(DFN,.141),"^",16)=USA,UPD=1
  1.  .L -^DPT(DFN)
  1.  .I UPD S ^XTMP(PROG,"TOTUPD")=$G(^XTMP(PROG,"TOTUPD"))+1
  1.  Q
  1.  ;
  1. USZIP(ZIP) ;Check if valid US zip code
  1.  ;Return 1=US zip code; 0=Not valid US zip code
  1.  N ST,Z
  1.  I $G(ZIP)="" Q 0
  1.  ;Lookup in POSTAL CODE file #5.12
  1.  S Z=$O(^XIP(5.12,"B",ZIP,0)) I 'Z Q 0
  1.  ;Get State
  1.  S ST=$P($G(^XIP(5.12,Z,0)),"^",4) I 'ST Q 0
  1.  ;Valid US state or possession?
  1.  I '$P($G(^DIC(5,ST,0)),"^",6) Q 0
  1.  Q 1
  1.  ;
  1. SENDMSG ;Send MailMan message when process completes
  1.  N XMSUB,XMDUZ,XMY,XMTEXT,MSG,LN
  1.  S XMY(DUZ)="",XMTEXT="MSG("
  1.  S XMDUZ=.5,XMSUB="DG*5.3*807 JOB TO UPDT OLD PAT ADDRS"
  1.  S MSG($$LN)="The DG*5.3*807 post-install process has completed."
  1.  S MSG($$LN)=""
  1.  S MSG($$LN)="This process ran through the Patient file #2 and checked"
  1.  S MSG($$LN)="the patient's Permanent, Temporary, and Confidential"
  1.  S MSG($$LN)="addresses.  If the address was a valid US address, but"
  1.  S MSG($$LN)="the Country field was blank, the Country was updated with"
  1.  S MSG($$LN)="UNITED STATES."
  1.  S MSG($$LN)=""
  1.  S MSG($$LN)="The process statistics:"
  1.  S MSG($$LN)=""
  1.  I $D(ERROR) D
  1.  .S MSG($$LN)="*** ERROR: THIS PROCESS COULD NOT BE RUN BECAUSE 'UNITED STATES'"
  1.  .S MSG($$LN)="           IS MISSING FROM THE COUNTRY CODE FILE #779.004"
  1.  .S MSG($$LN)=""
  1.  S MSG($$LN)="Job Start Date/Time: "_$G(^XTMP(PROG,"START"))
  1.  S MSG($$LN)="  Job End Date/Time: "_$G(^XTMP(PROG,"END"))
  1.  S MSG($$LN)=""
  1.  S MSG($$LN)="Total Patient Records Searched: "_+$G(^XTMP(PROG,"TOTPAT"))
  1.  S MSG($$LN)=" Total Patient Records Updated: "_+$G(^XTMP(PROG,"TOTUPD"))
  1.  I $G(^XTMP(PROG,"LOCKFAIL")) D
  1.  .S MSG($$LN)="  Total Patient Records Failed: "_+$G(^XTMP(PROG,"LOCKFAIL"))
  1.  D ^XMD
  1.  Q
  1. LN() ;Increment line counter
  1.  S LN=$G(LN)+1
  1.  Q LN
  1. FAIL ;Update ^XTMP with records that could not be locked
  1.  S ^XTMP(PROG,"LOCKFAIL")=$G(^XTMP(PROG,"LOCKFAIL"))+1
  1.  S ^XTMP(PROG,"LOCKFAIL",DFN)=""
  1.  Q
  1.  ;
  1. TEST ;Entry point for testing
  1.  N DIR,X,Y,DIRUT,DIROUT,TST
  1.  W !!,"ADDRESS UPDATE ROUTINE DG53807P"
  1.  S DIR(0)="NOA",DIR("A")="Enter number of records for test run: "
  1.  D ^DIR I 'Y Q
  1.  S TST=+Y
  1.  G ENQ
  1. TST() ;If testing, quit if number of records = TST
  1.  I '$D(TST) Q 0
  1.  I ^XTMP(PROG,"TOTPAT")=TST Q 1
  1.  Q 0