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.
DGREGTED ;ALB/BAJ,BDB,JAM - Temporary & Confidential Address Edits API ;23 May 2017  12:48 PM
 ;;5.3;Registration;**688,851,941,1014,1040**;Aug 13, 1993;Build 15
 ;
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
 S DGADVRET=$$EN^DGADDVAL(.DGINPUT,"C")
 ; 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
 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