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 Sep 23, 2025@19:28:49 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 ;
