DGREGTED ;ALB/BAJ,BDB,JAM,ARF - Temporary & Confidential Address Edits API ;23 May 2017 12:48 PM
;;5.3;Registration;**688,851,941,1014,1040,1127**;Aug 13, 1993;Build 11
;
EN(DFN,TYPE,RET) ;Entry point
; This routine controls Edits to Temporary & Confidential addresses
;
; Input
; DFN = Patient DFN
; TYPE = Type of address: "TEMP" or "CONF"
; RET = Flag to signal return to first prompt
;
; Output
; RET 0 = Return to first prompt in the address edit group
; 1 = Do not return (address was saved)
;
N DGINPUT,FORGN,FSTR,ICNTRY,CNTRY,PSTR,DGCMP,DGOLD,DR,DIE
N FSLINE1,FSLINE2,FSLINE3,FCITY,FSTATE,FCOUNTY,FZIP,FPHONE
N FPROV,FPSTAL,FCNTRY,FNODE1,FNODE2,CPEICE,OLDC,RPROC
N I,X,Y
I $G(DFN)="" Q
;I ($G(DFN)'?.N) Q
D INIT^DGREGTE2 I $P($G(^DPT(DFN,FNODE1)),U,9)="N" Q
D GETOLD^DGREGTE2(.DGCMP,DFN,TYPE) M DGOLD=DGCMP("OLD") K DGCMP
S CNTRY="",ICNTRY=$P($G(^DPT(DFN,FNODE2)),"^",CPEICE) I ICNTRY="" S ICNTRY=1 ;default US if NULL
;
; DG*5.3*1014; jam; ** Start changes **
; RETRY tag added below
RETRY ; Tag for reentering the address
S FORGN=$$FOREIGN^DGADDUTL(DFN,ICNTRY,2,FCNTRY,.CNTRY) I FORGN=-1 S RET=0,DGTMOT=1 Q
Q:$G(CNTRY)=""
S FSTR=$$INPT1^DGREGTE2(DFN,FORGN,.PSTR),DGINPUT=1 D INPUT(.DGINPUT,DFN,FSTR)
I $G(DGINPUT)=-1 S RET=0 Q
;
; DG*5.3*1014; jam; For confidential address, if required fields are missing, we can't call the validation service - force user to correct the address
I TYPE="CONF",DGINPUT(.1411)=""!(DGINPUT(.1414)="")!(($G(DGINPUT(.1416))="")&('FORGN)) D G RETRY
. I 'FORGN W !!?3,*7,"CONFIDENTIAL ADDRESS [LINE 1], CITY, and ZIP CODE fields are required."
. I FORGN W !!?3,*7,"CONFIDENTIAL ADDRESS [LINE 1] and CITY fields are required."
; DG*5.3*1014; jam; Address Validation service for confidential address only - TEMP address will skip over this
I TYPE'="CONF" G SVADD
; Place the country code and name into the DGINPUT array
S DGINPUT(FCNTRY)=$O(^HL(779.004,"B",CNTRY,""))_"^"_CNTRY
; DG*5.3*1014; Display address entered - user may reenter the address or continue to Validation service.
W !
N DGNEWADD
M DGNEWADD("NEW")=DGINPUT
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,DGOVERKEY ;DG*5.3*1127 - Added DGOVERKEY variable
S DGADVRET=$$EN^DGADDVAL(.DGINPUT,"C")
; DG*5.3*1127 - Get the override key. DGINPUT("overrideKey") will contain the value of the
; override key set in DGADDLST which is called when validating the address
S DGOVERKEY=$G(DGINPUT("overrideKey"))
; DG*5.3*1040; if return is -1 timeout occurred
I DGADVRET=-1 S DGTMOT=1 Q
; if return is 0 - address could not be 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
;
SVADD ; Save the address - SVADD tag added for DG*5.3*1014; jam; ** End of 1014 changes **
D SAVE(.DGINPUT,DFN,FSTR,CNTRY)
Q
;
INPUT(DGINPUT,DFN,FSTR) ;Let user input address changes
; Input:
; DGINPUT - Array to hold field values DGINPUT(field#)
; DFN - Patient DFN
; FSTR - String of fields (foreign or domestic) to work with
;
; Output:
; DGINPUT(field#)=external^internal(if any)
;
N DIR,X,Y,DA,DGR,DTOUT,DUOUT,DIROUT,DGN,L,SUCCESS,REP
F L=1:1:$L(FSTR,",") S DGN=$P(FSTR,",",L) Q:DGINPUT=-1 D
. S REP=0
. I $$SKIP^DGREGTE2(DGN,.DGINPUT) Q
. ; DG*5.3*1040 - Set variable DGTMOT to 1 to track ZIP timeout
. I DGN=FZIP D ZIPINP(.DGINPUT,DFN) S:DGINPUT=-1 DGTMOT=1 Q ;DG*5.3*851
. S SUCCESS=$$READ(DFN,.DGOLD,DGN,.Y,.REP) I 'SUCCESS D Q
. . ; DG*5.3*1040 - Set variable DGTMOT to 1 to track field timeout
. . I 'REP S DGINPUT=-1,DGTMOT=1 Q
. . ; repeat the question so we have to set the counter back
. . S L=L-1
. ; DG*5.3*1014 ;jam; prevent the @ from getting into the array
. I $G(Y)="@" S Y=""
. S DGINPUT(DGN)=$G(Y)
READ(DFN,DGOLD,DGN,Y,REP) ;Read input, return success
; Input:
; DFN - Patient DFN
; DGOLD - Array of current field values.
; DGN - Current field to read
; Y - Current Field value
; REP - Flag -- should prompt be repeated
;
; Output
; SUCCESS 1 = Input successful go to next prompt
; 0 = Input unsuccessful Repeat or Abort as indicated by REP variable
; REP 1 = Error - Repeat prompt
; 0 = Error - Do not repeat
; Y New field value
;
N SUCCESS,DIR,DA,DTOUT,DUOUT,DIRUT,DIROUT,X,L,T,POP,DGST,CNTYFLD,REVERSE
S SUCCESS=1,(POP,REVERSE)=0,CNTYFLD=$S(TYPE="TEMP":"TEMPORARY ADDRESS COUNTY",1:"CONFIDENTIAL ADDRESS COUNTY")
S DIR(0)=2_","_DGN,DIR("B")=$G(DGOLD(DGN))
S DA=DFN
F D Q:POP
. K DTOUT,DUOUT,DIROUT
. S MSG=""
. I ($G(DGINPUT(FSTATE))="")&(DGN=FCOUNTY) S POP=1 Q
. S DIR("B")=$S($D(DGINPUT(DGN)):DGINPUT(DGN),$G(DGOLD(DGN))]"":DGOLD(DGN),1:"")
. I DGN=FCOUNTY D
. . S DIR(0)="POA^DIC(5,"_$P(DGINPUT(FSTATE),U)_",1,:AEMQ"
. . S DIR("A")=CNTYFLD_": "
. . ; we can't prompt if there's no previous entry
. . I $D(DGOLD(DGN)) S T=$L(DGOLD(DGN)," "),DIR("B")=$P($G(DGOLD(DGN))," ",1,T-1)
. D ^DIR
. I $D(DTOUT) S POP=1,SUCCESS=0 Q
. I $D(DIRUT) S MSG="",REVERSE=0 D ANSW(X,.DGOLD,DGN,.MSG,.Y,.REP,$G(RET),.REVERSE) S:REP SUCCESS=0 W:MSG]"" !,MSG
. I REVERSE S (REP,SUCCESS)=0
. S POP=1
Q SUCCESS
;
SAVE(DGINPUT,DFN,FSTR,CNTRY) ;Save changes
N DATA,DGENDA,L,T,FILE,ERROR,LOOP,LOOP1,LOOP2
S DGENDA=DFN,FILE=2
; need to get the country code into the DGINPUT array
S DGINPUT(FCNTRY)=$O(^HL(779.004,"B",CNTRY,""))
S FSTR=FSTR_","_FCNTRY
I (TYPE="TEMP")!(TYPE="CONF") S FSTR=FSTR_","_FCITY_","_FSTATE_","_FCOUNTY ;DG*5.3*851
I (TYPE="CONF") S DGINPUT(.141201)=DGOVERKEY,FSTR=FSTR_","_.141201 ;DG*5.3*1127 - Store the override key returned from the address validation
F L=1:1:$L(FSTR,",") S T=$P(FSTR,",",L) S DATA(T)=$P($G(DGINPUT(T)),U)
;JAM; Set the CASS field for Temp and Confidential; DG*5.3*941
I TYPE="TEMP" S DATA(.12115)="NC"
I TYPE="CONF" S DATA(.14117)="NC"
Q $$UPD^DGENDBS(FILE,.DGENDA,.DATA,.ERROR)
;
ANSW(YIN,DGOLD,DGN,MSG,YOUT,REP,RET,REVERSE) ;analyze input commands
; This API will process reads and set bits, messages and flags accordingly.
; Because there is different behavior depending on prompt and input, the input
; of each field needs to be evaluated separately at the time of input and before
; deciding to continue the edit. Input rules are loaded into array RPROC at the
; beginning of this routine in call to INIT^DGREGTE2.
;
; Input
; N - User input "Y" value
; DGOLD - Array of current values
; DGN - Current field
; MSG - Variable for Text message
; YOUT - User input ("Y") value
; REP - Flag to repeat prompt
; RET - Flag to return success or failure to calling module
; REVERSE - Flag to revert to first prompt in sequence
;
; Output
; MSG - Text message (for incorrect entries)
; REP - Repeat current prompt
; REVERSE - Revert to first prompt in sequence
;
N X,Y,DTOUT,DIRUT,DUOUT,PRMPT,RMSG,TDGN,ACT
N OLDVAL,NEWVAL
;
S PRMPT=$S(TYPE="TEMP":"TEMPORARY",1:"CONFIDENTIAL")
S RMSG("LINE")="BUT I NEED AT LEAST ONE LINE OF A "_PRMPT_" ADDRESS"
S RMSG("REVERSE")="This is a required response."
S RMSG("REPEAT")="EXIT NOT ALLOWED ??"
S RMSG("QUES")="??"
S RMSG("INSTRUCT")=$S(TYPE="TEMP":"TADD^DGLOCK1",TYPE="CONF":"CADD1^DGLOCK3",1:"OK")
S OLDVAL=$G(DGOLD(DGN)),OLDVAL=$$PROC(OLDVAL),NEWVAL=$$PROC(YIN)
S TDGN=$S($D(RPROC(DGN,OLDVAL,NEWVAL)):DGN,1:"ALL")
I '$D(RPROC(TDGN,OLDVAL,NEWVAL)) S RPROC(TDGN,OLDVAL,NEWVAL)="OK"
S ACT=RPROC(TDGN,OLDVAL,NEWVAL)
D @ACT
Q
REVERSE ;
; DG*5.3*1040; LINE message for NULL "FSLINE1" is moved to REPEAT
;N MSUB
;S MSUB=$S(DGN=FSLINE1:"LINE",1:"REVERSE")
;W !,RMSG(MSUB)
W !,RMSG("REVERSE")
S REVERSE=1
Q
REPEAT ;
;W !,RMSG("REPEAT")
N MSUB
S MSUB=$S(DGN=FSLINE1:"LINE",1:"REPEAT")
W !,RMSG(MSUB)
S REP=1
Q
OK ;
Q
QUES ;
W RMSG("QUES")
S REP=1
Q
CONFIRM ;
I '$$SURE^DGREGTE2 S YOUT=DGOLD(DGN),REP=1 Q
S YOUT=YIN,REP=0
Q
INSTRUCT ;
D @RMSG("INSTRUCT")
S REP=1
Q
PROC(VAL) ;process the input and return a type of value
; input
; VAL - The value to examine
;
; output
; a value type
; VALUE = input - validation is a separate task and is not done here
; NULL = NULL input
; UPCAR = the "^" character
; DELETE = the "@" character
Q $S(VAL="":"NULL",$E(VAL)="^":"UPCAR",$E(VAL)="@":"DELETE",1:"VALUE")
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
; DG*5.3*851
ZIPINP(DGINPUT,DFN) ;get ZIP+4 input
N DGR,DGX
D EN^DGREGTZL(.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
S DGX=DGINPUT(FCOUNTY),DGINPUT(FCOUNTY)=$P(DGX,"^",2)_"^"_$P(DGX,"^",1)
S DGX=DGINPUT(FSTATE),DGINPUT(FSTATE)=$P(DGX,"^",2)_"^"_$P(DGX,"^",1)
Q
SKIP(DGN,DGINPUT,FLG) ; determine whether or not to skip this step
N SKIP
S SKIP=0
I ($G(DGINPUT(FSLINE1))="")&((DGN=FSLINE2)!(DGN=FSLINE3)) S SKIP=1
I ($G(DGINPUT(FSLINE2))="")&(DGN=FSLINE3) S SKIP=1
I ($G(FLG(1))'=1)&((DGN=FPHONE)) S SKIP=1
Q SKIP
UPCT ;Indicate "^" or "^^" are unacceptable inputs.
W !,"EXIT NOT ALLOWED ??"
Q
;
; DG*5.3*1014;jam; Added these tags to display the address prior to calling the Validation service
DISPUS(DGCMP,DGM) ;tag to display US data
N DGCNTRY
; "AddressLine1,AddressLine2,AddressLine3,City,State,County,Zip,Province,PostalCode^Country"
; ".1411,.1412,.1413,.1414,.1415,.14111,.1416,.14114,.14115,.14116" ; Confidential address fields
W !,?2,"[",DGM," CONFIDENTIAL ADDRESS]"
W !?16,$G(DGCMP(DGM,.1411))
I $G(DGCMP(DGM,.1412))'="" W !,?16,$G(DGCMP(DGM,.1412))
I $G(DGCMP(DGM,.1413))'="" W !,?16,$G(DGCMP(DGM,.1413))
W !,?16,$G(DGCMP(DGM,.1414))
W:($G(DGCMP(DGM,.1414))'="")!($P($G(DGCMP(DGM,.1415)),U,2)'="") ","
W $P($G(DGCMP(DGM,.1415)),U,2)
W " ",$G(DGCMP(DGM,.1416))
S DGCNTRY=$$CNTRYI^DGADDUTL($P($G(DGCMP(DGM,.14116)),U))
I DGCNTRY]"",(DGCNTRY'=-1) W !?16,DGCNTRY
I $P($G(DGCMP(DGM,.14111)),U)'="" W !,?6," County: ",$P($G(DGCMP(DGM,.14111)),U,2)
W !
Q
;
DISPFGN(DGCMP,DGM) ;tag to display Foreign data
N DGCNTRY
W !,?2,"[",DGM," CONFIDENTIAL ADDRESS]"
W !?16,$G(DGCMP(DGM,.1411))
I $G(DGCMP(DGM,.1412))'="" W !,?16,$G(DGCMP(DGM,.1412))
I $G(DGCMP(DGM,.1413))'="" W !,?16,$G(DGCMP(DGM,.1413))
W !,?16,$G(DGCMP(DGM,.1414))_" "_$G(DGCMP(DGM,.14114))_" "_$G(DGCMP(DGM,.14115))
S DGCNTRY=$$CNTRYI^DGADDUTL($P($G(DGCMP(DGM,.14116)),U))
S DGCNTRY=$S(DGCNTRY="":"UNSPECIFIED COUNTRY",DGCNTRY=-1:"UNKNOWN COUNTRY",1:DGCNTRY)
I DGCNTRY]"" W !?16,DGCNTRY
W !
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGREGTED 12153 printed Sep 23, 2025@20:30:58 Page 2
DGREGTED ;ALB/BAJ,BDB,JAM,ARF - Temporary & Confidential Address Edits API ;23 May 2017 12:48 PM
+1 ;;5.3;Registration;**688,851,941,1014,1040,1127**;Aug 13, 1993;Build 11
+2 ;
EN(DFN,TYPE,RET) ;Entry point
+1 ; This routine controls Edits to Temporary & Confidential addresses
+2 ;
+3 ; Input
+4 ; DFN = Patient DFN
+5 ; TYPE = Type of address: "TEMP" or "CONF"
+6 ; RET = Flag to signal return to first prompt
+7 ;
+8 ; Output
+9 ; RET 0 = Return to first prompt in the address edit group
+10 ; 1 = Do not return (address was saved)
+11 ;
+12 NEW DGINPUT,FORGN,FSTR,ICNTRY,CNTRY,PSTR,DGCMP,DGOLD,DR,DIE
+13 NEW FSLINE1,FSLINE2,FSLINE3,FCITY,FSTATE,FCOUNTY,FZIP,FPHONE
+14 NEW FPROV,FPSTAL,FCNTRY,FNODE1,FNODE2,CPEICE,OLDC,RPROC
+15 NEW I,X,Y
+16 IF $GET(DFN)=""
QUIT
+17 ;I ($G(DFN)'?.N) Q
+18 DO INIT^DGREGTE2
IF $PIECE($GET(^DPT(DFN,FNODE1)),U,9)="N"
QUIT
+19 DO GETOLD^DGREGTE2(.DGCMP,DFN,TYPE)
MERGE DGOLD=DGCMP("OLD")
KILL DGCMP
+20 ;default US if NULL
SET CNTRY=""
SET ICNTRY=$PIECE($GET(^DPT(DFN,FNODE2)),"^",CPEICE)
IF ICNTRY=""
SET ICNTRY=1
+21 ;
+22 ; DG*5.3*1014; jam; ** Start changes **
+23 ; RETRY tag added below
RETRY ; Tag for reentering the address
+1 SET FORGN=$$FOREIGN^DGADDUTL(DFN,ICNTRY,2,FCNTRY,.CNTRY)
IF FORGN=-1
SET RET=0
SET DGTMOT=1
QUIT
+2 if $GET(CNTRY)=""
QUIT
+3 SET FSTR=$$INPT1^DGREGTE2(DFN,FORGN,.PSTR)
SET DGINPUT=1
DO INPUT(.DGINPUT,DFN,FSTR)
+4 IF $GET(DGINPUT)=-1
SET RET=0
QUIT
+5 ;
+6 ; DG*5.3*1014; jam; For confidential address, if required fields are missing, we can't call the validation service - force user to correct the address
+7 IF TYPE="CONF"
IF DGINPUT(.1411)=""!(DGINPUT(.1414)="")!(($GET(DGINPUT(.1416))="")&('FORGN))
Begin DoDot:1
+8 IF 'FORGN
WRITE !!?3,*7,"CONFIDENTIAL ADDRESS [LINE 1], CITY, and ZIP CODE fields are required."
+9 IF FORGN
WRITE !!?3,*7,"CONFIDENTIAL ADDRESS [LINE 1] and CITY fields are required."
End DoDot:1
GOTO RETRY
+10 ; DG*5.3*1014; jam; Address Validation service for confidential address only - TEMP address will skip over this
+11 IF TYPE'="CONF"
GOTO SVADD
+12 ; Place the country code and name into the DGINPUT array
+13 SET DGINPUT(FCNTRY)=$ORDER(^HL(779.004,"B",CNTRY,""))_"^"_CNTRY
+14 ; DG*5.3*1014; Display address entered - user may reenter the address or continue to Validation service.
+15 WRITE !
+16 NEW DGNEWADD
+17 MERGE DGNEWADD("NEW")=DGINPUT
+18 IF FORGN
DO DISPFGN(.DGNEWADD,"NEW")
+19 IF 'FORGN
DO DISPUS(.DGNEWADD,"NEW")
+20 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 ;DG*5.3*1127 - Added DGOVERKEY variable
NEW DGADVRET,DGOVERKEY
+15 SET DGADVRET=$$EN^DGADDVAL(.DGINPUT,"C")
+16 ; DG*5.3*1127 - Get the override key. DGINPUT("overrideKey") will contain the value of the
+17 ; override key set in DGADDLST which is called when validating the address
+18 SET DGOVERKEY=$GET(DGINPUT("overrideKey"))
+19 ; DG*5.3*1040; if return is -1 timeout occurred
+20 IF DGADVRET=-1
SET DGTMOT=1
QUIT
+21 ; if return is 0 - address could not be validated
+22 ; 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
+23 ; DGINPUT array contains the address that is validated/accepted or what the user entered if the validation service failed
+24 ;
SVADD ; Save the address - SVADD tag added for DG*5.3*1014; jam; ** End of 1014 changes **
+1 DO SAVE(.DGINPUT,DFN,FSTR,CNTRY)
+2 QUIT
+3 ;
INPUT(DGINPUT,DFN,FSTR) ;Let user input address changes
+1 ; Input:
+2 ; DGINPUT - Array to hold field values DGINPUT(field#)
+3 ; DFN - Patient DFN
+4 ; FSTR - String of fields (foreign or domestic) to work with
+5 ;
+6 ; Output:
+7 ; DGINPUT(field#)=external^internal(if any)
+8 ;
+9 NEW DIR,X,Y,DA,DGR,DTOUT,DUOUT,DIROUT,DGN,L,SUCCESS,REP
+10 FOR L=1:1:$LENGTH(FSTR,",")
SET DGN=$PIECE(FSTR,",",L)
if DGINPUT=-1
QUIT
Begin DoDot:1
+11 SET REP=0
+12 IF $$SKIP^DGREGTE2(DGN,.DGINPUT)
QUIT
+13 ; DG*5.3*1040 - Set variable DGTMOT to 1 to track ZIP timeout
+14 ;DG*5.3*851
IF DGN=FZIP
DO ZIPINP(.DGINPUT,DFN)
if DGINPUT=-1
SET DGTMOT=1
QUIT
+15 SET SUCCESS=$$READ(DFN,.DGOLD,DGN,.Y,.REP)
IF 'SUCCESS
Begin DoDot:2
+16 ; DG*5.3*1040 - Set variable DGTMOT to 1 to track field timeout
+17 IF 'REP
SET DGINPUT=-1
SET DGTMOT=1
QUIT
+18 ; repeat the question so we have to set the counter back
+19 SET L=L-1
End DoDot:2
QUIT
+20 ; DG*5.3*1014 ;jam; prevent the @ from getting into the array
+21 IF $GET(Y)="@"
SET Y=""
+22 SET DGINPUT(DGN)=$GET(Y)
End DoDot:1
READ(DFN,DGOLD,DGN,Y,REP) ;Read input, return success
+1 ; Input:
+2 ; DFN - Patient DFN
+3 ; DGOLD - Array of current field values.
+4 ; DGN - Current field to read
+5 ; Y - Current Field value
+6 ; REP - Flag -- should prompt be repeated
+7 ;
+8 ; Output
+9 ; SUCCESS 1 = Input successful go to next prompt
+10 ; 0 = Input unsuccessful Repeat or Abort as indicated by REP variable
+11 ; REP 1 = Error - Repeat prompt
+12 ; 0 = Error - Do not repeat
+13 ; Y New field value
+14 ;
+15 NEW SUCCESS,DIR,DA,DTOUT,DUOUT,DIRUT,DIROUT,X,L,T,POP,DGST,CNTYFLD,REVERSE
+16 SET SUCCESS=1
SET (POP,REVERSE)=0
SET CNTYFLD=$SELECT(TYPE="TEMP":"TEMPORARY ADDRESS COUNTY",1:"CONFIDENTIAL ADDRESS COUNTY")
+17 SET DIR(0)=2_","_DGN
SET DIR("B")=$GET(DGOLD(DGN))
+18 SET DA=DFN
+19 FOR
Begin DoDot:1
+20 KILL DTOUT,DUOUT,DIROUT
+21 SET MSG=""
+22 IF ($GET(DGINPUT(FSTATE))="")&(DGN=FCOUNTY)
SET POP=1
QUIT
+23 SET DIR("B")=$SELECT($DATA(DGINPUT(DGN)):DGINPUT(DGN),$GET(DGOLD(DGN))]"":DGOLD(DGN),1:"")
+24 IF DGN=FCOUNTY
Begin DoDot:2
+25 SET DIR(0)="POA^DIC(5,"_$PIECE(DGINPUT(FSTATE),U)_",1,:AEMQ"
+26 SET DIR("A")=CNTYFLD_": "
+27 ; we can't prompt if there's no previous entry
+28 IF $DATA(DGOLD(DGN))
SET T=$LENGTH(DGOLD(DGN)," ")
SET DIR("B")=$PIECE($GET(DGOLD(DGN))," ",1,T-1)
End DoDot:2
+29 DO ^DIR
+30 IF $DATA(DTOUT)
SET POP=1
SET SUCCESS=0
QUIT
+31 IF $DATA(DIRUT)
SET MSG=""
SET REVERSE=0
DO ANSW(X,.DGOLD,DGN,.MSG,.Y,.REP,$GET(RET),.REVERSE)
if REP
SET SUCCESS=0
if MSG]""
WRITE !,MSG
+32 IF REVERSE
SET (REP,SUCCESS)=0
+33 SET POP=1
End DoDot:1
if POP
QUIT
+34 QUIT SUCCESS
+35 ;
SAVE(DGINPUT,DFN,FSTR,CNTRY) ;Save changes
+1 NEW DATA,DGENDA,L,T,FILE,ERROR,LOOP,LOOP1,LOOP2
+2 SET DGENDA=DFN
SET FILE=2
+3 ; need to get the country code into the DGINPUT array
+4 SET DGINPUT(FCNTRY)=$ORDER(^HL(779.004,"B",CNTRY,""))
+5 SET FSTR=FSTR_","_FCNTRY
+6 ;DG*5.3*851
IF (TYPE="TEMP")!(TYPE="CONF")
SET FSTR=FSTR_","_FCITY_","_FSTATE_","_FCOUNTY
+7 ;DG*5.3*1127 - Store the override key returned from the address validation
IF (TYPE="CONF")
SET DGINPUT(.141201)=DGOVERKEY
SET FSTR=FSTR_","_.141201
+8 FOR L=1:1:$LENGTH(FSTR,",")
SET T=$PIECE(FSTR,",",L)
SET DATA(T)=$PIECE($GET(DGINPUT(T)),U)
+9 ;JAM; Set the CASS field for Temp and Confidential; DG*5.3*941
+10 IF TYPE="TEMP"
SET DATA(.12115)="NC"
+11 IF TYPE="CONF"
SET DATA(.14117)="NC"
+12 QUIT $$UPD^DGENDBS(FILE,.DGENDA,.DATA,.ERROR)
+13 ;
ANSW(YIN,DGOLD,DGN,MSG,YOUT,REP,RET,REVERSE) ;analyze input commands
+1 ; This API will process reads and set bits, messages and flags accordingly.
+2 ; Because there is different behavior depending on prompt and input, the input
+3 ; of each field needs to be evaluated separately at the time of input and before
+4 ; deciding to continue the edit. Input rules are loaded into array RPROC at the
+5 ; beginning of this routine in call to INIT^DGREGTE2.
+6 ;
+7 ; Input
+8 ; N - User input "Y" value
+9 ; DGOLD - Array of current values
+10 ; DGN - Current field
+11 ; MSG - Variable for Text message
+12 ; YOUT - User input ("Y") value
+13 ; REP - Flag to repeat prompt
+14 ; RET - Flag to return success or failure to calling module
+15 ; REVERSE - Flag to revert to first prompt in sequence
+16 ;
+17 ; Output
+18 ; MSG - Text message (for incorrect entries)
+19 ; REP - Repeat current prompt
+20 ; REVERSE - Revert to first prompt in sequence
+21 ;
+22 NEW X,Y,DTOUT,DIRUT,DUOUT,PRMPT,RMSG,TDGN,ACT
+23 NEW OLDVAL,NEWVAL
+24 ;
+25 SET PRMPT=$SELECT(TYPE="TEMP":"TEMPORARY",1:"CONFIDENTIAL")
+26 SET RMSG("LINE")="BUT I NEED AT LEAST ONE LINE OF A "_PRMPT_" ADDRESS"
+27 SET RMSG("REVERSE")="This is a required response."
+28 SET RMSG("REPEAT")="EXIT NOT ALLOWED ??"
+29 SET RMSG("QUES")="??"
+30 SET RMSG("INSTRUCT")=$SELECT(TYPE="TEMP":"TADD^DGLOCK1",TYPE="CONF":"CADD1^DGLOCK3",1:"OK")
+31 SET OLDVAL=$GET(DGOLD(DGN))
SET OLDVAL=$$PROC(OLDVAL)
SET NEWVAL=$$PROC(YIN)
+32 SET TDGN=$SELECT($DATA(RPROC(DGN,OLDVAL,NEWVAL)):DGN,1:"ALL")
+33 IF '$DATA(RPROC(TDGN,OLDVAL,NEWVAL))
SET RPROC(TDGN,OLDVAL,NEWVAL)="OK"
+34 SET ACT=RPROC(TDGN,OLDVAL,NEWVAL)
+35 DO @ACT
+36 QUIT
REVERSE ;
+1 ; DG*5.3*1040; LINE message for NULL "FSLINE1" is moved to REPEAT
+2 ;N MSUB
+3 ;S MSUB=$S(DGN=FSLINE1:"LINE",1:"REVERSE")
+4 ;W !,RMSG(MSUB)
+5 WRITE !,RMSG("REVERSE")
+6 SET REVERSE=1
+7 QUIT
REPEAT ;
+1 ;W !,RMSG("REPEAT")
+2 NEW MSUB
+3 SET MSUB=$SELECT(DGN=FSLINE1:"LINE",1:"REPEAT")
+4 WRITE !,RMSG(MSUB)
+5 SET REP=1
+6 QUIT
OK ;
+1 QUIT
QUES ;
+1 WRITE RMSG("QUES")
+2 SET REP=1
+3 QUIT
CONFIRM ;
+1 IF '$$SURE^DGREGTE2
SET YOUT=DGOLD(DGN)
SET REP=1
QUIT
+2 SET YOUT=YIN
SET REP=0
+3 QUIT
INSTRUCT ;
+1 DO @RMSG("INSTRUCT")
+2 SET REP=1
+3 QUIT
PROC(VAL) ;process the input and return a type of value
+1 ; input
+2 ; VAL - The value to examine
+3 ;
+4 ; output
+5 ; a value type
+6 ; VALUE = input - validation is a separate task and is not done here
+7 ; NULL = NULL input
+8 ; UPCAR = the "^" character
+9 ; DELETE = the "@" character
+10 QUIT $SELECT(VAL="":"NULL",$EXTRACT(VAL)="^":"UPCAR",$EXTRACT(VAL)="@":"DELETE",1:"VALUE")
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
+8 ; DG*5.3*851
ZIPINP(DGINPUT,DFN) ;get ZIP+4 input
+1 NEW DGR,DGX
+2 DO EN^DGREGTZL(.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 SET DGX=DGINPUT(FCOUNTY)
SET DGINPUT(FCOUNTY)=$PIECE(DGX,"^",2)_"^"_$PIECE(DGX,"^",1)
+8 SET DGX=DGINPUT(FSTATE)
SET DGINPUT(FSTATE)=$PIECE(DGX,"^",2)_"^"_$PIECE(DGX,"^",1)
+9 QUIT
SKIP(DGN,DGINPUT,FLG) ; determine whether or not to skip this step
+1 NEW SKIP
+2 SET SKIP=0
+3 IF ($GET(DGINPUT(FSLINE1))="")&((DGN=FSLINE2)!(DGN=FSLINE3))
SET SKIP=1
+4 IF ($GET(DGINPUT(FSLINE2))="")&(DGN=FSLINE3)
SET SKIP=1
+5 IF ($GET(FLG(1))'=1)&((DGN=FPHONE))
SET SKIP=1
+6 QUIT SKIP
UPCT ;Indicate "^" or "^^" are unacceptable inputs.
+1 WRITE !,"EXIT NOT ALLOWED ??"
+2 QUIT
+3 ;
+4 ; DG*5.3*1014;jam; Added these tags to display the address prior to calling the Validation service
DISPUS(DGCMP,DGM) ;tag to display US data
+1 NEW DGCNTRY
+2 ; "AddressLine1,AddressLine2,AddressLine3,City,State,County,Zip,Province,PostalCode^Country"
+3 ; ".1411,.1412,.1413,.1414,.1415,.14111,.1416,.14114,.14115,.14116" ; Confidential address fields
+4 WRITE !,?2,"[",DGM," CONFIDENTIAL ADDRESS]"
+5 WRITE !?16,$GET(DGCMP(DGM,.1411))
+6 IF $GET(DGCMP(DGM,.1412))'=""
WRITE !,?16,$GET(DGCMP(DGM,.1412))
+7 IF $GET(DGCMP(DGM,.1413))'=""
WRITE !,?16,$GET(DGCMP(DGM,.1413))
+8 WRITE !,?16,$GET(DGCMP(DGM,.1414))
+9 if ($GET(DGCMP(DGM,.1414))'="")!($PIECE($GET(DGCMP(DGM,.1415)),U,2)'="")
WRITE ","
+10 WRITE $PIECE($GET(DGCMP(DGM,.1415)),U,2)
+11 WRITE " ",$GET(DGCMP(DGM,.1416))
+12 SET DGCNTRY=$$CNTRYI^DGADDUTL($PIECE($GET(DGCMP(DGM,.14116)),U))
+13 IF DGCNTRY]""
IF (DGCNTRY'=-1)
WRITE !?16,DGCNTRY
+14 IF $PIECE($GET(DGCMP(DGM,.14111)),U)'=""
WRITE !,?6," County: ",$PIECE($GET(DGCMP(DGM,.14111)),U,2)
+15 WRITE !
+16 QUIT
+17 ;
DISPFGN(DGCMP,DGM) ;tag to display Foreign data
+1 NEW DGCNTRY
+2 WRITE !,?2,"[",DGM," CONFIDENTIAL ADDRESS]"
+3 WRITE !?16,$GET(DGCMP(DGM,.1411))
+4 IF $GET(DGCMP(DGM,.1412))'=""
WRITE !,?16,$GET(DGCMP(DGM,.1412))
+5 IF $GET(DGCMP(DGM,.1413))'=""
WRITE !,?16,$GET(DGCMP(DGM,.1413))
+6 WRITE !,?16,$GET(DGCMP(DGM,.1414))_" "_$GET(DGCMP(DGM,.14114))_" "_$GET(DGCMP(DGM,.14115))
+7 SET DGCNTRY=$$CNTRYI^DGADDUTL($PIECE($GET(DGCMP(DGM,.14116)),U))
+8 SET DGCNTRY=$SELECT(DGCNTRY="":"UNSPECIFIED COUNTRY",DGCNTRY=-1:"UNKNOWN COUNTRY",1:DGCNTRY)
+9 IF DGCNTRY]""
WRITE !?16,DGCNTRY
+10 WRITE !
+11 QUIT
