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

BPSTEST.m

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