BPSTEST ;OAK/ELZ - ECME TESTING TOOL ;11/15/07 09:55
;;1.0;E CLAIMS MGMT ENGINE;**6,7,8,10,11,15,19,20,22,23,24,26,28**;JUN 2004;Build 22
;;Per VA Directive 6402, this routine should not be modified.
;
; Look at BPSTEST1 for additional documentation of the Testing Tool
;
GETOVER(KEY1,KEY2,BPSORESP,BPSWHERE,BPSTYPE,BPPAYSEQ) ;
; called by BPSNCPDP to enter overrides for a particular RX
; INPUT
; KEY1 - Prescription IEN/Patient IEN
; KEY2 - Fill Number/Policy Number
; BPSORESP - Previous response when this claim was processed
; BPSWHERE - RX Action passed into BPSNCPDP
; BPSTYPE - R (Reversal), S (Submission), E (Eligibility)
; BPPAYSEQ - payer sequence 1 - primary, 2 - secondary
; OUTPUT
; None - Table BPS PAYER RESPONSE OVERRIDE entry is created.
;
N BPSTRANS,BPSTIEN,BPSSRESP,DIC,X,Y,DIR,DIK,DA
;
; Check if testing is enabled
I '$$CHECK() Q
;
; Option cannot be run for Date of Death option as it causes errors
I $G(XQY0)["DG DEATH ENTRY" W !,"The testing tool cannot be run from Date of Death option" Q
;
; Do not run for background jobs
I $D(ZTQUEUED)!(",AREV,CRLB,CRLR,CRLX,CRRL,PC,PL,"[(","_BPSWHERE_",")) Q
;
; Create Transaction Number
S BPSTRANS=$$IEN59^BPSOSRX(KEY1,KEY2,$S($G(BPPAYSEQ)>0:+BPPAYSEQ,1:1))
;
; Lookup the record in the BPS PAYER RESPONSE OVERRIDE table
S DIC=9002313.32,DIC(0)="",X=BPSTRANS
D ^DIC
S BPSTIEN=+Y
;
; Prompt if user wants to do overrides
W !!,"Payer Overrides are enabled at this site. If this is production environment,"
W !,"do not enter overrides (enter No at the next prompt) and disable this"
W !,"functionality in the BPS SETUP table."
W !!,"Entering No at the next prompt will delete any current overrides for the"
W !,"request, if they exist.",!
S DIR(0)="SA^Y:Yes;N:No"
S DIR("A")="Do you want to enter overrides for this request? ",DIR("B")="NO"
D ^DIR
;
; If no, delete the transaction (if it exists) and quit
I Y'="Y" D:BPSTIEN'=-1 Q
. S DIK="^BPS(9002313.32,",DA=BPSTIEN
. D ^DIK
;
; If the record does not exist, create it
I BPSTIEN=-1 S BPSTIEN=$$CREATE(BPSTRANS)
I BPSTIEN=-1 W !,"Failed to create the BPS PAYER RESPONSE OVERRIDE record",! Q
;
; If BPSTYPE is 'S' (submission) and old response is 'E Payable', change BPSTYPE to 'RS'
; But don't change BPSTYPE to 'RS' if the BPSWHERE value is "ERWV" which is the Resubmit Without Reversal action (BPS*1*20)
I BPSTYPE="S",BPSWHERE'="ERWV",BPSORESP="E PAYABLE"!(BPSORESP="E DUPLICATE")!(BPSORESP="E REVERSAL REJECTED")!(BPSORESP="E REVERSAL UNSTRANDED") S BPSTYPE="RS"
;
; Update with the BPSTYPE
D FILE("^BPS(9002313.32,",BPSTIEN,.02,BPSTYPE)
;
; Message for RS
I BPSTYPE="RS" D
. W !!,"This submission may also have a reversal so you will be prompted for the"
. W !,"reversal overrides."
;
; If BPSTYPE is equal to 'E', then prompt for eligibility response
I BPSTYPE["E" D
. W !!,"Eligibility Questions"
. D PROMPT(BPSTIEN,.08,"A")
. N BPSRESP
. S BPSRESP=$$GET1^DIQ(9002313.32,BPSTIEN_",",.08,"I")
. I BPSRESP="R" D REJECTS(BPSTIEN) ; BPS*1*22
;
; If BPSTYPE contains 'R', then prompt for reversal response
I BPSTYPE["R" D
. W !!,"Reversal Questions"
. D PROMPT(BPSTIEN,.05,"A")
. N BPSRESP
. S BPSRESP=$$GET1^DIQ(9002313.32,BPSTIEN_",",.05,"I")
. I BPSRESP="R" D ENREVRJ(BPSTRANS)
;
; If BPSTYPE contains 'S', do submission response
I BPSTYPE["S" D SUBMISSION
;
W ! D PROMPT(BPSTIEN,.07,0)
Q
;
SUBMISSION ; Submission Reponse Questions
W !!,"Submission Questions"
D PROMPT(BPSTIEN,.03,"P")
S BPSSRESP=$$GET1^DIQ(9002313.32,BPSTIEN_",",.03,"I")
;
I BPSSRESP="P"!(BPSSRESP="D")!(BPSSRESP="Q")!(BPSSRESP="S") D
. D PROMPT(BPSTIEN,.04,40) ; total amount paid (509-F9)
. D PROMPT(BPSTIEN,.06,9) ; copay amount (518-FI)
;
SR ;
I BPSSRESP="R" D
. D REJECTS(BPSTIEN) ; BPS*1*22
. ; Check to ensure that the user entered at least one reject
. I $O(^BPS(9002313.32,BPSTIEN,1,0))="" D G SR
.. W !,*7,"Must select at least one reject."
. Q
;
; This section is for new D1-E7 fields and other fields so we can test that they are filed correctly
; At some point, these can probably be removed
;All but Submission Response T=STRANDED
I BPSSRESP'="T" D
. ; Ask if user wants to enter data for additional response file fields - Quit if user says no
. N DIR,DTOUT,DUOUT,DIROUT,DIRUT
. S DIR(0)="YA",DIR("A")="Populate Additional Response Fields? ",DIR("B")="No" W ! D ^DIR
. I Y'=1 Q
. ;Allow the user to select a Response Field that they want to override
. D SELFLD
. Q
;
Q
;
SELFLD ; Allow the user to Select a Response field
K BPSFIELDNAME,BPSFIELDIEN,BPSFLD
;
SELFLD1 ;
K DIC,X,Y
;
S DIC=9002313.91
S DIC(0)="AEMQ"
S DIC("A")="Select a Response Field you wish to override: "
S DIC("S")="I $$CHKDD^BPSTEST(Y)"
S DIC("T")=""
W !
D ^DIC
;
; Exit if the user enters "^" or "^^"
I X["^" S BPSFLD=X G SFEXIT
; When the user just hits <return>, skip down to SFEXIT.
I X="" G SFEXIT
;
S BPSFIELDNAME=$$GET1^DIQ(9002313.91,+Y,.03)
S BPSFIELDIEN=$O(^DD(9002313.32,"B",BPSFIELDNAME,""))
;
S BPSFLD=1
S BPSFLD(BPSFIELDIEN)=BPSFIELDNAME_"^"_X
;
; Disallow fields inappropriate for a claim submission.
I ",.01,.02,.03,.05,.07,.08,"[(","_BPSFIELDIEN_",") D G SELFLD1
. W !,?4,"Can't choose that one, make another selection.",*7
. Q
;
W !
D PROMPT(BPSTIEN,BPSFIELDIEN,"")
G SELFLD1
;
SFEXIT ;
Q
;
CHKDD(BPSY) ;
; Check NCPDP field and verify that it's in 9002313.32
;
N BPSFIELDNAME
S BPSFIELDNAME=$$GET1^DIQ(9002313.91,+BPSY,.03) ; Pull NCPDP field name.
;
; If this field is not in the DD for file 9002313.32, then disallow.
I '$D(^DD(9002313.32,"B",BPSFIELDNAME)) Q 0
;
Q 1
;
SETOVER(BPSTRANS,BPSTYPE,BPSDATA) ;
; called by BPSECMPS to set the override data
; Input
; BPSTRANS - Transaction IEN
; BPSTYPE - B1 for submission, B2 for reversals
; Output
; BPSDATA - Passed by reference and updated with appropriate overrides
;
N BPSTIEN,BPSRRESP,BPSSRESP,BPSPAID,BPSRCNT,BPSRIEN,BPSRCODE,BPSRCD,BPSCOPAY,BPSXXXX,BPSUNDEF
N BPSAJPAY,BPSNFLDT,BPSX
N BPS506,BPS507,BPS513,BPS517
;
; Check the Test Flag in set in BPS SETUP
I '$$CHECK() Q
;
; Check if the Transaction Number is defined in BPS RESPONSE OVERRIDES
S BPSTIEN=$O(^BPS(9002313.32,"B",BPSTRANS,""))
I BPSTIEN="" Q
;
; If a eligibility, check for specific reversal overrides and set
; If a reversal, check for specific reversal overrides and set
; If a submission, check for specific submission overrides and set
; the code for the above checks was moved to SETOVER^BPSTEST2
D SETOVER^BPSTEST2
Q
;
SELOVER ;
; Used to create overrides for prescription that will processed in the
; background (CMOP, auto-reversals). The user is prompted for the
; prescription and other information and then calls GETOVER. It is called
; by option BPS PROVIDER RESPONSE OVERRIDES
;
; This does not work for eligibility but we don't do them in the background
; right now.
;
N BPSRXIEN,BPSRXNM,BPSRXFL,BPSRFL,BPSORESP,BPSTYPE,BPSRXARR,BPSRARR,DIC,Y,DIR
;
; Check if test mode is on
I '$$CHECK() Q
;
; Prompt for the Prescription
S BPSRXIEN=$$PROMPTRX^BPSUTIL1 Q:BPSRXIEN<1
D RXAPI^BPSUTIL1(BPSRXIEN,".01;22","BPSRXARR","IE")
S BPSRXNM=$G(BPSRXARR(52,BPSRXIEN,.01,"E"))
;
; Prompt for Fill/Refill
S DIR(0)="S^0:"_$G(BPSRXARR(52,BPSRXIEN,22,"E"))
F BPSRFL=1:1 D RXSUBF^BPSUTIL1(BPSRXIEN,52,52.1,BPSRFL,.01,"BPSRARR","E") Q:$G(BPSRARR(52.1,BPSRFL,.01,"E"))="" D
. S DIR(0)=DIR(0)_";"_BPSRFL_":"_BPSRARR(52.1,BPSRFL,.01,"E")
S DIR("A")="Select fill/refill for prescription "_BPSRXNM,DIR("B")=0
D ^DIR
I Y'=+Y Q
S BPSRXFL=Y
;
; Prompt for BPSTYPE
S DIR(0)="S^R:Reversal;RS:Resubmit with Reversal;S:Submit"
S DIR("A")="Enter BPSTYPE of transaction",DIR("B")="SUBMIT"
D ^DIR
I ",R,RS,S,"'[","_Y_"," Q
S BPSTYPE=Y
;
; Set up parameters
S BPSORESP=""
I BPSTYPE="RS" S BPSTYPE="S",BPSORESP="E PAYABLE"
;
; Call GETOVER
D GETOVER(BPSRXIEN,BPSRXFL,BPSORESP,"",BPSTYPE)
Q
;
CHECK() ;
; Check if Test Mode is ON in the BPS Setup table
; Also called by BPSNCPDP and BPSEMCPS
;
;IA#4440
Q $S($$PROD^XUPROD:0,1:$P($G(^BPS(9002313.99,1,0)),"^",3))
;
CREATE(BPSTRANS) ;
; Create the Override record
;
N DIC,X,Y,BPSTIEN,DA
S DIC=9002313.32,DIC(0)="L",X=BPSTRANS
D ^DIC
S BPSTIEN=+Y
Q BPSTIEN
;
FILE(DIE,DA,BPSFLD,BPSDATA) ;
; File in the Override record
;
N DR,X,Y
S DR=BPSFLD_"///"_BPSDATA
L +@(DIE_DA_")"):0 I $T D ^DIE L -@(DIE_DA_")") Q
W !?5,"Another user is editing this entry."
Q
;
PROMPT(DA,BPSFLD,BPSDFLT) ;
; Prompt for a specific field and set the data
;
N DIE,DR,DTOUT,X,Y
S DIE="^BPS(9002313.32,",DR=BPSFLD_"//"_BPSDFLT
L +@(DIE_DA_")"):0 I $T D ^DIE L -@(DIE_DA_")") Q
W !?5,"Another user is editing this entry."
Q
;
REJECTS(BPSTIEN) ; BPS*1*22
N DA,DIE,DR,DTOUT,X,Y
; Delete all entries from the reject multiple so user doesn't have to manually delete
; The reject code prompt will have a default value of '07'
K ^BPS(9002313.32,BPSTIEN,1)
; Prompt for Reject Code(s) and set the data
S DA=BPSTIEN,DIE="^BPS(9002313.32,",DR=1_"//07"
L +@(DIE_DA_")"):0 I $T D ^DIE L -@(DIE_DA_")") Q
W !?5,"Another user is editing this entry."
Q
;
SETDELAY(BPSTRANS) ;
; Input
; BPSTRANS - Transaction IEN
; Check the Test Flag in set in BPS SETUP
I '$$CHECK() Q 0
N BPSDELAY,BPSTIEN,BPSTIME
; Check if the Transaction Number is defined in BPS RESPONSE OVERRIDES
S BPSTIEN=$O(^BPS(9002313.32,"B",BPSTRANS,""))
I BPSTIEN="" Q 0
S BPSDELAY=$$GET1^DIQ(9002313.32,BPSTIEN_",",.07,"I")*60
I BPSDELAY'>0 Q 0
S BPSTIME=$$FMADD^XLFDT($$NOW^XLFDT,,,,BPSDELAY)
I BPSTIME>0 D Q BPSTIME
. ;schedule a task to run RUNNING^BPSOSRX
. N ZTRTN,ZTDTH,ZTIO,ZTSK
. S ZTRTN="RUNECME^BPSTEST",ZTDESC="BPSTEST: ECME testing tool"
. S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,,,,BPSDELAY+10),ZTIO=""
. D ^%ZTLOAD
Q 0
;
RUNECME ;
D RUNNING^BPSOSRX()
Q
;get the reversal reject from the ^XTMP and set BPSDATA to override data
SETREJ(BPSTRANS) ;
N BPSREJ
S BPSREJ=$G(^XTMP("BPSTEST",BPSTRANS))
I BPSREJ="" Q
S BPSDATA(1,511,1)=BPSREJ
S BPSDATA(1,510)=1
Q
;enter a reversal reject
ENREVRJ(BPSTRANS) ;
N BPRJCODE,TMSTAMP
S BPRJCODE=$$PROMPT^BPSSCRU4("Enter a reject code for reversal")
I $P(BPRJCODE,U)="" Q
I $P(BPRJCODE,U)=0 Q
N X,X1,X2
S X1=DT,X2=2 D C^%DTC
S ^XTMP("BPSTEST",0)=X_U_DT_U_"ECME TESTING TOOL, SEE BPSTEST ROUTINE"
S ^XTMP("BPSTEST",BPSTRANS)=$P(BPRJCODE,U)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSTEST 10760 printed Oct 16, 2024@17:54:17 Page 2
BPSTEST ;OAK/ELZ - ECME TESTING TOOL ;11/15/07 09:55
+1 ;;1.0;E CLAIMS MGMT ENGINE;**6,7,8,10,11,15,19,20,22,23,24,26,28**;JUN 2004;Build 22
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Look at BPSTEST1 for additional documentation of the Testing Tool
+5 ;
GETOVER(KEY1,KEY2,BPSORESP,BPSWHERE,BPSTYPE,BPPAYSEQ) ;
+1 ; called by BPSNCPDP to enter overrides for a particular RX
+2 ; INPUT
+3 ; KEY1 - Prescription IEN/Patient IEN
+4 ; KEY2 - Fill Number/Policy Number
+5 ; BPSORESP - Previous response when this claim was processed
+6 ; BPSWHERE - RX Action passed into BPSNCPDP
+7 ; BPSTYPE - R (Reversal), S (Submission), E (Eligibility)
+8 ; BPPAYSEQ - payer sequence 1 - primary, 2 - secondary
+9 ; OUTPUT
+10 ; None - Table BPS PAYER RESPONSE OVERRIDE entry is created.
+11 ;
+12 NEW BPSTRANS,BPSTIEN,BPSSRESP,DIC,X,Y,DIR,DIK,DA
+13 ;
+14 ; Check if testing is enabled
+15 IF '$$CHECK()
QUIT
+16 ;
+17 ; Option cannot be run for Date of Death option as it causes errors
+18 IF $GET(XQY0)["DG DEATH ENTRY"
WRITE !,"The testing tool cannot be run from Date of Death option"
QUIT
+19 ;
+20 ; Do not run for background jobs
+21 IF $DATA(ZTQUEUED)!(",AREV,CRLB,CRLR,CRLX,CRRL,PC,PL,"[(","_BPSWHERE_","))
QUIT
+22 ;
+23 ; Create Transaction Number
+24 SET BPSTRANS=$$IEN59^BPSOSRX(KEY1,KEY2,$SELECT($GET(BPPAYSEQ)>0:+BPPAYSEQ,1:1))
+25 ;
+26 ; Lookup the record in the BPS PAYER RESPONSE OVERRIDE table
+27 SET DIC=9002313.32
SET DIC(0)=""
SET X=BPSTRANS
+28 DO ^DIC
+29 SET BPSTIEN=+Y
+30 ;
+31 ; Prompt if user wants to do overrides
+32 WRITE !!,"Payer Overrides are enabled at this site. If this is production environment,"
+33 WRITE !,"do not enter overrides (enter No at the next prompt) and disable this"
+34 WRITE !,"functionality in the BPS SETUP table."
+35 WRITE !!,"Entering No at the next prompt will delete any current overrides for the"
+36 WRITE !,"request, if they exist.",!
+37 SET DIR(0)="SA^Y:Yes;N:No"
+38 SET DIR("A")="Do you want to enter overrides for this request? "
SET DIR("B")="NO"
+39 DO ^DIR
+40 ;
+41 ; If no, delete the transaction (if it exists) and quit
+42 IF Y'="Y"
if BPSTIEN'=-1
Begin DoDot:1
+43 SET DIK="^BPS(9002313.32,"
SET DA=BPSTIEN
+44 DO ^DIK
End DoDot:1
QUIT
+45 ;
+46 ; If the record does not exist, create it
+47 IF BPSTIEN=-1
SET BPSTIEN=$$CREATE(BPSTRANS)
+48 IF BPSTIEN=-1
WRITE !,"Failed to create the BPS PAYER RESPONSE OVERRIDE record",!
QUIT
+49 ;
+50 ; If BPSTYPE is 'S' (submission) and old response is 'E Payable', change BPSTYPE to 'RS'
+51 ; But don't change BPSTYPE to 'RS' if the BPSWHERE value is "ERWV" which is the Resubmit Without Reversal action (BPS*1*20)
+52 IF BPSTYPE="S"
IF BPSWHERE'="ERWV"
IF BPSORESP="E PAYABLE"!(BPSORESP="E DUPLICATE")!(BPSORESP="E REVERSAL REJECTED")!(BPSORESP="E REVERSAL UNSTRANDED")
SET BPSTYPE="RS"
+53 ;
+54 ; Update with the BPSTYPE
+55 DO FILE("^BPS(9002313.32,",BPSTIEN,.02,BPSTYPE)
+56 ;
+57 ; Message for RS
+58 IF BPSTYPE="RS"
Begin DoDot:1
+59 WRITE !!,"This submission may also have a reversal so you will be prompted for the"
+60 WRITE !,"reversal overrides."
End DoDot:1
+61 ;
+62 ; If BPSTYPE is equal to 'E', then prompt for eligibility response
+63 IF BPSTYPE["E"
Begin DoDot:1
+64 WRITE !!,"Eligibility Questions"
+65 DO PROMPT(BPSTIEN,.08,"A")
+66 NEW BPSRESP
+67 SET BPSRESP=$$GET1^DIQ(9002313.32,BPSTIEN_",",.08,"I")
+68 ; BPS*1*22
IF BPSRESP="R"
DO REJECTS(BPSTIEN)
End DoDot:1
+69 ;
+70 ; If BPSTYPE contains 'R', then prompt for reversal response
+71 IF BPSTYPE["R"
Begin DoDot:1
+72 WRITE !!,"Reversal Questions"
+73 DO PROMPT(BPSTIEN,.05,"A")
+74 NEW BPSRESP
+75 SET BPSRESP=$$GET1^DIQ(9002313.32,BPSTIEN_",",.05,"I")
+76 IF BPSRESP="R"
DO ENREVRJ(BPSTRANS)
End DoDot:1
+77 ;
+78 ; If BPSTYPE contains 'S', do submission response
+79 IF BPSTYPE["S"
DO SUBMISSION
+80 ;
+81 WRITE !
DO PROMPT(BPSTIEN,.07,0)
+82 QUIT
+83 ;
SUBMISSION ; Submission Reponse Questions
+1 WRITE !!,"Submission Questions"
+2 DO PROMPT(BPSTIEN,.03,"P")
+3 SET BPSSRESP=$$GET1^DIQ(9002313.32,BPSTIEN_",",.03,"I")
+4 ;
+5 IF BPSSRESP="P"!(BPSSRESP="D")!(BPSSRESP="Q")!(BPSSRESP="S")
Begin DoDot:1
+6 ; total amount paid (509-F9)
DO PROMPT(BPSTIEN,.04,40)
+7 ; copay amount (518-FI)
DO PROMPT(BPSTIEN,.06,9)
End DoDot:1
+8 ;
SR ;
+1 IF BPSSRESP="R"
Begin DoDot:1
+2 ; BPS*1*22
DO REJECTS(BPSTIEN)
+3 ; Check to ensure that the user entered at least one reject
+4 IF $ORDER(^BPS(9002313.32,BPSTIEN,1,0))=""
Begin DoDot:2
+5 WRITE !,*7,"Must select at least one reject."
End DoDot:2
GOTO SR
+6 QUIT
End DoDot:1
+7 ;
+8 ; This section is for new D1-E7 fields and other fields so we can test that they are filed correctly
+9 ; At some point, these can probably be removed
+10 ;All but Submission Response T=STRANDED
+11 IF BPSSRESP'="T"
Begin DoDot:1
+12 ; Ask if user wants to enter data for additional response file fields - Quit if user says no
+13 NEW DIR,DTOUT,DUOUT,DIROUT,DIRUT
+14 SET DIR(0)="YA"
SET DIR("A")="Populate Additional Response Fields? "
SET DIR("B")="No"
WRITE !
DO ^DIR
+15 IF Y'=1
QUIT
+16 ;Allow the user to select a Response Field that they want to override
+17 DO SELFLD
+18 QUIT
End DoDot:1
+19 ;
+20 QUIT
+21 ;
SELFLD ; Allow the user to Select a Response field
+1 KILL BPSFIELDNAME,BPSFIELDIEN,BPSFLD
+2 ;
SELFLD1 ;
+1 KILL DIC,X,Y
+2 ;
+3 SET DIC=9002313.91
+4 SET DIC(0)="AEMQ"
+5 SET DIC("A")="Select a Response Field you wish to override: "
+6 SET DIC("S")="I $$CHKDD^BPSTEST(Y)"
+7 SET DIC("T")=""
+8 WRITE !
+9 DO ^DIC
+10 ;
+11 ; Exit if the user enters "^" or "^^"
+12 IF X["^"
SET BPSFLD=X
GOTO SFEXIT
+13 ; When the user just hits <return>, skip down to SFEXIT.
+14 IF X=""
GOTO SFEXIT
+15 ;
+16 SET BPSFIELDNAME=$$GET1^DIQ(9002313.91,+Y,.03)
+17 SET BPSFIELDIEN=$ORDER(^DD(9002313.32,"B",BPSFIELDNAME,""))
+18 ;
+19 SET BPSFLD=1
+20 SET BPSFLD(BPSFIELDIEN)=BPSFIELDNAME_"^"_X
+21 ;
+22 ; Disallow fields inappropriate for a claim submission.
+23 IF ",.01,.02,.03,.05,.07,.08,"[(","_BPSFIELDIEN_",")
Begin DoDot:1
+24 WRITE !,?4,"Can't choose that one, make another selection.",*7
+25 QUIT
End DoDot:1
GOTO SELFLD1
+26 ;
+27 WRITE !
+28 DO PROMPT(BPSTIEN,BPSFIELDIEN,"")
+29 GOTO SELFLD1
+30 ;
SFEXIT ;
+1 QUIT
+2 ;
CHKDD(BPSY) ;
+1 ; Check NCPDP field and verify that it's in 9002313.32
+2 ;
+3 NEW BPSFIELDNAME
+4 ; Pull NCPDP field name.
SET BPSFIELDNAME=$$GET1^DIQ(9002313.91,+BPSY,.03)
+5 ;
+6 ; If this field is not in the DD for file 9002313.32, then disallow.
+7 IF '$DATA(^DD(9002313.32,"B",BPSFIELDNAME))
QUIT 0
+8 ;
+9 QUIT 1
+10 ;
SETOVER(BPSTRANS,BPSTYPE,BPSDATA) ;
+1 ; called by BPSECMPS to set the override data
+2 ; Input
+3 ; BPSTRANS - Transaction IEN
+4 ; BPSTYPE - B1 for submission, B2 for reversals
+5 ; Output
+6 ; BPSDATA - Passed by reference and updated with appropriate overrides
+7 ;
+8 NEW BPSTIEN,BPSRRESP,BPSSRESP,BPSPAID,BPSRCNT,BPSRIEN,BPSRCODE,BPSRCD,BPSCOPAY,BPSXXXX,BPSUNDEF
+9 NEW BPSAJPAY,BPSNFLDT,BPSX
+10 NEW BPS506,BPS507,BPS513,BPS517
+11 ;
+12 ; Check the Test Flag in set in BPS SETUP
+13 IF '$$CHECK()
QUIT
+14 ;
+15 ; Check if the Transaction Number is defined in BPS RESPONSE OVERRIDES
+16 SET BPSTIEN=$ORDER(^BPS(9002313.32,"B",BPSTRANS,""))
+17 IF BPSTIEN=""
QUIT
+18 ;
+19 ; If a eligibility, check for specific reversal overrides and set
+20 ; If a reversal, check for specific reversal overrides and set
+21 ; If a submission, check for specific submission overrides and set
+22 ; the code for the above checks was moved to SETOVER^BPSTEST2
+23 DO SETOVER^BPSTEST2
+24 QUIT
+25 ;
SELOVER ;
+1 ; Used to create overrides for prescription that will processed in the
+2 ; background (CMOP, auto-reversals). The user is prompted for the
+3 ; prescription and other information and then calls GETOVER. It is called
+4 ; by option BPS PROVIDER RESPONSE OVERRIDES
+5 ;
+6 ; This does not work for eligibility but we don't do them in the background
+7 ; right now.
+8 ;
+9 NEW BPSRXIEN,BPSRXNM,BPSRXFL,BPSRFL,BPSORESP,BPSTYPE,BPSRXARR,BPSRARR,DIC,Y,DIR
+10 ;
+11 ; Check if test mode is on
+12 IF '$$CHECK()
QUIT
+13 ;
+14 ; Prompt for the Prescription
+15 SET BPSRXIEN=$$PROMPTRX^BPSUTIL1
if BPSRXIEN<1
QUIT
+16 DO RXAPI^BPSUTIL1(BPSRXIEN,".01;22","BPSRXARR","IE")
+17 SET BPSRXNM=$GET(BPSRXARR(52,BPSRXIEN,.01,"E"))
+18 ;
+19 ; Prompt for Fill/Refill
+20 SET DIR(0)="S^0:"_$GET(BPSRXARR(52,BPSRXIEN,22,"E"))
+21 FOR BPSRFL=1:1
DO RXSUBF^BPSUTIL1(BPSRXIEN,52,52.1,BPSRFL,.01,"BPSRARR","E")
if $GET(BPSRARR(52.1,BPSRFL,.01,"E"))=""
QUIT
Begin DoDot:1
+22 SET DIR(0)=DIR(0)_";"_BPSRFL_":"_BPSRARR(52.1,BPSRFL,.01,"E")
End DoDot:1
+23 SET DIR("A")="Select fill/refill for prescription "_BPSRXNM
SET DIR("B")=0
+24 DO ^DIR
+25 IF Y'=+Y
QUIT
+26 SET BPSRXFL=Y
+27 ;
+28 ; Prompt for BPSTYPE
+29 SET DIR(0)="S^R:Reversal;RS:Resubmit with Reversal;S:Submit"
+30 SET DIR("A")="Enter BPSTYPE of transaction"
SET DIR("B")="SUBMIT"
+31 DO ^DIR
+32 IF ",R,RS,S,"'[","_Y_","
QUIT
+33 SET BPSTYPE=Y
+34 ;
+35 ; Set up parameters
+36 SET BPSORESP=""
+37 IF BPSTYPE="RS"
SET BPSTYPE="S"
SET BPSORESP="E PAYABLE"
+38 ;
+39 ; Call GETOVER
+40 DO GETOVER(BPSRXIEN,BPSRXFL,BPSORESP,"",BPSTYPE)
+41 QUIT
+42 ;
CHECK() ;
+1 ; Check if Test Mode is ON in the BPS Setup table
+2 ; Also called by BPSNCPDP and BPSEMCPS
+3 ;
+4 ;IA#4440
+5 QUIT $SELECT($$PROD^XUPROD:0,1:$PIECE($GET(^BPS(9002313.99,1,0)),"^",3))
+6 ;
CREATE(BPSTRANS) ;
+1 ; Create the Override record
+2 ;
+3 NEW DIC,X,Y,BPSTIEN,DA
+4 SET DIC=9002313.32
SET DIC(0)="L"
SET X=BPSTRANS
+5 DO ^DIC
+6 SET BPSTIEN=+Y
+7 QUIT BPSTIEN
+8 ;
FILE(DIE,DA,BPSFLD,BPSDATA) ;
+1 ; File in the Override record
+2 ;
+3 NEW DR,X,Y
+4 SET DR=BPSFLD_"///"_BPSDATA
+5 LOCK +@(DIE_DA_")"):0
IF $TEST
DO ^DIE
LOCK -@(DIE_DA_")")
QUIT
+6 WRITE !?5,"Another user is editing this entry."
+7 QUIT
+8 ;
PROMPT(DA,BPSFLD,BPSDFLT) ;
+1 ; Prompt for a specific field and set the data
+2 ;
+3 NEW DIE,DR,DTOUT,X,Y
+4 SET DIE="^BPS(9002313.32,"
SET DR=BPSFLD_"//"_BPSDFLT
+5 LOCK +@(DIE_DA_")"):0
IF $TEST
DO ^DIE
LOCK -@(DIE_DA_")")
QUIT
+6 WRITE !?5,"Another user is editing this entry."
+7 QUIT
+8 ;
REJECTS(BPSTIEN) ; BPS*1*22
+1 NEW DA,DIE,DR,DTOUT,X,Y
+2 ; Delete all entries from the reject multiple so user doesn't have to manually delete
+3 ; The reject code prompt will have a default value of '07'
+4 KILL ^BPS(9002313.32,BPSTIEN,1)
+5 ; Prompt for Reject Code(s) and set the data
+6 SET DA=BPSTIEN
SET DIE="^BPS(9002313.32,"
SET DR=1_"//07"
+7 LOCK +@(DIE_DA_")"):0
IF $TEST
DO ^DIE
LOCK -@(DIE_DA_")")
QUIT
+8 WRITE !?5,"Another user is editing this entry."
+9 QUIT
+10 ;
SETDELAY(BPSTRANS) ;
+1 ; Input
+2 ; BPSTRANS - Transaction IEN
+3 ; Check the Test Flag in set in BPS SETUP
+4 IF '$$CHECK()
QUIT 0
+5 NEW BPSDELAY,BPSTIEN,BPSTIME
+6 ; Check if the Transaction Number is defined in BPS RESPONSE OVERRIDES
+7 SET BPSTIEN=$ORDER(^BPS(9002313.32,"B",BPSTRANS,""))
+8 IF BPSTIEN=""
QUIT 0
+9 SET BPSDELAY=$$GET1^DIQ(9002313.32,BPSTIEN_",",.07,"I")*60
+10 IF BPSDELAY'>0
QUIT 0
+11 SET BPSTIME=$$FMADD^XLFDT($$NOW^XLFDT,,,,BPSDELAY)
+12 IF BPSTIME>0
Begin DoDot:1
+13 ;schedule a task to run RUNNING^BPSOSRX
+14 NEW ZTRTN,ZTDTH,ZTIO,ZTSK
+15 SET ZTRTN="RUNECME^BPSTEST"
SET ZTDESC="BPSTEST: ECME testing tool"
+16 SET ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,,,,BPSDELAY+10)
SET ZTIO=""
+17 DO ^%ZTLOAD
End DoDot:1
QUIT BPSTIME
+18 QUIT 0
+19 ;
RUNECME ;
+1 DO RUNNING^BPSOSRX()
+2 QUIT
+3 ;get the reversal reject from the ^XTMP and set BPSDATA to override data
SETREJ(BPSTRANS) ;
+1 NEW BPSREJ
+2 SET BPSREJ=$GET(^XTMP("BPSTEST",BPSTRANS))
+3 IF BPSREJ=""
QUIT
+4 SET BPSDATA(1,511,1)=BPSREJ
+5 SET BPSDATA(1,510)=1
+6 QUIT
+7 ;enter a reversal reject
ENREVRJ(BPSTRANS) ;
+1 NEW BPRJCODE,TMSTAMP
+2 SET BPRJCODE=$$PROMPT^BPSSCRU4("Enter a reject code for reversal")
+3 IF $PIECE(BPRJCODE,U)=""
QUIT
+4 IF $PIECE(BPRJCODE,U)=0
QUIT
+5 NEW X,X1,X2
+6 SET X1=DT
SET X2=2
DO C^%DTC
+7 SET ^XTMP("BPSTEST",0)=X_U_DT_U_"ECME TESTING TOOL, SEE BPSTEST ROUTINE"
+8 SET ^XTMP("BPSTEST",BPSTRANS)=$PIECE(BPRJCODE,U)
+9 QUIT
+10 ;