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