DGREGRED ;ALB/JAM,ARF,JAM - Residential Address Edit API ;1/6/21 10:30
;;5.3;Registration;**941,1010,1014,1040,1127,1143**;Aug 13, 1993;Build 36
;;
;
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
;
; DG*5.3*1143 - If not already set, set variables to be used during editing and flag that real-time address update is active or inactive
I +$G(DGRTAON)=0 N DGRTAON S DGRTAON=$$ISRTAUON^DGRTAUPD() I DGRTAON=1 N DGADDGRP1,DGADDEDIT
;
S FLG(1)=$G(FLG(1)),FLG(2)=$G(FLG(2))
RETRY ; Entry point if address must be re-entered
D GETOLD(.DGCMP,DFN)
; DG*5.3*1143 - Merge any current values being entered with the old values
I $D(DGADDGRP1) M DGCMP=DGADDGRP1
S CNTRY="",ICNTRY=$S(DFN:$P($G(^DPT(DFN,.115)),"^",10),1:"")
; DG*5.3*1143 - Overwrite the Country with what is in the local array for Country
I $D(DGADDGRP1) S ICNTRY=DGADDGRP1(.11573)
;
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
; DG*5.3*1143 - for domestic address, require State
I DGINPUT(.1151)=""!(DGINPUT(.1154)="")!(($G(DGINPUT(.1156))="")!($G(DGINPUT(.1155))="")!($G(DGINPUT(.1155))="^")&('FORGN)) D G RETRY
. I 'FORGN W !!?3,*7,"RESIDENTIAL ADDRESS [LINE 1], CITY, STATE 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*1143 - for RTA, if user quit with ^, clean out edit data and exit
I $G(DGRTAON)=1 I $D(DUOUT) W !,"Changes not saved." D EOP 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 ****
;
; DG*5.3*1143 - If Real-time address (RTA) update is active, and hold flag is set, skip over the confirmation and handle saving the data for RTA updates.
I $G(DGRTAON)=1,$G(DGRTAHOLD)=1 D SAVERTA G:BAD=1 RETRY Q
;
; 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*1143 - After confirmation, if Real-time address (RTA) update is active, handle saving the data for RTA updates.
I $G(DGRTAON)=1 I 'DGCONFIRM W !,"Changes not saved." D CLEAN D EOP Q
I $G(DGRTAON)=1 D SAVERTA G:BAD=1 RETRY 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
;
CLEAN ; DG*5.3*1143 - Clear out edit data when the user saves or discards the changes
K DGADDGRP1,DGADDEDIT(1)
Q
;
SAVERTA ; DG*5.3*1143 - Save the address edits with RTA updates active
; Validate the address fields and set BAD=1 if not valid
I DGINPUT(.1151)=""!(DGINPUT(.1154)="")!(($G(DGINPUT(.1156))="")&('FORGN)) D S BAD=1 Q
. 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 Q
. W !!?3,*7,"You cannot enter 'P. O. Box' or 'General Delivery' for a Residential Address."
;
; Hold the data in local array DGADDGRP1
D SAVETOLOCAL
; Set the Address Edit flag (for group 1) so in ^DGRPP the user will be prompted to save or discard the changes
S DGADDEDIT(1)=1
; If RTA Hold flag is set (set in DGRPCADD) edits to fields are held for filing later - quit
I +$G(DGRTAHOLD)=1 Q
; Otherwise data should be sent to ES via RTA webservice and saved if valid response
; At the time of this patch the only way Residential address is edited is via screen 1.1 which sets DGRTAHOLD=1
; so this code will not actually run. If another path to editing is written which does not set DGRTAHOLD
; this code below would execute.
I $$SENDRTAU() D Q
. D SAVEFROMLOCAL
. W !,"Change saved."
. D EOP
; Address saved failed - this code should be updated to handle unsuccesful response and allow the user the option to quit or retry edits (see ^DGREGAED)
S BAD=1
Q
;
SAVETOLOCAL ; DG*5.3*1143 Save user input to local array
; Hold the data in the DGADDGRP1 array and save to the DB later
K DGADDGRP1
; This code mimics the SAVE logic except the data is stored in the local array
S FSTR=FSTR_$S('FORGN:",.1154,.1155,.1157,.11573",1:",.11573")
F L=1:1:$L(FSTR,",") S DGN=$P(FSTR,",",L) D
. N DGCODE,DGNAME
. S DGCODE=$P($G(DGINPUT(DGN)),U,2)
. S DGNAME=$P($G(DGINPUT(DGN)),U)
. S DGADDGRP1(DGN)=$S(DGCODE:DGCODE,1:DGNAME)
; Store the override key and the CASS indicator
S DGADDGRP1(.11591)=$G(DGOVERKEY)
S DGADDGRP1(.1159)="NC"
Q
;
SENDRTAU() ; DG*5.3*1143 - send edited address data to ES via webservice
N DGRTARET,DGERRS
S DGRTARET=$$EN^DGRTAUPD(DFN,.DGERRS,.DGADDGRP1)
I 'DGRTARET D
. N X,Z,DGI,DGLINE,DIWR,DGL,DIWL,DIWF
. S DIWL=0,DIWR=75,DIWF=""
. ; Print out the message attached to the return
. S X=$P(DGRTARET,"^",2)
. K ^UTILITY($J,"W")
. D ^DIWP
. M DGLINE=^UTILITY($J,"W",0)
. W !!,"** Webservice call failed:" F DGL=1:1:DGLINE W DGLINE(DGL,0),!
. ; Print out the DGERRS text
. S DGI="" F S DGI=$O(DGERRS(DGI)) Q:'DGI D
. . W !,"("_DGI_") "
. . S X=DGERRS(DGI)
. . K ^UTILITY($J,"W")
. . D ^DIWP
. . M DGLINE=^UTILITY($J,"W",0)
. . F DGL=1:1:DGLINE W DGLINE(DGL,0),!
. D EOP
Q DGRTARET
;
SAVEFROMLOCAL ; DG*5.3*1143 Save data to the DB from the local DGADDGRP1 array
N DGN,DGVALUE,FDA
S DGN=0
F S DGN=$O(DGADDGRP1(DGN)) Q:'DGN D
. S DGVALUE=DGADDGRP1(DGN)
. S FDA(2,DFN_",",DGN)=DGVALUE
. ; for home and office phone number, if there is an extension, store it
. I DGN=.131 I DGADDGRP1(DGN)["X" S FDA(2,DFN_",",.13211)=$P(DGADDGRP1(DGN),"X",2)
. I DGN=.132 I DGADDGRP1(DGN)["X" S FDA(2,DFN_",",.13213)=$P(DGADDGRP1(DGN),"X",2)
D FILE^DIE("","FDA","MSG")
; Clean out the edit data
D CLEAN
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,DGVAL
S SUCCESS=1,POP=0
F L=0:0 D Q:POP
. S DIR(0)=2_","_DGN
. ; DG*5.3*1143 - use the value in the local array for the field default
. I $D(DGADDGRP1(DGN)) S DIR("B")=DGADDGRP1(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
. ; DG*5.3*1143 - Check the format of the phone number fields since the user may have accepted the default value which would not be checked by Fileman
. S DGVAL=Y
. I DGN=.131!(DGN=.132) I DGVAL'="" D I '$D(DGVAL) W !,*7,"Answer must be 10 numbers in length with an optional 'X' and 1-6 digit",!,"extension number allowed.",!! Q
. . S DGVAL=$TR(DGVAL,"x","X") K:$L(DGVAL)>17 DGVAL I $D(DGVAL) K:'(DGVAL?10N!(DGVAL?10.N1"X"1.6N)) DGVAL
. 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 zip code.
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=""
; DG*5.3*1143 - Pass the local array value for FZIP and FCITY (if defined) to use as the default values
D EN^DGREGTZL(.DGR,DFN,$G(DGADDGRP1(FZIP)),$G(DGADDGRP1(FCITY)))
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 18658 printed May 25, 2026@12:59 Page 2
DGREGRED ;ALB/JAM,ARF,JAM - Residential Address Edit API ;1/6/21 10:30
+1 ;;5.3;Registration;**941,1010,1014,1040,1127,1143**;Aug 13, 1993;Build 36
+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 ;
+9 IF $GET(DFN)=""
QUIT
+10 ;
+11 ; DG*5.3*1143 - If not already set, set variables to be used during editing and flag that real-time address update is active or inactive
+12 IF +$GET(DGRTAON)=0
NEW DGRTAON
SET DGRTAON=$$ISRTAUON^DGRTAUPD()
IF DGRTAON=1
NEW DGADDGRP1,DGADDEDIT
+13 ;
+14 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 ; DG*5.3*1143 - Merge any current values being entered with the old values
+3 IF $DATA(DGADDGRP1)
MERGE DGCMP=DGADDGRP1
+4 SET CNTRY=""
SET ICNTRY=$SELECT(DFN:$PIECE($GET(^DPT(DFN,.115)),"^",10),1:"")
+5 ; DG*5.3*1143 - Overwrite the Country with what is in the local array for Country
+6 IF $DATA(DGADDGRP1)
SET ICNTRY=DGADDGRP1(.11573)
+7 ;
+8 ;default country is USA if NULL
IF ICNTRY=""
SET ICNTRY=1
+9 ; DG*5.3*1040 - Set variable DGTMOT to 1 to track timeout
+10 SET OLDC=DGCMP("OLD",.11573)
SET FORGN=$$FOREIGN^DGADDUTL(DFN,ICNTRY,2,.11573,.CNTRY)
IF FORGN=-1
SET DGTMOT=1
QUIT
+11 ;set up field string of address prompts
KILL FSTR,PSTR
SET FSTR=$$INPT1(FORGN,.PSTR)
+12 KILL DGINPUT
SET DGINPUT=1
DO INPUT(.DGINPUT,DFN,FSTR,CNTRY)
IF $GET(DGINPUT)=-1
QUIT
+13 ; initialize valid address flag
+14 SET BAD=0
+15 ;
+16 ; **** DG*5.3*1014; jam; Start changes ****
+17 ;
+18 ; DG*5.3*1014; jam; If required fields are missing, we can't call the validation service - force user to correct the address
+19 ; DG*5.3*1143 - for domestic address, require State
+20 IF DGINPUT(.1151)=""!(DGINPUT(.1154)="")!(($GET(DGINPUT(.1156))="")!($GET(DGINPUT(.1155))="")!($GET(DGINPUT(.1155))="^")&('FORGN))
Begin DoDot:1
+21 IF 'FORGN
WRITE !!?3,*7,"RESIDENTIAL ADDRESS [LINE 1], CITY, STATE and ZIP CODE fields are required."
+22 IF FORGN
WRITE !!?3,*7,"RESIDENTIAL ADDRESS [LINE 1] and CITY fields are required."
End DoDot:1
GOTO RETRY
+23 ; DG*5.3*1014; Display the address entered
+24 NEW DGNEWADD
+25 MERGE DGNEWADD("NEW")=DGINPUT
+26 WRITE !
+27 IF FORGN
DO DISPFGN(.DGNEWADD,"NEW")
+28 IF 'FORGN
DO DISPUS(.DGNEWADD,"NEW")
+29 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*1143 - for RTA, if user quit with ^, clean out edit data and exit
+10 IF $GET(DGRTAON)=1
IF $DATA(DUOUT)
WRITE !,"Changes not saved."
DO EOP
QUIT
+11 ; DG*5.3*1040 - Remove the DTOUT check and Quit if EOP timeout
+12 ;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
+13 ; re-enter address
IF X="E"!(X="e")
GOTO RETRY
+14 ; at this point, any response but <RET> will not be accepted
IF X'=""
GOTO CHK
+15 ; DG*5.3*1014; jam; Add call to Address Validation service
+16 ;DG*5.3*1127 - Added DGOVERKEY variable
NEW DGADVRET,DGOVERKEY
+17 SET DGADVRET=$$EN^DGADDVAL(.DGINPUT,"R")
+18 ; DG*5.3*1127 - Get the override key. DGINPUT("overrideKey") will contain the value of the
+19 ; override key set in DGADDLST which is called when validating the address
+20 SET DGOVERKEY=$GET(DGINPUT("overrideKey"))
+21 ; DG*5.3*1040; if return is -1 timeout occurred
+22 IF DGADVRET=-1
SET DGTMOT=1
QUIT
+23 ; if return is 0 - address was not validated
+24 ; 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
+25 ; DGINPUT array contains the address that is validated/accepted or what the user entered if the validation service failed
+26 ;
+27 ; **** DG*5.3*1014; jam; End changes ****
+28 ;
+29 ; DG*5.3*1143 - If Real-time address (RTA) update is active, and hold flag is set, skip over the confirmation and handle saving the data for RTA updates.
+30 IF $GET(DGRTAON)=1
IF $GET(DGRTAHOLD)=1
DO SAVERTA
if BAD=1
GOTO RETRY
QUIT
+31 ;
+32 ; if flag is set, show old and new address
+33 IF FLG(2)=1
DO COMPARE(.DGINPUT,.DGCMP)
+34 ; DG*5.3*1040 - Use variable DGCONFIRM to hold value of $$CONFIRM("ADDRESS")
+35 NEW DGCONFIRM
SET DGCONFIRM=$$CONFIRM("ADDRESS")
IF DGCONFIRM=-1
SET DGTMOT=1
QUIT
+36 ;
+37 ; DG*5.3*1143 - After confirmation, if Real-time address (RTA) update is active, handle saving the data for RTA updates.
+38 IF $GET(DGRTAON)=1
IF 'DGCONFIRM
WRITE !,"Changes not saved."
DO CLEAN
DO EOP
QUIT
+39 IF $GET(DGRTAON)=1
DO SAVERTA
if BAD=1
GOTO RETRY
QUIT
+40 ;
+41 ; DG*5.3*1040 - Check variable DGCONFIRM
+42 ;Not saving address - go to phone saving process
IF 'DGCONFIRM
WRITE !,"Address changes not saved."
GOTO PHONE
+43 ; Validate the address fields and set BAD=1 if not valid
+44 IF DGINPUT(.1151)=""!(DGINPUT(.1154)="")!(($GET(DGINPUT(.1156))="")&('FORGN))
Begin DoDot:1
+45 IF 'FORGN
WRITE !!?3,*7,"RESIDENTIAL ADDRESS [LINE 1], ZIP CODE and CITY fields are required."
+46 IF FORGN
WRITE !!?3,*7,"RESIDENTIAL ADDRESS [LINE 1] and CITY fields are required."
End DoDot:1
SET BAD=1
GOTO PHONE
+47 ; If address is valid, next check is for PO Box and General Delivery -
+48 ; Pass in LINE 1, State and Country codes
+49 IF $$POBOXRES^DGREGCP2(DGINPUT(.1151),$PIECE($GET(DGINPUT(.1155)),"^",2),$PIECE(DGINPUT(.11573),"^",2))
Begin DoDot:1
+50 WRITE !!?3,*7,"You cannot enter 'P. O. Box' or 'General Delivery' for a Residential Address."
End DoDot:1
SET BAD=1
GOTO PHONE
+51 ;
+52 ; If all Validations passed - save the address
+53 DO SAVE(.DGINPUT,DFN,FSTR,FORGN)
if +$GET(DGTMOT)
QUIT
+54 ;
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
+12 ;
CLEAN ; DG*5.3*1143 - Clear out edit data when the user saves or discards the changes
+1 KILL DGADDGRP1,DGADDEDIT(1)
+2 QUIT
+3 ;
SAVERTA ; DG*5.3*1143 - Save the address edits with RTA updates active
+1 ; Validate the address fields and set BAD=1 if not valid
+2 IF DGINPUT(.1151)=""!(DGINPUT(.1154)="")!(($GET(DGINPUT(.1156))="")&('FORGN))
Begin DoDot:1
+3 IF 'FORGN
WRITE !!?3,*7,"RESIDENTIAL ADDRESS [LINE 1], ZIP CODE and CITY fields are required."
+4 IF FORGN
WRITE !!?3,*7,"RESIDENTIAL ADDRESS [LINE 1] and CITY fields are required."
End DoDot:1
SET BAD=1
QUIT
+5 ; If address is valid, next check is for PO Box and General Delivery -
+6 ; Pass in LINE 1, State and Country codes
+7 IF $$POBOXRES^DGREGCP2(DGINPUT(.1151),$PIECE($GET(DGINPUT(.1155)),"^",2),$PIECE(DGINPUT(.11573),"^",2))
Begin DoDot:1
+8 WRITE !!?3,*7,"You cannot enter 'P. O. Box' or 'General Delivery' for a Residential Address."
End DoDot:1
SET BAD=1
QUIT
+9 ;
+10 ; Hold the data in local array DGADDGRP1
+11 DO SAVETOLOCAL
+12 ; Set the Address Edit flag (for group 1) so in ^DGRPP the user will be prompted to save or discard the changes
+13 SET DGADDEDIT(1)=1
+14 ; If RTA Hold flag is set (set in DGRPCADD) edits to fields are held for filing later - quit
+15 IF +$GET(DGRTAHOLD)=1
QUIT
+16 ; Otherwise data should be sent to ES via RTA webservice and saved if valid response
+17 ; At the time of this patch the only way Residential address is edited is via screen 1.1 which sets DGRTAHOLD=1
+18 ; so this code will not actually run. If another path to editing is written which does not set DGRTAHOLD
+19 ; this code below would execute.
+20 IF $$SENDRTAU()
Begin DoDot:1
+21 DO SAVEFROMLOCAL
+22 WRITE !,"Change saved."
+23 DO EOP
End DoDot:1
QUIT
+24 ; Address saved failed - this code should be updated to handle unsuccesful response and allow the user the option to quit or retry edits (see ^DGREGAED)
+25 SET BAD=1
+26 QUIT
+27 ;
SAVETOLOCAL ; DG*5.3*1143 Save user input to local array
+1 ; Hold the data in the DGADDGRP1 array and save to the DB later
+2 KILL DGADDGRP1
+3 ; This code mimics the SAVE logic except the data is stored in the local array
+4 SET FSTR=FSTR_$SELECT('FORGN:",.1154,.1155,.1157,.11573",1:",.11573")
+5 FOR L=1:1:$LENGTH(FSTR,",")
SET DGN=$PIECE(FSTR,",",L)
Begin DoDot:1
+6 NEW DGCODE,DGNAME
+7 SET DGCODE=$PIECE($GET(DGINPUT(DGN)),U,2)
+8 SET DGNAME=$PIECE($GET(DGINPUT(DGN)),U)
+9 SET DGADDGRP1(DGN)=$SELECT(DGCODE:DGCODE,1:DGNAME)
End DoDot:1
+10 ; Store the override key and the CASS indicator
+11 SET DGADDGRP1(.11591)=$GET(DGOVERKEY)
+12 SET DGADDGRP1(.1159)="NC"
+13 QUIT
+14 ;
SENDRTAU() ; DG*5.3*1143 - send edited address data to ES via webservice
+1 NEW DGRTARET,DGERRS
+2 SET DGRTARET=$$EN^DGRTAUPD(DFN,.DGERRS,.DGADDGRP1)
+3 IF 'DGRTARET
Begin DoDot:1
+4 NEW X,Z,DGI,DGLINE,DIWR,DGL,DIWL,DIWF
+5 SET DIWL=0
SET DIWR=75
SET DIWF=""
+6 ; Print out the message attached to the return
+7 SET X=$PIECE(DGRTARET,"^",2)
+8 KILL ^UTILITY($JOB,"W")
+9 DO ^DIWP
+10 MERGE DGLINE=^UTILITY($JOB,"W",0)
+11 WRITE !!,"** Webservice call failed:"
FOR DGL=1:1:DGLINE
WRITE DGLINE(DGL,0),!
+12 ; Print out the DGERRS text
+13 SET DGI=""
FOR
SET DGI=$ORDER(DGERRS(DGI))
if 'DGI
QUIT
Begin DoDot:2
+14 WRITE !,"("_DGI_") "
+15 SET X=DGERRS(DGI)
+16 KILL ^UTILITY($JOB,"W")
+17 DO ^DIWP
+18 MERGE DGLINE=^UTILITY($JOB,"W",0)
+19 FOR DGL=1:1:DGLINE
WRITE DGLINE(DGL,0),!
End DoDot:2
+20 DO EOP
End DoDot:1
+21 QUIT DGRTARET
+22 ;
SAVEFROMLOCAL ; DG*5.3*1143 Save data to the DB from the local DGADDGRP1 array
+1 NEW DGN,DGVALUE,FDA
+2 SET DGN=0
+3 FOR
SET DGN=$ORDER(DGADDGRP1(DGN))
if 'DGN
QUIT
Begin DoDot:1
+4 SET DGVALUE=DGADDGRP1(DGN)
+5 SET FDA(2,DFN_",",DGN)=DGVALUE
+6 ; for home and office phone number, if there is an extension, store it
+7 IF DGN=.131
IF DGADDGRP1(DGN)["X"
SET FDA(2,DFN_",",.13211)=$PIECE(DGADDGRP1(DGN),"X",2)
+8 IF DGN=.132
IF DGADDGRP1(DGN)["X"
SET FDA(2,DFN_",",.13213)=$PIECE(DGADDGRP1(DGN),"X",2)
End DoDot:1
+9 DO FILE^DIE("","FDA","MSG")
+10 ; Clean out the edit data
+11 DO CLEAN
+12 QUIT
+13 ;
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,DGVAL
+2 SET SUCCESS=1
SET POP=0
+3 FOR L=0:0
Begin DoDot:1
+4 SET DIR(0)=2_","_DGN
+5 ; DG*5.3*1143 - use the value in the local array for the field default
+6 IF $DATA(DGADDGRP1(DGN))
SET DIR("B")=DGADDGRP1(DGN)
+7 IF DFN
SET DA=DFN
+8 DO ^DIR
+9 IF $DATA(DTOUT)
SET POP=1
SET SUCCESS=0
QUIT
+10 IF $DATA(DUOUT)!$DATA(DIROUT)
DO UPCT
QUIT
+11 ; DG*5.3*1143 - Check the format of the phone number fields since the user may have accepted the default value which would not be checked by Fileman
+12 SET DGVAL=Y
+13 IF DGN=.131!(DGN=.132)
IF DGVAL'=""
Begin DoDot:2
+14 SET DGVAL=$TRANSLATE(DGVAL,"x","X")
if $LENGTH(DGVAL)>17
KILL DGVAL
IF $DATA(DGVAL)
if '(DGVAL?10N!(DGVAL?10.N1"X"1.6N))
KILL DGVAL
End DoDot:2
IF '$DATA(DGVAL)
WRITE !,*7,"Answer must be 10 numbers in length with an optional 'X' and 1-6 digit",!,"extension number allowed.",!!
QUIT
+15 SET POP=1
End DoDot:1
if POP
QUIT
+16 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 zip code.
+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 ; DG*5.3*1143 - Pass the local array value for FZIP and FCITY (if defined) to use as the default values
+10 DO EN^DGREGTZL(.DGR,DFN,$GET(DGADDGRP1(FZIP)),$GET(DGADDGRP1(FCITY)))
+11 MERGE DGINPUT=DGR
+12 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
