RCDPEUPO ;ALBANY/KML - Unposted EFT Override ; 6/10/19 12:30pm
;;4.5;Accounts Receivable;**298,332,349**;Mar 20, 1995;Build 44
;Per VA Directive 6402, this routine should not be modified.
Q
;
; prca*4.5*298 - procedures built to implement the Unposted EFT Override option
;
EN ; Display warning message when aged, unposted EFTs exist
N MSG
D OWNSKEY^XUSRB(.MSG,"RCDPE AGED PMT",DUZ)
I 'MSG(0) D NOENTRY Q
N AGEDEFTS
S AGEDEFTS=$$GETEFTS^RCDPEWLP("A",1) ; need to examine both medical and pharmacy EFTs
D DMSGS(AGEDEFTS)
Q
;
DMSGS(CODES) ; display warning/error messages (if any)
; Input: CODES
; 1P - error condition for aged, unposted Pharmacy EFTs
; 2P - warning condition for aged,unposted Pharmacy EFTs
; 3P - Override exists for aged, unposted pharmacy EFTs
; 1M - error condition for aged, unposted Medical EFTs
; 2M - warning condition for aged, unposted Medical EFTs
; 3M - Override exists for aged, unposted Medical EFTs
; 1T - error condition for aged, unposted Tricare EFTs
; 2T - warning condition for aged, unposted Tricare EFTs
; 3T - Override exists for aged, unposted Tricare EFTs
; 0 - no error or warning conditions
; possible values:
; "1P" or "2P" or "3P" or "1M" or "2M" or "3M" or "1P^1M" or "1P^2M" or
; "1P^3M" or "2P^1M" or "2P^2M" or "2P^3M" or "3P^1M" or "3P^2M" or "3P^3M"
I 'CODES D NONE Q
N DAYSLIMT,DIR,ERROR,I,LN,MSGTXT,OVERRIDE,S1,S2,STATE,TYPE,X,Y
S (OVERRIDE,ERROR)=0
S DIR("A",1)="Current Warning and/or Error messages for Unposted EFTs:"
S DIR("A",2)=" ",LN=2
F I=1:1 S STATE=$P(CODES,U,I) Q:STATE="" D
. S S1=$E(STATE,1),S2=$E(STATE,2)
. I S1=1 D ; 1 = ERROR
.. S ERROR=1,TYPE=$G(TYPE)_S2
.. ; Number of days an EFT can age before post prevention rules apply
.. S DAYSLIMT=$$GET1^DIQ(344.61,1,$S(S2="M":.06,S2="P":.07,1:.13))
.. S LN=LN+1
.. S DIR("A",LN)="ERROR: Unposted "_$S(S2="P":"pharmacy ",S2="M":"medical ",1:"TRICARE ")
.. S DIR("A",LN)=DIR("A",LN)_"EFTs exist that are more than "_DAYSLIMT_" days old."
.. S LN=LN+1,DIR("A",LN)="Scratchpad creation is not allowed for newer payments."
.. S LN=LN+1,DIR("A",LN)=" "
. I S1=2 D ; 2 = warning
.. S LN=LN+1
.. S DIR("A",LN)="WARNING: Unposted "_$S(S2="P":"pharmacy ",S2="M":"medical ",1:"TRICARE ")
.. S DIR("A",LN)=DIR("A",LN)_"EFTs exist that are more than "
.. S DIR("A",LN)=DIR("A",LN)_$S(S2="P":21,1:14)_" days old."
.. S LN=LN+1,DIR("A",LN)=" "
. I S1=3 D ; OVERRIDE
.. S OVERRIDE=OVERRIDE+1
.. S LN=LN+1,DIR("A",LN)="An Override for "_$S(S2="P":"pharmacy ",S2="M":"medical ",1:"TRICARE ")
.. S DIR("A",LN)=DIR("A",LN)_"is already in place."
.. S LN=LN+1,DIR("A",LN)=" "
I OVERRIDE=3 D Q
. S DIR(0)="EA",DIR("A")="Press ENTER to continue: "
. D ^DIR
I ERROR D
. M MSGTXT=DIR("A")
. S DIR(0)="YA"
. S LN=LN+1,DIR("A",LN)="An override will allow unrestricted scratchpad creation for one day."
. S DIR("A")="Do you want to continue (Y/N)? "
. D ^DIR
. Q:'Y
. S OVERRIDE=$$OVERRIDE(TYPE,.MSGTXT)
. I OVERRIDE D MAIL(.MSGTXT)
I 'ERROR D
. S LN=LN+1,DIR("A",LN)="There are no error conditions to override."
. S LN=LN+1,DIR("A",LN)=" ",DIR("A")="Press ENTER to continue: "
. S DIR(0)="EA" D ^DIR
Q
;
OVERRIDE(TYPE,TEXT) ; when ERROR state exists, perform the Override
; Input: TYPE - "M" Medical
; "P" Phamacy
; "T" - Tricare
; Any combination of above flags
; TEXT - Warning and/or error statements; passed by reference
; Output: TEXT - Additional text to be displayed with warning and/or error statements
; contents of TEXT array will be in the body of the mail message
; (refer to MAIL tag)
; Returns: DONE - 1 - OVERRIDE was performed; 0 - Override was not performed
;
N DIR,DIRUT,DONE,DTTM,DUOUT,IENS,RCDFDA,REASON,X1,XX,Y
L +^RCY(344.61,1,0):DILOCKTM E D NOLOCK S DONE=0 G OVERQ
S DONE=1
I TYPE="P"!(TYPE="M")!(TYPE="T") D
. S DIR(0)="EA",DIR("A",1)="An Override now exists for posting "
. S DIR("A",1)=DIR("A",1)_$S(TYPE="P":"pharmacy ",TYPE="M":"medical ",1:"TRICARE ")_"payments."
. S DIR("A",2)=" "
. S DIR("A")="Press ENTER to continue: "
. D ^DIR
I $L(TYPE)>1 D I 'DONE G OVERQ
. S DIR(0)="SA^"
. S:TYPE["M" DIR(0)=DIR(0)_"M:Medical;"
. S:TYPE["P" DIR(0)=DIR(0)_"P:Pharmacy;"
. S:TYPE["T" DIR(0)=DIR(0)_"T:TRICARE;"
. I $L(TYPE)=3 S DIR("A")="Override for (M)edical, (P)harmacy or (T)RICARE? "
. E D
. . S DIR("A")="Override for "
. . I (TYPE="PM")!(TYPE="MP") S DIR("A")=DIR("A")_"(M)edical or (P)harmacy? "
. . E I (TYPE="PT")!(TYPE="TP") S DIR("A")=DIR("A")_"(P)harmacy or (T)RICARE? "
. . E S DIR("A")=DIR("A")_"(M)edical or (T)RICARE? "
. D ^DIR
. I $D(DUOUT)!($D(DIRUT)) S DONE=0 Q
. S TYPE=Y
W !
K DIR
S DIR("A")="Reason for Override: ",DIR(0)="FA^1:50"
D ^DIR
I $D(DUOUT)!($D(DIRUT)) D G OVERQ
. S DONE=0
. W !!," Need to enter a reason for Override.",!," Override not performed.",!
S REASON=Y,DTTM=$$NOW^XLFDT
S RCDFDA(344.61,"1,",$S(TYPE="M":20,TYPE="P":21,1:26))=DTTM
S RCDFDA(344.61,"1,",$S(TYPE="M":22,TYPE="P":23,1:27))=DUZ
S RCDFDA(344.61,"1,",$S(TYPE="M":24,TYPE="P":25,1:28))=REASON
D FILE^DIE("","RCDFDA")
;
; PRCA*4.5*349 - File override into Override history
K RCDFDA
S XX=$S(TYPE="M":.06,TYPE="P":.07,1:.13)
S XX=$$GET1^DIQ(344.61,"1,",XX,"I")
S IENS="+1,1,"
S RCDFDA(344.612,IENS,.01)=$P(DTTM,".")
S RCDFDA(344.612,IENS,.02)=DUZ
S RCDFDA(344.612,IENS,.03)=REASON
S RCDFDA(344.612,IENS,.04)=TYPE
S RCDFDA(344.612,IENS,.05)=XX
D UPDATE^DIE("","RCDFDA")
;
S X1="" S X1=$O(TEXT(X1),-1)
S X1=X1+1
S TEXT(X1)=$S(TYPE="M":"Medical ",TYPE="P":"Pharmacy ",1:"TRICARE ")_"Override Details"
S X1=X1+1
S TEXT(X1)="User: "_$P($G(^VA(200,DUZ,0)),"^") S X1=X1+1
S TEXT(X1)="Date/Time: "_DTTM
S TEXT(X1)="Reason for Override: "_REASON
OVERQ ;
L -^RCY(344.61,1,0)
Q DONE
;
MAIL(TEXT) ;generate mail message when OVERRIDE is implemented
; Input: TEXT - Lines of text that represent the body of the mail message
;
N ARRAY,CNT,CNT1,GLB,RCPROG1,SBJ,SUB
S RCPROG1="RCDUPEO",GLB=$NA(^TMP(RCPROG1,$J,"XMTEXT"))
;
;Build header
S SUB="EFT" K @GLB
S SBJ="EDI LBOX-STA# "_$P($$SITE^VASITE,"^",3)_"-Unposted EFTs Override "_$$FMTE^XLFDT($$NOW^XLFDT)
M @GLB=TEXT
N XMDUZ,XMINSTR,XMSUB,XMTEXT,XMY
S XMDUZ=DUZ,XMTEXT=GLB,XMSUB=SBJ,XMY("I:G.RCDPE AUDIT")=""
S XMINSTR("FROM")="POSTMASTER"
S XMINSTR("FLAGS")="P"
D SENDMSG^XMXAPI(XMDUZ,XMSUB,XMTEXT,.XMY,.XMINSTR)
Q
;
CHECK(TYPE,OVERRIDE) ; Determine if override exists for today's date
; Input: TYPE - "M" for medical, "P" for Pharmacy or "T" for Tricare
; OVERRIDE - Passed by reference; array to hold the OVERRIDE data
; Output: OVERRIDE - Returned array holding existing OVERRIDE data
K OVERRIDE
;
; Get MEDICAL EFT OVERRIDE (344.61, 20), PHARMACY EFT OVERRIDE (344.61, 21) or
; TRICARE EFT OVERRIDE (344.61, 20) date dependent on type of EFTs
S OVERRIDE(TYPE)=+$$GET1^DIQ(344.61,1,$S(TYPE="M":20,TYPE="P":21,1:26),"I")
I 'OVERRIDE(TYPE) K OVERRIDE(TYPE) S OVERRIDE=0 Q
;
; Override does not exist for 'TODAYS' date, post prevention rules will apply
I $P(OVERRIDE(TYPE),".")'=DT K OVERRIDE(TYPE) S OVERRIDE=0 Q
S OVERRIDE=1
Q
;
NONE ; the system does not have any aged, unposted EFTs
N DIR
S DIR(0)="EA"
S DIR("A",1)="The sytem does not have any aged, unposted EFTs."
S DIR("A",2)="Therefore, no error conditions to override."
S DIR("A",3)=" "
S DIR("A")="Press ENTER to continue: "
D ^DIR
Q
;
NOACTION ; OVERRIDE already exists
; Input: TYPE - "M" for medical, "P" for Pharmacy or "T" for Tricare
N DIR
S DIR(0)="EA"
S DIR("A",1)="An Override for "_$S(TYPE="P":"pharmacy ",TYPE="M":"medical ",1:"TRICARE ")
S DIR("A",1)=DIR("A",1)_"is already in place."
S DIR("A",2)="No action needed"
S DIR("A",3)=" "
S DIR("A")="Press ENTER to continue: "
D ^DIR
Q
;
NOENTRY ; user is not authorized to use the option
N DIR
S DIR(0)="EA"
S DIR("A",1)="You are not authorized to use this option."
S DIR("A",2)="This option is locked with RCDPE AGED PMT key."
S DIR("A",3)=" "
S DIR("A")="Press ENTER to continue: "
D ^DIR
Q
;
NOLOCK ; entry at 344.61 cannot be locked
N DIR
S DIR(0)="EA"
S DIR("A",1)="Another user is editing the Override Parameters."
S DIR("A",2)="Try again later."
S DIR("A",3)=" "
S DIR("A")="Press ENTER to continue: "
D ^DIR
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEUPO 8614 printed Dec 13, 2024@01:45:35 Page 2
RCDPEUPO ;ALBANY/KML - Unposted EFT Override ; 6/10/19 12:30pm
+1 ;;4.5;Accounts Receivable;**298,332,349**;Mar 20, 1995;Build 44
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
+5 ; prca*4.5*298 - procedures built to implement the Unposted EFT Override option
+6 ;
EN ; Display warning message when aged, unposted EFTs exist
+1 NEW MSG
+2 DO OWNSKEY^XUSRB(.MSG,"RCDPE AGED PMT",DUZ)
+3 IF 'MSG(0)
DO NOENTRY
QUIT
+4 NEW AGEDEFTS
+5 ; need to examine both medical and pharmacy EFTs
SET AGEDEFTS=$$GETEFTS^RCDPEWLP("A",1)
+6 DO DMSGS(AGEDEFTS)
+7 QUIT
+8 ;
DMSGS(CODES) ; display warning/error messages (if any)
+1 ; Input: CODES
+2 ; 1P - error condition for aged, unposted Pharmacy EFTs
+3 ; 2P - warning condition for aged,unposted Pharmacy EFTs
+4 ; 3P - Override exists for aged, unposted pharmacy EFTs
+5 ; 1M - error condition for aged, unposted Medical EFTs
+6 ; 2M - warning condition for aged, unposted Medical EFTs
+7 ; 3M - Override exists for aged, unposted Medical EFTs
+8 ; 1T - error condition for aged, unposted Tricare EFTs
+9 ; 2T - warning condition for aged, unposted Tricare EFTs
+10 ; 3T - Override exists for aged, unposted Tricare EFTs
+11 ; 0 - no error or warning conditions
+12 ; possible values:
+13 ; "1P" or "2P" or "3P" or "1M" or "2M" or "3M" or "1P^1M" or "1P^2M" or
+14 ; "1P^3M" or "2P^1M" or "2P^2M" or "2P^3M" or "3P^1M" or "3P^2M" or "3P^3M"
+15 IF 'CODES
DO NONE
QUIT
+16 NEW DAYSLIMT,DIR,ERROR,I,LN,MSGTXT,OVERRIDE,S1,S2,STATE,TYPE,X,Y
+17 SET (OVERRIDE,ERROR)=0
+18 SET DIR("A",1)="Current Warning and/or Error messages for Unposted EFTs:"
+19 SET DIR("A",2)=" "
SET LN=2
+20 FOR I=1:1
SET STATE=$PIECE(CODES,U,I)
if STATE=""
QUIT
Begin DoDot:1
+21 SET S1=$EXTRACT(STATE,1)
SET S2=$EXTRACT(STATE,2)
+22 ; 1 = ERROR
IF S1=1
Begin DoDot:2
+23 SET ERROR=1
SET TYPE=$GET(TYPE)_S2
+24 ; Number of days an EFT can age before post prevention rules apply
+25 SET DAYSLIMT=$$GET1^DIQ(344.61,1,$SELECT(S2="M":.06,S2="P":.07,1:.13))
+26 SET LN=LN+1
+27 SET DIR("A",LN)="ERROR: Unposted "_$SELECT(S2="P":"pharmacy ",S2="M":"medical ",1:"TRICARE ")
+28 SET DIR("A",LN)=DIR("A",LN)_"EFTs exist that are more than "_DAYSLIMT_" days old."
+29 SET LN=LN+1
SET DIR("A",LN)="Scratchpad creation is not allowed for newer payments."
+30 SET LN=LN+1
SET DIR("A",LN)=" "
End DoDot:2
+31 ; 2 = warning
IF S1=2
Begin DoDot:2
+32 SET LN=LN+1
+33 SET DIR("A",LN)="WARNING: Unposted "_$SELECT(S2="P":"pharmacy ",S2="M":"medical ",1:"TRICARE ")
+34 SET DIR("A",LN)=DIR("A",LN)_"EFTs exist that are more than "
+35 SET DIR("A",LN)=DIR("A",LN)_$SELECT(S2="P":21,1:14)_" days old."
+36 SET LN=LN+1
SET DIR("A",LN)=" "
End DoDot:2
+37 ; OVERRIDE
IF S1=3
Begin DoDot:2
+38 SET OVERRIDE=OVERRIDE+1
+39 SET LN=LN+1
SET DIR("A",LN)="An Override for "_$SELECT(S2="P":"pharmacy ",S2="M":"medical ",1:"TRICARE ")
+40 SET DIR("A",LN)=DIR("A",LN)_"is already in place."
+41 SET LN=LN+1
SET DIR("A",LN)=" "
End DoDot:2
End DoDot:1
+42 IF OVERRIDE=3
Begin DoDot:1
+43 SET DIR(0)="EA"
SET DIR("A")="Press ENTER to continue: "
+44 DO ^DIR
End DoDot:1
QUIT
+45 IF ERROR
Begin DoDot:1
+46 MERGE MSGTXT=DIR("A")
+47 SET DIR(0)="YA"
+48 SET LN=LN+1
SET DIR("A",LN)="An override will allow unrestricted scratchpad creation for one day."
+49 SET DIR("A")="Do you want to continue (Y/N)? "
+50 DO ^DIR
+51 if 'Y
QUIT
+52 SET OVERRIDE=$$OVERRIDE(TYPE,.MSGTXT)
+53 IF OVERRIDE
DO MAIL(.MSGTXT)
End DoDot:1
+54 IF 'ERROR
Begin DoDot:1
+55 SET LN=LN+1
SET DIR("A",LN)="There are no error conditions to override."
+56 SET LN=LN+1
SET DIR("A",LN)=" "
SET DIR("A")="Press ENTER to continue: "
+57 SET DIR(0)="EA"
DO ^DIR
End DoDot:1
+58 QUIT
+59 ;
OVERRIDE(TYPE,TEXT) ; when ERROR state exists, perform the Override
+1 ; Input: TYPE - "M" Medical
+2 ; "P" Phamacy
+3 ; "T" - Tricare
+4 ; Any combination of above flags
+5 ; TEXT - Warning and/or error statements; passed by reference
+6 ; Output: TEXT - Additional text to be displayed with warning and/or error statements
+7 ; contents of TEXT array will be in the body of the mail message
+8 ; (refer to MAIL tag)
+9 ; Returns: DONE - 1 - OVERRIDE was performed; 0 - Override was not performed
+10 ;
+11 NEW DIR,DIRUT,DONE,DTTM,DUOUT,IENS,RCDFDA,REASON,X1,XX,Y
+12 LOCK +^RCY(344.61,1,0):DILOCKTM
IF '$TEST
DO NOLOCK
SET DONE=0
GOTO OVERQ
+13 SET DONE=1
+14 IF TYPE="P"!(TYPE="M")!(TYPE="T")
Begin DoDot:1
+15 SET DIR(0)="EA"
SET DIR("A",1)="An Override now exists for posting "
+16 SET DIR("A",1)=DIR("A",1)_$SELECT(TYPE="P":"pharmacy ",TYPE="M":"medical ",1:"TRICARE ")_"payments."
+17 SET DIR("A",2)=" "
+18 SET DIR("A")="Press ENTER to continue: "
+19 DO ^DIR
End DoDot:1
+20 IF $LENGTH(TYPE)>1
Begin DoDot:1
+21 SET DIR(0)="SA^"
+22 if TYPE["M"
SET DIR(0)=DIR(0)_"M:Medical;"
+23 if TYPE["P"
SET DIR(0)=DIR(0)_"P:Pharmacy;"
+24 if TYPE["T"
SET DIR(0)=DIR(0)_"T:TRICARE;"
+25 IF $LENGTH(TYPE)=3
SET DIR("A")="Override for (M)edical, (P)harmacy or (T)RICARE? "
+26 IF '$TEST
Begin DoDot:2
+27 SET DIR("A")="Override for "
+28 IF (TYPE="PM")!(TYPE="MP")
SET DIR("A")=DIR("A")_"(M)edical or (P)harmacy? "
+29 IF '$TEST
IF (TYPE="PT")!(TYPE="TP")
SET DIR("A")=DIR("A")_"(P)harmacy or (T)RICARE? "
+30 IF '$TEST
SET DIR("A")=DIR("A")_"(M)edical or (T)RICARE? "
End DoDot:2
+31 DO ^DIR
+32 IF $DATA(DUOUT)!($DATA(DIRUT))
SET DONE=0
QUIT
+33 SET TYPE=Y
End DoDot:1
IF 'DONE
GOTO OVERQ
+34 WRITE !
+35 KILL DIR
+36 SET DIR("A")="Reason for Override: "
SET DIR(0)="FA^1:50"
+37 DO ^DIR
+38 IF $DATA(DUOUT)!($DATA(DIRUT))
Begin DoDot:1
+39 SET DONE=0
+40 WRITE !!," Need to enter a reason for Override.",!," Override not performed.",!
End DoDot:1
GOTO OVERQ
+41 SET REASON=Y
SET DTTM=$$NOW^XLFDT
+42 SET RCDFDA(344.61,"1,",$SELECT(TYPE="M":20,TYPE="P":21,1:26))=DTTM
+43 SET RCDFDA(344.61,"1,",$SELECT(TYPE="M":22,TYPE="P":23,1:27))=DUZ
+44 SET RCDFDA(344.61,"1,",$SELECT(TYPE="M":24,TYPE="P":25,1:28))=REASON
+45 DO FILE^DIE("","RCDFDA")
+46 ;
+47 ; PRCA*4.5*349 - File override into Override history
+48 KILL RCDFDA
+49 SET XX=$SELECT(TYPE="M":.06,TYPE="P":.07,1:.13)
+50 SET XX=$$GET1^DIQ(344.61,"1,",XX,"I")
+51 SET IENS="+1,1,"
+52 SET RCDFDA(344.612,IENS,.01)=$PIECE(DTTM,".")
+53 SET RCDFDA(344.612,IENS,.02)=DUZ
+54 SET RCDFDA(344.612,IENS,.03)=REASON
+55 SET RCDFDA(344.612,IENS,.04)=TYPE
+56 SET RCDFDA(344.612,IENS,.05)=XX
+57 DO UPDATE^DIE("","RCDFDA")
+58 ;
+59 SET X1=""
SET X1=$ORDER(TEXT(X1),-1)
+60 SET X1=X1+1
+61 SET TEXT(X1)=$SELECT(TYPE="M":"Medical ",TYPE="P":"Pharmacy ",1:"TRICARE ")_"Override Details"
+62 SET X1=X1+1
+63 SET TEXT(X1)="User: "_$PIECE($GET(^VA(200,DUZ,0)),"^")
SET X1=X1+1
+64 SET TEXT(X1)="Date/Time: "_DTTM
+65 SET TEXT(X1)="Reason for Override: "_REASON
OVERQ ;
+1 LOCK -^RCY(344.61,1,0)
+2 QUIT DONE
+3 ;
MAIL(TEXT) ;generate mail message when OVERRIDE is implemented
+1 ; Input: TEXT - Lines of text that represent the body of the mail message
+2 ;
+3 NEW ARRAY,CNT,CNT1,GLB,RCPROG1,SBJ,SUB
+4 SET RCPROG1="RCDUPEO"
SET GLB=$NAME(^TMP(RCPROG1,$JOB,"XMTEXT"))
+5 ;
+6 ;Build header
+7 SET SUB="EFT"
KILL @GLB
+8 SET SBJ="EDI LBOX-STA# "_$PIECE($$SITE^VASITE,"^",3)_"-Unposted EFTs Override "_$$FMTE^XLFDT($$NOW^XLFDT)
+9 MERGE @GLB=TEXT
+10 NEW XMDUZ,XMINSTR,XMSUB,XMTEXT,XMY
+11 SET XMDUZ=DUZ
SET XMTEXT=GLB
SET XMSUB=SBJ
SET XMY("I:G.RCDPE AUDIT")=""
+12 SET XMINSTR("FROM")="POSTMASTER"
+13 SET XMINSTR("FLAGS")="P"
+14 DO SENDMSG^XMXAPI(XMDUZ,XMSUB,XMTEXT,.XMY,.XMINSTR)
+15 QUIT
+16 ;
CHECK(TYPE,OVERRIDE) ; Determine if override exists for today's date
+1 ; Input: TYPE - "M" for medical, "P" for Pharmacy or "T" for Tricare
+2 ; OVERRIDE - Passed by reference; array to hold the OVERRIDE data
+3 ; Output: OVERRIDE - Returned array holding existing OVERRIDE data
+4 KILL OVERRIDE
+5 ;
+6 ; Get MEDICAL EFT OVERRIDE (344.61, 20), PHARMACY EFT OVERRIDE (344.61, 21) or
+7 ; TRICARE EFT OVERRIDE (344.61, 20) date dependent on type of EFTs
+8 SET OVERRIDE(TYPE)=+$$GET1^DIQ(344.61,1,$SELECT(TYPE="M":20,TYPE="P":21,1:26),"I")
+9 IF 'OVERRIDE(TYPE)
KILL OVERRIDE(TYPE)
SET OVERRIDE=0
QUIT
+10 ;
+11 ; Override does not exist for 'TODAYS' date, post prevention rules will apply
+12 IF $PIECE(OVERRIDE(TYPE),".")'=DT
KILL OVERRIDE(TYPE)
SET OVERRIDE=0
QUIT
+13 SET OVERRIDE=1
+14 QUIT
+15 ;
NONE ; the system does not have any aged, unposted EFTs
+1 NEW DIR
+2 SET DIR(0)="EA"
+3 SET DIR("A",1)="The sytem does not have any aged, unposted EFTs."
+4 SET DIR("A",2)="Therefore, no error conditions to override."
+5 SET DIR("A",3)=" "
+6 SET DIR("A")="Press ENTER to continue: "
+7 DO ^DIR
+8 QUIT
+9 ;
NOACTION ; OVERRIDE already exists
+1 ; Input: TYPE - "M" for medical, "P" for Pharmacy or "T" for Tricare
+2 NEW DIR
+3 SET DIR(0)="EA"
+4 SET DIR("A",1)="An Override for "_$SELECT(TYPE="P":"pharmacy ",TYPE="M":"medical ",1:"TRICARE ")
+5 SET DIR("A",1)=DIR("A",1)_"is already in place."
+6 SET DIR("A",2)="No action needed"
+7 SET DIR("A",3)=" "
+8 SET DIR("A")="Press ENTER to continue: "
+9 DO ^DIR
+10 QUIT
+11 ;
NOENTRY ; user is not authorized to use the option
+1 NEW DIR
+2 SET DIR(0)="EA"
+3 SET DIR("A",1)="You are not authorized to use this option."
+4 SET DIR("A",2)="This option is locked with RCDPE AGED PMT key."
+5 SET DIR("A",3)=" "
+6 SET DIR("A")="Press ENTER to continue: "
+7 DO ^DIR
+8 QUIT
+9 ;
NOLOCK ; entry at 344.61 cannot be locked
+1 NEW DIR
+2 SET DIR(0)="EA"
+3 SET DIR("A",1)="Another user is editing the Override Parameters."
+4 SET DIR("A",2)="Try again later."
+5 SET DIR("A",3)=" "
+6 SET DIR("A")="Press ENTER to continue: "
+7 DO ^DIR
+8 QUIT
+9 ;
