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