DGREGAED ;ALB/DW/PHH,BAJ,TDM,JAM - Address Edit API ;1/6/21 10:28
;;5.3;Registration;**522,560,658,730,688,808,915,941,1010,1014,1040**;Aug 13, 1993;Build 15
;;
;; **688** Modifications for Country and Foreign address
;; **915** Make DFN optional in case one is not established yet
;
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
N I,X,Y
S DFN=+$G(DFN)
;I ($G(DFN)'?.N) Q
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*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
; DG*5.3*1014; jam; If required fields are missing, we can't call the validation service
I DGINPUT(.111)=""!(DGINPUT(.114)="")!(($G(DGINPUT(.1112))="")&('FORGN)) D G RETRY
. I 'FORGN W !!?3,*7,"ADDRESS [LINE 1], CITY, 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
S DGADVRET=$$EN^DGADDVAL(.DGINPUT,"P")
; 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 **
;
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*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
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 funtion
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 above 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")
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
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=".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"
Q FSTR
ZIPINP(DGINPUT,DFN) ; get ZIP+4 input
N DGR
D EN^DGREGAZL(.DGR,DFN)
;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 10894 printed Dec 13, 2024@02:54:51 Page 2
DGREGAED ;ALB/DW/PHH,BAJ,TDM,JAM - Address Edit API ;1/6/21 10:28
+1 ;;5.3;Registration;**522,560,658,730,688,808,915,941,1010,1014,1040**;Aug 13, 1993;Build 15
+2 ;;
+3 ;; **688** Modifications for Country and Foreign address
+4 ;; **915** Make DFN optional in case one is not established yet
+5 ;
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
+10 NEW I,X,Y
+11 SET DFN=+$GET(DFN)
+12 ;I ($G(DFN)'?.N) Q
+13 SET FLG(1)=$GET(FLG(1))
SET FLG(2)=$GET(FLG(2))
+14 DO GETOLD(.DGCMP,DFN)
+15 SET CNTRY=""
SET ICNTRY=$SELECT(DFN:$PIECE($GET(^DPT(DFN,.11)),"^",10),1:"")
+16 ;default country is USA if NULL
IF ICNTRY=""
SET ICNTRY=1
+17 ;
+18 ; 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*1040 - Set variable DGTMOT to 1 to track timeout
+2 SET OLDC=DGCMP("OLD",.1173)
SET FORGN=$$FOREIGN^DGADDUTL(DFN,ICNTRY,2,.1173,.CNTRY)
IF FORGN=-1
SET DGTMOT=1
QUIT
+3 ;set up field string of address prompts
SET FSTR=$$INPT1(FORGN,.PSTR)
+4 SET DGINPUT=1
DO INPUT(.DGINPUT,DFN,FSTR,CNTRY)
IF $GET(DGINPUT)=-1
QUIT
+5 IF 'DFN
MERGE DGRET=DGINPUT
QUIT
+6 ; DG*5.3*1014; jam; If required fields are missing, we can't call the validation service
+7 IF DGINPUT(.111)=""!(DGINPUT(.114)="")!(($GET(DGINPUT(.1112))="")&('FORGN))
Begin DoDot:1
+8 IF 'FORGN
WRITE !!?3,*7,"ADDRESS [LINE 1], CITY, and ZIP CODE fields are required."
+9 IF FORGN
WRITE !!?3,*7,"ADDRESS [LINE 1] and CITY fields are required."
End DoDot:1
GOTO RETRY
+10 ; DG*5.3*1014; Display address entered - user may reenter the address or continue to Validation service.
+11 NEW DGNEWADD
+12 MERGE DGNEWADD("NEW")=DGINPUT
+13 WRITE !
+14 IF FORGN
DO DISPFGN(.DGNEWADD,"NEW")
+15 IF 'FORGN
DO DISPUS(.DGNEWADD,"NEW")
+16 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
+10 ;Exiting - Not saving address
IF $DATA(DUOUT)
WRITE !,"Address changes not saved."
DO EOP
QUIT
+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 NEW DGADVRET
+15 SET DGADVRET=$$EN^DGADDVAL(.DGINPUT,"P")
+16 ; if return is -1 timeout occurred
+17 IF DGADVRET=-1
SET DGTMOT=1
QUIT
+18 ; if return is 0 - address was not validated
+19 ; 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
+20 ; DGINPUT array contains the address that is validated/accepted or what the user entered if the validation service failed
+21 ;
+22 ; DG*5.3*1014; jam; ** End changes **
+23 ;
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 ; DG*5.3*1040 - Check variable DGCONFIRM
+6 IF 'DGCONFIRM
WRITE !,"Address changes not saved."
DO EOP
QUIT
+7 NEW DGPRIOR
+8 DO GETPRIOR^DGADDUTL(DFN,.DGPRIOR)
+9 DO SAVE(.DGINPUT,DFN,FSTR,FORGN)
IF $GET(SRC)=""
IF +$GET(DGNEW)
QUIT
+10 if '$$FILEYN^DGADDUTL(.DGPRIOR,.DGINPUT)
QUIT
+11 DO GETUPDTS^DGADDUTL(DFN,.DGINPUT)
+12 DO UPDADDLG^DGADDUTL(DFN,.DGPRIOR,.DGINPUT)
+13 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=.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 funtion
+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 above 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 FOR L=1:1:$LENGTH(FSTR,",")
SET DGN=$PIECE(FSTR,",",L)
Begin DoDot:1
+7 IF ($GET(FLG(1))'=1)&((DGN=.131)!(DGN=.132))
QUIT
+8 NEW DGCODE,DGNAME,FDA,MSG
+9 SET DGCODE=$PIECE($GET(DGINPUT(DGN)),U,2)
+10 SET DGNAME=$PIECE($GET(DGINPUT(DGN)),U)
+11 SET FDA(2,DFN_",",DGN)=$SELECT(DGCODE:DGCODE,1:DGNAME)
+12 DO FILE^DIE($SELECT(DGCODE:"",1:"E"),"FDA","MSG")
+13 IF $DATA(MSG)
Begin DoDot:2
+14 SET DGM=""
SET DGER=1
+15 WRITE !,"Please review the saved changes!!",!
+16 FOR
SET DGM=$ORDER(MSG("DIERR",1,"TEXT",DGM))
if DGM=""
QUIT
Begin DoDot:3
+17 WRITE $GET(MSG("DIERR",1,"TEXT",DGM))
End DoDot:3
End DoDot:2
End DoDot:1
+18 IF $GET(DGER)=0
WRITE !,"Change saved."
Begin DoDot:1
+19 ;JAM, Set the CASS value for Perm Mailing Address ;DG*5.3*941
+20 SET DATA(.1118)="NC"
+21 IF $$UPD^DGENDBS(2,DFN,.DATA)
End DoDot:1
+22 DO EOP
+23 QUIT
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=".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 QUIT FSTR
ZIPINP(DGINPUT,DFN) ; get ZIP+4 input
+1 NEW DGR
+2 DO EN^DGREGAZL(.DGR,DFN)
+3 ;DG*5.3*1014 - Zip entry failed (due to timeout, or ^ entry, or input error) - before the Quit, set DGINPUT=-1
+4 ;I $G(DGR)=-1 Q
+5 IF $GET(DGR)=-1
SET DGINPUT=-1
QUIT
+6 MERGE DGINPUT=DGR
+7 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
