Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGREGAED

DGREGAED.m

Go to the documentation of this file.
  1. 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
  1. ;;
  1. ;; **688** Modifications for Country and Foreign address
  1. ;; **915** Make DFN optional in case one is not established yet
  1. ;
  1. EN(DFN,FLG,SRC,DGRET) ;Entry point
  1. ;Input:
  1. ; DFN (optional) - Internal Entry # of Patient File (#2)
  1. ; If not supplied then nothing filed or defaulted
  1. ; FLG (optional) - Flags of 1 or 0; if null, 0 is assumed. Details:
  1. ; FLG(1) - if 1 let user edit phone numbers (field #.131 and #.132)
  1. ; FLG(2) - if 1 display before & after address for user confirmation
  1. ; DGRET - if passed by reference will contain address info array
  1. K EASZIPLK,DGRET
  1. N DGINPUT,DGCMP,ICNTRY,CNTRY,FORGN,PSTR,OLDC
  1. N I,X,Y
  1. S DFN=+$G(DFN)
  1. ;I ($G(DFN)'?.N) Q
  1. S FLG(1)=$G(FLG(1)),FLG(2)=$G(FLG(2))
  1. D GETOLD(.DGCMP,DFN)
  1. S CNTRY="",ICNTRY=$S(DFN:$P($G(^DPT(DFN,.11)),"^",10),1:"")
  1. I ICNTRY="" S ICNTRY=1 ;default country is USA if NULL
  1. ;
  1. ; DG*5.3*1014; jam; ** Start changes **
  1. 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
  1. S OLDC=DGCMP("OLD",.1173),FORGN=$$FOREIGN^DGADDUTL(DFN,ICNTRY,2,.1173,.CNTRY) I FORGN=-1 S DGTMOT=1 Q
  1. S FSTR=$$INPT1(FORGN,.PSTR) ;set up field string of address prompts
  1. S DGINPUT=1 D INPUT(.DGINPUT,DFN,FSTR,CNTRY) I $G(DGINPUT)=-1 Q
  1. I 'DFN M DGRET=DGINPUT Q
  1. ; DG*5.3*1014; jam; If required fields are missing, we can't call the validation service
  1. I DGINPUT(.111)=""!(DGINPUT(.114)="")!(($G(DGINPUT(.1112))="")&('FORGN)) D G RETRY
  1. . I 'FORGN W !!?3,*7,"ADDRESS [LINE 1], CITY, and ZIP CODE fields are required."
  1. . I FORGN W !!?3,*7,"ADDRESS [LINE 1] and CITY fields are required."
  1. ; DG*5.3*1014; Display address entered - user may reenter the address or continue to Validation service.
  1. N DGNEWADD
  1. M DGNEWADD("NEW")=DGINPUT
  1. W !
  1. I FORGN D DISPFGN(.DGNEWADD,"NEW")
  1. I 'FORGN D DISPUS(.DGNEWADD,"NEW")
  1. K DGNEWADD
  1. CHK ; DG*5.3*1014; Prompt user and allow them to correct the address or continue to Validation service
  1. N DIR
  1. S DIR("A",1)="If address is ready for validation enter <RET> to continue, 'E' to Edit"
  1. S DIR("A")=" or '^' to quit"
  1. S DIR(0)="FO"
  1. S DIR("?")="Enter 'E' to edit the address, <RET> to continue to address validation or '^' to exit and cancel the address entry/edit."
  1. D ^DIR K DIR
  1. ; DG*5.3*1040 - Set variable DGTMOT=1, if timeout and QUIT
  1. I $D(DTOUT) S DGTMOT=1 Q
  1. ; DG*5.3*1040 - Remove the DTOUT check
  1. I $D(DUOUT) W !,"Address changes not saved." D EOP Q ;Exiting - Not saving address
  1. I X="E"!(X="e") G RETRY ; re-enter address
  1. I X'="" G CHK ; at this point, any response but <RET> will not be accepted
  1. ; DG*5.3*1014; jam; Add call to Address Validation service
  1. N DGADVRET
  1. S DGADVRET=$$EN^DGADDVAL(.DGINPUT,"P")
  1. ; if return is -1 timeout occurred
  1. I DGADVRET=-1 S DGTMOT=1 Q
  1. ; if return is 0 - address was not validated
  1. 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
  1. ; DGINPUT array contains the address that is validated/accepted or what the user entered if the validation service failed
  1. ;
  1. ; DG*5.3*1014; jam; ** End changes **
  1. ;
  1. CONF I $G(FLG(2))=1 D COMPARE(.DGINPUT,.DGCMP,.FLG)
  1. ; DG*5.3*1040 - Store return value from $$CONFIRM()
  1. N DGCONFIRM S DGCONFIRM=$$CONFIRM()
  1. ; DG*5.3*1040 - Quit if timeout when DGCONFIRM = -1
  1. Q:DGCONFIRM=-1
  1. ; DG*5.3*1040 - Check variable DGCONFIRM
  1. I 'DGCONFIRM W !,"Address changes not saved." D EOP Q
  1. N DGPRIOR
  1. D GETPRIOR^DGADDUTL(DFN,.DGPRIOR)
  1. D SAVE(.DGINPUT,DFN,FSTR,FORGN) I $G(SRC)="",+$G(DGNEW) Q
  1. Q:'$$FILEYN^DGADDUTL(.DGPRIOR,.DGINPUT)
  1. D GETUPDTS^DGADDUTL(DFN,.DGINPUT)
  1. D UPDADDLG^DGADDUTL(DFN,.DGPRIOR,.DGINPUT)
  1. Q
  1. INPUT(DGINPUT,DFN,FSTR,CNTRY) ;Let user input address changes
  1. ;Output: DGINPUT(field#)=external^internal(if any)
  1. N DIR,X,Y,DA,DGR,DTOUT,DUOUT,DIROUT,DGN,L
  1. F L=1:1:$L(FSTR,",") S DGN=$P(FSTR,",",L),DGINPUT(DGN)="" Q:DGINPUT=-1 D
  1. . I $$SKIP(DGN,.DGINPUT,.FLG) Q
  1. . ; DG*5.3*1040 - Set timeout variable DGTMOT to 1, if ZIP timeout
  1. . I DGN=.1112 D ZIPINP(.DGINPUT,DFN) S:DGINPUT=-1 DGTMOT=1 Q
  1. . ; DG*5.3*1040 - Set timeout variable DGTMOT to 1, if field timeout
  1. . I '$$READ(DFN,DGN,.Y) S DGINPUT=-1,DGTMOT=1 Q
  1. . I DGN=.121 S Y=$G(Y) D Q
  1. .. I Y="",DGINPUT(DGN)="" Q
  1. .. I DFN,$P(Y,U)=$$GET1^DIQ(2,DFN_",",DGN,"I") S DGINPUT(DGN)=$$GET1^DIQ(2,DFN_",",DGN)_U_$P(Y,U) Q
  1. .. S DGINPUT(DGN)=$P(Y(0),U)_U_Y
  1. . S DGINPUT(DGN)=$G(Y)
  1. I DGINPUT'=-1 S DGINPUT(.1173)=CNTRY_"^"_$O(^HL(779.004,"B",CNTRY,""))
  1. Q
  1. GETOLD(DGCMP,DFN) ;populate array with existing address info
  1. N CCIEN,DGCURR,CFORGN,CFSTR,L,T,DGCIEN,DGST,DGCNTY,COUNTRY
  1. S CFORGN=0
  1. ; get current country
  1. ; If current country is NULL it is old data
  1. ; Leave it NULL here because this is not an edit funtion
  1. S CCIEN=$S(DFN:$$GET1^DIQ(2,DFN_",","COUNTRY","I"),1:"")
  1. ;I CCIEN="" S CCIEN=$O(^HL(779.004,"D","UNITED STATES",""))
  1. S CFORGN=$$FORIEN^DGADDUTL(CCIEN)
  1. ;get current address fields and xlate to ^DIQ format
  1. S CFSTR=$$INPT1(CFORGN),CFSTR=$TR(CFSTR,",",";")
  1. ; Domestic data needs some extra fields
  1. I 'CFORGN S CFSTR=CFSTR_";.114;.115;.117"
  1. I DFN D GETS^DIQ(2,DFN_",",CFSTR,"EI","DGCURR")
  1. F L=1:1:$L(CFSTR,";") S T=$P(CFSTR,";",L),DGCMP("OLD",T)=$G(DGCURR(2,DFN_",",T,"E"))
  1. S COUNTRY=$$CNTRYI^DGADDUTL(CCIEN) I COUNTRY=-1 S COUNTRY="UNKNOWN COUNTRY"
  1. S DGCMP("OLD",.1173)=COUNTRY_"^"_CCIEN
  1. I 'CFORGN D
  1. . S DGCIEN=$G(DGCURR(2,DFN_",",.117,"I"))
  1. . S DGST=$G(DGCURR(2,DFN_",",.115,"I"))
  1. . S DGCNTY=$$CNTY^DGREGAZL(DGST,DGCIEN)
  1. . I DGCNTY=-1 S DGCNTY=""
  1. . S DGCMP("OLD",.117)=$P(DGCNTY,U)_" "_$P(DGCNTY,U,3)
  1. Q
  1. ;
  1. COMPARE(DGINPUT,DGCMP,FLG) ;Display before & after address fields.
  1. N DGM
  1. M DGCMP("NEW")=DGINPUT
  1. F DGM="OLD","NEW" D
  1. . I DGCMP(DGM,.1173)]"",$$FORIEN^DGADDUTL($P(DGCMP(DGM,.1173),U,2)) D DISPFGN(.DGCMP,DGM,.FLG) Q
  1. . I DGM="NEW" D
  1. . . S DGCNTY=$P($G(DGCMP("NEW",.117)),U)_" "_$P($G(DGCMP("NEW",.117)),U,3)
  1. . . S DGCMP("NEW",.117)=DGCNTY
  1. . . 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)
  1. . D DISPUS(.DGCMP,DGM,.FLG)
  1. Q
  1. ;
  1. DISPUS(DGCMP,DGM,FLG) ;tag to display US data
  1. N DGCNTRY
  1. W !,?2,"[",DGM," ADDRESS]"
  1. W ?16,$P($G(DGCMP(DGM,.111)),U)
  1. I $P($G(DGCMP(DGM,.112)),U)'="" W !,?16,$P($G(DGCMP(DGM,.112)),U)
  1. I $P($G(DGCMP(DGM,.113)),U)'="" W !,?16,$P($G(DGCMP(DGM,.113)),U)
  1. W !,?16,$P($G(DGCMP(DGM,.114)),U)
  1. W:($P($G(DGCMP(DGM,.114)),U)'="")!($P($G(DGCMP(DGM,.115)),U)'="") ","
  1. W $P($G(DGCMP(DGM,.115)),U)
  1. W " ",$G(DGCMP(DGM,.1112))
  1. S DGCNTRY=$$CNTRYI^DGADDUTL($P($G(DGCMP(DGM,.1173)),U,2))
  1. I DGCNTRY]"",(DGCNTRY'=-1) W !?16,DGCNTRY
  1. I $P($G(DGCMP(DGM,.117)),U)'="" W !,?6," County: ",$P($G(DGCMP(DGM,.117)),U)
  1. I $G(FLG(1))=1 D
  1. . W !,?6," Phone: ",?16,$P($G(DGCMP(DGM,.131)),U)
  1. . W !,?6," Office: ",?16,$P($G(DGCMP(DGM,.132)),U)
  1. W !,?6,"Bad Addr: ",?16,$P($G(DGCMP(DGM,.121)),U)
  1. W !
  1. Q
  1. ;
  1. DISPFGN(DGCMP,DGM,FLG) ;tag to display Foreign data
  1. N DGCNTRY
  1. W !,?2,"[",DGM," ADDRESS]"
  1. W ?16,$P($G(DGCMP(DGM,.111)),U)
  1. I $P($G(DGCMP(DGM,.112)),U)'="" W !,?16,$P($G(DGCMP(DGM,.112)),U)
  1. I $P($G(DGCMP(DGM,.113)),U)'="" W !,?16,$P($G(DGCMP(DGM,.113)),U)
  1. ;W !,?16,$P($G(DGCMP(DGM,.1172)),U)_" "_$P($G(DGCMP(DGM,.114)),U)_" "_$P($G(DGCMP(DGM,.1171)),U) ;DG*1010 comment out
  1. 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
  1. S DGCNTRY=$$CNTRYI^DGADDUTL($P($G(DGCMP(DGM,.1173)),U,2))
  1. S DGCNTRY=$S(DGCNTRY="":"UNSPECIFIED COUNTRY",DGCNTRY=-1:"UNKNOWN COUNTRY",1:DGCNTRY)
  1. I DGCNTRY]"" W !?16,DGCNTRY
  1. I $G(FLG(1))=1 D
  1. . W !,?6," Phone: ",?16,$P($G(DGCMP(DGM,.131)),U)
  1. . W !,?6," Office: ",?16,$P($G(DGCMP(DGM,.132)),U)
  1. W !,?6,"Bad Addr: ",?16,$P($G(DGCMP(DGM,.121)),U)
  1. W !
  1. Q
  1. ;
  1. CONFIRM() ;Confirm if user wants to save the change
  1. N DIR,X,Y,DTOUT,DUOUT,DIROUT
  1. S DIR(0)="Y"
  1. S DIR("A")="Are you sure that you want to save the above changes"
  1. S DIR("?")="Please answer Y for YES or N for NO."
  1. D ^DIR
  1. ; DG*5.3*1040 - If timeout set DGTMOT=1 and return -1
  1. I $D(DTOUT) S DGTMOT=1 Q -1
  1. ; DG*5.3*1040 - Remove the DTOUT check
  1. I $G(Y)=0 Q 0
  1. I $D(DUOUT)!$D(DIROUT) Q 0
  1. Q 1
  1. SAVE(DGINPUT,DFN,FSTR,FORGN) ;Save changes
  1. N DGN,DGER,DGM,L,DATA
  1. S DGER=0
  1. ; need to get the country code into the DGINPUT array
  1. ; if it's a domestic address, we have to add in CITY,STATE & COUNTY
  1. S FSTR=FSTR_$S('FORGN:",.114,.115,.117,.1173",1:",.1173")
  1. F L=1:1:$L(FSTR,",") S DGN=$P(FSTR,",",L) D
  1. . I ($G(FLG(1))'=1)&((DGN=.131)!(DGN=.132)) Q
  1. . N DGCODE,DGNAME,FDA,MSG
  1. . S DGCODE=$P($G(DGINPUT(DGN)),U,2)
  1. . S DGNAME=$P($G(DGINPUT(DGN)),U)
  1. . S FDA(2,DFN_",",DGN)=$S(DGCODE:DGCODE,1:DGNAME)
  1. . D FILE^DIE($S(DGCODE:"",1:"E"),"FDA","MSG")
  1. . I $D(MSG) D
  1. .. S DGM="",DGER=1
  1. .. W !,"Please review the saved changes!!",!
  1. .. F S DGM=$O(MSG("DIERR",1,"TEXT",DGM)) Q:DGM="" D
  1. ... W $G(MSG("DIERR",1,"TEXT",DGM))
  1. I $G(DGER)=0 W !,"Change saved." D
  1. .;JAM, Set the CASS value for Perm Mailing Address ;DG*5.3*941
  1. . S DATA(.1118)="NC"
  1. . I $$UPD^DGENDBS(2,DFN,.DATA)
  1. D EOP
  1. Q
  1. READ(DFN,DGN,Y) ;Read input, return success
  1. N SUCCESS,DIR,DA,DTOUT,DUOUT,DIROUT,L,POP
  1. S SUCCESS=1,POP=0
  1. F L=0:0 D Q:POP
  1. . S DIR(0)=2_","_DGN
  1. . I DFN S DA=DFN
  1. . D ^DIR
  1. . I $D(DTOUT) S POP=1,SUCCESS=0 Q
  1. . I $D(DUOUT)!$D(DIROUT) D UPCT Q
  1. . S POP=1
  1. Q SUCCESS
  1. INPT1(FORGN,PSTR) ; first address input prompts
  1. N FSTR
  1. ; PSTR is the full set of fields domestic & foreign combined
  1. ; FSTR is the set of fields depending on Country code
  1. S PSTR=".111,.112,.113,.114,.115,.117,.1112,.1171,.1172,.1173,.131,.132,.121"
  1. S FSTR=".111,.112,.113,.1112,.131,.132,.121"
  1. I FORGN S FSTR=".111,.112,.113,.114,.1171,.1172,.131,.132,.121"
  1. Q FSTR
  1. ZIPINP(DGINPUT,DFN) ; get ZIP+4 input
  1. N DGR
  1. D EN^DGREGAZL(.DGR,DFN)
  1. ;DG*5.3*1014 - Zip entry failed (due to timeout, or ^ entry, or input error) - before the Quit, set DGINPUT=-1
  1. ;I $G(DGR)=-1 Q
  1. I $G(DGR)=-1 S DGINPUT=-1 Q
  1. M DGINPUT=DGR
  1. Q
  1. SKIP(DGN,DGINPUT,FLG) ; determine whether or not to skip this step
  1. N SKIP
  1. S SKIP=0
  1. I ($G(DGINPUT(.111))="")&((DGN=.112)!(DGN=.113)) S SKIP=1
  1. I ($G(DGINPUT(.112))="")&(DGN=.113) S SKIP=1
  1. I ($G(FLG(1))'=1)&((DGN=.131)!(DGN=.132)) S SKIP=1
  1. Q SKIP
  1. EOP ;End of page prompt
  1. N DIR,DTOUT,DUOUT,DIROUT,X,Y
  1. S DIR(0)="E"
  1. S DIR("A")="Press ENTER to continue"
  1. D ^DIR
  1. ; DG*5.3*1040 - Set variable DGTMOT=1, if timeout
  1. S:$D(DTOUT) DGTMOT=1
  1. Q
  1. UPCT ;Indicate "^" or "^^" are unacceptable inputs.
  1. W !,"EXIT NOT ALLOWED ??"
  1. Q