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

BPSRPC02.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. Q
  1. ;
  1. EXTRACT(RESULT,ARGS) ; RPC: BPS TAS CLAIM DATA EXTRACT
  1. ; Extract the data for a specific Txn IEN
  1. ;
  1. ; EXTRACT requires a single BPS TRANSACTION IEN be passed in. Code
  1. ; will retrieve data fields for the transaction and return the data
  1. ; in a JSON formatted array.
  1. ;
  1. ; BPS59 - Input (Required)
  1. ; - Transaction IEN from BPS TRANSACTION file (#9002313.59)
  1. ; RESULT - Output
  1. ; - JSON formatted array of data fields
  1. ;
  1. N BPS57,BPS59,BPSCNT,BPSDFN,BPSDRG,BPSDRGCLID,BPSDRGCLNM,BPSECME
  1. N BPSFHIR,BPSFLD,BPSI,BPSLST,BPSPC,BPSPC1,BPSPOS,BPSPR,BPSPRV,BPSPTID,BPSRC
  1. N BPSRDT,BPSRF,BPSRJC,BPSRJDATA,BPSRJE,BPSRJF,BPSRJN,BPSRX,BPSRXACT
  1. N BPSRXACT1,BPSSQ,BPSSTATUS,BPSSTR,BPSTMP,BPSTMP1,BPSVASITE,BPSX,RESP1
  1. ;
  1. S RESULT=$NA(^TMP("JSON",$J)) K @RESULT
  1. I $G(ARGS("LOG")) D LOG("ARGS") ; create log if requested
  1. S BPS57=$G(ARGS("BPS59"))
  1. I BPS57="" Q
  1. I '$D(^BPSTL(BPS57)) Q
  1. I BPS57=12345 D EXTRACT^BPSRPC04 G JSON
  1. S BPS59=$$GET1^DIQ(9002313.57,BPS57,.01,"I")
  1. ;
  1. ; ---------------------------------------
  1. ; Set up variables from BPS LOG OF TRANSACTIONS FILE required for collection
  1. ; of data fields
  1. ;
  1. ; PRESCRIPTION NUMBER - Field 1.11 - Pointer to PRESCRIPTION FILE #52
  1. S BPSRX=$$GET1^DIQ(9002313.57,BPS57,1.11,"I")
  1. ;
  1. ; CLAIM - Field 3 - Pointer to BPS CLAIMS FILE #9002313.02
  1. S BPSPC=$$GET1^DIQ(9002313.57,BPS57,3,"I")
  1. ;
  1. ; RESPONSE - Field 4 - Pointer to BPS RESPONSES FILE #9002313.03
  1. S BPSRC=$$GET1^DIQ(9002313.57,BPS57,4,"I")
  1. ;
  1. ; PATIENT - Field 5 - Pointer to PATIENT FILE #2
  1. S BPSDFN=$$GET1^DIQ(9002313.57,BPS57,5,"I")
  1. ;
  1. ; LAST UPDATE - Field 7 - Date/Time transaction last updated
  1. S BPSLST=$$GET1^DIQ(9002313.57,BPS57,7,"I")
  1. ;
  1. ; FILL NUMBER - Field 9
  1. S BPSRF=$$GET1^DIQ(9002313.57,BPS57,9,"I")
  1. ;
  1. ; POSITION IN CLAIM - Field 14
  1. S BPSPOS=$$GET1^DIQ(9002313.57,BPS57,14)
  1. ;
  1. ; START TIME - Field 15 - Date/Time transaction started
  1. S BPSSTR=$$GET1^DIQ(9002313.57,BPS57,15,"I")
  1. ;
  1. ; REVERSAL CLAIM - Field 401 - Pointer to BPS CLAIMS FILE #9002313.02
  1. S BPSPR=$$GET1^DIQ(9002313.57,BPS57,401,"I")
  1. ;
  1. ; RX ACTION - Field 1201
  1. S BPSRXACT=$$GET1^DIQ(9002313.57,BPS57,1201)
  1. ;
  1. ; COB Indicator (Payer Sequence)
  1. S BPSSQ=$$GET1^DIQ(9002313.57,BPS57,18,"I")
  1. ;
  1. ; Status of the Request
  1. S BPSSTATUS=$$GET1^DIQ(9002313.57,BPS57,4.0098)
  1. ;
  1. ; PROVIDER - Field 4 - Pointer to NEW PERSON FILE #200
  1. S BPSPRV=$$GET1^DIQ(52,BPSRX,4,"I")
  1. ;
  1. ; DRUG - Field 6 - Pointer to DRUG FILE #50
  1. S BPSDRG=$$GET1^DIQ(9002313.57,BPS57,9999.94)
  1. S BPSDRGCLID=$$DRUGDIE^BPSUTIL1(BPSDRG,25)
  1. S BPSDRGCLNM=$$DRGCLNAM^BPSRPT6(BPSDRGCLID,50)
  1. ;
  1. S BPSVASITE=$$NS^XUAF4($$KSP^XUPARAM("INST"))
  1. ;
  1. ; ---------------------------------------
  1. ;
  1. ; Build BPSTMP array
  1. ;
  1. I $$GET1^DIQ(9002313.02,BPSPC,901,"I")=1 S BPSTMP("OpenClosed")="C"
  1. E S BPSTMP("OpenClosed")="O"
  1. ;
  1. I BPSTMP("OpenClosed")="C" D
  1. . S BPSTMP("ClosedByUser")=$$GET1^DIQ(9002313.02,BPSPC,903)
  1. . S BPSTMP("ClosedDate")=$$FMTE^XLFDT($$GET1^DIQ(9002313.02,BPSPC,902,"I"),"7DZ")
  1. . S BPSTMP("ClosedDate")=$TR(BPSTMP("ClosedDate"),"/","-")
  1. . S BPSTMP("ClosedReason")=$$GET1^DIQ(9002313.02,BPSPC,904)
  1. E D
  1. . S BPSTMP("ClosedByUser")=""
  1. . S BPSTMP("ClosedDate")=""
  1. . S BPSTMP("ClosedReason")=""
  1. ;
  1. S BPSTMP("BilledAmount")=$$GET1^DIQ(9002313.57,BPS57,505)
  1. S BPSTMP("BillNumber")=$$BILL^BPSRPT6(BPSRX,BPSRF,BPSSQ)
  1. S BPSTMP("BIN")=$$GET1^DIQ(9002313.57,BPS57,10101)
  1. S BPSTMP("ClaimID")=$$GET1^DIQ(9002313.57,BPS57,3)
  1. I BPSPR'="" S BPSTMP("ClaimID")=$$GET1^DIQ(9002313.57,BPS57,401)
  1. S BPSTMP("CollectedAmount")=+$$COLLECTD^BPSRPT6(BPSRX,BPSRF,BPSSQ)
  1. S BPSTMP("CompletedDate")=$$FMTE^XLFDT($$GET1^DIQ(9002313.57,BPS57,7,"I"),"7DZ")
  1. S BPSTMP("CompletedDate")=$TR(BPSTMP("CompletedDate"),"/","-")
  1. S BPSTMP("DispensingFee")=$$GET1^DIQ(9002313.57,BPS57,504)
  1. S BPSTMP("DispensingFeePaid")=$$GET1^DIQ(9002313.57,BPS57,10507)
  1. S BPSTMP("Division")=$$GET1^DIQ(9002313.57,BPS57,1.07)
  1. S BPSTMP("DrugClass")=BPSDRGCLNM
  1. S BPSTMP("DrugName")=$$GET1^DIQ(9002313.57,BPS57,9999.93)
  1. ;
  1. S BPSPC1=BPSPC
  1. ; Check if claim is a reversal
  1. I BPSPR'="" S BPSPC1=BPSPR
  1. I BPSPC1=""!(BPSPOS="") S BPSECME=""
  1. E S BPSECME=$P($G(^BPSC(BPSPC1,400,BPSPOS,400)),"^",2)
  1. I BPSECME="" S BPSECME=$$FORMAT^BPSSCRU2("",12," ",1)
  1. S BPSTMP("ECMENumber")=$E(BPSECME,3,14)
  1. ;
  1. S BPSTMP("ElapseTimeInSeconds")=$$GET1^DIQ(9002313.57,BPS57,9999.97)
  1. S BPSTMP("Eligibility")=$$GET1^DIQ(9002313.57,BPS57,901.04)
  1. I BPSTMP("Eligibility")="VETERAN" S BPSTMP("Eligibility")="Veteran"
  1. I (BPSRX&BPSRF) S BPSTMP("FillLocation")=$$MWC^PSOBPSU2(BPSRX,BPSRF)
  1. ;
  1. S BPSRXACT1="RT"
  1. I BPSRXACT="BB" S BPSRXACT1="BB"
  1. I BPSRXACT="P2"!(BPSRXACT="P2S") S BPSRXACT1="P2"
  1. I BPSRXACT="ERES"!(BPSRXACT="ERMV")!(BPSRXACT="ERNB") S BPSRXACT1="RS"
  1. S BPSTMP("FillType")=BPSRXACT1
  1. ;
  1. S BPSTMP("GroupID")=$$GET1^DIQ(9002313.57,BPS57,10301)
  1. S BPSTMP("IngredientCost")=$$GET1^DIQ(9002313.57,BPS57,10409)
  1. S BPSTMP("IngredientCostPaid")=$$GET1^DIQ(9002313.57,BPS57,10506)
  1. S BPSTMP("InsuranceName")=$P($$INSNAM^BPSRPT6(BPS59),"^",2)
  1. ;
  1. I (BPSPOS&BPSRC) S BPSTMP("InsurancePaidAmount")=+$$INSPAID1^BPSOS03(BPSRC,BPSPOS)
  1. E S BPSTMP("InsurancePaidAmount")=0
  1. ;
  1. I $$GET1^DIQ(9002313.57,BPS57,10510)>1 S BPSTMP("MultipleRejects")="Y"
  1. E S BPSTMP("MultipleRejects")="N"
  1. I $$GET1^DIQ(9002313.57,BPS57,10510)="" S BPSTMP("MultipleRejects")=""
  1. ;
  1. S BPSTMP("NDC")=$$GET1^DIQ(9002313.57,BPS57,10)
  1. ;
  1. S BPSPTID=$$GET1^DIQ(2,BPSDFN,.09)
  1. S BPSPTID=$E(BPSPTID,($L(BPSPTID)-3),$L(BPSPTID))
  1. S BPSTMP("PatientID")=BPSPTID
  1. ;
  1. S BPSTMP("PatientName")=$$GET1^DIQ(9002313.57,BPS57,5)
  1. S BPSTMP("PatientPayAmount")=$$GET1^DIQ(9002313.57,BPS57,10505)
  1. S BPSTMP("PayerResponse")=BPSSTATUS
  1. S BPSTMP("Prescriber")=$$GET1^DIQ(9002313.57,BPS57,10427)
  1. S BPSTMP("PrescriberID")=$$GET1^DIQ(9002313.57,BPS57,10411)
  1. S BPSTMP("Quantity")=$$GET1^DIQ(9002313.57,BPS57,501)
  1. S BPSTMP("Refill")=$$GET1^DIQ(9002313.57,BPS57,9)
  1. ;
  1. I BPSSTATUS["REJECTED" S BPSTMP("Rejected")="REJ"
  1. E S BPSTMP("Rejected")=""
  1. ;
  1. F BPSRJF=10511.01:.01:10511.2 I $$GET1^DIQ(9002313.57,BPS57,BPSRJF)'="" D
  1. . S BPSRJDATA=$$GET1^DIQ(9002313.57,BPS57,BPSRJF)
  1. . S BPSRJC=$P(BPSRJDATA," ")
  1. . S BPSRJE=$P(BPSRJDATA," ",2,99)
  1. . S BPSRJN=(BPSRJF-10511)*100
  1. . S BPSTMP("RejectCode"_BPSRJN)=BPSRJC
  1. . S BPSTMP("RejectExplanation"_BPSRJN)=BPSRJE
  1. ;
  1. S BPSTMP("ReleasedDate")=$$FMTE^XLFDT($$GET1^DIQ(9002313.57,BPS57,9999.95,"I"),"7DZ")
  1. S BPSTMP("ReleasedDate")=$TR(BPSTMP("ReleasedDate"),"/","-")
  1. ;
  1. I BPSSTATUS["REVERSAL" D
  1. . I BPSSTATUS["ACCEPTED" S BPSTMP("ReturnStatus")="ACCEPTED"
  1. . E S BPSTMP("ReturnStatus")="REJECTED"
  1. . ;
  1. . I +$$GET1^DIQ(9002313.02,BPSPC,.07,"I")=0 S BPSTMP("ReversalMethod")="Regular"
  1. . E S BPSTMP("ReversalMethod")="Auto"
  1. . ;
  1. . S BPSTMP("ReversalReason")=$$GET1^DIQ(9002313.57,BPS57,404)
  1. E D
  1. . S BPSTMP("ReturnStatus")=""
  1. . S BPSTMP("ReversalMethod")=""
  1. . S BPSTMP("ReversalReason")=""
  1. ;
  1. S BPSTMP("RxCOB")=""
  1. I BPSSQ=1 S BPSTMP("RxCOB")="p"
  1. I BPSSQ=2 S BPSTMP("RxCOB")="s"
  1. I BPSSQ=3 S BPSTMP("RxCOB")="t"
  1. ;
  1. S BPSTMP("RxNumber")=$$GET1^DIQ(9002313.57,BPS57,1.11)
  1. S BPSTMP("SiteName")=$P(BPSVASITE,"^")
  1. S BPSTMP("SiteNumber")=$P(BPSVASITE,"^",2)
  1. S BPSTMP("Touched")=$$TOUCHED^BPSUTIL(BPS57)
  1. S BPSTMP("TransactionDate")=$$FMTE^XLFDT($$GET1^DIQ(9002313.57,BPS57,6,"I"),"7DZ")
  1. S BPSTMP("TransactionDate")=$TR(BPSTMP("TransactionDate"),"/","-")
  1. ;
  1. I BPSRF=0 S BPSRDT=$$RXRELDT^BPSRPT6(BPSRX)\1
  1. I BPSRF'=0 S BPSRDT=$$REFRELDT^BPSRPT6(BPSRX,BPSRF)\1
  1. S BPSX="/N"
  1. I $P(BPSRDT,"^") S BPSX="/R"
  1. S BPSTMP("TransactionStatus")=$$RXST^BPSSCRU2(BPS59)_BPSX
  1. ;
  1. S RESP1=""
  1. I BPSSTATUS="E CAPTURED" S RESP1="Captured"
  1. I BPSSTATUS="E DUPLICATE" S RESP1="Duplicate"
  1. I BPSSTATUS="E PAYABLE" S RESP1="Payable"
  1. I BPSSTATUS="E REJECTED" S RESP1="Rejected"
  1. I BPSSTATUS["REVERSAL" S RESP1="Reversal"
  1. I BPSSTATUS["UNSTRANDED" D
  1. . S RESP1="Unstranded"
  1. . S BPSTMP("Touched")=1
  1. I RESP1="" S RESP1="Other"
  1. S BPSTMP("TransactionType")=RESP1
  1. ;
  1. D REFORMAT
  1. ;
  1. JSON ; Prepare JSON file
  1. ; Transform the BPSTMP1 array into JSON format
  1. D ENCODE^XLFJSON("BPSTMP1",RESULT,$NA(^TMP("JSERR",$J)))
  1. I $D(^TMP("JSERR",$J)) D Q ; handle encoder error
  1. . D MSGSET(.RESULT,"Error","JSON encoding error.")
  1. S @RESULT@(1)="["_@RESULT@(1) ;$P(RESULT(1),":",2,9999)
  1. S BPSCNT=""
  1. S BPSCNT=$O(@RESULT@(BPSCNT),-1)
  1. S @RESULT@(BPSCNT)=$E(@RESULT@(BPSCNT),1,($L(@RESULT@(BPSCNT))-1))_"}]"
  1. Q
  1. ;
  1. REFORMAT ; Reformat BPSTMP array
  1. ; Reformat BPSTMP array into BPSTMP1 to transform to JSON format
  1. ; BPSTMP1 will regroup fields by FHIR Resource
  1. S BPSFLD=""
  1. S BPSCNT=0
  1. F S BPSFLD=$O(BPSTMP(BPSFLD)) Q:BPSFLD="" D
  1. . ; Exclude field if value is nil
  1. . I $G(BPSTMP(BPSFLD))="" Q
  1. . S BPSFHIR1=""
  1. . F BPSI=1:1 S BPSFHIR=$P($T(FHIR+BPSI),";;",2,99) Q:BPSFHIR=""!(BPSFHIR1'="") D
  1. . . I BPSFLD=$P(BPSFHIR,";;") S BPSFHIR1=$P(BPSFHIR,";;",2)
  1. . I BPSFHIR1="" S BPSFHIR1="Basic"
  1. . S BPSCNT=BPSCNT+1
  1. . S BPSTMP1("Bundle",BPSFHIR1,BPSCNT,BPSFLD)=BPSTMP(BPSFLD)
  1. Q
  1. ;
  1. MSGSET(TYP,MSG) ;return error or informational message
  1. ; RSLT - storage location, passed by ref.
  1. ; TYP - message type
  1. ; MSG - text
  1. K @RESULT
  1. S @RESULT@(1)="[{"_$C(34)_$G(TYP)_$C(34)_" : "_$C(34)_$G(MSG)_$C(34)_"}]"
  1. Q
  1. LOG(SVARRY) ; create log in ^XTMP('BPSTAS-LOG-'_'+$h')
  1. ; SVARRY - name of array to save, e.g. "RCVAL" or "ARG"
  1. N A,C,ND
  1. S ND="BPSTAS-LOG-"_(+$H) ; one log node per day
  1. I '$D(^XTMP(ND,0)) D ; need a zero node
  1. . ; expires after 3 days ^ created on ^ desc.
  1. . S A=$$HTFM^XLFDT($H+3),$P(A,"^",2)=$$NOW^XLFDT,$P(A,"^",3)="routine "_$T(+0)_" log"
  1. . S ^XTMP(ND,0)=A
  1. ; C - log counter
  1. S C=$G(^XTMP(ND,0,"COUNT"))+1,^("COUNT")=C_"^"_$H
  1. S ^XTMP(ND,C,"$J")=$J,^("$H")=$H,^("$I")=$I
  1. F A="DUZ","IO" M ^XTMP(ND,C,"var",A)=@A
  1. ; if SVARRY passed in, log it
  1. I $L($G(SVARRY)) S A=$NA(@SVARRY) M ^XTMP(ND,C,"log",A)=@A
  1. Q
  1. ;
  1. FHIR ; Get FHIR Resource for field
  1. ;;BilledAmount;;Claim
  1. ;;BillNumber;;Claim
  1. ;;BIN;;Organization
  1. ;;ClaimID;;Claim
  1. ;;ClosedByUser;;Basic
  1. ;;ClosedDate;;Basic
  1. ;;ClosedReason;;Basic
  1. ;;CollectedAmount;;ClaimResponse
  1. ;;CompletedDate;;PaymentReconciliation
  1. ;;DispensingFee;;Claim
  1. ;;DispensingFeePaid;;ClaimResponse
  1. ;;Division;;Organization
  1. ;;DrugClass;;Substance
  1. ;;DrugName;;Medication
  1. ;;ECMENumber;;Basic
  1. ;;ElapseTimeInSeconds;;MedicationDispense
  1. ;;Eligibility;;Basic
  1. ;;FillLocation;;Location
  1. ;;FillType;;MedicationDispense
  1. ;;GroupID;;Coverage
  1. ;;IngredientCost;;Claim
  1. ;;IngredientCostPaid;;ClaimResponse
  1. ;;InsuranceName;;Organization
  1. ;;InsurancePaidAmount;;ClaimResponse
  1. ;;MultipleRejects;;Basic
  1. ;;NDC;;Medication
  1. ;;OpenClosed;;Claim
  1. ;;PatientID;;Patient
  1. ;;PatientName;;Patient
  1. ;;PatientPayAmount;;ExplanationOfBenefit
  1. ;;PayerResponse;;ClaimResponse
  1. ;;Prescriber;;Practitioner
  1. ;;PrescriberID;;Practitioner
  1. ;;Quantity;;MedicationDispense
  1. ;;Refill;;MedicationDispense
  1. ;;RejectCode1;;ClaimResponse
  1. ;;RejectCode2;;ClaimResponse
  1. ;;RejectCode3;;ClaimResponse
  1. ;;RejectCode4;;ClaimResponse
  1. ;;RejectCode5;;ClaimResponse
  1. ;;RejectCode6;;ClaimResponse
  1. ;;RejectCode7;;ClaimResponse
  1. ;;RejectCode8;;ClaimResponse
  1. ;;RejectCode9;;ClaimResponse
  1. ;;RejectCode10;;ClaimResponse
  1. ;;RejectCode11;;ClaimResponse
  1. ;;RejectCode12;;ClaimResponse
  1. ;;RejectCode13;;ClaimResponse
  1. ;;RejectCode14;;ClaimResponse
  1. ;;RejectCode15;;ClaimResponse
  1. ;;RejectCode16;;ClaimResponse
  1. ;;RejectCode17;;ClaimResponse
  1. ;;RejectCode18;;ClaimResponse
  1. ;;RejectCode19;;ClaimResponse
  1. ;;RejectCode20;;ClaimResponse
  1. ;;RejectCount;;ClaimResponse
  1. ;;Rejected;;Basic
  1. ;;RejectExplanation1;;ClaimResponse
  1. ;;RejectExplanation2;;ClaimResponse
  1. ;;RejectExplanation3;;ClaimResponse
  1. ;;RejectExplanation4;;ClaimResponse
  1. ;;RejectExplanation5;;ClaimResponse
  1. ;;RejectExplanation6;;ClaimResponse
  1. ;;RejectExplanation7;;ClaimResponse
  1. ;;RejectExplanation8;;ClaimResponse
  1. ;;RejectExplanation9;;ClaimResponse
  1. ;;RejectExplanation10;;ClaimResponse
  1. ;;RejectExplanation11;;ClaimResponse
  1. ;;RejectExplanation12;;ClaimResponse
  1. ;;RejectExplanation13;;ClaimResponse
  1. ;;RejectExplanation14;;ClaimResponse
  1. ;;RejectExplanation15;;ClaimResponse
  1. ;;RejectExplanation16;;ClaimResponse
  1. ;;RejectExplanation17;;ClaimResponse
  1. ;;RejectExplanation18;;ClaimResponse
  1. ;;RejectExplanation19;;ClaimResponse
  1. ;;RejectExplanation20;;ClaimResponse
  1. ;;ReleasedDate;;MedicationDispense
  1. ;;ReturnStatus;;Basic
  1. ;;ReversalMethod;;Claim
  1. ;;ReversalReason;;ClaimResponse
  1. ;;RxCOB;;Basic
  1. ;;RxNumber;;MedicationRequest
  1. ;;SiteName;;Organization
  1. ;;SiteNumber;;Organization
  1. ;;Touched;;Claim
  1. ;;TransactionDate;;MessageHeader
  1. ;;TransactionStatus;;MessageHeader
  1. ;;TransactionType;;MessageHeader
  1. ;
  1. ;