- BPSRPC02 ;AITC/PD - ECME TAS RPC - Extract Txn Data;7/30/2018
- ;;1.0;E CLAIMS MGMT ENGINE;**27,31**;JUN 2004;Build 16
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- Q
- ;
- ; Extract the data for a specific Txn IEN
- ;
- ; EXTRACT requires a single BPS TRANSACTION IEN be passed in. Code
- ; will retrieve data fields for the transaction and return the data
- ; in a JSON formatted array.
- ;
- ; BPS59 - Input (Required)
- ; - Transaction IEN from BPS TRANSACTION file (#9002313.59)
- ; RESULT - Output
- ; - JSON formatted array of data fields
- ;
- N BPS57,BPS59,BPSCNT,BPSDFN,BPSDRG,BPSDRGCLID,BPSDRGCLNM,BPSECME
- N BPSFHIR,BPSFLD,BPSI,BPSLST,BPSPC,BPSPC1,BPSPOS,BPSPR,BPSPRV,BPSPTID,BPSRC
- N BPSRDT,BPSRF,BPSRJC,BPSRJDATA,BPSRJE,BPSRJF,BPSRJN,BPSRX,BPSRXACT
- N BPSRXACT1,BPSSQ,BPSSTATUS,BPSSTR,BPSTMP,BPSTMP1,BPSVASITE,BPSX,RESP1
- ;
- S RESULT=$NA(^TMP("JSON",$J)) K @RESULT
- I $G(ARGS("LOG")) D LOG("ARGS") ; create log if requested
- S BPS57=$G(ARGS("BPS59"))
- I BPS57="" Q
- I '$D(^BPSTL(BPS57)) Q
- I BPS57=12345 D EXTRACT^BPSRPC04 G JSON
- S BPS59=$$GET1^DIQ(9002313.57,BPS57,.01,"I")
- ;
- ; ---------------------------------------
- ; Set up variables from BPS LOG OF TRANSACTIONS FILE required for collection
- ; of data fields
- ;
- ; PRESCRIPTION NUMBER - Field 1.11 - Pointer to PRESCRIPTION FILE #52
- S BPSRX=$$GET1^DIQ(9002313.57,BPS57,1.11,"I")
- ;
- ; CLAIM - Field 3 - Pointer to BPS CLAIMS FILE #9002313.02
- S BPSPC=$$GET1^DIQ(9002313.57,BPS57,3,"I")
- ;
- ; RESPONSE - Field 4 - Pointer to BPS RESPONSES FILE #9002313.03
- S BPSRC=$$GET1^DIQ(9002313.57,BPS57,4,"I")
- ;
- ; PATIENT - Field 5 - Pointer to PATIENT FILE #2
- S BPSDFN=$$GET1^DIQ(9002313.57,BPS57,5,"I")
- ;
- ; LAST UPDATE - Field 7 - Date/Time transaction last updated
- S BPSLST=$$GET1^DIQ(9002313.57,BPS57,7,"I")
- ;
- ; FILL NUMBER - Field 9
- S BPSRF=$$GET1^DIQ(9002313.57,BPS57,9,"I")
- ;
- ; POSITION IN CLAIM - Field 14
- S BPSPOS=$$GET1^DIQ(9002313.57,BPS57,14)
- ;
- ; START TIME - Field 15 - Date/Time transaction started
- S BPSSTR=$$GET1^DIQ(9002313.57,BPS57,15,"I")
- ;
- ; REVERSAL CLAIM - Field 401 - Pointer to BPS CLAIMS FILE #9002313.02
- S BPSPR=$$GET1^DIQ(9002313.57,BPS57,401,"I")
- ;
- ; RX ACTION - Field 1201
- S BPSRXACT=$$GET1^DIQ(9002313.57,BPS57,1201)
- ;
- ; COB Indicator (Payer Sequence)
- S BPSSQ=$$GET1^DIQ(9002313.57,BPS57,18,"I")
- ;
- ; Status of the Request
- S BPSSTATUS=$$GET1^DIQ(9002313.57,BPS57,4.0098)
- ;
- ; PROVIDER - Field 4 - Pointer to NEW PERSON FILE #200
- S BPSPRV=$$GET1^DIQ(52,BPSRX,4,"I")
- ;
- ; DRUG - Field 6 - Pointer to DRUG FILE #50
- S BPSDRG=$$GET1^DIQ(9002313.57,BPS57,9999.94)
- S BPSDRGCLID=$$DRUGDIE^BPSUTIL1(BPSDRG,25)
- S BPSDRGCLNM=$$DRGCLNAM^BPSRPT6(BPSDRGCLID,50)
- ;
- S BPSVASITE=$$NS^XUAF4($$KSP^XUPARAM("INST"))
- ;
- ; ---------------------------------------
- ;
- ; Build BPSTMP array
- ;
- I $$GET1^DIQ(9002313.02,BPSPC,901,"I")=1 S BPSTMP("OpenClosed")="C"
- E S BPSTMP("OpenClosed")="O"
- ;
- I BPSTMP("OpenClosed")="C" D
- . S BPSTMP("ClosedByUser")=$$GET1^DIQ(9002313.02,BPSPC,903)
- . S BPSTMP("ClosedDate")=$$FMTE^XLFDT($$GET1^DIQ(9002313.02,BPSPC,902,"I"),"7DZ")
- . S BPSTMP("ClosedDate")=$TR(BPSTMP("ClosedDate"),"/","-")
- . S BPSTMP("ClosedReason")=$$GET1^DIQ(9002313.02,BPSPC,904)
- E D
- . S BPSTMP("ClosedByUser")=""
- . S BPSTMP("ClosedDate")=""
- . S BPSTMP("ClosedReason")=""
- ;
- S BPSTMP("BilledAmount")=$$GET1^DIQ(9002313.57,BPS57,505)
- S BPSTMP("BillNumber")=$$BILL^BPSRPT6(BPSRX,BPSRF,BPSSQ)
- S BPSTMP("BIN")=$$GET1^DIQ(9002313.57,BPS57,10101)
- S BPSTMP("ClaimID")=$$GET1^DIQ(9002313.57,BPS57,3)
- I BPSPR'="" S BPSTMP("ClaimID")=$$GET1^DIQ(9002313.57,BPS57,401)
- S BPSTMP("CollectedAmount")=+$$COLLECTD^BPSRPT6(BPSRX,BPSRF,BPSSQ)
- S BPSTMP("CompletedDate")=$$FMTE^XLFDT($$GET1^DIQ(9002313.57,BPS57,7,"I"),"7DZ")
- S BPSTMP("CompletedDate")=$TR(BPSTMP("CompletedDate"),"/","-")
- S BPSTMP("DispensingFee")=$$GET1^DIQ(9002313.57,BPS57,504)
- S BPSTMP("DispensingFeePaid")=$$GET1^DIQ(9002313.57,BPS57,10507)
- S BPSTMP("Division")=$$GET1^DIQ(9002313.57,BPS57,1.07)
- S BPSTMP("DrugClass")=BPSDRGCLNM
- S BPSTMP("DrugName")=$$GET1^DIQ(9002313.57,BPS57,9999.93)
- ;
- S BPSPC1=BPSPC
- ; Check if claim is a reversal
- I BPSPR'="" S BPSPC1=BPSPR
- I BPSPC1=""!(BPSPOS="") S BPSECME=""
- E S BPSECME=$P($G(^BPSC(BPSPC1,400,BPSPOS,400)),"^",2)
- I BPSECME="" S BPSECME=$$FORMAT^BPSSCRU2("",12," ",1)
- S BPSTMP("ECMENumber")=$E(BPSECME,3,14)
- ;
- S BPSTMP("ElapseTimeInSeconds")=$$GET1^DIQ(9002313.57,BPS57,9999.97)
- S BPSTMP("Eligibility")=$$GET1^DIQ(9002313.57,BPS57,901.04)
- I BPSTMP("Eligibility")="VETERAN" S BPSTMP("Eligibility")="Veteran"
- I (BPSRX&BPSRF) S BPSTMP("FillLocation")=$$MWC^PSOBPSU2(BPSRX,BPSRF)
- ;
- S BPSRXACT1="RT"
- I BPSRXACT="BB" S BPSRXACT1="BB"
- I BPSRXACT="P2"!(BPSRXACT="P2S") S BPSRXACT1="P2"
- I BPSRXACT="ERES"!(BPSRXACT="ERMV")!(BPSRXACT="ERNB") S BPSRXACT1="RS"
- S BPSTMP("FillType")=BPSRXACT1
- ;
- S BPSTMP("GroupID")=$$GET1^DIQ(9002313.57,BPS57,10301)
- S BPSTMP("IngredientCost")=$$GET1^DIQ(9002313.57,BPS57,10409)
- S BPSTMP("IngredientCostPaid")=$$GET1^DIQ(9002313.57,BPS57,10506)
- S BPSTMP("InsuranceName")=$P($$INSNAM^BPSRPT6(BPS59),"^",2)
- ;
- I (BPSPOS&BPSRC) S BPSTMP("InsurancePaidAmount")=+$$INSPAID1^BPSOS03(BPSRC,BPSPOS)
- E S BPSTMP("InsurancePaidAmount")=0
- ;
- I $$GET1^DIQ(9002313.57,BPS57,10510)>1 S BPSTMP("MultipleRejects")="Y"
- E S BPSTMP("MultipleRejects")="N"
- I $$GET1^DIQ(9002313.57,BPS57,10510)="" S BPSTMP("MultipleRejects")=""
- ;
- S BPSTMP("NDC")=$$GET1^DIQ(9002313.57,BPS57,10)
- ;
- S BPSPTID=$$GET1^DIQ(2,BPSDFN,.09)
- S BPSPTID=$E(BPSPTID,($L(BPSPTID)-3),$L(BPSPTID))
- S BPSTMP("PatientID")=BPSPTID
- ;
- S BPSTMP("PatientName")=$$GET1^DIQ(9002313.57,BPS57,5)
- S BPSTMP("PatientPayAmount")=$$GET1^DIQ(9002313.57,BPS57,10505)
- S BPSTMP("PayerResponse")=BPSSTATUS
- S BPSTMP("Prescriber")=$$GET1^DIQ(9002313.57,BPS57,10427)
- S BPSTMP("PrescriberID")=$$GET1^DIQ(9002313.57,BPS57,10411)
- S BPSTMP("Quantity")=$$GET1^DIQ(9002313.57,BPS57,501)
- S BPSTMP("Refill")=$$GET1^DIQ(9002313.57,BPS57,9)
- ;
- I BPSSTATUS["REJECTED" S BPSTMP("Rejected")="REJ"
- E S BPSTMP("Rejected")=""
- ;
- F BPSRJF=10511.01:.01:10511.2 I $$GET1^DIQ(9002313.57,BPS57,BPSRJF)'="" D
- . S BPSRJDATA=$$GET1^DIQ(9002313.57,BPS57,BPSRJF)
- . S BPSRJC=$P(BPSRJDATA," ")
- . S BPSRJE=$P(BPSRJDATA," ",2,99)
- . S BPSRJN=(BPSRJF-10511)*100
- . S BPSTMP("RejectCode"_BPSRJN)=BPSRJC
- . S BPSTMP("RejectExplanation"_BPSRJN)=BPSRJE
- ;
- S BPSTMP("ReleasedDate")=$$FMTE^XLFDT($$GET1^DIQ(9002313.57,BPS57,9999.95,"I"),"7DZ")
- S BPSTMP("ReleasedDate")=$TR(BPSTMP("ReleasedDate"),"/","-")
- ;
- I BPSSTATUS["REVERSAL" D
- . I BPSSTATUS["ACCEPTED" S BPSTMP("ReturnStatus")="ACCEPTED"
- . E S BPSTMP("ReturnStatus")="REJECTED"
- . ;
- . I +$$GET1^DIQ(9002313.02,BPSPC,.07,"I")=0 S BPSTMP("ReversalMethod")="Regular"
- . E S BPSTMP("ReversalMethod")="Auto"
- . ;
- . S BPSTMP("ReversalReason")=$$GET1^DIQ(9002313.57,BPS57,404)
- E D
- . S BPSTMP("ReturnStatus")=""
- . S BPSTMP("ReversalMethod")=""
- . S BPSTMP("ReversalReason")=""
- ;
- S BPSTMP("RxCOB")=""
- I BPSSQ=1 S BPSTMP("RxCOB")="p"
- I BPSSQ=2 S BPSTMP("RxCOB")="s"
- I BPSSQ=3 S BPSTMP("RxCOB")="t"
- ;
- S BPSTMP("RxNumber")=$$GET1^DIQ(9002313.57,BPS57,1.11)
- S BPSTMP("SiteName")=$P(BPSVASITE,"^")
- S BPSTMP("SiteNumber")=$P(BPSVASITE,"^",2)
- S BPSTMP("Touched")=$$TOUCHED^BPSUTIL(BPS57)
- S BPSTMP("TransactionDate")=$$FMTE^XLFDT($$GET1^DIQ(9002313.57,BPS57,6,"I"),"7DZ")
- S BPSTMP("TransactionDate")=$TR(BPSTMP("TransactionDate"),"/","-")
- ;
- I BPSRF=0 S BPSRDT=$$RXRELDT^BPSRPT6(BPSRX)\1
- I BPSRF'=0 S BPSRDT=$$REFRELDT^BPSRPT6(BPSRX,BPSRF)\1
- S BPSX="/N"
- I $P(BPSRDT,"^") S BPSX="/R"
- S BPSTMP("TransactionStatus")=$$RXST^BPSSCRU2(BPS59)_BPSX
- ;
- S RESP1=""
- I BPSSTATUS="E CAPTURED" S RESP1="Captured"
- I BPSSTATUS="E DUPLICATE" S RESP1="Duplicate"
- I BPSSTATUS="E PAYABLE" S RESP1="Payable"
- I BPSSTATUS="E REJECTED" S RESP1="Rejected"
- I BPSSTATUS["REVERSAL" S RESP1="Reversal"
- I BPSSTATUS["UNSTRANDED" D
- . S RESP1="Unstranded"
- . S BPSTMP("Touched")=1
- I RESP1="" S RESP1="Other"
- S BPSTMP("TransactionType")=RESP1
- ;
- D REFORMAT
- ;
- JSON ; Prepare JSON file
- ; Transform the BPSTMP1 array into JSON format
- D ENCODE^XLFJSON("BPSTMP1",RESULT,$NA(^TMP("JSERR",$J)))
- I $D(^TMP("JSERR",$J)) D Q ; handle encoder error
- . D MSGSET(.RESULT,"Error","JSON encoding error.")
- S @RESULT@(1)="["_@RESULT@(1) ;$P(RESULT(1),":",2,9999)
- S BPSCNT=""
- S BPSCNT=$O(@RESULT@(BPSCNT),-1)
- S @RESULT@(BPSCNT)=$E(@RESULT@(BPSCNT),1,($L(@RESULT@(BPSCNT))-1))_"}]"
- Q
- ;
- REFORMAT ; Reformat BPSTMP array
- ; Reformat BPSTMP array into BPSTMP1 to transform to JSON format
- ; BPSTMP1 will regroup fields by FHIR Resource
- S BPSFLD=""
- S BPSCNT=0
- F S BPSFLD=$O(BPSTMP(BPSFLD)) Q:BPSFLD="" D
- . ; Exclude field if value is nil
- . I $G(BPSTMP(BPSFLD))="" Q
- . S BPSFHIR1=""
- . F BPSI=1:1 S BPSFHIR=$P($T(FHIR+BPSI),";;",2,99) Q:BPSFHIR=""!(BPSFHIR1'="") D
- . . I BPSFLD=$P(BPSFHIR,";;") S BPSFHIR1=$P(BPSFHIR,";;",2)
- . I BPSFHIR1="" S BPSFHIR1="Basic"
- . S BPSCNT=BPSCNT+1
- . S BPSTMP1("Bundle",BPSFHIR1,BPSCNT,BPSFLD)=BPSTMP(BPSFLD)
- Q
- ;
- MSGSET(TYP,MSG) ;return error or informational message
- ; RSLT - storage location, passed by ref.
- ; TYP - message type
- ; MSG - text
- K @RESULT
- S @RESULT@(1)="[{"_$C(34)_$G(TYP)_$C(34)_" : "_$C(34)_$G(MSG)_$C(34)_"}]"
- Q
- LOG(SVARRY) ; create log in ^XTMP('BPSTAS-LOG-'_'+$h')
- ; SVARRY - name of array to save, e.g. "RCVAL" or "ARG"
- N A,C,ND
- S ND="BPSTAS-LOG-"_(+$H) ; one log node per day
- I '$D(^XTMP(ND,0)) D ; need a zero node
- . ; expires after 3 days ^ created on ^ desc.
- . S A=$$HTFM^XLFDT($H+3),$P(A,"^",2)=$$NOW^XLFDT,$P(A,"^",3)="routine "_$T(+0)_" log"
- . S ^XTMP(ND,0)=A
- ; C - log counter
- S C=$G(^XTMP(ND,0,"COUNT"))+1,^("COUNT")=C_"^"_$H
- S ^XTMP(ND,C,"$J")=$J,^("$H")=$H,^("$I")=$I
- F A="DUZ","IO" M ^XTMP(ND,C,"var",A)=@A
- ; if SVARRY passed in, log it
- I $L($G(SVARRY)) S A=$NA(@SVARRY) M ^XTMP(ND,C,"log",A)=@A
- Q
- ;
- FHIR ; Get FHIR Resource for field
- ;;BilledAmount;;Claim
- ;;BillNumber;;Claim
- ;;BIN;;Organization
- ;;ClaimID;;Claim
- ;;ClosedByUser;;Basic
- ;;ClosedDate;;Basic
- ;;ClosedReason;;Basic
- ;;CollectedAmount;;ClaimResponse
- ;;CompletedDate;;PaymentReconciliation
- ;;DispensingFee;;Claim
- ;;DispensingFeePaid;;ClaimResponse
- ;;Division;;Organization
- ;;DrugClass;;Substance
- ;;DrugName;;Medication
- ;;ECMENumber;;Basic
- ;;ElapseTimeInSeconds;;MedicationDispense
- ;;Eligibility;;Basic
- ;;FillLocation;;Location
- ;;FillType;;MedicationDispense
- ;;GroupID;;Coverage
- ;;IngredientCost;;Claim
- ;;IngredientCostPaid;;ClaimResponse
- ;;InsuranceName;;Organization
- ;;InsurancePaidAmount;;ClaimResponse
- ;;MultipleRejects;;Basic
- ;;NDC;;Medication
- ;;OpenClosed;;Claim
- ;;PatientID;;Patient
- ;;PatientName;;Patient
- ;;PatientPayAmount;;ExplanationOfBenefit
- ;;PayerResponse;;ClaimResponse
- ;;Prescriber;;Practitioner
- ;;PrescriberID;;Practitioner
- ;;Quantity;;MedicationDispense
- ;;Refill;;MedicationDispense
- ;;RejectCode1;;ClaimResponse
- ;;RejectCode2;;ClaimResponse
- ;;RejectCode3;;ClaimResponse
- ;;RejectCode4;;ClaimResponse
- ;;RejectCode5;;ClaimResponse
- ;;RejectCode6;;ClaimResponse
- ;;RejectCode7;;ClaimResponse
- ;;RejectCode8;;ClaimResponse
- ;;RejectCode9;;ClaimResponse
- ;;RejectCode10;;ClaimResponse
- ;;RejectCode11;;ClaimResponse
- ;;RejectCode12;;ClaimResponse
- ;;RejectCode13;;ClaimResponse
- ;;RejectCode14;;ClaimResponse
- ;;RejectCode15;;ClaimResponse
- ;;RejectCode16;;ClaimResponse
- ;;RejectCode17;;ClaimResponse
- ;;RejectCode18;;ClaimResponse
- ;;RejectCode19;;ClaimResponse
- ;;RejectCode20;;ClaimResponse
- ;;RejectCount;;ClaimResponse
- ;;Rejected;;Basic
- ;;RejectExplanation1;;ClaimResponse
- ;;RejectExplanation2;;ClaimResponse
- ;;RejectExplanation3;;ClaimResponse
- ;;RejectExplanation4;;ClaimResponse
- ;;RejectExplanation5;;ClaimResponse
- ;;RejectExplanation6;;ClaimResponse
- ;;RejectExplanation7;;ClaimResponse
- ;;RejectExplanation8;;ClaimResponse
- ;;RejectExplanation9;;ClaimResponse
- ;;RejectExplanation10;;ClaimResponse
- ;;RejectExplanation11;;ClaimResponse
- ;;RejectExplanation12;;ClaimResponse
- ;;RejectExplanation13;;ClaimResponse
- ;;RejectExplanation14;;ClaimResponse
- ;;RejectExplanation15;;ClaimResponse
- ;;RejectExplanation16;;ClaimResponse
- ;;RejectExplanation17;;ClaimResponse
- ;;RejectExplanation18;;ClaimResponse
- ;;RejectExplanation19;;ClaimResponse
- ;;RejectExplanation20;;ClaimResponse
- ;;ReleasedDate;;MedicationDispense
- ;;ReturnStatus;;Basic
- ;;ReversalMethod;;Claim
- ;;ReversalReason;;ClaimResponse
- ;;RxCOB;;Basic
- ;;RxNumber;;MedicationRequest
- ;;SiteName;;Organization
- ;;SiteNumber;;Organization
- ;;Touched;;Claim
- ;;TransactionDate;;MessageHeader
- ;;TransactionStatus;;MessageHeader
- ;;TransactionType;;MessageHeader
- ;
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSRPC02 13010 printed Feb 18, 2025@23:18:59 Page 2
- BPSRPC02 ;AITC/PD - ECME TAS RPC - Extract Txn Data;7/30/2018
- +1 ;;1.0;E CLAIMS MGMT ENGINE;**27,31**;JUN 2004;Build 16
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 QUIT
- +5 ;
- +1 ; Extract the data for a specific Txn IEN
- +2 ;
- +3 ; EXTRACT requires a single BPS TRANSACTION IEN be passed in. Code
- +4 ; will retrieve data fields for the transaction and return the data
- +5 ; in a JSON formatted array.
- +6 ;
- +7 ; BPS59 - Input (Required)
- +8 ; - Transaction IEN from BPS TRANSACTION file (#9002313.59)
- +9 ; RESULT - Output
- +10 ; - JSON formatted array of data fields
- +11 ;
- +12 NEW BPS57,BPS59,BPSCNT,BPSDFN,BPSDRG,BPSDRGCLID,BPSDRGCLNM,BPSECME
- +13 NEW BPSFHIR,BPSFLD,BPSI,BPSLST,BPSPC,BPSPC1,BPSPOS,BPSPR,BPSPRV,BPSPTID,BPSRC
- +14 NEW BPSRDT,BPSRF,BPSRJC,BPSRJDATA,BPSRJE,BPSRJF,BPSRJN,BPSRX,BPSRXACT
- +15 NEW BPSRXACT1,BPSSQ,BPSSTATUS,BPSSTR,BPSTMP,BPSTMP1,BPSVASITE,BPSX,RESP1
- +16 ;
- +17 SET RESULT=$NAME(^TMP("JSON",$JOB))
- KILL @RESULT
- +18 ; create log if requested
- IF $GET(ARGS("LOG"))
- DO LOG("ARGS")
- +19 SET BPS57=$GET(ARGS("BPS59"))
- +20 IF BPS57=""
- QUIT
- +21 IF '$DATA(^BPSTL(BPS57))
- QUIT
- +22 IF BPS57=12345
- DO EXTRACT^BPSRPC04
- GOTO JSON
- +23 SET BPS59=$$GET1^DIQ(9002313.57,BPS57,.01,"I")
- +24 ;
- +25 ; ---------------------------------------
- +26 ; Set up variables from BPS LOG OF TRANSACTIONS FILE required for collection
- +27 ; of data fields
- +28 ;
- +29 ; PRESCRIPTION NUMBER - Field 1.11 - Pointer to PRESCRIPTION FILE #52
- +30 SET BPSRX=$$GET1^DIQ(9002313.57,BPS57,1.11,"I")
- +31 ;
- +32 ; CLAIM - Field 3 - Pointer to BPS CLAIMS FILE #9002313.02
- +33 SET BPSPC=$$GET1^DIQ(9002313.57,BPS57,3,"I")
- +34 ;
- +35 ; RESPONSE - Field 4 - Pointer to BPS RESPONSES FILE #9002313.03
- +36 SET BPSRC=$$GET1^DIQ(9002313.57,BPS57,4,"I")
- +37 ;
- +38 ; PATIENT - Field 5 - Pointer to PATIENT FILE #2
- +39 SET BPSDFN=$$GET1^DIQ(9002313.57,BPS57,5,"I")
- +40 ;
- +41 ; LAST UPDATE - Field 7 - Date/Time transaction last updated
- +42 SET BPSLST=$$GET1^DIQ(9002313.57,BPS57,7,"I")
- +43 ;
- +44 ; FILL NUMBER - Field 9
- +45 SET BPSRF=$$GET1^DIQ(9002313.57,BPS57,9,"I")
- +46 ;
- +47 ; POSITION IN CLAIM - Field 14
- +48 SET BPSPOS=$$GET1^DIQ(9002313.57,BPS57,14)
- +49 ;
- +50 ; START TIME - Field 15 - Date/Time transaction started
- +51 SET BPSSTR=$$GET1^DIQ(9002313.57,BPS57,15,"I")
- +52 ;
- +53 ; REVERSAL CLAIM - Field 401 - Pointer to BPS CLAIMS FILE #9002313.02
- +54 SET BPSPR=$$GET1^DIQ(9002313.57,BPS57,401,"I")
- +55 ;
- +56 ; RX ACTION - Field 1201
- +57 SET BPSRXACT=$$GET1^DIQ(9002313.57,BPS57,1201)
- +58 ;
- +59 ; COB Indicator (Payer Sequence)
- +60 SET BPSSQ=$$GET1^DIQ(9002313.57,BPS57,18,"I")
- +61 ;
- +62 ; Status of the Request
- +63 SET BPSSTATUS=$$GET1^DIQ(9002313.57,BPS57,4.0098)
- +64 ;
- +65 ; PROVIDER - Field 4 - Pointer to NEW PERSON FILE #200
- +66 SET BPSPRV=$$GET1^DIQ(52,BPSRX,4,"I")
- +67 ;
- +68 ; DRUG - Field 6 - Pointer to DRUG FILE #50
- +69 SET BPSDRG=$$GET1^DIQ(9002313.57,BPS57,9999.94)
- +70 SET BPSDRGCLID=$$DRUGDIE^BPSUTIL1(BPSDRG,25)
- +71 SET BPSDRGCLNM=$$DRGCLNAM^BPSRPT6(BPSDRGCLID,50)
- +72 ;
- +73 SET BPSVASITE=$$NS^XUAF4($$KSP^XUPARAM("INST"))
- +74 ;
- +75 ; ---------------------------------------
- +76 ;
- +77 ; Build BPSTMP array
- +78 ;
- +79 IF $$GET1^DIQ(9002313.02,BPSPC,901,"I")=1
- SET BPSTMP("OpenClosed")="C"
- +80 IF '$TEST
- SET BPSTMP("OpenClosed")="O"
- +81 ;
- +82 IF BPSTMP("OpenClosed")="C"
- Begin DoDot:1
- +83 SET BPSTMP("ClosedByUser")=$$GET1^DIQ(9002313.02,BPSPC,903)
- +84 SET BPSTMP("ClosedDate")=$$FMTE^XLFDT($$GET1^DIQ(9002313.02,BPSPC,902,"I"),"7DZ")
- +85 SET BPSTMP("ClosedDate")=$TRANSLATE(BPSTMP("ClosedDate"),"/","-")
- +86 SET BPSTMP("ClosedReason")=$$GET1^DIQ(9002313.02,BPSPC,904)
- End DoDot:1
- +87 IF '$TEST
- Begin DoDot:1
- +88 SET BPSTMP("ClosedByUser")=""
- +89 SET BPSTMP("ClosedDate")=""
- +90 SET BPSTMP("ClosedReason")=""
- End DoDot:1
- +91 ;
- +92 SET BPSTMP("BilledAmount")=$$GET1^DIQ(9002313.57,BPS57,505)
- +93 SET BPSTMP("BillNumber")=$$BILL^BPSRPT6(BPSRX,BPSRF,BPSSQ)
- +94 SET BPSTMP("BIN")=$$GET1^DIQ(9002313.57,BPS57,10101)
- +95 SET BPSTMP("ClaimID")=$$GET1^DIQ(9002313.57,BPS57,3)
- +96 IF BPSPR'=""
- SET BPSTMP("ClaimID")=$$GET1^DIQ(9002313.57,BPS57,401)
- +97 SET BPSTMP("CollectedAmount")=+$$COLLECTD^BPSRPT6(BPSRX,BPSRF,BPSSQ)
- +98 SET BPSTMP("CompletedDate")=$$FMTE^XLFDT($$GET1^DIQ(9002313.57,BPS57,7,"I"),"7DZ")
- +99 SET BPSTMP("CompletedDate")=$TRANSLATE(BPSTMP("CompletedDate"),"/","-")
- +100 SET BPSTMP("DispensingFee")=$$GET1^DIQ(9002313.57,BPS57,504)
- +101 SET BPSTMP("DispensingFeePaid")=$$GET1^DIQ(9002313.57,BPS57,10507)
- +102 SET BPSTMP("Division")=$$GET1^DIQ(9002313.57,BPS57,1.07)
- +103 SET BPSTMP("DrugClass")=BPSDRGCLNM
- +104 SET BPSTMP("DrugName")=$$GET1^DIQ(9002313.57,BPS57,9999.93)
- +105 ;
- +106 SET BPSPC1=BPSPC
- +107 ; Check if claim is a reversal
- +108 IF BPSPR'=""
- SET BPSPC1=BPSPR
- +109 IF BPSPC1=""!(BPSPOS="")
- SET BPSECME=""
- +110 IF '$TEST
- SET BPSECME=$PIECE($GET(^BPSC(BPSPC1,400,BPSPOS,400)),"^",2)
- +111 IF BPSECME=""
- SET BPSECME=$$FORMAT^BPSSCRU2("",12," ",1)
- +112 SET BPSTMP("ECMENumber")=$EXTRACT(BPSECME,3,14)
- +113 ;
- +114 SET BPSTMP("ElapseTimeInSeconds")=$$GET1^DIQ(9002313.57,BPS57,9999.97)
- +115 SET BPSTMP("Eligibility")=$$GET1^DIQ(9002313.57,BPS57,901.04)
- +116 IF BPSTMP("Eligibility")="VETERAN"
- SET BPSTMP("Eligibility")="Veteran"
- +117 IF (BPSRX&BPSRF)
- SET BPSTMP("FillLocation")=$$MWC^PSOBPSU2(BPSRX,BPSRF)
- +118 ;
- +119 SET BPSRXACT1="RT"
- +120 IF BPSRXACT="BB"
- SET BPSRXACT1="BB"
- +121 IF BPSRXACT="P2"!(BPSRXACT="P2S")
- SET BPSRXACT1="P2"
- +122 IF BPSRXACT="ERES"!(BPSRXACT="ERMV")!(BPSRXACT="ERNB")
- SET BPSRXACT1="RS"
- +123 SET BPSTMP("FillType")=BPSRXACT1
- +124 ;
- +125 SET BPSTMP("GroupID")=$$GET1^DIQ(9002313.57,BPS57,10301)
- +126 SET BPSTMP("IngredientCost")=$$GET1^DIQ(9002313.57,BPS57,10409)
- +127 SET BPSTMP("IngredientCostPaid")=$$GET1^DIQ(9002313.57,BPS57,10506)
- +128 SET BPSTMP("InsuranceName")=$PIECE($$INSNAM^BPSRPT6(BPS59),"^",2)
- +129 ;
- +130 IF (BPSPOS&BPSRC)
- SET BPSTMP("InsurancePaidAmount")=+$$INSPAID1^BPSOS03(BPSRC,BPSPOS)
- +131 IF '$TEST
- SET BPSTMP("InsurancePaidAmount")=0
- +132 ;
- +133 IF $$GET1^DIQ(9002313.57,BPS57,10510)>1
- SET BPSTMP("MultipleRejects")="Y"
- +134 IF '$TEST
- SET BPSTMP("MultipleRejects")="N"
- +135 IF $$GET1^DIQ(9002313.57,BPS57,10510)=""
- SET BPSTMP("MultipleRejects")=""
- +136 ;
- +137 SET BPSTMP("NDC")=$$GET1^DIQ(9002313.57,BPS57,10)
- +138 ;
- +139 SET BPSPTID=$$GET1^DIQ(2,BPSDFN,.09)
- +140 SET BPSPTID=$EXTRACT(BPSPTID,($LENGTH(BPSPTID)-3),$LENGTH(BPSPTID))
- +141 SET BPSTMP("PatientID")=BPSPTID
- +142 ;
- +143 SET BPSTMP("PatientName")=$$GET1^DIQ(9002313.57,BPS57,5)
- +144 SET BPSTMP("PatientPayAmount")=$$GET1^DIQ(9002313.57,BPS57,10505)
- +145 SET BPSTMP("PayerResponse")=BPSSTATUS
- +146 SET BPSTMP("Prescriber")=$$GET1^DIQ(9002313.57,BPS57,10427)
- +147 SET BPSTMP("PrescriberID")=$$GET1^DIQ(9002313.57,BPS57,10411)
- +148 SET BPSTMP("Quantity")=$$GET1^DIQ(9002313.57,BPS57,501)
- +149 SET BPSTMP("Refill")=$$GET1^DIQ(9002313.57,BPS57,9)
- +150 ;
- +151 IF BPSSTATUS["REJECTED"
- SET BPSTMP("Rejected")="REJ"
- +152 IF '$TEST
- SET BPSTMP("Rejected")=""
- +153 ;
- +154 FOR BPSRJF=10511.01:.01:10511.2
- IF $$GET1^DIQ(9002313.57,BPS57,BPSRJF)'=""
- Begin DoDot:1
- +155 SET BPSRJDATA=$$GET1^DIQ(9002313.57,BPS57,BPSRJF)
- +156 SET BPSRJC=$PIECE(BPSRJDATA," ")
- +157 SET BPSRJE=$PIECE(BPSRJDATA," ",2,99)
- +158 SET BPSRJN=(BPSRJF-10511)*100
- +159 SET BPSTMP("RejectCode"_BPSRJN)=BPSRJC
- +160 SET BPSTMP("RejectExplanation"_BPSRJN)=BPSRJE
- End DoDot:1
- +161 ;
- +162 SET BPSTMP("ReleasedDate")=$$FMTE^XLFDT($$GET1^DIQ(9002313.57,BPS57,9999.95,"I"),"7DZ")
- +163 SET BPSTMP("ReleasedDate")=$TRANSLATE(BPSTMP("ReleasedDate"),"/","-")
- +164 ;
- +165 IF BPSSTATUS["REVERSAL"
- Begin DoDot:1
- +166 IF BPSSTATUS["ACCEPTED"
- SET BPSTMP("ReturnStatus")="ACCEPTED"
- +167 IF '$TEST
- SET BPSTMP("ReturnStatus")="REJECTED"
- +168 ;
- +169 IF +$$GET1^DIQ(9002313.02,BPSPC,.07,"I")=0
- SET BPSTMP("ReversalMethod")="Regular"
- +170 IF '$TEST
- SET BPSTMP("ReversalMethod")="Auto"
- +171 ;
- +172 SET BPSTMP("ReversalReason")=$$GET1^DIQ(9002313.57,BPS57,404)
- End DoDot:1
- +173 IF '$TEST
- Begin DoDot:1
- +174 SET BPSTMP("ReturnStatus")=""
- +175 SET BPSTMP("ReversalMethod")=""
- +176 SET BPSTMP("ReversalReason")=""
- End DoDot:1
- +177 ;
- +178 SET BPSTMP("RxCOB")=""
- +179 IF BPSSQ=1
- SET BPSTMP("RxCOB")="p"
- +180 IF BPSSQ=2
- SET BPSTMP("RxCOB")="s"
- +181 IF BPSSQ=3
- SET BPSTMP("RxCOB")="t"
- +182 ;
- +183 SET BPSTMP("RxNumber")=$$GET1^DIQ(9002313.57,BPS57,1.11)
- +184 SET BPSTMP("SiteName")=$PIECE(BPSVASITE,"^")
- +185 SET BPSTMP("SiteNumber")=$PIECE(BPSVASITE,"^",2)
- +186 SET BPSTMP("Touched")=$$TOUCHED^BPSUTIL(BPS57)
- +187 SET BPSTMP("TransactionDate")=$$FMTE^XLFDT($$GET1^DIQ(9002313.57,BPS57,6,"I"),"7DZ")
- +188 SET BPSTMP("TransactionDate")=$TRANSLATE(BPSTMP("TransactionDate"),"/","-")
- +189 ;
- +190 IF BPSRF=0
- SET BPSRDT=$$RXRELDT^BPSRPT6(BPSRX)\1
- +191 IF BPSRF'=0
- SET BPSRDT=$$REFRELDT^BPSRPT6(BPSRX,BPSRF)\1
- +192 SET BPSX="/N"
- +193 IF $PIECE(BPSRDT,"^")
- SET BPSX="/R"
- +194 SET BPSTMP("TransactionStatus")=$$RXST^BPSSCRU2(BPS59)_BPSX
- +195 ;
- +196 SET RESP1=""
- +197 IF BPSSTATUS="E CAPTURED"
- SET RESP1="Captured"
- +198 IF BPSSTATUS="E DUPLICATE"
- SET RESP1="Duplicate"
- +199 IF BPSSTATUS="E PAYABLE"
- SET RESP1="Payable"
- +200 IF BPSSTATUS="E REJECTED"
- SET RESP1="Rejected"
- +201 IF BPSSTATUS["REVERSAL"
- SET RESP1="Reversal"
- +202 IF BPSSTATUS["UNSTRANDED"
- Begin DoDot:1
- +203 SET RESP1="Unstranded"
- +204 SET BPSTMP("Touched")=1
- End DoDot:1
- +205 IF RESP1=""
- SET RESP1="Other"
- +206 SET BPSTMP("TransactionType")=RESP1
- +207 ;
- +208 DO REFORMAT
- +209 ;
- JSON ; Prepare JSON file
- +1 ; Transform the BPSTMP1 array into JSON format
- +2 DO ENCODE^XLFJSON("BPSTMP1",RESULT,$NAME(^TMP("JSERR",$JOB)))
- +3 ; handle encoder error
- IF $DATA(^TMP("JSERR",$JOB))
- Begin DoDot:1
- +4 DO MSGSET(.RESULT,"Error","JSON encoding error.")
- End DoDot:1
- QUIT
- +5 ;$P(RESULT(1),":",2,9999)
- SET @RESULT@(1)="["_@RESULT@(1)
- +6 SET BPSCNT=""
- +7 SET BPSCNT=$ORDER(@RESULT@(BPSCNT),-1)
- +8 SET @RESULT@(BPSCNT)=$EXTRACT(@RESULT@(BPSCNT),1,($LENGTH(@RESULT@(BPSCNT))-1))_"}]"
- +9 QUIT
- +10 ;
- REFORMAT ; Reformat BPSTMP array
- +1 ; Reformat BPSTMP array into BPSTMP1 to transform to JSON format
- +2 ; BPSTMP1 will regroup fields by FHIR Resource
- +3 SET BPSFLD=""
- +4 SET BPSCNT=0
- +5 FOR
- SET BPSFLD=$ORDER(BPSTMP(BPSFLD))
- if BPSFLD=""
- QUIT
- Begin DoDot:1
- +6 ; Exclude field if value is nil
- +7 IF $GET(BPSTMP(BPSFLD))=""
- QUIT
- +8 SET BPSFHIR1=""
- +9 FOR BPSI=1:1
- SET BPSFHIR=$PIECE($TEXT(FHIR+BPSI),";;",2,99)
- if BPSFHIR=""!(BPSFHIR1'="")
- QUIT
- Begin DoDot:2
- +10 IF BPSFLD=$PIECE(BPSFHIR,";;")
- SET BPSFHIR1=$PIECE(BPSFHIR,";;",2)
- End DoDot:2
- +11 IF BPSFHIR1=""
- SET BPSFHIR1="Basic"
- +12 SET BPSCNT=BPSCNT+1
- +13 SET BPSTMP1("Bundle",BPSFHIR1,BPSCNT,BPSFLD)=BPSTMP(BPSFLD)
- End DoDot:1
- +14 QUIT
- +15 ;
- MSGSET(TYP,MSG) ;return error or informational message
- +1 ; RSLT - storage location, passed by ref.
- +2 ; TYP - message type
- +3 ; MSG - text
- +4 KILL @RESULT
- +5 SET @RESULT@(1)="[{"_$CHAR(34)_$GET(TYP)_$CHAR(34)_" : "_$CHAR(34)_$GET(MSG)_$CHAR(34)_"}]"
- +6 QUIT
- LOG(SVARRY) ; create log in ^XTMP('BPSTAS-LOG-'_'+$h')
- +1 ; SVARRY - name of array to save, e.g. "RCVAL" or "ARG"
- +2 NEW A,C,ND
- +3 ; one log node per day
- SET ND="BPSTAS-LOG-"_(+$HOROLOG)
- +4 ; need a zero node
- IF '$DATA(^XTMP(ND,0))
- Begin DoDot:1
- +5 ; expires after 3 days ^ created on ^ desc.
- +6 SET A=$$HTFM^XLFDT($HOROLOG+3)
- SET $PIECE(A,"^",2)=$$NOW^XLFDT
- SET $PIECE(A,"^",3)="routine "_$TEXT(+0)_" log"
- +7 SET ^XTMP(ND,0)=A
- End DoDot:1
- +8 ; C - log counter
- +9 SET C=$GET(^XTMP(ND,0,"COUNT"))+1
- SET ^("COUNT")=C_"^"_$HOROLOG
- +10 SET ^XTMP(ND,C,"$J")=$JOB
- SET ^("$H")=$HOROLOG
- SET ^("$I")=$IO
- +11 FOR A="DUZ","IO"
- MERGE ^XTMP(ND,C,"var",A)=@A
- +12 ; if SVARRY passed in, log it
- +13 IF $LENGTH($GET(SVARRY))
- SET A=$NAME(@SVARRY)
- MERGE ^XTMP(ND,C,"log",A)=@A
- +14 QUIT
- +15 ;
- FHIR ; Get FHIR Resource for field
- +1 ;;BilledAmount;;Claim
- +2 ;;BillNumber;;Claim
- +3 ;;BIN;;Organization
- +4 ;;ClaimID;;Claim
- +5 ;;ClosedByUser;;Basic
- +6 ;;ClosedDate;;Basic
- +7 ;;ClosedReason;;Basic
- +8 ;;CollectedAmount;;ClaimResponse
- +9 ;;CompletedDate;;PaymentReconciliation
- +10 ;;DispensingFee;;Claim
- +11 ;;DispensingFeePaid;;ClaimResponse
- +12 ;;Division;;Organization
- +13 ;;DrugClass;;Substance
- +14 ;;DrugName;;Medication
- +15 ;;ECMENumber;;Basic
- +16 ;;ElapseTimeInSeconds;;MedicationDispense
- +17 ;;Eligibility;;Basic
- +18 ;;FillLocation;;Location
- +19 ;;FillType;;MedicationDispense
- +20 ;;GroupID;;Coverage
- +21 ;;IngredientCost;;Claim
- +22 ;;IngredientCostPaid;;ClaimResponse
- +23 ;;InsuranceName;;Organization
- +24 ;;InsurancePaidAmount;;ClaimResponse
- +25 ;;MultipleRejects;;Basic
- +26 ;;NDC;;Medication
- +27 ;;OpenClosed;;Claim
- +28 ;;PatientID;;Patient
- +29 ;;PatientName;;Patient
- +30 ;;PatientPayAmount;;ExplanationOfBenefit
- +31 ;;PayerResponse;;ClaimResponse
- +32 ;;Prescriber;;Practitioner
- +33 ;;PrescriberID;;Practitioner
- +34 ;;Quantity;;MedicationDispense
- +35 ;;Refill;;MedicationDispense
- +36 ;;RejectCode1;;ClaimResponse
- +37 ;;RejectCode2;;ClaimResponse
- +38 ;;RejectCode3;;ClaimResponse
- +39 ;;RejectCode4;;ClaimResponse
- +40 ;;RejectCode5;;ClaimResponse
- +41 ;;RejectCode6;;ClaimResponse
- +42 ;;RejectCode7;;ClaimResponse
- +43 ;;RejectCode8;;ClaimResponse
- +44 ;;RejectCode9;;ClaimResponse
- +45 ;;RejectCode10;;ClaimResponse
- +46 ;;RejectCode11;;ClaimResponse
- +47 ;;RejectCode12;;ClaimResponse
- +48 ;;RejectCode13;;ClaimResponse
- +49 ;;RejectCode14;;ClaimResponse
- +50 ;;RejectCode15;;ClaimResponse
- +51 ;;RejectCode16;;ClaimResponse
- +52 ;;RejectCode17;;ClaimResponse
- +53 ;;RejectCode18;;ClaimResponse
- +54 ;;RejectCode19;;ClaimResponse
- +55 ;;RejectCode20;;ClaimResponse
- +56 ;;RejectCount;;ClaimResponse
- +57 ;;Rejected;;Basic
- +58 ;;RejectExplanation1;;ClaimResponse
- +59 ;;RejectExplanation2;;ClaimResponse
- +60 ;;RejectExplanation3;;ClaimResponse
- +61 ;;RejectExplanation4;;ClaimResponse
- +62 ;;RejectExplanation5;;ClaimResponse
- +63 ;;RejectExplanation6;;ClaimResponse
- +64 ;;RejectExplanation7;;ClaimResponse
- +65 ;;RejectExplanation8;;ClaimResponse
- +66 ;;RejectExplanation9;;ClaimResponse
- +67 ;;RejectExplanation10;;ClaimResponse
- +68 ;;RejectExplanation11;;ClaimResponse
- +69 ;;RejectExplanation12;;ClaimResponse
- +70 ;;RejectExplanation13;;ClaimResponse
- +71 ;;RejectExplanation14;;ClaimResponse
- +72 ;;RejectExplanation15;;ClaimResponse
- +73 ;;RejectExplanation16;;ClaimResponse
- +74 ;;RejectExplanation17;;ClaimResponse
- +75 ;;RejectExplanation18;;ClaimResponse
- +76 ;;RejectExplanation19;;ClaimResponse
- +77 ;;RejectExplanation20;;ClaimResponse
- +78 ;;ReleasedDate;;MedicationDispense
- +79 ;;ReturnStatus;;Basic
- +80 ;;ReversalMethod;;Claim
- +81 ;;ReversalReason;;ClaimResponse
- +82 ;;RxCOB;;Basic
- +83 ;;RxNumber;;MedicationRequest
- +84 ;;SiteName;;Organization
- +85 ;;SiteNumber;;Organization
- +86 ;;Touched;;Claim
- +87 ;;TransactionDate;;MessageHeader
- +88 ;;TransactionStatus;;MessageHeader
- +89 ;;TransactionType;;MessageHeader
- +90 ;
- +91 ;