DGREGTED ;ALB/BAJ - Temporary & Confidential Address Edits API ; 8/1/08 1:22pm
;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
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
; 1 = Do not return
;
N DGINPUT,FORGN,FSTR,ICNTRY,CNTRY,PSTR,DGCMP,DGOLD
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
S FORGN=$$FOREIGN^DGADDUTL(DFN,ICNTRY,2,FCNTRY,.CNTRY) Q:$G(CNTRY)="" I FORGN=-1 S RET=0 Q
S FSTR=$$INPT1^DGREGTE2(DFN,FORGN,.PSTR),DGINPUT=1 D INPUT(.DGINPUT,DFN,FSTR)
I $G(DGINPUT)=-1 S RET=0 Q
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
. S SUCCESS=$$READ(DFN,.DGOLD,DGN,.Y,.REP) I 'SUCCESS D Q
. . I 'REP S DGINPUT=-1 Q
. . ; repeat the question so we have to set the counter back
. . S L=L-1
. S DGINPUT(DGN)=$G(Y)
Q
;
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
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
F L=1:1:$L(FSTR,",") S T=$P(FSTR,",",L) S DATA(T)=$P($G(DGINPUT(T)),U)
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 ;
N MSUB
S MSUB=$S(DGN=FSLINE1:"LINE",1:"REVERSE")
W !,RMSG(MSUB)
S REVERSE=1
Q
REPEAT ;
W !,RMSG("REPEAT")
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
Q
DGREGTED ;ALB/BAJ - Temporary & Confidential Address Edits API ; 8/1/08 1:22pm
+1 ;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
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
+10 ; 1 = Do not return
+11 ;
+12 NEW DGINPUT,FORGN,FSTR,ICNTRY,CNTRY,PSTR,DGCMP,DGOLD
+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 SET FORGN=$$FOREIGN^DGADDUTL(DFN,ICNTRY,2,FCNTRY,.CNTRY)
IF $GET(CNTRY)=""
QUIT
IF FORGN=-1
SET RET=0
QUIT
+22 SET FSTR=$$INPT1^DGREGTE2(DFN,FORGN,.PSTR)
SET DGINPUT=1
DO INPUT(.DGINPUT,DFN,FSTR)
+23 IF $GET(DGINPUT)=-1
SET RET=0
QUIT
+24 DO SAVE(.DGINPUT,DFN,FSTR,CNTRY)
+25 QUIT
+26 ;
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 SET SUCCESS=$$READ(DFN,.DGOLD,DGN,.Y,.REP)
IF 'SUCCESS
Begin DoDot:2
+14 IF 'REP
SET DGINPUT=-1
QUIT
+15 ; repeat the question so we have to set the counter back
+16 SET L=L-1
End DoDot:2
QUIT
+17 SET DGINPUT(DGN)=$GET(Y)
End DoDot:1
+18 QUIT
+19 ;
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
+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 FOR L=1:1:$LENGTH(FSTR,",")
SET T=$PIECE(FSTR,",",L)
SET DATA(T)=$PIECE($GET(DGINPUT(T)),U)
+7 QUIT $$UPD^DGENDBS(FILE,.DGENDA,.DATA,.ERROR)
+8 ;
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 NEW MSUB
+2 SET MSUB=$SELECT(DGN=FSLINE1:"LINE",1:"REVERSE")
+3 WRITE !,RMSG(MSUB)
+4 SET REVERSE=1
+5 QUIT
REPEAT ;
+1 WRITE !,RMSG("REPEAT")
+2 SET REP=1
+3 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 QUIT
