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

DGREGTED.m

Go to the documentation of this file. 
  1. DGREGTED ;ALB/BAJ - Temporary & Confidential Address Edits API ; 8/1/08 1:22pm
  1.  ;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
  1. EN(DFN,TYPE,RET) ;Entry point
  1.  ; This routine controls Edits to Temporary & Confidential addresses
  1.  ; 
  1.  ; Input
  1.  ;       DFN  = Patient DFN
  1.  ;       TYPE = Type of address: "TEMP" or "CONF"
  1.  ;       RET  = Flag to signal return to first prompt
  1.  ;       
  1.  ; Output
  1.  ;       RET  0 = Return to first prompt
  1.  ;            1 = Do not return
  1.  ;       
  1.  N DGINPUT,FORGN,FSTR,ICNTRY,CNTRY,PSTR,DGCMP,DGOLD
  1.  N FSLINE1,FSLINE2,FSLINE3,FCITY,FSTATE,FCOUNTY,FZIP,FPHONE
  1.  N FPROV,FPSTAL,FCNTRY,FNODE1,FNODE2,CPEICE,OLDC,RPROC
  1.  N I,X,Y
  1.  I $G(DFN)="" Q
  1.  ;I ($G(DFN)'?.N) Q
  1.  D INIT^DGREGTE2  I $P($G(^DPT(DFN,FNODE1)),U,9)="N" Q
  1.  D GETOLD^DGREGTE2(.DGCMP,DFN,TYPE) M DGOLD=DGCMP("OLD") K DGCMP
  1.  S CNTRY="",ICNTRY=$P($G(^DPT(DFN,FNODE2)),"^",CPEICE) I ICNTRY="" S ICNTRY=1    ;default US if NULL
  1.  S FORGN=$$FOREIGN^DGADDUTL(DFN,ICNTRY,2,FCNTRY,.CNTRY) Q:$G(CNTRY)=""  I FORGN=-1 S RET=0 Q
  1.  S FSTR=$$INPT1^DGREGTE2(DFN,FORGN,.PSTR),DGINPUT=1 D INPUT(.DGINPUT,DFN,FSTR)
  1.  I $G(DGINPUT)=-1 S RET=0 Q
  1.  D SAVE(.DGINPUT,DFN,FSTR,CNTRY)
  1.  Q
  1.  ;
  1. INPUT(DGINPUT,DFN,FSTR) ;Let user input address changes
  1.  ; Input:
  1.  ;       DGINPUT - Array to hold field values DGINPUT(field#)
  1.  ;       DFN     - Patient DFN
  1.  ;       FSTR    - String of fields (foreign or domestic) to work with
  1.  ;       
  1.  ; Output: 
  1.  ;       DGINPUT(field#)=external^internal(if any)
  1.  ; 
  1.  N DIR,X,Y,DA,DGR,DTOUT,DUOUT,DIROUT,DGN,L,SUCCESS,REP
  1.  F L=1:1:$L(FSTR,",") S DGN=$P(FSTR,",",L) Q:DGINPUT=-1  D
  1.  . S REP=0
  1.  . I $$SKIP^DGREGTE2(DGN,.DGINPUT) Q
  1.  . S SUCCESS=$$READ(DFN,.DGOLD,DGN,.Y,.REP) I 'SUCCESS D  Q
  1.  . . I 'REP S DGINPUT=-1 Q
  1.  . . ; repeat the question so we have to set the counter back
  1.  . . S L=L-1
  1.  . S DGINPUT(DGN)=$G(Y)
  1.  Q
  1.  ;
  1. READ(DFN,DGOLD,DGN,Y,REP) ;Read input, return success
  1.  ; Input:
  1.  ;       DFN   - Patient DFN
  1.  ;       DGOLD - Array of current field values.
  1.  ;       DGN   - Current field to read
  1.  ;       Y     - Current Field value
  1.  ;       REP   - Flag -- should prompt be repeated
  1.  ;       
  1.  ; Output
  1.  ;       SUCCESS 1 = Input successful go to next prompt
  1.  ;               0 = Input unsuccessful Repeat or Abort as indicated by REP variable
  1.  ;       REP     1 = Error - Repeat prompt
  1.  ;               0 = Error - Do not repeat
  1.  ;       Y       New field value
  1.  ;       
  1.  N SUCCESS,DIR,DA,DTOUT,DUOUT,DIRUT,DIROUT,X,L,T,POP,DGST,CNTYFLD,REVERSE
  1.  S SUCCESS=1,(POP,REVERSE)=0,CNTYFLD=$S(TYPE="TEMP":"TEMPORARY ADDRESS COUNTY",1:"CONFIDENTIAL ADDRESS COUNTY")
  1.  S DIR(0)=2_","_DGN,DIR("B")=$G(DGOLD(DGN))
  1.  S DA=DFN
  1.  F  D  Q:POP
  1.  . K DTOUT,DUOUT,DIROUT
  1.  . S MSG=""
  1.  . I ($G(DGINPUT(FSTATE))="")&(DGN=FCOUNTY) S POP=1 Q
  1.  . S DIR("B")=$S($D(DGINPUT(DGN)):DGINPUT(DGN),$G(DGOLD(DGN))]"":DGOLD(DGN),1:"")
  1.  . I DGN=FCOUNTY D 
  1.  . . S DIR(0)="POA^DIC(5,"_$P(DGINPUT(FSTATE),U)_",1,:AEMQ"
  1.  . . S DIR("A")=CNTYFLD_": "
  1.  . . ; we can't prompt if there's no previous entry
  1.  . . I $D(DGOLD(DGN)) S T=$L(DGOLD(DGN)," "),DIR("B")=$P($G(DGOLD(DGN))," ",1,T-1)
  1.  . D ^DIR
  1.  . I $D(DTOUT) S POP=1,SUCCESS=0 Q
  1.  . 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
  1.  . I REVERSE S (REP,SUCCESS)=0
  1.  . S POP=1
  1.  Q SUCCESS
  1.  ;
  1. SAVE(DGINPUT,DFN,FSTR,CNTRY) ;Save changes
  1.  N DATA,DGENDA,L,T,FILE,ERROR
  1.  S DGENDA=DFN,FILE=2
  1.  ; need to get the country code into the DGINPUT array
  1.  S DGINPUT(FCNTRY)=$O(^HL(779.004,"B",CNTRY,""))
  1.  S FSTR=FSTR_","_FCNTRY
  1.  F L=1:1:$L(FSTR,",") S T=$P(FSTR,",",L) S DATA(T)=$P($G(DGINPUT(T)),U)
  1.  Q $$UPD^DGENDBS(FILE,.DGENDA,.DATA,.ERROR)
  1.  ;
  1. 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.
  1.  ; Because there is different behavior depending on prompt and input, the input
  1.  ; of each field needs to be evaluated separately at the time of input and before
  1.  ; deciding to continue the edit.  Input rules are loaded into array RPROC at the
  1.  ; beginning of this routine in call to INIT^DGREGTE2.
  1.  ; 
  1.  ; Input
  1.  ;       N       - User input "Y" value
  1.  ;       DGOLD   - Array of current values
  1.  ;       DGN     - Current field
  1.  ;       MSG     - Variable for Text message
  1.  ;       YOUT    - User input ("Y") value
  1.  ;       REP     - Flag to repeat prompt
  1.  ;       RET     - Flag to return success or failure to calling module
  1.  ;       REVERSE - Flag to revert to first prompt in sequence
  1.  ; 
  1.  ; Output
  1.  ;       MSG     - Text message (for incorrect entries)
  1.  ;       REP     - Repeat current prompt
  1.  ;       REVERSE - Revert to first prompt in sequence
  1.  ; 
  1.  N X,Y,DTOUT,DIRUT,DUOUT,PRMPT,RMSG,TDGN,ACT
  1.  N OLDVAL,NEWVAL
  1.  ;
  1.  S PRMPT=$S(TYPE="TEMP":"TEMPORARY",1:"CONFIDENTIAL")
  1.  S RMSG("LINE")="BUT I NEED AT LEAST ONE LINE OF A "_PRMPT_" ADDRESS"
  1.  S RMSG("REVERSE")="This is a required response."
  1.  S RMSG("REPEAT")="EXIT NOT ALLOWED ??"
  1.  S RMSG("QUES")="??"
  1.  S RMSG("INSTRUCT")=$S(TYPE="TEMP":"TADD^DGLOCK1",TYPE="CONF":"CADD1^DGLOCK3",1:"OK")
  1.  S OLDVAL=$G(DGOLD(DGN)),OLDVAL=$$PROC(OLDVAL),NEWVAL=$$PROC(YIN)
  1.  S TDGN=$S($D(RPROC(DGN,OLDVAL,NEWVAL)):DGN,1:"ALL")
  1.  I '$D(RPROC(TDGN,OLDVAL,NEWVAL)) S RPROC(TDGN,OLDVAL,NEWVAL)="OK"
  1.  S ACT=RPROC(TDGN,OLDVAL,NEWVAL)
  1.  D @ACT
  1.  Q
  1. REVERSE ;
  1.  N MSUB
  1.  S MSUB=$S(DGN=FSLINE1:"LINE",1:"REVERSE")
  1.  W !,RMSG(MSUB)
  1.  S REVERSE=1
  1.  Q
  1. REPEAT ;
  1.  W !,RMSG("REPEAT")
  1.  S REP=1
  1.  Q
  1. OK ;
  1.  Q
  1. QUES ;
  1.  W RMSG("QUES")
  1.  S REP=1
  1.  Q
  1. CONFIRM ;
  1.  I '$$SURE^DGREGTE2 S YOUT=DGOLD(DGN),REP=1 Q
  1.  S YOUT=YIN,REP=0
  1.  Q
  1. INSTRUCT ;
  1.  D @RMSG("INSTRUCT")
  1.  S REP=1
  1.  Q
  1. PROC(VAL) ;process the input and return a type of value
  1.  ; input
  1.  ;   VAL - The value to examine
  1.  ;       
  1.  ; output
  1.  ;   a value type
  1.  ;     VALUE  = input - validation is a separate task and is not done here
  1.  ;     NULL   = NULL input
  1.  ;     UPCAR  = the "^" character
  1.  ;     DELETE = the "@" character
  1.  Q $S(VAL="":"NULL",$E(VAL)="^":"UPCAR",$E(VAL)="@":"DELETE",1:"VALUE")
  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.  Q