- 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 Feb 18, 2025@23:19:52 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 ;