DGREGAED ;ALB/DW,PHH,BAJ,TDM,JAM,ARF,JAM - Address Edit API ;1/6/21 10:28
;;5.3;Registration;**522,560,658,730,688,808,915,941,1010,1014,1040,1127,1143**;Aug 13, 1993;Build 36
;;
;; **688** Modifications for Country and Foreign address
;; **915** Make DFN optional in case one is not established yet
;; ** 1143 ** Modifications and real-time address update
;
EN(DFN,FLG,SRC,DGRET) ;Entry point
;Input:
; DFN (optional) - Internal Entry # of Patient File (#2)
; If not supplied then nothing filed or defaulted
; 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 for user confirmation
; DGRET - if passed by reference will contain address info array
K EASZIPLK,DGRET
N DGINPUT,DGCMP,ICNTRY,CNTRY,FORGN,PSTR,OLDC,BAD
N I,X,Y
S DFN=+$G(DFN)
;I ($G(DFN)'?.N) 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 DGADDGRP2,DGADDEDIT,DGRETRY
;
S FLG(1)=$G(FLG(1)),FLG(2)=$G(FLG(2))
D GETOLD(.DGCMP,DFN)
S CNTRY="",ICNTRY=$S(DFN:$P($G(^DPT(DFN,.11)),"^",10),1:"")
I ICNTRY="" S ICNTRY=1 ;default country is USA if NULL
;
; DG*5.3*1014; jam; ** Start changes **
RETRY ; DG*5.3*1014;jam ; Tag added for entry point to re-enter the address
; DG*5.3*1143 - Merge any current values being entered with the old values and overwrite the Country with what is in the local array for Country
I $D(DGADDGRP2) M DGCMP=DGADDGRP2 S ICNTRY=DGADDGRP2(.1173)
;
; DG*5.3*1040 - Set variable DGTMOT to 1 to track timeout
S OLDC=DGCMP("OLD",.1173),FORGN=$$FOREIGN^DGADDUTL(DFN,ICNTRY,2,.1173,.CNTRY) I FORGN=-1 S DGTMOT=1 Q
S FSTR=$$INPT1(FORGN,.PSTR) ;set up field string of address prompts
S DGINPUT=1 D INPUT(.DGINPUT,DFN,FSTR,CNTRY) I $G(DGINPUT)=-1 Q
I 'DFN M DGRET=DGINPUT Q
S BAD=0
; DG*5.3*1014; jam; If required fields are missing, we can't call the validation service
; DG*5.3*1143 - Add State as required (for domestic addresses)
I DGINPUT(.111)=""!(DGINPUT(.114)="")!(($G(DGINPUT(.1112))=""!($G(DGINPUT(.115))="")!($G(DGINPUT(.115))="^"))&('FORGN)) D G RETRY
. I 'FORGN W !!?3,*7,"ADDRESS [LINE 1], CITY, STATE, and ZIP CODE fields are required."
. I FORGN W !!?3,*7,"ADDRESS [LINE 1] and CITY fields are required."
; DG*5.3*1014; Display address entered - user may reenter the address or continue to Validation service.
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
I $D(DUOUT) W !,"Address changes not saved." D EOP Q ;Exiting - Not saving address
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,"P")
; 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"))
; 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 S DGRETRY=0 D SAVERTA G:DGRETRY=1 RETRY Q
;
CONF I $G(FLG(2))=1 D COMPARE(.DGINPUT,.DGCMP,.FLG)
; DG*5.3*1040 - Store return value from $$CONFIRM()
N DGCONFIRM S DGCONFIRM=$$CONFIRM()
; DG*5.3*1040 - Quit if timeout when DGCONFIRM = -1
Q:DGCONFIRM=-1
;
; 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,'DGCONFIRM W !,"Address changes not saved." D CLEAN D EOP Q
I $G(DGRTAON)=1 S DGRETRY=0 D SAVERTA G:DGRETRY=1 RETRY Q
;
; DG*5.3*1040 - Check variable DGCONFIRM
I 'DGCONFIRM W !,"Address changes not saved." D EOP Q
;
N DGPRIOR
D GETPRIOR^DGADDUTL(DFN,.DGPRIOR)
D SAVE(.DGINPUT,DFN,FSTR,FORGN) I $G(SRC)="",+$G(DGNEW) Q
Q:'$$FILEYN^DGADDUTL(.DGPRIOR,.DGINPUT)
D GETUPDTS^DGADDUTL(DFN,.DGINPUT)
D UPDADDLG^DGADDUTL(DFN,.DGPRIOR,.DGINPUT)
Q
;
CLEAN ; DG*5.3*1143 - Clean out edit data when the user saves or discards the changes
K DGADDGRP2,DGADDEDIT(2)
Q
SAVERTA ; DG*5.3*1143 - Save the address edits with RTA updates active
; Hold the data in local array DGADDGRP2
D SAVETOLOCAL
; Set the Address Edit flag (group 2) so in ^DGRPP the user will be prompted to save or discard the changes
S DGADDEDIT(2)=1
; If RTA Hold flag is set (set in DGRPCADD) changes will be filed later, quit
I +$G(DGRTAHOLD)=1 Q
; Otherwise data should be sent to ES via RTA webservice and saved if valid response
I $$SENDRTAU() D Q
. D SAVEFROMLOCAL
. W !,"Change saved."
. D EOP
; Sending of data failed - determine if the user will retry edits, and quit with 0
; If a timeout occurred
I $D(DTOUT)!(+$G(DGTMOT)) Q 0
; If user entered "^"
I $D(DUOUT) Q 0
N X,Y,DIR
ASK ; Give the user the option to retry edits or quit
S DIR("A")="Enter 'E' to re-enter the data or '^' to quit"
S DIR(0)="FO"
S DIR("?")="Enter 'E' to re-edit the data, or '^' to exit and cancel the address entry/edit."
D ^DIR K DIR
; If timeout, set timeout
I $D(DTOUT) S DGTMOT=1 Q 0
; If user quit with ^
I $D(DUOUT) Q 0
; User has opted to retry
I X="E"!(X="e") S DGRETRY=1 Q 0
G ASK ; at this point, any other response is not accepted
;
SAVETOLOCAL ; DG*5.3*1143 - Save user input to local array DGADDGRP2
; Hold the data in the DGADDGRP2 array and save to the DB later
K DGADDGRP2
; This code mimics the SAVE logic except the data is saved to the local array
S FSTR=FSTR_$S('FORGN:",.114,.115,.117,.1173",1:",.1173")
F L=1:1:$L(FSTR,",") S DGN=$P(FSTR,",",L) D
. N DGCODE,DGNAME
. ; if the field contains external^internal value, store the internal value
. S DGCODE=$P($G(DGINPUT(DGN)),U,2)
. S DGNAME=$P($G(DGINPUT(DGN)),U)
. S DGADDGRP2(DGN)=$S(DGCODE:DGCODE,1:DGNAME)
; store the Override key and the CASS indicator
S DGADDGRP2(.1119)=$G(DGOVERKEY)
S DGADDGRP2(.1118)="NC"
Q
;
SENDRTAU() ; DG*5.3*1143 - send edited address data to ES via webservice directly
N DGRTARET,DGERRS
S DGRTARET=$$EN^DGRTAUPD(DFN,.DGERRS,,.DGADDGRP2)
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 DGADDGRP2 array
N DGN,DGVALUE,FDA
S DGN=0
F S DGN=$O(DGADDGRP2(DGN)) Q:'DGN D
. S DGVALUE=DGADDGRP2(DGN)
. S FDA(2,DFN_",",DGN)=DGVALUE
. ; for home and office phone number, update the extension field
. I DGN=.131 S FDA(2,DFN_",",.13211)=$P(DGADDGRP2(DGN),"X",2)
. I DGN=.132 S FDA(2,DFN_",",.13213)=$P(DGADDGRP2(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=.1112 D ZIPINP(.DGINPUT,DFN) S:DGINPUT=-1 DGTMOT=1 Q
. ; DG*5.3*1040 - Set timeout variable DGTMOT to 1, if field timeout
. I '$$READ(DFN,DGN,.Y) S DGINPUT=-1,DGTMOT=1 Q
. I DGN=.121 S Y=$G(Y) D Q
.. I Y="",DGINPUT(DGN)="" Q
.. I DFN,$P(Y,U)=$$GET1^DIQ(2,DFN_",",DGN,"I") S DGINPUT(DGN)=$$GET1^DIQ(2,DFN_",",DGN)_U_$P(Y,U) Q
.. S DGINPUT(DGN)=$P(Y(0),U)_U_Y
. S DGINPUT(DGN)=$G(Y)
I DGINPUT'=-1 S DGINPUT(.1173)=CNTRY_"^"_$O(^HL(779.004,"B",CNTRY,""))
Q
GETOLD(DGCMP,DFN) ;populate array with existing address info
N CCIEN,DGCURR,CFORGN,CFSTR,L,T,DGCIEN,DGST,DGCNTY,COUNTRY
S CFORGN=0
; get current country
; If current country is NULL it is old data
; Leave it NULL here because this is not an edit function
S CCIEN=$S(DFN:$$GET1^DIQ(2,DFN_",","COUNTRY","I"),1:"")
;I CCIEN="" S CCIEN=$O(^HL(779.004,"D","UNITED STATES",""))
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_";.114;.115;.117"
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",.1173)=COUNTRY_"^"_CCIEN
I 'CFORGN D
. S DGCIEN=$G(DGCURR(2,DFN_",",.117,"I"))
. S DGST=$G(DGCURR(2,DFN_",",.115,"I"))
. S DGCNTY=$$CNTY^DGREGAZL(DGST,DGCIEN)
. I DGCNTY=-1 S DGCNTY=""
. S DGCMP("OLD",.117)=$P(DGCNTY,U)_" "_$P(DGCNTY,U,3)
Q
;
COMPARE(DGINPUT,DGCMP,FLG) ;Display before & after address fields.
N DGM
M DGCMP("NEW")=DGINPUT
F DGM="OLD","NEW" D
. I DGCMP(DGM,.1173)]"",$$FORIEN^DGADDUTL($P(DGCMP(DGM,.1173),U,2)) D DISPFGN(.DGCMP,DGM,.FLG) Q
. I DGM="NEW" D
. . S DGCNTY=$P($G(DGCMP("NEW",.117)),U)_" "_$P($G(DGCMP("NEW",.117)),U,3)
. . S DGCMP("NEW",.117)=DGCNTY
. . I ($L(DGCMP("NEW",.1112))>5)&($P(DGCMP("NEW",.1112),"-",2)="") S DGCMP("NEW",.1112)=$E(DGCMP("NEW",.1112),1,5)_"-"_$E(DGCMP("NEW",.1112),6,9)
. D DISPUS(.DGCMP,DGM,.FLG)
Q
;
DISPUS(DGCMP,DGM,FLG) ;tag to display US data
N DGCNTRY
W !,?2,"[",DGM," ADDRESS]"
W ?16,$P($G(DGCMP(DGM,.111)),U)
I $P($G(DGCMP(DGM,.112)),U)'="" W !,?16,$P($G(DGCMP(DGM,.112)),U)
I $P($G(DGCMP(DGM,.113)),U)'="" W !,?16,$P($G(DGCMP(DGM,.113)),U)
W !,?16,$P($G(DGCMP(DGM,.114)),U)
W:($P($G(DGCMP(DGM,.114)),U)'="")!($P($G(DGCMP(DGM,.115)),U)'="") ","
W $P($G(DGCMP(DGM,.115)),U)
W " ",$G(DGCMP(DGM,.1112))
S DGCNTRY=$$CNTRYI^DGADDUTL($P($G(DGCMP(DGM,.1173)),U,2))
I DGCNTRY]"",(DGCNTRY'=-1) W !?16,DGCNTRY
I $P($G(DGCMP(DGM,.117)),U)'="" W !,?6," County: ",$P($G(DGCMP(DGM,.117)),U)
I $G(FLG(1))=1 D
. W !,?6," Phone: ",?16,$P($G(DGCMP(DGM,.131)),U)
. W !,?6," Office: ",?16,$P($G(DGCMP(DGM,.132)),U)
W !,?6,"Bad Addr: ",?16,$P($G(DGCMP(DGM,.121)),U)
W !
Q
;
DISPFGN(DGCMP,DGM,FLG) ;tag to display Foreign data
N DGCNTRY
W !,?2,"[",DGM," ADDRESS]"
W ?16,$P($G(DGCMP(DGM,.111)),U)
I $P($G(DGCMP(DGM,.112)),U)'="" W !,?16,$P($G(DGCMP(DGM,.112)),U)
I $P($G(DGCMP(DGM,.113)),U)'="" W !,?16,$P($G(DGCMP(DGM,.113)),U)
;W !,?16,$P($G(DGCMP(DGM,.1172)),U)_" "_$P($G(DGCMP(DGM,.114)),U)_" "_$P($G(DGCMP(DGM,.1171)),U) ;DG*1010 comment out
W !,?16,$P($G(DGCMP(DGM,.114)),U)_" "_$P($G(DGCMP(DGM,.1171)),U)_" "_$P($G(DGCMP(DGM,.1172)),U) ; DG*1010 - display postal code last
S DGCNTRY=$$CNTRYI^DGADDUTL($P($G(DGCMP(DGM,.1173)),U,2))
S DGCNTRY=$S(DGCNTRY="":"UNSPECIFIED COUNTRY",DGCNTRY=-1:"UNKNOWN COUNTRY",1:DGCNTRY)
I DGCNTRY]"" W !?16,DGCNTRY
I $G(FLG(1))=1 D
. W !,?6," Phone: ",?16,$P($G(DGCMP(DGM,.131)),U)
. W !,?6," Office: ",?16,$P($G(DGCMP(DGM,.132)),U)
W !,?6,"Bad Addr: ",?16,$P($G(DGCMP(DGM,.121)),U)
W !
Q
;
CONFIRM() ;Confirm if user wants to save the change
N DIR,X,Y,DTOUT,DUOUT,DIROUT
S DIR(0)="Y"
S DIR("A")="Are you sure that you want to save the address changes"
S DIR("?")="Please answer Y for YES or N for NO."
D ^DIR
; DG*5.3*1040 - If timeout set DGTMOT=1 and return -1
I $D(DTOUT) S DGTMOT=1 Q -1
; DG*5.3*1040 - Remove the DTOUT check
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:",.114,.115,.117,.1173",1:",.1173")
S FSTR=FSTR_",.1119",DGINPUT(.1119)=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
. I ($G(FLG(1))'=1)&((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
.;JAM, Set the CASS value for Perm Mailing Address ;DG*5.3*941
. S DATA(.1118)="NC"
. I $$UPD^DGENDBS(2,DFN,.DATA)
D EOP
Q
READ(DFN,DGN,Y) ;Read input, return success
N SUCCESS,DIR,DA,DTOUT,DUOUT,DIROUT,L,POP,DGBAI,DGVAL
S SUCCESS=1,POP=0
F L=0:0 D Q:POP
. S DIR(0)=2_","_DGN
. ; DG*5.3*1143 - If the RTA array has a value, use it for the field default
. I $D(DGADDGRP2(DGN)) D
. . S DIR("B")=DGADDGRP2(DGN)
. . ; For the Bad Addr Ind. set the proper external value from the internal value
. . I DGN=.121 S DGBAI=DGADDGRP2(DGN),DIR("B")=$S(DGBAI=1:"UNDELIVERABLE",DGBAI=2:"HOMELESS",DGBAI=3:"OTHER",1:"")
. 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=".111,.112,.113,.114,.115,.117,.1112,.1171,.1172,.1173,.131,.132,.121"
S FSTR=".111,.112,.113,.1112,.131,.132,.121"
I FORGN S FSTR=".111,.112,.113,.114,.1171,.1172,.131,.132,.121"
; DG*5.3*1143 - if FLG(1) is not set, don't include the .131, .132 phone fields in the list below
I FLG(1)=0 D
. S PSTR=$P(PSTR,".131,.132,",1)_$P(PSTR,".131,.132,",2)
. S FSTR=$P(FSTR,".131,.132,",1)_$P(FSTR,".131,.132,",2)
Q FSTR
ZIPINP(DGINPUT,DFN) ; get ZIP+4 input
N DGR
; DG*5.3*1143 - Pass the RTA local array values for zip code and city to use as the default value for input
D EN^DGREGAZL(.DGR,DFN,$G(DGADDGRP2(.1112)),$G(DGADDGRP2(.114)))
;DG*5.3*1014 - Zip entry failed (due to timeout, or ^ entry, or input error) - before the Quit, set DGINPUT=-1
;I $G(DGR)=-1 Q
I $G(DGR)=-1 S DGINPUT=-1 Q
M DGINPUT=DGR
Q
SKIP(DGN,DGINPUT,FLG) ; determine whether or not to skip this step
N SKIP
S SKIP=0
I ($G(DGINPUT(.111))="")&((DGN=.112)!(DGN=.113)) S SKIP=1
I ($G(DGINPUT(.112))="")&(DGN=.113) 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[HDGREGAED 16851 printed May 25, 2026@12:58:47 Page 2
DGREGAED ;ALB/DW,PHH,BAJ,TDM,JAM,ARF,JAM - Address Edit API ;1/6/21 10:28
+1 ;;5.3;Registration;**522,560,658,730,688,808,915,941,1010,1014,1040,1127,1143**;Aug 13, 1993;Build 36
+2 ;;
+3 ;; **688** Modifications for Country and Foreign address
+4 ;; **915** Make DFN optional in case one is not established yet
+5 ;; ** 1143 ** Modifications and real-time address update
+6 ;
EN(DFN,FLG,SRC,DGRET) ;Entry point
+1 ;Input:
+2 ; DFN (optional) - Internal Entry # of Patient File (#2)
+3 ; If not supplied then nothing filed or defaulted
+4 ; FLG (optional) - Flags of 1 or 0; if null, 0 is assumed. Details:
+5 ; FLG(1) - if 1 let user edit phone numbers (field #.131 and #.132)
+6 ; FLG(2) - if 1 display before & after address for user confirmation
+7 ; DGRET - if passed by reference will contain address info array
+8 KILL EASZIPLK,DGRET
+9 NEW DGINPUT,DGCMP,ICNTRY,CNTRY,FORGN,PSTR,OLDC,BAD
+10 NEW I,X,Y
+11 SET DFN=+$GET(DFN)
+12 ;I ($G(DFN)'?.N) Q
+13 ; 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
+14 IF +$GET(DGRTAON)=0
NEW DGRTAON
SET DGRTAON=$$ISRTAUON^DGRTAUPD()
IF DGRTAON=1
NEW DGADDGRP2,DGADDEDIT,DGRETRY
+15 ;
+16 SET FLG(1)=$GET(FLG(1))
SET FLG(2)=$GET(FLG(2))
+17 DO GETOLD(.DGCMP,DFN)
+18 SET CNTRY=""
SET ICNTRY=$SELECT(DFN:$PIECE($GET(^DPT(DFN,.11)),"^",10),1:"")
+19 ;default country is USA if NULL
IF ICNTRY=""
SET ICNTRY=1
+20 ;
+21 ; DG*5.3*1014; jam; ** Start changes **
RETRY ; DG*5.3*1014;jam ; Tag added for entry point to re-enter the address
+1 ; DG*5.3*1143 - Merge any current values being entered with the old values and overwrite the Country with what is in the local array for Country
+2 IF $DATA(DGADDGRP2)
MERGE DGCMP=DGADDGRP2
SET ICNTRY=DGADDGRP2(.1173)
+3 ;
+4 ; DG*5.3*1040 - Set variable DGTMOT to 1 to track timeout
+5 SET OLDC=DGCMP("OLD",.1173)
SET FORGN=$$FOREIGN^DGADDUTL(DFN,ICNTRY,2,.1173,.CNTRY)
IF FORGN=-1
SET DGTMOT=1
QUIT
+6 ;set up field string of address prompts
SET FSTR=$$INPT1(FORGN,.PSTR)
+7 SET DGINPUT=1
DO INPUT(.DGINPUT,DFN,FSTR,CNTRY)
IF $GET(DGINPUT)=-1
QUIT
+8 IF 'DFN
MERGE DGRET=DGINPUT
QUIT
+9 SET BAD=0
+10 ; DG*5.3*1014; jam; If required fields are missing, we can't call the validation service
+11 ; DG*5.3*1143 - Add State as required (for domestic addresses)
+12 IF DGINPUT(.111)=""!(DGINPUT(.114)="")!(($GET(DGINPUT(.1112))=""!($GET(DGINPUT(.115))="")!($GET(DGINPUT(.115))="^"))&('FORGN))
Begin DoDot:1
+13 IF 'FORGN
WRITE !!?3,*7,"ADDRESS [LINE 1], CITY, STATE, and ZIP CODE fields are required."
+14 IF FORGN
WRITE !!?3,*7,"ADDRESS [LINE 1] and CITY fields are required."
End DoDot:1
GOTO RETRY
+15 ; DG*5.3*1014; Display address entered - user may reenter the address or continue to Validation service.
+16 NEW DGNEWADD
+17 MERGE DGNEWADD("NEW")=DGINPUT
+18 WRITE !
+19 IF FORGN
DO DISPFGN(.DGNEWADD,"NEW")
+20 IF 'FORGN
DO DISPUS(.DGNEWADD,"NEW")
+21 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 ;
+10 ; DG*5.3*1040 - Remove the DTOUT check
+11 ;Exiting - Not saving address
IF $DATA(DUOUT)
WRITE !,"Address changes not saved."
DO EOP
QUIT
+12 ; re-enter address
IF X="E"!(X="e")
GOTO RETRY
+13 ; at this point, any response but <RET> will not be accepted
IF X'=""
GOTO CHK
+14 ; DG*5.3*1014; jam; Add call to Address Validation service
+15 ;DG*5.3*1127 - Added DGOVERKEY variable
NEW DGADVRET,DGOVERKEY
+16 SET DGADVRET=$$EN^DGADDVAL(.DGINPUT,"P")
+17 ; DG*5.3*1127 - Get the override key. DGINPUT("overrideKey") will contain the value of the
+18 ; override key set in DGADDLST which is called when validating the address
+19 SET DGOVERKEY=$GET(DGINPUT("overrideKey"))
+20 ; if return is -1 timeout occurred
+21 IF DGADVRET=-1
SET DGTMOT=1
QUIT
+22 ; if return is 0 - address was not validated
+23 ; 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
+24 ; DGINPUT array contains the address that is validated/accepted or what the user entered if the validation service failed
+25 ;
+26 ; DG*5.3*1014; jam; ** End changes **
+27 ;
+28 ; 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.
+29 IF $GET(DGRTAON)=1
IF $GET(DGRTAHOLD)=1
SET DGRETRY=0
DO SAVERTA
if DGRETRY=1
GOTO RETRY
QUIT
+30 ;
CONF IF $GET(FLG(2))=1
DO COMPARE(.DGINPUT,.DGCMP,.FLG)
+1 ; DG*5.3*1040 - Store return value from $$CONFIRM()
+2 NEW DGCONFIRM
SET DGCONFIRM=$$CONFIRM()
+3 ; DG*5.3*1040 - Quit if timeout when DGCONFIRM = -1
+4 if DGCONFIRM=-1
QUIT
+5 ;
+6 ; DG*5.3*1143 - After confirmation, if Real-time address (RTA) update is active, handle saving the data for RTA updates.
+7 IF $GET(DGRTAON)=1
IF 'DGCONFIRM
WRITE !,"Address changes not saved."
DO CLEAN
DO EOP
QUIT
+8 IF $GET(DGRTAON)=1
SET DGRETRY=0
DO SAVERTA
if DGRETRY=1
GOTO RETRY
QUIT
+9 ;
+10 ; DG*5.3*1040 - Check variable DGCONFIRM
+11 IF 'DGCONFIRM
WRITE !,"Address changes not saved."
DO EOP
QUIT
+12 ;
+13 NEW DGPRIOR
+14 DO GETPRIOR^DGADDUTL(DFN,.DGPRIOR)
+15 DO SAVE(.DGINPUT,DFN,FSTR,FORGN)
IF $GET(SRC)=""
IF +$GET(DGNEW)
QUIT
+16 if '$$FILEYN^DGADDUTL(.DGPRIOR,.DGINPUT)
QUIT
+17 DO GETUPDTS^DGADDUTL(DFN,.DGINPUT)
+18 DO UPDADDLG^DGADDUTL(DFN,.DGPRIOR,.DGINPUT)
+19 QUIT
+20 ;
CLEAN ; DG*5.3*1143 - Clean out edit data when the user saves or discards the changes
+1 KILL DGADDGRP2,DGADDEDIT(2)
+2 QUIT
SAVERTA ; DG*5.3*1143 - Save the address edits with RTA updates active
+1 ; Hold the data in local array DGADDGRP2
+2 DO SAVETOLOCAL
+3 ; Set the Address Edit flag (group 2) so in ^DGRPP the user will be prompted to save or discard the changes
+4 SET DGADDEDIT(2)=1
+5 ; If RTA Hold flag is set (set in DGRPCADD) changes will be filed later, quit
+6 IF +$GET(DGRTAHOLD)=1
QUIT
+7 ; Otherwise data should be sent to ES via RTA webservice and saved if valid response
+8 IF $$SENDRTAU()
Begin DoDot:1
+9 DO SAVEFROMLOCAL
+10 WRITE !,"Change saved."
+11 DO EOP
End DoDot:1
QUIT
+12 ; Sending of data failed - determine if the user will retry edits, and quit with 0
+13 ; If a timeout occurred
+14 IF $DATA(DTOUT)!(+$GET(DGTMOT))
QUIT 0
+15 ; If user entered "^"
+16 IF $DATA(DUOUT)
QUIT 0
+17 NEW X,Y,DIR
ASK ; Give the user the option to retry edits or quit
+1 SET DIR("A")="Enter 'E' to re-enter the data or '^' to quit"
+2 SET DIR(0)="FO"
+3 SET DIR("?")="Enter 'E' to re-edit the data, or '^' to exit and cancel the address entry/edit."
+4 DO ^DIR
KILL DIR
+5 ; If timeout, set timeout
+6 IF $DATA(DTOUT)
SET DGTMOT=1
QUIT 0
+7 ; If user quit with ^
+8 IF $DATA(DUOUT)
QUIT 0
+9 ; User has opted to retry
+10 IF X="E"!(X="e")
SET DGRETRY=1
QUIT 0
+11 ; at this point, any other response is not accepted
GOTO ASK
+12 ;
SAVETOLOCAL ; DG*5.3*1143 - Save user input to local array DGADDGRP2
+1 ; Hold the data in the DGADDGRP2 array and save to the DB later
+2 KILL DGADDGRP2
+3 ; This code mimics the SAVE logic except the data is saved to the local array
+4 SET FSTR=FSTR_$SELECT('FORGN:",.114,.115,.117,.1173",1:",.1173")
+5 FOR L=1:1:$LENGTH(FSTR,",")
SET DGN=$PIECE(FSTR,",",L)
Begin DoDot:1
+6 NEW DGCODE,DGNAME
+7 ; if the field contains external^internal value, store the internal value
+8 SET DGCODE=$PIECE($GET(DGINPUT(DGN)),U,2)
+9 SET DGNAME=$PIECE($GET(DGINPUT(DGN)),U)
+10 SET DGADDGRP2(DGN)=$SELECT(DGCODE:DGCODE,1:DGNAME)
End DoDot:1
+11 ; store the Override key and the CASS indicator
+12 SET DGADDGRP2(.1119)=$GET(DGOVERKEY)
+13 SET DGADDGRP2(.1118)="NC"
+14 QUIT
+15 ;
SENDRTAU() ; DG*5.3*1143 - send edited address data to ES via webservice directly
+1 NEW DGRTARET,DGERRS
+2 SET DGRTARET=$$EN^DGRTAUPD(DFN,.DGERRS,,.DGADDGRP2)
+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 DGADDGRP2 array
+1 NEW DGN,DGVALUE,FDA
+2 SET DGN=0
+3 FOR
SET DGN=$ORDER(DGADDGRP2(DGN))
if 'DGN
QUIT
Begin DoDot:1
+4 SET DGVALUE=DGADDGRP2(DGN)
+5 SET FDA(2,DFN_",",DGN)=DGVALUE
+6 ; for home and office phone number, update the extension field
+7 IF DGN=.131
SET FDA(2,DFN_",",.13211)=$PIECE(DGADDGRP2(DGN),"X",2)
+8 IF DGN=.132
SET FDA(2,DFN_",",.13213)=$PIECE(DGADDGRP2(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=.1112
DO ZIPINP(.DGINPUT,DFN)
if DGINPUT=-1
SET DGTMOT=1
QUIT
+7 ; DG*5.3*1040 - Set timeout variable DGTMOT to 1, if field timeout
+8 IF '$$READ(DFN,DGN,.Y)
SET DGINPUT=-1
SET DGTMOT=1
QUIT
+9 IF DGN=.121
SET Y=$GET(Y)
Begin DoDot:2
+10 IF Y=""
IF DGINPUT(DGN)=""
QUIT
+11 IF DFN
IF $PIECE(Y,U)=$$GET1^DIQ(2,DFN_",",DGN,"I")
SET DGINPUT(DGN)=$$GET1^DIQ(2,DFN_",",DGN)_U_$PIECE(Y,U)
QUIT
+12 SET DGINPUT(DGN)=$PIECE(Y(0),U)_U_Y
End DoDot:2
QUIT
+13 SET DGINPUT(DGN)=$GET(Y)
End DoDot:1
+14 IF DGINPUT'=-1
SET DGINPUT(.1173)=CNTRY_"^"_$ORDER(^HL(779.004,"B",CNTRY,""))
+15 QUIT
GETOLD(DGCMP,DFN) ;populate array with existing address info
+1 NEW CCIEN,DGCURR,CFORGN,CFSTR,L,T,DGCIEN,DGST,DGCNTY,COUNTRY
+2 SET CFORGN=0
+3 ; get current country
+4 ; If current country is NULL it is old data
+5 ; Leave it NULL here because this is not an edit function
+6 SET CCIEN=$SELECT(DFN:$$GET1^DIQ(2,DFN_",","COUNTRY","I"),1:"")
+7 ;I CCIEN="" S CCIEN=$O(^HL(779.004,"D","UNITED STATES",""))
+8 SET CFORGN=$$FORIEN^DGADDUTL(CCIEN)
+9 ;get current address fields and xlate to ^DIQ format
+10 SET CFSTR=$$INPT1(CFORGN)
SET CFSTR=$TRANSLATE(CFSTR,",",";")
+11 ; Domestic data needs some extra fields
+12 IF 'CFORGN
SET CFSTR=CFSTR_";.114;.115;.117"
+13 IF DFN
DO GETS^DIQ(2,DFN_",",CFSTR,"EI","DGCURR")
+14 FOR L=1:1:$LENGTH(CFSTR,";")
SET T=$PIECE(CFSTR,";",L)
SET DGCMP("OLD",T)=$GET(DGCURR(2,DFN_",",T,"E"))
+15 SET COUNTRY=$$CNTRYI^DGADDUTL(CCIEN)
IF COUNTRY=-1
SET COUNTRY="UNKNOWN COUNTRY"
+16 SET DGCMP("OLD",.1173)=COUNTRY_"^"_CCIEN
+17 IF 'CFORGN
Begin DoDot:1
+18 SET DGCIEN=$GET(DGCURR(2,DFN_",",.117,"I"))
+19 SET DGST=$GET(DGCURR(2,DFN_",",.115,"I"))
+20 SET DGCNTY=$$CNTY^DGREGAZL(DGST,DGCIEN)
+21 IF DGCNTY=-1
SET DGCNTY=""
+22 SET DGCMP("OLD",.117)=$PIECE(DGCNTY,U)_" "_$PIECE(DGCNTY,U,3)
End DoDot:1
+23 QUIT
+24 ;
COMPARE(DGINPUT,DGCMP,FLG) ;Display before & after address fields.
+1 NEW DGM
+2 MERGE DGCMP("NEW")=DGINPUT
+3 FOR DGM="OLD","NEW"
Begin DoDot:1
+4 IF DGCMP(DGM,.1173)]""
IF $$FORIEN^DGADDUTL($PIECE(DGCMP(DGM,.1173),U,2))
DO DISPFGN(.DGCMP,DGM,.FLG)
QUIT
+5 IF DGM="NEW"
Begin DoDot:2
+6 SET DGCNTY=$PIECE($GET(DGCMP("NEW",.117)),U)_" "_$PIECE($GET(DGCMP("NEW",.117)),U,3)
+7 SET DGCMP("NEW",.117)=DGCNTY
+8 IF ($LENGTH(DGCMP("NEW",.1112))>5)&($PIECE(DGCMP("NEW",.1112),"-",2)="")
SET DGCMP("NEW",.1112)=$EXTRACT(DGCMP("NEW",.1112),1,5)_"-"_$EXTRACT(DGCMP("NEW",.1112),6,9)
End DoDot:2
+9 DO DISPUS(.DGCMP,DGM,.FLG)
End DoDot:1
+10 QUIT
+11 ;
DISPUS(DGCMP,DGM,FLG) ;tag to display US data
+1 NEW DGCNTRY
+2 WRITE !,?2,"[",DGM," ADDRESS]"
+3 WRITE ?16,$PIECE($GET(DGCMP(DGM,.111)),U)
+4 IF $PIECE($GET(DGCMP(DGM,.112)),U)'=""
WRITE !,?16,$PIECE($GET(DGCMP(DGM,.112)),U)
+5 IF $PIECE($GET(DGCMP(DGM,.113)),U)'=""
WRITE !,?16,$PIECE($GET(DGCMP(DGM,.113)),U)
+6 WRITE !,?16,$PIECE($GET(DGCMP(DGM,.114)),U)
+7 if ($PIECE($GET(DGCMP(DGM,.114)),U)'="")!($PIECE($GET(DGCMP(DGM,.115)),U)'="")
WRITE ","
+8 WRITE $PIECE($GET(DGCMP(DGM,.115)),U)
+9 WRITE " ",$GET(DGCMP(DGM,.1112))
+10 SET DGCNTRY=$$CNTRYI^DGADDUTL($PIECE($GET(DGCMP(DGM,.1173)),U,2))
+11 IF DGCNTRY]""
IF (DGCNTRY'=-1)
WRITE !?16,DGCNTRY
+12 IF $PIECE($GET(DGCMP(DGM,.117)),U)'=""
WRITE !,?6," County: ",$PIECE($GET(DGCMP(DGM,.117)),U)
+13 IF $GET(FLG(1))=1
Begin DoDot:1
+14 WRITE !,?6," Phone: ",?16,$PIECE($GET(DGCMP(DGM,.131)),U)
+15 WRITE !,?6," Office: ",?16,$PIECE($GET(DGCMP(DGM,.132)),U)
End DoDot:1
+16 WRITE !,?6,"Bad Addr: ",?16,$PIECE($GET(DGCMP(DGM,.121)),U)
+17 WRITE !
+18 QUIT
+19 ;
DISPFGN(DGCMP,DGM,FLG) ;tag to display Foreign data
+1 NEW DGCNTRY
+2 WRITE !,?2,"[",DGM," ADDRESS]"
+3 WRITE ?16,$PIECE($GET(DGCMP(DGM,.111)),U)
+4 IF $PIECE($GET(DGCMP(DGM,.112)),U)'=""
WRITE !,?16,$PIECE($GET(DGCMP(DGM,.112)),U)
+5 IF $PIECE($GET(DGCMP(DGM,.113)),U)'=""
WRITE !,?16,$PIECE($GET(DGCMP(DGM,.113)),U)
+6 ;W !,?16,$P($G(DGCMP(DGM,.1172)),U)_" "_$P($G(DGCMP(DGM,.114)),U)_" "_$P($G(DGCMP(DGM,.1171)),U) ;DG*1010 comment out
+7 ; DG*1010 - display postal code last
WRITE !,?16,$PIECE($GET(DGCMP(DGM,.114)),U)_" "_$PIECE($GET(DGCMP(DGM,.1171)),U)_" "_$PIECE($GET(DGCMP(DGM,.1172)),U)
+8 SET DGCNTRY=$$CNTRYI^DGADDUTL($PIECE($GET(DGCMP(DGM,.1173)),U,2))
+9 SET DGCNTRY=$SELECT(DGCNTRY="":"UNSPECIFIED COUNTRY",DGCNTRY=-1:"UNKNOWN COUNTRY",1:DGCNTRY)
+10 IF DGCNTRY]""
WRITE !?16,DGCNTRY
+11 IF $GET(FLG(1))=1
Begin DoDot:1
+12 WRITE !,?6," Phone: ",?16,$PIECE($GET(DGCMP(DGM,.131)),U)
+13 WRITE !,?6," Office: ",?16,$PIECE($GET(DGCMP(DGM,.132)),U)
End DoDot:1
+14 WRITE !,?6,"Bad Addr: ",?16,$PIECE($GET(DGCMP(DGM,.121)),U)
+15 WRITE !
+16 QUIT
+17 ;
CONFIRM() ;Confirm if user wants to save the change
+1 NEW DIR,X,Y,DTOUT,DUOUT,DIROUT
+2 SET DIR(0)="Y"
+3 SET DIR("A")="Are you sure that you want to save the address changes"
+4 SET DIR("?")="Please answer Y for YES or N for NO."
+5 DO ^DIR
+6 ; DG*5.3*1040 - If timeout set DGTMOT=1 and return -1
+7 IF $DATA(DTOUT)
SET DGTMOT=1
QUIT -1
+8 ; DG*5.3*1040 - Remove the DTOUT check
+9 IF $GET(Y)=0
QUIT 0
+10 IF $DATA(DUOUT)!$DATA(DIROUT)
QUIT 0
+11 QUIT 1
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:",.114,.115,.117,.1173",1:",.1173")
+6 ;DG*5.3*1127 - Store the override key returned from address validation
SET FSTR=FSTR_",.1119"
SET DGINPUT(.1119)=DGOVERKEY
+7 FOR L=1:1:$LENGTH(FSTR,",")
SET DGN=$PIECE(FSTR,",",L)
Begin DoDot:1
+8 IF ($GET(FLG(1))'=1)&((DGN=.131)!(DGN=.132))
QUIT
+9 NEW DGCODE,DGNAME,FDA,MSG
+10 SET DGCODE=$PIECE($GET(DGINPUT(DGN)),U,2)
+11 SET DGNAME=$PIECE($GET(DGINPUT(DGN)),U)
+12 SET FDA(2,DFN_",",DGN)=$SELECT(DGCODE:DGCODE,1:DGNAME)
+13 DO FILE^DIE($SELECT(DGCODE:"",1:"E"),"FDA","MSG")
+14 IF $DATA(MSG)
Begin DoDot:2
+15 SET DGM=""
SET DGER=1
+16 WRITE !,"Please review the saved changes!!",!
+17 FOR
SET DGM=$ORDER(MSG("DIERR",1,"TEXT",DGM))
if DGM=""
QUIT
Begin DoDot:3
+18 WRITE $GET(MSG("DIERR",1,"TEXT",DGM))
End DoDot:3
End DoDot:2
End DoDot:1
+19 IF $GET(DGER)=0
WRITE !,"Change saved."
Begin DoDot:1
+20 ;JAM, Set the CASS value for Perm Mailing Address ;DG*5.3*941
+21 SET DATA(.1118)="NC"
+22 IF $$UPD^DGENDBS(2,DFN,.DATA)
End DoDot:1
+23 DO EOP
+24 QUIT
READ(DFN,DGN,Y) ;Read input, return success
+1 NEW SUCCESS,DIR,DA,DTOUT,DUOUT,DIROUT,L,POP,DGBAI,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 - If the RTA array has a value, use it for the field default
+6 IF $DATA(DGADDGRP2(DGN))
Begin DoDot:2
+7 SET DIR("B")=DGADDGRP2(DGN)
+8 ; For the Bad Addr Ind. set the proper external value from the internal value
+9 IF DGN=.121
SET DGBAI=DGADDGRP2(DGN)
SET DIR("B")=$SELECT(DGBAI=1:"UNDELIVERABLE",DGBAI=2:"HOMELESS",DGBAI=3:"OTHER",1:"")
End DoDot:2
+10 IF DFN
SET DA=DFN
+11 DO ^DIR
+12 IF $DATA(DTOUT)
SET POP=1
SET SUCCESS=0
QUIT
+13 IF $DATA(DUOUT)!$DATA(DIROUT)
DO UPCT
QUIT
+14 ; 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
+15 SET DGVAL=Y
+16 IF DGN=.131!(DGN=.132)
IF DGVAL'=""
Begin DoDot:2
+17 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
+18 SET POP=1
End DoDot:1
if POP
QUIT
+19 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=".111,.112,.113,.114,.115,.117,.1112,.1171,.1172,.1173,.131,.132,.121"
+5 SET FSTR=".111,.112,.113,.1112,.131,.132,.121"
+6 IF FORGN
SET FSTR=".111,.112,.113,.114,.1171,.1172,.131,.132,.121"
+7 ; DG*5.3*1143 - if FLG(1) is not set, don't include the .131, .132 phone fields in the list below
+8 IF FLG(1)=0
Begin DoDot:1
+9 SET PSTR=$PIECE(PSTR,".131,.132,",1)_$PIECE(PSTR,".131,.132,",2)
+10 SET FSTR=$PIECE(FSTR,".131,.132,",1)_$PIECE(FSTR,".131,.132,",2)
End DoDot:1
+11 QUIT FSTR
ZIPINP(DGINPUT,DFN) ; get ZIP+4 input
+1 NEW DGR
+2 ; DG*5.3*1143 - Pass the RTA local array values for zip code and city to use as the default value for input
+3 DO EN^DGREGAZL(.DGR,DFN,$GET(DGADDGRP2(.1112)),$GET(DGADDGRP2(.114)))
+4 ;DG*5.3*1014 - Zip entry failed (due to timeout, or ^ entry, or input error) - before the Quit, set DGINPUT=-1
+5 ;I $G(DGR)=-1 Q
+6 IF $GET(DGR)=-1
SET DGINPUT=-1
QUIT
+7 MERGE DGINPUT=DGR
+8 QUIT
SKIP(DGN,DGINPUT,FLG) ; determine whether or not to skip this step
+1 NEW SKIP
+2 SET SKIP=0
+3 IF ($GET(DGINPUT(.111))="")&((DGN=.112)!(DGN=.113))
SET SKIP=1
+4 IF ($GET(DGINPUT(.112))="")&(DGN=.113)
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
