- 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 Jan 18, 2025@03:55:32 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