DGREGRED ;ALB/JAM,ARF - Residential Address Edit API ;1/6/21 10:30
;;5.3;Registration;**941,1010,1014,1040,1127**;Aug 13, 1993;Build 11
;;
;
EN(DFN,FLG) ;Entry point
;Input:
; DFN (required) - Internal Entry # of Patient File (#2)
; FLG (optional) - Flags of 1 or 0; if null, 0 is assumed. Details:
; FLG(1) - if 1 let user edit phone numbers (field #.131 and #.132)
; FLG(2) - if 1 display before & after address (and phone if FLG(1)=1) for user confirmation
N DGINPUT,DGCMP,ICNTRY,CNTRY,FORGN,PSTR,OLDC,FSTR,BAD
N I,X,Y
I $G(DFN)="" Q
S FLG(1)=$G(FLG(1)),FLG(2)=$G(FLG(2))
RETRY ; Entry point if address must be re-entered
D GETOLD(.DGCMP,DFN)
S CNTRY="",ICNTRY=$S(DFN:$P($G(^DPT(DFN,.115)),"^",10),1:"")
I ICNTRY="" S ICNTRY=1 ;default country is USA if NULL
; DG*5.3*1040 - Set variable DGTMOT to 1 to track timeout
S OLDC=DGCMP("OLD",.11573),FORGN=$$FOREIGN^DGADDUTL(DFN,ICNTRY,2,.11573,.CNTRY) I FORGN=-1 S DGTMOT=1 Q
K FSTR,PSTR S FSTR=$$INPT1(FORGN,.PSTR) ;set up field string of address prompts
K DGINPUT S DGINPUT=1 D INPUT(.DGINPUT,DFN,FSTR,CNTRY) I $G(DGINPUT)=-1 Q
; initialize valid address flag
S BAD=0
;
; **** DG*5.3*1014; jam; Start changes ****
;
; DG*5.3*1014; jam; If required fields are missing, we can't call the validation service - force user to correct the address
I DGINPUT(.1151)=""!(DGINPUT(.1154)="")!(($G(DGINPUT(.1156))="")&('FORGN)) D G RETRY
. I 'FORGN W !!?3,*7,"RESIDENTIAL ADDRESS [LINE 1], CITY, and ZIP CODE fields are required."
. I FORGN W !!?3,*7,"RESIDENTIAL ADDRESS [LINE 1] and CITY fields are required."
; DG*5.3*1014; Display the address entered
N DGNEWADD
M DGNEWADD("NEW")=DGINPUT
W !
I FORGN D DISPFGN(.DGNEWADD,"NEW")
I 'FORGN D DISPUS(.DGNEWADD,"NEW")
K DGNEWADD
CHK ; DG*5.3*1014; Prompt user and allow them to correct the address or continue to Validation service
N DIR
S DIR("A",1)="If address is ready for validation enter <RET> to continue, 'E' to Edit"
S DIR("A")=" or '^' to quit"
S DIR(0)="FO"
S DIR("?")="Enter 'E' to edit the address, <RET> to continue to address validation or '^' to exit and cancel the address entry/edit.."
D ^DIR K DIR
; DG*5.3*1040 - Set variable DGTMOT=1, if timeout and QUIT
I $D(DTOUT) S DGTMOT=1 Q
; DG*5.3*1040 - Remove the DTOUT check and Quit if EOP timeout
I $D(DUOUT) W !,"Address changes not saved." D EOP Q:+$G(DGTMOT) G PHONE ;Exiting - Not saving address - go to phone saving process
I X="E"!(X="e") G RETRY ; re-enter address
I X'="" G CHK ; at this point, any response but <RET> will not be accepted
; DG*5.3*1014; jam; Add call to Address Validation service
N DGADVRET,DGOVERKEY ;DG*5.3*1127 - Added DGOVERKEY variable
S DGADVRET=$$EN^DGADDVAL(.DGINPUT,"R")
; DG*5.3*1127 - Get the override key. DGINPUT("overrideKey") will contain the value of the
; override key set in DGADDLST which is called when validating the address
S DGOVERKEY=$G(DGINPUT("overrideKey"))
; DG*5.3*1040; if return is -1 timeout occurred
I DGADVRET=-1 S DGTMOT=1 Q
; if return is 0 - address was not validated
I 'DGADVRET W !!,"No Results - UAM Address Validation Service is unable to validate the address.",!,"Please verify the address entered. " D EOP Q:+$G(DGTMOT) ; DG*5.3*1040 - Check EOP timeout and QUIT
; DGINPUT array contains the address that is validated/accepted or what the user entered if the validation service failed
;
; **** DG*5.3*1014; jam; End changes ****
;
; if flag is set, show old and new address
I FLG(2)=1 D COMPARE(.DGINPUT,.DGCMP)
; DG*5.3*1040 - Use variable DGCONFIRM to hold value of $$CONFIRM("ADDRESS")
N DGCONFIRM S DGCONFIRM=$$CONFIRM("ADDRESS") I DGCONFIRM=-1 S DGTMOT=1 Q
; DG*5.3*1040 - Check variable DGCONFIRM
I 'DGCONFIRM W !,"Address changes not saved." G PHONE ;Not saving address - go to phone saving process
; Validate the address fields and set BAD=1 if not valid
I DGINPUT(.1151)=""!(DGINPUT(.1154)="")!(($G(DGINPUT(.1156))="")&('FORGN)) D S BAD=1 G PHONE
. I 'FORGN W !!?3,*7,"RESIDENTIAL ADDRESS [LINE 1], ZIP CODE and CITY fields are required."
. I FORGN W !!?3,*7,"RESIDENTIAL ADDRESS [LINE 1] and CITY fields are required."
; If address is valid, next check is for PO Box and General Delivery -
; Pass in LINE 1, State and Country codes
I $$POBOXRES^DGREGCP2(DGINPUT(.1151),$P($G(DGINPUT(.1155)),"^",2),$P(DGINPUT(.11573),"^",2)) D S BAD=1 G PHONE
. W !!?3,*7,"You cannot enter 'P. O. Box' or 'General Delivery' for a Residential Address."
; If all Validations passed - save the address
D SAVE(.DGINPUT,DFN,FSTR,FORGN) Q:+$G(DGTMOT)
PHONE ; Process the phone number changes IF FLG(1) = 1
I $G(FLG(1))=1 D
. ; if compare flag is set, display old/new values
. I $G(FLG(2))=1 D COMPAREP(.DGINPUT,.DGCMP)
. ; DG*5.3*1040 - Use variable DGCONFIRM to hold value of $$CONFIRM("PHONE")
. N DGCONFIRM S DGCONFIRM=$$CONFIRM("PHONE") I DGCONFIRM=-1 S DGTMOT=1 Q
. ; DG*5.3*1040 - Check variable DGCONFIRM and DGTMOT
. I 'DGCONFIRM W !,"Phone changes not saved." D EOP Q:+$G(DGTMOT)
. E D SAVEPH(.DGINPUT,DFN) Q:+$G(DGTMOT) ; DG*5.3*1040 - QUIT if timeout
; Phone number process is completed - go to RETRY if address validation failed
I BAD G RETRY
Q
INPUT(DGINPUT,DFN,FSTR,CNTRY) ;Let user input address changes
; Output: DGINPUT(field#)=external^internal(if any)
N DIR,X,Y,DA,DGR,DTOUT,DUOUT,DIROUT,DGN,L
F L=1:1:$L(FSTR,",") S DGN=$P(FSTR,",",L),DGINPUT(DGN)="" Q:DGINPUT=-1 D
. I $$SKIP(DGN,.DGINPUT,.FLG) Q
. ; DG*5.3*1040 - Set timeout variable DGTMOT to 1, if ZIP timeout
. I DGN=.1156 D ZIPINP(.DGINPUT,DFN) S:DGINPUT=-1 DGTMOT=1 Q
. ; DG*5.3*1040 - Include flag DGTMOUT to track timeout with DGTMOT set to 1
. I '$$READ(DFN,DGN,.Y) S DGINPUT=-1,DGTMOT=1 Q
. S DGINPUT(DGN)=$G(Y)
I DGINPUT'=-1 S DGINPUT(.11573)=CNTRY_"^"_$O(^HL(779.004,"B",CNTRY,""))
Q
GETOLD(DGCMP,DFN) ;populate array with existing address info
K DGCMP
N CCIEN,DGCURR,CFORGN,CFSTR,L,T,DGCIEN,DGST,DGCNTY,COUNTRY
S CFORGN=0
; get current country
S CCIEN=$S(DFN:$$GET1^DIQ(2,DFN_",",.11573,"I"),1:"")
S CFORGN=$$FORIEN^DGADDUTL(CCIEN)
; get current address fields and xlate to ^DIQ format
S CFSTR=$$INPT1(CFORGN),CFSTR=$TR(CFSTR,",",";")
; Domestic data needs some extra fields
I 'CFORGN S CFSTR=CFSTR_";.1154;.1155;.1157"
I DFN D GETS^DIQ(2,DFN_",",CFSTR,"EI","DGCURR")
F L=1:1:$L(CFSTR,";") S T=$P(CFSTR,";",L),DGCMP("OLD",T)=$G(DGCURR(2,DFN_",",T,"E"))
S COUNTRY=$$CNTRYI^DGADDUTL(CCIEN) I COUNTRY=-1 S COUNTRY="UNKNOWN COUNTRY"
S DGCMP("OLD",.11573)=COUNTRY_"^"_CCIEN
I 'CFORGN D
. S DGCIEN=$G(DGCURR(2,DFN_",",.1157,"I"))
. S DGST=$G(DGCURR(2,DFN_",",.1155,"I"))
. S DGCNTY=$$CNTY^DGREGAZL(DGST,DGCIEN)
. I DGCNTY=-1 S DGCNTY=""
. S DGCMP("OLD",.1157)=$P(DGCNTY,U)_" "_$P(DGCNTY,U,3)
Q
;
COMPARE(DGINPUT,DGCMP) ;Display before & after address fields.
N DGM,DGCNTY
M DGCMP("NEW")=DGINPUT
W !
F DGM="OLD","NEW" D
. I DGCMP(DGM,.11573)]"",$$FORIEN^DGADDUTL($P(DGCMP(DGM,.11573),U,2)) D DISPFGN(.DGCMP,DGM) Q
. I DGM="NEW" D
. . S DGCNTY=$P($G(DGCMP("NEW",.1157)),U)_" "_$P($G(DGCMP("NEW",.1157)),U,3)
. . S DGCMP("NEW",.1157)=DGCNTY
. . I ($L(DGCMP("NEW",.1156))>5)&($P(DGCMP("NEW",.1156),"-",2)="") S DGCMP("NEW",.1156)=$E(DGCMP("NEW",.1156),1,5)_"-"_$E(DGCMP("NEW",.1156),6,9)
. D DISPUS(.DGCMP,DGM)
Q
;
COMPAREP(DGINPUT,DGCMP) ;Display before & after phone fields.
N DGM
M DGCMP("NEW")=DGINPUT
W !
F DGM="OLD","NEW" D
. W !,?2,"[",DGM," PHONE NUMBERS]"
. W !,?6," Phone: ",?16,$P($G(DGCMP(DGM,.131)),U)
. W !,?6," Office: ",?16,$P($G(DGCMP(DGM,.132)),U)
. W !
Q
;
DISPUS(DGCMP,DGM) ;tag to display US data
N DGCNTRY
W !,?2,"[",DGM," RESIDENTIAL ADDRESS]"
W !?16,$P($G(DGCMP(DGM,.1151)),U)
I $P($G(DGCMP(DGM,.1152)),U)'="" W !,?16,$P($G(DGCMP(DGM,.1152)),U)
I $P($G(DGCMP(DGM,.1153)),U)'="" W !,?16,$P($G(DGCMP(DGM,.1153)),U)
W !,?16,$P($G(DGCMP(DGM,.1154)),U)
W:($P($G(DGCMP(DGM,.1154)),U)'="")!($P($G(DGCMP(DGM,.1155)),U)'="") ","
W $P($G(DGCMP(DGM,.1155)),U)
W " ",$G(DGCMP(DGM,.1156))
S DGCNTRY=$$CNTRYI^DGADDUTL($P($G(DGCMP(DGM,.11573)),U,2))
I DGCNTRY]"",(DGCNTRY'=-1) W !?16,DGCNTRY
I $P($G(DGCMP(DGM,.1157)),U)'="" W !,?6," County: ",$P($G(DGCMP(DGM,.1157)),U)
W !
Q
;
DISPFGN(DGCMP,DGM) ;tag to display Foreign data
N DGCNTRY
W !,?2,"[",DGM," RESIDENTIAL ADDRESS]"
W !?16,$P($G(DGCMP(DGM,.1151)),U)
I $P($G(DGCMP(DGM,.1152)),U)'="" W !,?16,$P($G(DGCMP(DGM,.1152)),U)
I $P($G(DGCMP(DGM,.1153)),U)'="" W !,?16,$P($G(DGCMP(DGM,.1153)),U)
;W !,?16,$P($G(DGCMP(DGM,.11572)),U)_" "_$P($G(DGCMP(DGM,.1154)),U)_" "_$P($G(DGCMP(DGM,.11571)),U) ;DG*1010 comment out
W !,?16,$P($G(DGCMP(DGM,.1154)),U)_" "_$P($G(DGCMP(DGM,.11571)),U)_" "_$P($G(DGCMP(DGM,.11572)),U) ;DG*1010 - display postal code last
S DGCNTRY=$$CNTRYI^DGADDUTL($P($G(DGCMP(DGM,.11573)),U,2))
S DGCNTRY=$S(DGCNTRY="":"UNSPECIFIED COUNTRY",DGCNTRY=-1:"UNKNOWN COUNTRY",1:DGCNTRY)
I DGCNTRY]"" W !?16,DGCNTRY
W !
Q
;
CONFIRM(TYPE) ;Confirm if user wants to save the changes
; TYPE - used for the query message displayed to the user: "address" or "phone number"
N DIR,X,Y,DTOUT,DUOUT,DIROUT
S DIR(0)="Y"
S DIR("A")="Are you sure that you want to save the "_TYPE_" changes"
S DIR("?")="Please answer Y for YES or N for NO."
D ^DIR
; DG*5.3*1040 - prompt timeout return -1
I $D(DTOUT) Q -1
I $G(Y)=0 Q 0
I $D(DUOUT)!$D(DIROUT) Q 0
Q 1
;
SAVE(DGINPUT,DFN,FSTR,FORGN) ;Save changes
N DGN,DGER,DGM,L,DATA
S DGER=0
; need to get the country code into the DGINPUT array
; if it's a domestic address, we have to add in CITY,STATE & COUNTY
S FSTR=FSTR_$S('FORGN:",.1154,.1155,.1157,.11573",1:",.11573")
S FSTR=FSTR_",.11591",DGINPUT(.11591)=DGOVERKEY ;DG*5.3*1127 - Store the override Key returned from address validation
F L=1:1:$L(FSTR,",") S DGN=$P(FSTR,",",L) D
. ; Phone numbers saved separately - skip over here
. I (DGN=.131)!(DGN=.132) Q
. N DGCODE,DGNAME,FDA,MSG
. S DGCODE=$P($G(DGINPUT(DGN)),U,2)
. S DGNAME=$P($G(DGINPUT(DGN)),U)
. S FDA(2,DFN_",",DGN)=$S(DGCODE:DGCODE,1:DGNAME)
. D FILE^DIE($S(DGCODE:"",1:"E"),"FDA","MSG")
. I $D(MSG) D
.. S DGM="",DGER=1
.. W !,"Please review the saved changes!!",!
.. F S DGM=$O(MSG("DIERR",1,"TEXT",DGM)) Q:DGM="" D
... W $G(MSG("DIERR",1,"TEXT",DGM))
I $G(DGER)=0 W !,"Change saved." D
. ; Set the CASS IND field
. S DATA(.1159)="NC"
. I $$UPD^DGENDBS(2,DFN,.DATA)
; DG*5.3*1040 - If EOP timeout, QUIT if variable DGTMOT exists
D EOP Q:+$G(DGTMOT)
Q
;
SAVEPH(DGINPUT,DFN) ;Save phone changes
N DGN,DGER,DGM,DATA
S DGER=0
F DGN=.131,.132 D
. N DGCODE,DGNAME,FDA,MSG
. S DGCODE=$P($G(DGINPUT(DGN)),U,2)
. S DGNAME=$P($G(DGINPUT(DGN)),U)
. S FDA(2,DFN_",",DGN)=$S(DGCODE:DGCODE,1:DGNAME)
. D FILE^DIE($S(DGCODE:"",1:"E"),"FDA","MSG")
. I $D(MSG) D
.. S DGM="",DGER=1
.. W !,"Please review the saved changes!!",!
.. F S DGM=$O(MSG("DIERR",1,"TEXT",DGM)) Q:DGM="" D
... W $G(MSG("DIERR",1,"TEXT",DGM))
I $G(DGER)=0 W !,"Change saved."
; DG*5.3*1040 - If EOP timeout, QUIT if variable DGTMOT exists
D EOP Q:+$G(DGTMOT)
Q
;
READ(DFN,DGN,Y) ;Read input, return success
N SUCCESS,DIR,DA,DTOUT,DUOUT,DIROUT,L,POP
S SUCCESS=1,POP=0
F L=0:0 D Q:POP
. S DIR(0)=2_","_DGN
. I DFN S DA=DFN
. D ^DIR
. I $D(DTOUT) S POP=1,SUCCESS=0 Q
. I $D(DUOUT)!$D(DIROUT) D UPCT Q
. S POP=1
Q SUCCESS
INPT1(FORGN,PSTR) ; first address input prompts
N FSTR
; PSTR is the full set of fields domestic & foreign combined
; FSTR is the set of fields depending on Country code
S PSTR=".1151,.1152,.1153,.1154,.1155,.1157,.1156,.11571,.11572,.11573,.131,.132"
S FSTR=".1151,.1152,.1153,.1156,.131,.132"
I FORGN S FSTR=".1151,.1152,.1153,.1154,.11571,.11572,.131,.132"
Q FSTR
ZIPINP(DGINPUT,DFN) ; get ZIP+4 input
; This subroutine calls existing code to prompt for zip code and return corresponding city, state and county
; DFN must be the patient internal ID.
; DGINPUT - passed by reference - the array containing the resulting county, city, and state for the zipcode.
N FCITY,FZIP,FSTATE,FCOUNTY,TYPE,DGR
; Set the necessary variables for the Residential Address
; The variable TYPE is used for Confidential and temporary address types.
; Here for the Residential Address we clear this variable.
S FZIP=".1156",FCITY=".1154",FSTATE=".1155",FCOUNTY=".1157",TYPE=""
D EN^DGREGTZL(.DGR,DFN)
M DGINPUT=DGR
Q
SKIP(DGN,DGINPUT,FLG) ; determine whether or not to skip this step
N SKIP
S SKIP=0
I ($G(DGINPUT(.1151))="")&((DGN=.1152)!(DGN=.1153)) S SKIP=1
I ($G(DGINPUT(.1152))="")&(DGN=.1153) S SKIP=1
I ($G(FLG(1))'=1)&((DGN=.131)!(DGN=.132)) S SKIP=1
Q SKIP
EOP ;End of page prompt
N DIR,DTOUT,DUOUT,DIROUT,X,Y
S DIR(0)="E"
S DIR("A")="Press ENTER to continue"
D ^DIR
; DG*5.3*1040 - Set variable DGTMOT=1, if timeout
S:$D(DTOUT) DGTMOT=1
Q
UPCT ;Indicate "^" or "^^" are unacceptable inputs.
W !,"EXIT NOT ALLOWED"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGREGRED 13110 printed Sep 23, 2025@20:30:56 Page 2
DGREGRED ;ALB/JAM,ARF - Residential Address Edit API ;1/6/21 10:30
+1 ;;5.3;Registration;**941,1010,1014,1040,1127**;Aug 13, 1993;Build 11
+2 ;;
+3 ;
EN(DFN,FLG) ;Entry point
+1 ;Input:
+2 ; DFN (required) - Internal Entry # of Patient File (#2)
+3 ; FLG (optional) - Flags of 1 or 0; if null, 0 is assumed. Details:
+4 ; FLG(1) - if 1 let user edit phone numbers (field #.131 and #.132)
+5 ; FLG(2) - if 1 display before & after address (and phone if FLG(1)=1) for user confirmation
+6 NEW DGINPUT,DGCMP,ICNTRY,CNTRY,FORGN,PSTR,OLDC,FSTR,BAD
+7 NEW I,X,Y
+8 IF $GET(DFN)=""
QUIT
+9 SET FLG(1)=$GET(FLG(1))
SET FLG(2)=$GET(FLG(2))
RETRY ; Entry point if address must be re-entered
+1 DO GETOLD(.DGCMP,DFN)
+2 SET CNTRY=""
SET ICNTRY=$SELECT(DFN:$PIECE($GET(^DPT(DFN,.115)),"^",10),1:"")
+3 ;default country is USA if NULL
IF ICNTRY=""
SET ICNTRY=1
+4 ; DG*5.3*1040 - Set variable DGTMOT to 1 to track timeout
+5 SET OLDC=DGCMP("OLD",.11573)
SET FORGN=$$FOREIGN^DGADDUTL(DFN,ICNTRY,2,.11573,.CNTRY)
IF FORGN=-1
SET DGTMOT=1
QUIT
+6 ;set up field string of address prompts
KILL FSTR,PSTR
SET FSTR=$$INPT1(FORGN,.PSTR)
+7 KILL DGINPUT
SET DGINPUT=1
DO INPUT(.DGINPUT,DFN,FSTR,CNTRY)
IF $GET(DGINPUT)=-1
QUIT
+8 ; initialize valid address flag
+9 SET BAD=0
+10 ;
+11 ; **** DG*5.3*1014; jam; Start changes ****
+12 ;
+13 ; DG*5.3*1014; jam; If required fields are missing, we can't call the validation service - force user to correct the address
+14 IF DGINPUT(.1151)=""!(DGINPUT(.1154)="")!(($GET(DGINPUT(.1156))="")&('FORGN))
Begin DoDot:1
+15 IF 'FORGN
WRITE !!?3,*7,"RESIDENTIAL ADDRESS [LINE 1], CITY, and ZIP CODE fields are required."
+16 IF FORGN
WRITE !!?3,*7,"RESIDENTIAL ADDRESS [LINE 1] and CITY fields are required."
End DoDot:1
GOTO RETRY
+17 ; DG*5.3*1014; Display the address entered
+18 NEW DGNEWADD
+19 MERGE DGNEWADD("NEW")=DGINPUT
+20 WRITE !
+21 IF FORGN
DO DISPFGN(.DGNEWADD,"NEW")
+22 IF 'FORGN
DO DISPUS(.DGNEWADD,"NEW")
+23 KILL DGNEWADD
CHK ; DG*5.3*1014; Prompt user and allow them to correct the address or continue to Validation service
+1 NEW DIR
+2 SET DIR("A",1)="If address is ready for validation enter <RET> to continue, 'E' to Edit"
+3 SET DIR("A")=" or '^' to quit"
+4 SET DIR(0)="FO"
+5 SET DIR("?")="Enter 'E' to edit the address, <RET> to continue to address validation or '^' to exit and cancel the address entry/edit.."
+6 DO ^DIR
KILL DIR
+7 ; DG*5.3*1040 - Set variable DGTMOT=1, if timeout and QUIT
+8 IF $DATA(DTOUT)
SET DGTMOT=1
QUIT
+9 ; DG*5.3*1040 - Remove the DTOUT check and Quit if EOP timeout
+10 ;Exiting - Not saving address - go to phone saving process
IF $DATA(DUOUT)
WRITE !,"Address changes not saved."
DO EOP
if +$GET(DGTMOT)
QUIT
GOTO PHONE
+11 ; re-enter address
IF X="E"!(X="e")
GOTO RETRY
+12 ; at this point, any response but <RET> will not be accepted
IF X'=""
GOTO CHK
+13 ; DG*5.3*1014; jam; Add call to Address Validation service
+14 ;DG*5.3*1127 - Added DGOVERKEY variable
NEW DGADVRET,DGOVERKEY
+15 SET DGADVRET=$$EN^DGADDVAL(.DGINPUT,"R")
+16 ; DG*5.3*1127 - Get the override key. DGINPUT("overrideKey") will contain the value of the
+17 ; override key set in DGADDLST which is called when validating the address
+18 SET DGOVERKEY=$GET(DGINPUT("overrideKey"))
+19 ; DG*5.3*1040; if return is -1 timeout occurred
+20 IF DGADVRET=-1
SET DGTMOT=1
QUIT
+21 ; if return is 0 - address was not validated
+22 ; DG*5.3*1040 - Check EOP timeout and QUIT
IF 'DGADVRET
WRITE !!,"No Results - UAM Address Validation Service is unable to validate the address.",!,"Please verify the address entered. "
DO EOP
if +$GET(DGTMOT)
QUIT
+23 ; DGINPUT array contains the address that is validated/accepted or what the user entered if the validation service failed
+24 ;
+25 ; **** DG*5.3*1014; jam; End changes ****
+26 ;
+27 ; if flag is set, show old and new address
+28 IF FLG(2)=1
DO COMPARE(.DGINPUT,.DGCMP)
+29 ; DG*5.3*1040 - Use variable DGCONFIRM to hold value of $$CONFIRM("ADDRESS")
+30 NEW DGCONFIRM
SET DGCONFIRM=$$CONFIRM("ADDRESS")
IF DGCONFIRM=-1
SET DGTMOT=1
QUIT
+31 ; DG*5.3*1040 - Check variable DGCONFIRM
+32 ;Not saving address - go to phone saving process
IF 'DGCONFIRM
WRITE !,"Address changes not saved."
GOTO PHONE
+33 ; Validate the address fields and set BAD=1 if not valid
+34 IF DGINPUT(.1151)=""!(DGINPUT(.1154)="")!(($GET(DGINPUT(.1156))="")&('FORGN))
Begin DoDot:1
+35 IF 'FORGN
WRITE !!?3,*7,"RESIDENTIAL ADDRESS [LINE 1], ZIP CODE and CITY fields are required."
+36 IF FORGN
WRITE !!?3,*7,"RESIDENTIAL ADDRESS [LINE 1] and CITY fields are required."
End DoDot:1
SET BAD=1
GOTO PHONE
+37 ; If address is valid, next check is for PO Box and General Delivery -
+38 ; Pass in LINE 1, State and Country codes
+39 IF $$POBOXRES^DGREGCP2(DGINPUT(.1151),$PIECE($GET(DGINPUT(.1155)),"^",2),$PIECE(DGINPUT(.11573),"^",2))
Begin DoDot:1
+40 WRITE !!?3,*7,"You cannot enter 'P. O. Box' or 'General Delivery' for a Residential Address."
End DoDot:1
SET BAD=1
GOTO PHONE
+41 ; If all Validations passed - save the address
+42 DO SAVE(.DGINPUT,DFN,FSTR,FORGN)
if +$GET(DGTMOT)
QUIT
PHONE ; Process the phone number changes IF FLG(1) = 1
+1 IF $GET(FLG(1))=1
Begin DoDot:1
+2 ; if compare flag is set, display old/new values
+3 IF $GET(FLG(2))=1
DO COMPAREP(.DGINPUT,.DGCMP)
+4 ; DG*5.3*1040 - Use variable DGCONFIRM to hold value of $$CONFIRM("PHONE")
+5 NEW DGCONFIRM
SET DGCONFIRM=$$CONFIRM("PHONE")
IF DGCONFIRM=-1
SET DGTMOT=1
QUIT
+6 ; DG*5.3*1040 - Check variable DGCONFIRM and DGTMOT
+7 IF 'DGCONFIRM
WRITE !,"Phone changes not saved."
DO EOP
if +$GET(DGTMOT)
QUIT
+8 ; DG*5.3*1040 - QUIT if timeout
IF '$TEST
DO SAVEPH(.DGINPUT,DFN)
if +$GET(DGTMOT)
QUIT
End DoDot:1
+9 ; Phone number process is completed - go to RETRY if address validation failed
+10 IF BAD
GOTO RETRY
+11 QUIT
INPUT(DGINPUT,DFN,FSTR,CNTRY) ;Let user input address changes
+1 ; Output: DGINPUT(field#)=external^internal(if any)
+2 NEW DIR,X,Y,DA,DGR,DTOUT,DUOUT,DIROUT,DGN,L
+3 FOR L=1:1:$LENGTH(FSTR,",")
SET DGN=$PIECE(FSTR,",",L)
SET DGINPUT(DGN)=""
if DGINPUT=-1
QUIT
Begin DoDot:1
+4 IF $$SKIP(DGN,.DGINPUT,.FLG)
QUIT
+5 ; DG*5.3*1040 - Set timeout variable DGTMOT to 1, if ZIP timeout
+6 IF DGN=.1156
DO ZIPINP(.DGINPUT,DFN)
if DGINPUT=-1
SET DGTMOT=1
QUIT
+7 ; DG*5.3*1040 - Include flag DGTMOUT to track timeout with DGTMOT set to 1
+8 IF '$$READ(DFN,DGN,.Y)
SET DGINPUT=-1
SET DGTMOT=1
QUIT
+9 SET DGINPUT(DGN)=$GET(Y)
End DoDot:1
+10 IF DGINPUT'=-1
SET DGINPUT(.11573)=CNTRY_"^"_$ORDER(^HL(779.004,"B",CNTRY,""))
+11 QUIT
GETOLD(DGCMP,DFN) ;populate array with existing address info
+1 KILL DGCMP
+2 NEW CCIEN,DGCURR,CFORGN,CFSTR,L,T,DGCIEN,DGST,DGCNTY,COUNTRY
+3 SET CFORGN=0
+4 ; get current country
+5 SET CCIEN=$SELECT(DFN:$$GET1^DIQ(2,DFN_",",.11573,"I"),1:"")
+6 SET CFORGN=$$FORIEN^DGADDUTL(CCIEN)
+7 ; get current address fields and xlate to ^DIQ format
+8 SET CFSTR=$$INPT1(CFORGN)
SET CFSTR=$TRANSLATE(CFSTR,",",";")
+9 ; Domestic data needs some extra fields
+10 IF 'CFORGN
SET CFSTR=CFSTR_";.1154;.1155;.1157"
+11 IF DFN
DO GETS^DIQ(2,DFN_",",CFSTR,"EI","DGCURR")
+12 FOR L=1:1:$LENGTH(CFSTR,";")
SET T=$PIECE(CFSTR,";",L)
SET DGCMP("OLD",T)=$GET(DGCURR(2,DFN_",",T,"E"))
+13 SET COUNTRY=$$CNTRYI^DGADDUTL(CCIEN)
IF COUNTRY=-1
SET COUNTRY="UNKNOWN COUNTRY"
+14 SET DGCMP("OLD",.11573)=COUNTRY_"^"_CCIEN
+15 IF 'CFORGN
Begin DoDot:1
+16 SET DGCIEN=$GET(DGCURR(2,DFN_",",.1157,"I"))
+17 SET DGST=$GET(DGCURR(2,DFN_",",.1155,"I"))
+18 SET DGCNTY=$$CNTY^DGREGAZL(DGST,DGCIEN)
+19 IF DGCNTY=-1
SET DGCNTY=""
+20 SET DGCMP("OLD",.1157)=$PIECE(DGCNTY,U)_" "_$PIECE(DGCNTY,U,3)
End DoDot:1
+21 QUIT
+22 ;
COMPARE(DGINPUT,DGCMP) ;Display before & after address fields.
+1 NEW DGM,DGCNTY
+2 MERGE DGCMP("NEW")=DGINPUT
+3 WRITE !
+4 FOR DGM="OLD","NEW"
Begin DoDot:1
+5 IF DGCMP(DGM,.11573)]""
IF $$FORIEN^DGADDUTL($PIECE(DGCMP(DGM,.11573),U,2))
DO DISPFGN(.DGCMP,DGM)
QUIT
+6 IF DGM="NEW"
Begin DoDot:2
+7 SET DGCNTY=$PIECE($GET(DGCMP("NEW",.1157)),U)_" "_$PIECE($GET(DGCMP("NEW",.1157)),U,3)
+8 SET DGCMP("NEW",.1157)=DGCNTY
+9 IF ($LENGTH(DGCMP("NEW",.1156))>5)&($PIECE(DGCMP("NEW",.1156),"-",2)="")
SET DGCMP("NEW",.1156)=$EXTRACT(DGCMP("NEW",.1156),1,5)_"-"_$EXTRACT(DGCMP("NEW",.1156),6,9)
End DoDot:2
+10 DO DISPUS(.DGCMP,DGM)
End DoDot:1
+11 QUIT
+12 ;
COMPAREP(DGINPUT,DGCMP) ;Display before & after phone fields.
+1 NEW DGM
+2 MERGE DGCMP("NEW")=DGINPUT
+3 WRITE !
+4 FOR DGM="OLD","NEW"
Begin DoDot:1
+5 WRITE !,?2,"[",DGM," PHONE NUMBERS]"
+6 WRITE !,?6," Phone: ",?16,$PIECE($GET(DGCMP(DGM,.131)),U)
+7 WRITE !,?6," Office: ",?16,$PIECE($GET(DGCMP(DGM,.132)),U)
+8 WRITE !
End DoDot:1
+9 QUIT
+10 ;
DISPUS(DGCMP,DGM) ;tag to display US data
+1 NEW DGCNTRY
+2 WRITE !,?2,"[",DGM," RESIDENTIAL ADDRESS]"
+3 WRITE !?16,$PIECE($GET(DGCMP(DGM,.1151)),U)
+4 IF $PIECE($GET(DGCMP(DGM,.1152)),U)'=""
WRITE !,?16,$PIECE($GET(DGCMP(DGM,.1152)),U)
+5 IF $PIECE($GET(DGCMP(DGM,.1153)),U)'=""
WRITE !,?16,$PIECE($GET(DGCMP(DGM,.1153)),U)
+6 WRITE !,?16,$PIECE($GET(DGCMP(DGM,.1154)),U)
+7 if ($PIECE($GET(DGCMP(DGM,.1154)),U)'="")!($PIECE($GET(DGCMP(DGM,.1155)),U)'="")
WRITE ","
+8 WRITE $PIECE($GET(DGCMP(DGM,.1155)),U)
+9 WRITE " ",$GET(DGCMP(DGM,.1156))
+10 SET DGCNTRY=$$CNTRYI^DGADDUTL($PIECE($GET(DGCMP(DGM,.11573)),U,2))
+11 IF DGCNTRY]""
IF (DGCNTRY'=-1)
WRITE !?16,DGCNTRY
+12 IF $PIECE($GET(DGCMP(DGM,.1157)),U)'=""
WRITE !,?6," County: ",$PIECE($GET(DGCMP(DGM,.1157)),U)
+13 WRITE !
+14 QUIT
+15 ;
DISPFGN(DGCMP,DGM) ;tag to display Foreign data
+1 NEW DGCNTRY
+2 WRITE !,?2,"[",DGM," RESIDENTIAL ADDRESS]"
+3 WRITE !?16,$PIECE($GET(DGCMP(DGM,.1151)),U)
+4 IF $PIECE($GET(DGCMP(DGM,.1152)),U)'=""
WRITE !,?16,$PIECE($GET(DGCMP(DGM,.1152)),U)
+5 IF $PIECE($GET(DGCMP(DGM,.1153)),U)'=""
WRITE !,?16,$PIECE($GET(DGCMP(DGM,.1153)),U)
+6 ;W !,?16,$P($G(DGCMP(DGM,.11572)),U)_" "_$P($G(DGCMP(DGM,.1154)),U)_" "_$P($G(DGCMP(DGM,.11571)),U) ;DG*1010 comment out
+7 ;DG*1010 - display postal code last
WRITE !,?16,$PIECE($GET(DGCMP(DGM,.1154)),U)_" "_$PIECE($GET(DGCMP(DGM,.11571)),U)_" "_$PIECE($GET(DGCMP(DGM,.11572)),U)
+8 SET DGCNTRY=$$CNTRYI^DGADDUTL($PIECE($GET(DGCMP(DGM,.11573)),U,2))
+9 SET DGCNTRY=$SELECT(DGCNTRY="":"UNSPECIFIED COUNTRY",DGCNTRY=-1:"UNKNOWN COUNTRY",1:DGCNTRY)
+10 IF DGCNTRY]""
WRITE !?16,DGCNTRY
+11 WRITE !
+12 QUIT
+13 ;
CONFIRM(TYPE) ;Confirm if user wants to save the changes
+1 ; TYPE - used for the query message displayed to the user: "address" or "phone number"
+2 NEW DIR,X,Y,DTOUT,DUOUT,DIROUT
+3 SET DIR(0)="Y"
+4 SET DIR("A")="Are you sure that you want to save the "_TYPE_" changes"
+5 SET DIR("?")="Please answer Y for YES or N for NO."
+6 DO ^DIR
+7 ; DG*5.3*1040 - prompt timeout return -1
+8 IF $DATA(DTOUT)
QUIT -1
+9 IF $GET(Y)=0
QUIT 0
+10 IF $DATA(DUOUT)!$DATA(DIROUT)
QUIT 0
+11 QUIT 1
+12 ;
SAVE(DGINPUT,DFN,FSTR,FORGN) ;Save changes
+1 NEW DGN,DGER,DGM,L,DATA
+2 SET DGER=0
+3 ; need to get the country code into the DGINPUT array
+4 ; if it's a domestic address, we have to add in CITY,STATE & COUNTY
+5 SET FSTR=FSTR_$SELECT('FORGN:",.1154,.1155,.1157,.11573",1:",.11573")
+6 ;DG*5.3*1127 - Store the override Key returned from address validation
SET FSTR=FSTR_",.11591"
SET DGINPUT(.11591)=DGOVERKEY
+7 FOR L=1:1:$LENGTH(FSTR,",")
SET DGN=$PIECE(FSTR,",",L)
Begin DoDot:1
+8 ; Phone numbers saved separately - skip over here
+9 IF (DGN=.131)!(DGN=.132)
QUIT
+10 NEW DGCODE,DGNAME,FDA,MSG
+11 SET DGCODE=$PIECE($GET(DGINPUT(DGN)),U,2)
+12 SET DGNAME=$PIECE($GET(DGINPUT(DGN)),U)
+13 SET FDA(2,DFN_",",DGN)=$SELECT(DGCODE:DGCODE,1:DGNAME)
+14 DO FILE^DIE($SELECT(DGCODE:"",1:"E"),"FDA","MSG")
+15 IF $DATA(MSG)
Begin DoDot:2
+16 SET DGM=""
SET DGER=1
+17 WRITE !,"Please review the saved changes!!",!
+18 FOR
SET DGM=$ORDER(MSG("DIERR",1,"TEXT",DGM))
if DGM=""
QUIT
Begin DoDot:3
+19 WRITE $GET(MSG("DIERR",1,"TEXT",DGM))
End DoDot:3
End DoDot:2
End DoDot:1
+20 IF $GET(DGER)=0
WRITE !,"Change saved."
Begin DoDot:1
+21 ; Set the CASS IND field
+22 SET DATA(.1159)="NC"
+23 IF $$UPD^DGENDBS(2,DFN,.DATA)
End DoDot:1
+24 ; DG*5.3*1040 - If EOP timeout, QUIT if variable DGTMOT exists
+25 DO EOP
if +$GET(DGTMOT)
QUIT
+26 QUIT
+27 ;
SAVEPH(DGINPUT,DFN) ;Save phone changes
+1 NEW DGN,DGER,DGM,DATA
+2 SET DGER=0
+3 FOR DGN=.131,.132
Begin DoDot:1
+4 NEW DGCODE,DGNAME,FDA,MSG
+5 SET DGCODE=$PIECE($GET(DGINPUT(DGN)),U,2)
+6 SET DGNAME=$PIECE($GET(DGINPUT(DGN)),U)
+7 SET FDA(2,DFN_",",DGN)=$SELECT(DGCODE:DGCODE,1:DGNAME)
+8 DO FILE^DIE($SELECT(DGCODE:"",1:"E"),"FDA","MSG")
+9 IF $DATA(MSG)
Begin DoDot:2
+10 SET DGM=""
SET DGER=1
+11 WRITE !,"Please review the saved changes!!",!
+12 FOR
SET DGM=$ORDER(MSG("DIERR",1,"TEXT",DGM))
if DGM=""
QUIT
Begin DoDot:3
+13 WRITE $GET(MSG("DIERR",1,"TEXT",DGM))
End DoDot:3
End DoDot:2
End DoDot:1
+14 IF $GET(DGER)=0
WRITE !,"Change saved."
+15 ; DG*5.3*1040 - If EOP timeout, QUIT if variable DGTMOT exists
+16 DO EOP
if +$GET(DGTMOT)
QUIT
+17 QUIT
+18 ;
READ(DFN,DGN,Y) ;Read input, return success
+1 NEW SUCCESS,DIR,DA,DTOUT,DUOUT,DIROUT,L,POP
+2 SET SUCCESS=1
SET POP=0
+3 FOR L=0:0
Begin DoDot:1
+4 SET DIR(0)=2_","_DGN
+5 IF DFN
SET DA=DFN
+6 DO ^DIR
+7 IF $DATA(DTOUT)
SET POP=1
SET SUCCESS=0
QUIT
+8 IF $DATA(DUOUT)!$DATA(DIROUT)
DO UPCT
QUIT
+9 SET POP=1
End DoDot:1
if POP
QUIT
+10 QUIT SUCCESS
INPT1(FORGN,PSTR) ; first address input prompts
+1 NEW FSTR
+2 ; PSTR is the full set of fields domestic & foreign combined
+3 ; FSTR is the set of fields depending on Country code
+4 SET PSTR=".1151,.1152,.1153,.1154,.1155,.1157,.1156,.11571,.11572,.11573,.131,.132"
+5 SET FSTR=".1151,.1152,.1153,.1156,.131,.132"
+6 IF FORGN
SET FSTR=".1151,.1152,.1153,.1154,.11571,.11572,.131,.132"
+7 QUIT FSTR
ZIPINP(DGINPUT,DFN) ; get ZIP+4 input
+1 ; This subroutine calls existing code to prompt for zip code and return corresponding city, state and county
+2 ; DFN must be the patient internal ID.
+3 ; DGINPUT - passed by reference - the array containing the resulting county, city, and state for the zipcode.
+4 NEW FCITY,FZIP,FSTATE,FCOUNTY,TYPE,DGR
+5 ; Set the necessary variables for the Residential Address
+6 ; The variable TYPE is used for Confidential and temporary address types.
+7 ; Here for the Residential Address we clear this variable.
+8 SET FZIP=".1156"
SET FCITY=".1154"
SET FSTATE=".1155"
SET FCOUNTY=".1157"
SET TYPE=""
+9 DO EN^DGREGTZL(.DGR,DFN)
+10 MERGE DGINPUT=DGR
+11 QUIT
SKIP(DGN,DGINPUT,FLG) ; determine whether or not to skip this step
+1 NEW SKIP
+2 SET SKIP=0
+3 IF ($GET(DGINPUT(.1151))="")&((DGN=.1152)!(DGN=.1153))
SET SKIP=1
+4 IF ($GET(DGINPUT(.1152))="")&(DGN=.1153)
SET SKIP=1
+5 IF ($GET(FLG(1))'=1)&((DGN=.131)!(DGN=.132))
SET SKIP=1
+6 QUIT SKIP
EOP ;End of page prompt
+1 NEW DIR,DTOUT,DUOUT,DIROUT,X,Y
+2 SET DIR(0)="E"
+3 SET DIR("A")="Press ENTER to continue"
+4 DO ^DIR
+5 ; DG*5.3*1040 - Set variable DGTMOT=1, if timeout
+6 if $DATA(DTOUT)
SET DGTMOT=1
+7 QUIT
UPCT ;Indicate "^" or "^^" are unacceptable inputs.
+1 WRITE !,"EXIT NOT ALLOWED"
+2 QUIT
