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

DGREGRED.m

Go to the documentation of this file. 
  1. DGREGRED ;ALB/JAM - Residential Address Edit API ;1/6/21  10:30
  1.  ;;5.3;Registration;**941,1010,1014,1040**;Aug 13, 1993;Build 15
  1.  ;;
  1.  ;
  1. EN(DFN,FLG) ;Entry point
  1.  ;Input:
  1.  ;  DFN (required) - Internal Entry # of Patient File (#2)
  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 (and phone if FLG(1)=1) for user confirmation
  1.  N DGINPUT,DGCMP,ICNTRY,CNTRY,FORGN,PSTR,OLDC,FSTR,BAD
  1.  N I,X,Y
  1.  I $G(DFN)="" Q
  1.  S FLG(1)=$G(FLG(1)),FLG(2)=$G(FLG(2))
  1. RETRY  ; Entry point if address must be re-entered
  1.  D GETOLD(.DGCMP,DFN)
  1.  S CNTRY="",ICNTRY=$S(DFN:$P($G(^DPT(DFN,.115)),"^",10),1:"")
  1.  I ICNTRY="" S ICNTRY=1  ;default country is USA if NULL
  1.  ; DG*5.3*1040 - Set variable DGTMOT to 1 to track timeout
  1.  S OLDC=DGCMP("OLD",.11573),FORGN=$$FOREIGN^DGADDUTL(DFN,ICNTRY,2,.11573,.CNTRY) I FORGN=-1 S DGTMOT=1 Q
  1.  K FSTR,PSTR S FSTR=$$INPT1(FORGN,.PSTR)      ;set up field string of address prompts
  1.  K DGINPUT S DGINPUT=1 D INPUT(.DGINPUT,DFN,FSTR,CNTRY) I $G(DGINPUT)=-1 Q
  1.  ; initialize valid address flag
  1.  S BAD=0
  1.  ;
  1.  ; **** DG*5.3*1014; jam;  Start changes ****
  1.  ;
  1.  ; DG*5.3*1014; jam; If required fields are missing, we can't call the validation service - force user to correct the address
  1.  I DGINPUT(.1151)=""!(DGINPUT(.1154)="")!(($G(DGINPUT(.1156))="")&('FORGN)) D  G RETRY
  1.  . I 'FORGN W !!?3,*7,"RESIDENTIAL ADDRESS [LINE 1], CITY, and ZIP CODE fields are required."
  1.  . I FORGN W !!?3,*7,"RESIDENTIAL ADDRESS [LINE 1] and CITY fields are required."
  1.  ; DG*5.3*1014; Display the address entered
  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 and Quit if EOP timeout
  1.  I $D(DUOUT) W !,"Address changes not saved." D EOP Q:+$G(DGTMOT)  G PHONE    ;Exiting - Not saving address - go to phone saving process
  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,"R")
  1.  ; DG*5.3*1040; 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.  ; if flag is set, show old and new address
  1.  I FLG(2)=1 D COMPARE(.DGINPUT,.DGCMP)
  1.  ; DG*5.3*1040 - Use variable DGCONFIRM to hold value of $$CONFIRM("ADDRESS")
  1.  N DGCONFIRM S DGCONFIRM=$$CONFIRM("ADDRESS") I DGCONFIRM=-1 S DGTMOT=1 Q
  1.  ; DG*5.3*1040 - Check variable DGCONFIRM
  1.  I 'DGCONFIRM W !,"Address changes not saved." G PHONE    ;Not saving address - go to phone saving process
  1.  ; Validate the address fields and set BAD=1 if not valid
  1.  I DGINPUT(.1151)=""!(DGINPUT(.1154)="")!(($G(DGINPUT(.1156))="")&('FORGN)) D  S BAD=1 G PHONE
  1.  . I 'FORGN W !!?3,*7,"RESIDENTIAL ADDRESS [LINE 1], ZIP CODE and CITY fields are required."
  1.  . I FORGN W !!?3,*7,"RESIDENTIAL ADDRESS [LINE 1] and CITY fields are required."
  1.  ; If address is valid, next check is for PO Box and General Delivery - 
  1.  ;    Pass in LINE 1, State and Country codes
  1.  I $$POBOXRES^DGREGCP2(DGINPUT(.1151),$P($G(DGINPUT(.1155)),"^",2),$P(DGINPUT(.11573),"^",2)) D  S BAD=1 G PHONE
  1.  . W !!?3,*7,"You cannot enter 'P. O. Box' or 'General Delivery' for a Residential Address."
  1.  ; If all Validations passed - save the address
  1.  D SAVE(.DGINPUT,DFN,FSTR,FORGN) Q:+$G(DGTMOT)
  1. PHONE ; Process the phone number changes IF FLG(1) = 1
  1.  I $G(FLG(1))=1 D
  1.  . ; if compare flag is set, display old/new values
  1.  . I $G(FLG(2))=1 D COMPAREP(.DGINPUT,.DGCMP)
  1.  . ; DG*5.3*1040 - Use variable DGCONFIRM to hold value of $$CONFIRM("PHONE")
  1.  . N DGCONFIRM S DGCONFIRM=$$CONFIRM("PHONE") I DGCONFIRM=-1 S DGTMOT=1 Q
  1.  . ; DG*5.3*1040 - Check variable DGCONFIRM and DGTMOT
  1.  . I 'DGCONFIRM W !,"Phone changes not saved." D EOP Q:+$G(DGTMOT)
  1.  . E  D SAVEPH(.DGINPUT,DFN) Q:+$G(DGTMOT)  ; DG*5.3*1040 - QUIT if timeout
  1.  ; Phone number process is completed - go to RETRY if address validation failed
  1.  I BAD G RETRY
  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=.1156 D ZIPINP(.DGINPUT,DFN) S:DGINPUT=-1 DGTMOT=1 Q
  1.  . ; DG*5.3*1040 - Include flag DGTMOUT to track timeout with DGTMOT set to 1
  1.  . I '$$READ(DFN,DGN,.Y) S DGINPUT=-1,DGTMOT=1 Q
  1.  . S DGINPUT(DGN)=$G(Y)
  1.  I DGINPUT'=-1 S DGINPUT(.11573)=CNTRY_"^"_$O(^HL(779.004,"B",CNTRY,""))
  1.  Q
  1. GETOLD(DGCMP,DFN) ;populate array with existing address info
  1.  K DGCMP
  1.  N CCIEN,DGCURR,CFORGN,CFSTR,L,T,DGCIEN,DGST,DGCNTY,COUNTRY
  1.  S CFORGN=0
  1.  ; get current country
  1.  S CCIEN=$S(DFN:$$GET1^DIQ(2,DFN_",",.11573,"I"),1:"")
  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_";.1154;.1155;.1157"
  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",.11573)=COUNTRY_"^"_CCIEN
  1.  I 'CFORGN D
  1.  . S DGCIEN=$G(DGCURR(2,DFN_",",.1157,"I"))
  1.  . S DGST=$G(DGCURR(2,DFN_",",.1155,"I"))
  1.  . S DGCNTY=$$CNTY^DGREGAZL(DGST,DGCIEN)
  1.  . I DGCNTY=-1 S DGCNTY=""
  1.  . S DGCMP("OLD",.1157)=$P(DGCNTY,U)_" "_$P(DGCNTY,U,3)
  1.  Q
  1.  ;
  1. COMPARE(DGINPUT,DGCMP) ;Display before & after address fields.
  1.  N DGM,DGCNTY
  1.  M DGCMP("NEW")=DGINPUT
  1.  W !
  1.  F DGM="OLD","NEW" D
  1.  . I DGCMP(DGM,.11573)]"",$$FORIEN^DGADDUTL($P(DGCMP(DGM,.11573),U,2)) D DISPFGN(.DGCMP,DGM) Q
  1.  . I DGM="NEW" D
  1.  . . S DGCNTY=$P($G(DGCMP("NEW",.1157)),U)_" "_$P($G(DGCMP("NEW",.1157)),U,3)
  1.  . . S DGCMP("NEW",.1157)=DGCNTY
  1.  . . I ($L(DGCMP("NEW",.1156))>5)&($P(DGCMP("NEW",.1156),"-",2)="") S DGCMP("NEW",.1156)=$E(DGCMP("NEW",.1156),1,5)_"-"_$E(DGCMP("NEW",.1156),6,9)
  1.  . D DISPUS(.DGCMP,DGM)
  1.  Q
  1.  ;
  1. COMPAREP(DGINPUT,DGCMP) ;Display before & after phone fields.
  1.  N DGM
  1.  M DGCMP("NEW")=DGINPUT
  1.  W !
  1.  F DGM="OLD","NEW" D
  1.  . W !,?2,"[",DGM," PHONE NUMBERS]"
  1.  . W !,?6,"   Phone: ",?16,$P($G(DGCMP(DGM,.131)),U)
  1.  . W !,?6,"  Office: ",?16,$P($G(DGCMP(DGM,.132)),U)
  1.  . W !
  1.  Q
  1.  ;
  1. DISPUS(DGCMP,DGM) ;tag to display US data
  1.  N DGCNTRY
  1.  W !,?2,"[",DGM," RESIDENTIAL ADDRESS]"
  1.  W !?16,$P($G(DGCMP(DGM,.1151)),U)
  1.  I $P($G(DGCMP(DGM,.1152)),U)'="" W !,?16,$P($G(DGCMP(DGM,.1152)),U)
  1.  I $P($G(DGCMP(DGM,.1153)),U)'="" W !,?16,$P($G(DGCMP(DGM,.1153)),U)
  1.  W !,?16,$P($G(DGCMP(DGM,.1154)),U)
  1.  W:($P($G(DGCMP(DGM,.1154)),U)'="")!($P($G(DGCMP(DGM,.1155)),U)'="") ","
  1.  W $P($G(DGCMP(DGM,.1155)),U)
  1.  W " ",$G(DGCMP(DGM,.1156))
  1.  S DGCNTRY=$$CNTRYI^DGADDUTL($P($G(DGCMP(DGM,.11573)),U,2))
  1.  I DGCNTRY]"",(DGCNTRY'=-1) W !?16,DGCNTRY
  1.  I $P($G(DGCMP(DGM,.1157)),U)'="" W !,?6,"  County: ",$P($G(DGCMP(DGM,.1157)),U)
  1.  W !
  1.  Q
  1.  ;
  1. DISPFGN(DGCMP,DGM) ;tag to display Foreign data
  1.  N DGCNTRY
  1.  W !,?2,"[",DGM," RESIDENTIAL ADDRESS]"
  1.  W !?16,$P($G(DGCMP(DGM,.1151)),U)
  1.  I $P($G(DGCMP(DGM,.1152)),U)'="" W !,?16,$P($G(DGCMP(DGM,.1152)),U)
  1.  I $P($G(DGCMP(DGM,.1153)),U)'="" W !,?16,$P($G(DGCMP(DGM,.1153)),U)
  1.  ;W !,?16,$P($G(DGCMP(DGM,.11572)),U)_" "_$P($G(DGCMP(DGM,.1154)),U)_" "_$P($G(DGCMP(DGM,.11571)),U) ;DG*1010 comment out
  1.  W !,?16,$P($G(DGCMP(DGM,.1154)),U)_" "_$P($G(DGCMP(DGM,.11571)),U)_" "_$P($G(DGCMP(DGM,.11572)),U) ;DG*1010 - display postal code last
  1.  S DGCNTRY=$$CNTRYI^DGADDUTL($P($G(DGCMP(DGM,.11573)),U,2))
  1.  S DGCNTRY=$S(DGCNTRY="":"UNSPECIFIED COUNTRY",DGCNTRY=-1:"UNKNOWN COUNTRY",1:DGCNTRY)
  1.  I DGCNTRY]"" W !?16,DGCNTRY
  1.  W !
  1.  Q
  1.  ;
  1. CONFIRM(TYPE) ;Confirm if user wants to save the changes 
  1.  ; TYPE - used for the query message displayed to the user: "address" or "phone number"
  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 "_TYPE_" changes"
  1.  S DIR("?")="Please answer Y for YES or N for NO."
  1.  D ^DIR
  1.  ; DG*5.3*1040 - prompt timeout return -1
  1.  I $D(DTOUT) Q -1
  1.  I $G(Y)=0 Q 0
  1.  I $D(DUOUT)!$D(DIROUT) Q 0
  1.  Q 1
  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:",.1154,.1155,.1157,.11573",1:",.11573")
  1.  F L=1:1:$L(FSTR,",") S DGN=$P(FSTR,",",L) D
  1.  . ; Phone numbers saved separately - skip over here
  1.  . I (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.  . ; Set the CASS IND field 
  1.  . S DATA(.1159)="NC"
  1.  . I $$UPD^DGENDBS(2,DFN,.DATA)
  1.  ; DG*5.3*1040 - If EOP timeout, QUIT if variable DGTMOT exists
  1.  D EOP Q:+$G(DGTMOT)
  1.  Q
  1.  ;
  1. SAVEPH(DGINPUT,DFN) ;Save phone changes
  1.  N DGN,DGER,DGM,DATA
  1.  S DGER=0
  1.  F DGN=.131,.132 D
  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."
  1.  ; DG*5.3*1040 - If EOP timeout, QUIT if variable DGTMOT exists
  1.  D EOP Q:+$G(DGTMOT)
  1.  Q
  1.  ;
  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=".1151,.1152,.1153,.1154,.1155,.1157,.1156,.11571,.11572,.11573,.131,.132"
  1.  S FSTR=".1151,.1152,.1153,.1156,.131,.132"
  1.  I FORGN S FSTR=".1151,.1152,.1153,.1154,.11571,.11572,.131,.132"
  1.  Q FSTR
  1. ZIPINP(DGINPUT,DFN) ; get ZIP+4 input
  1.  ; This subroutine calls existing code to prompt for zip code and return corresponding city, state and county
  1.  ; DFN must be the patient internal ID.  
  1.  ; DGINPUT - passed by reference - the array containing the resulting county, city, and state for the zipcode.
  1.  N FCITY,FZIP,FSTATE,FCOUNTY,TYPE,DGR
  1.  ; Set the necessary variables for the Residential Address
  1.  ; The variable TYPE is used for Confidential and temporary address types. 
  1.  ; Here for the Residential Address we clear this variable.
  1.  S FZIP=".1156",FCITY=".1154",FSTATE=".1155",FCOUNTY=".1157",TYPE=""
  1.  D EN^DGREGTZL(.DGR,DFN)
  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(.1151))="")&((DGN=.1152)!(DGN=.1153)) S SKIP=1
  1.  I ($G(DGINPUT(.1152))="")&(DGN=.1153) 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