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

BPSOSCD.m

Go to the documentation of this file.
  1. BPSOSCD ;BHAM ISC/FCS/DRS/DLF - Set BPS() "RX" nodes for current medication ;06/01/2004
  1. ;;1.0;E CLAIMS MGMT ENGINE;**1,3,2,5,7,8,10,11,15,19,20,23,24,27**;JUN 2004;Build 15
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; reference to $$ACPHONE^IBNCPDPI supported by DBIA 4721
  1. ; reference to $$MADD^XUAF4 supported by DBIA 2171
  1. ; reference to $$GET1^DIQ(200,field) supported by DBIA 10060
  1. ; reference to $$GET1^DIQ(5,field) supported by DBIA 10056
  1. ; reference to PSS^PSO59 supported by DBIA 4827
  1. ; reference to $$SITE^VASITE supported by DBIA 10112
  1. ;
  1. Q
  1. ;
  1. ;MEDINFO, Set BPS("RX)" nodes for current medication
  1. ; Called from BPSOSCA for every transaction in the multiple
  1. ; IEN59 = IEN in BPS TRANSACTION (#9002313.59)
  1. ; IEN5902 = IEN for Insurance multiple of BPS Transactions
  1. ; MEDN = Index number of medication being processed
  1. ; BPS array shared by all of the BPSOSC* routines, created in BPSOSCA
  1. ; VAINFO created in BPSOSCB
  1. MEDINFO(IEN59,IEN5902,MEDN) ;
  1. ; Verify Parameters
  1. I $G(IEN59)="" Q
  1. I $G(IEN5902)="" Q
  1. I $G(MEDN)="" Q
  1. ;
  1. N %,BPS0,DRUGIEN,IENS,J,NDC,NPI,OSITEIEN,PRICING,PROVIEN,RTN,RXI,RXIEN,RXRFIEN,VANATURE,VAOIEN,X,ADFEE
  1. ;
  1. ;RXIEN=Rx IEN, RXRFIEN=Fill Number, IENS=FileMan style IENS
  1. S BPS0=$G(^BPST(IEN59,1)),RXIEN=$P(BPS0,U,11),RXRFIEN=$P(BPS0,U,1),IENS=IEN5902_","_IEN59_","
  1. ;
  1. S RTN=$T(+0) ; for log
  1. ; Get any user-entered overrides stored in BPS NCPDP OVERRIDES
  1. D OVERRIDE(IEN59,MEDN)
  1. ;
  1. ; Retrieve DUR values
  1. D DURVALUE(IEN59,MEDN)
  1. ;
  1. ; Build COB array for secondary claims
  1. I $$COB59^BPSUTIL2(IEN59)>1 D COB(IEN59,MEDN)
  1. ;
  1. ; Basic RX info
  1. S BPS("RX",MEDN,"IEN59")=IEN59
  1. S BPS("RX",MEDN,"RX IEN")=RXIEN
  1. S BPS("RX",MEDN,"RX Number")=RXIEN
  1. ;
  1. ; Stop if the transaction code is "E1" and there is no Prescription IEN
  1. I BPS("Transaction Code")="E1",RXIEN="" Q
  1. ;
  1. ; Get Provider Info
  1. S PROVIEN=+$$RXAPI1^BPSUTIL1(RXIEN,4,"I")
  1. S BPS("RX",MEDN,"Prescriber IEN")=PROVIEN
  1. I PROVIEN'="" D
  1. .S X=$$GET1^DIQ(200,PROVIEN,.01)
  1. .D NAMECOMP^XLFNAME(.X)
  1. .S BPS("RX",MEDN,"Prescriber Last Name")=X("FAMILY")
  1. .S BPS("RX",MEDN,"Prescriber First Name")=X("GIVEN") ; NCPDP field 364-2J
  1. .S BPS("RX",MEDN,"Prescriber Middle Name")=X("MIDDLE") ; NCPDP field E12-0F
  1. .S BPS("RX",MEDN,"Prescriber Phone #")=$$ACPHONE^IBNCPDPI ; DBIA 4721, Agent Cashier Phone Number
  1. .S BPS("RX",MEDN,"Prescriber Billing Location")=""
  1. .S NPI=$$NPI^BPSNPI("Individual_ID",+PROVIEN)
  1. .I NPI<0 S NPI=""
  1. .S BPS("RX",MEDN,"Prescriber NPI")=$P(NPI,U)
  1. .S BPS("RX",MEDN,"Primary Care Provider NPI")=$P(NPI,U)
  1. .S BPS("RX",MEDN,"Provider NPI")=$P(NPI,U)
  1. .;
  1. .S BPS("RX",MEDN,"Prescriber DEA")=$$GET1^DIQ(200,PROVIEN,53.2) ; NCPDP field D01-KV
  1. .S X=$$PRVADRS(IEN59,PROVIEN) ; provide address info
  1. .S BPS("RX",MEDN,"Prescriber Street Address")=$P(X,U)_$S($P(X,U,5)]"":" ",1:"")_$P(X,U,5) ; NCPDP field 365-2K
  1. .S BPS("RX",MEDN,"Prescriber Street Address Line 1")=$P(X,U) ; NCPDP field B27-7U
  1. .S BPS("RX",MEDN,"Prescriber Street Address Line 2")=$P(X,U,5) ; NCPDP field B28-8U
  1. .S BPS("RX",MEDN,"Prescriber City Address")=$P(X,U,2) ; NCPDP field 366-2M
  1. .S BPS("RX",MEDN,"Prescriber State/Province Address")=$P(X,U,3) ; NCPDP field 367-2N
  1. .S BPS("RX",MEDN,"Prescriber Zip/Postal Zone")=$TR($P(X,U,4)," -") ; NCPDP field 368-2P
  1. .S BPS("RX",MEDN,"Prescriber Country")=$$COUNTRY($P(X,U,3),$P(X,U,6)) ;NCPDP field B42-3C
  1. ;
  1. ; Stop if Eligibility as we do not need any of the claim data below
  1. I BPS("Transaction Code")="E1" Q
  1. ;
  1. ; Basic Prescription Info
  1. S BPS("RX",MEDN,"Date Written")=$$RXAPI1^BPSUTIL1(RXIEN,1,"I")
  1. ; SLT - BPS*1.0*11
  1. ; if the RX Issue Date is in the future, set it to the current date
  1. I BPS("RX",MEDN,"Date Written")>DT S BPS("RX",MEDN,"Date Written")=DT
  1. S BPS("RX",MEDN,"New/Refill")=$S(RXRFIEN="":"N",1:"R")
  1. S BPS("RX",MEDN,"# Refills")=$$RXAPI1^BPSUTIL1(RXIEN,9,"I")
  1. S BPS("RX",MEDN,"Refill #")=+RXRFIEN
  1. S BPS("RX",MEDN,"Pharmacy Service Type")="01" ; 147-U7 Pharmacy Service Type, 1=Community/Retail Pharmacy Services
  1. ;
  1. ; PreAuth and Prior Authorization
  1. ; #1.09 Prior Authorization Number, #1.15 Prior Auth Type Code
  1. S X=$G(^BPST(IEN59,1))
  1. S BPS("RX",MEDN,"Preauth #")=$P(X,U,15)_$P(X,U,9)
  1. S BPS("Claim",MEDN,"Prior Auth Type")=$P(X,U,15)
  1. S BPS("Claim",MEDN,"Prior Auth Num Sub")=$P(X,U,9)
  1. ;
  1. ; delay reason code not sent unless user specifies a code
  1. S BPS("Claim",MEDN,"Delay Reason Code")="" ; 357-NV Delay Reason Code
  1. ;
  1. ; Calculate date/time for Time of Service 678-Y6 - BPS*1*15
  1. ; using SUBMIT REQUEST DATE TIME field #17 from earliest transmission log entry
  1. N FDTIME,IEN57 S IEN57=$O(^BPSTL("B",IEN59,0)) I IEN57 S FDTIME=$P($G(^BPSTL(IEN57,0)),U,13)
  1. ; Otherwise use current time
  1. I $G(FDTIME)="" S FDTIME=$$NOW^XLFDT
  1. ; Save time as HHMMSS
  1. S BPS("Claim",MEDN,"Time of Service")=$$LJ^XLFSTR($P(FDTIME,".",2),6,0) ; 678-Y6 Time of Service
  1. ;
  1. ; NDC = NDC number drug, try transaction 1st, if null get it from Rx/refill
  1. S BPS("RX",MEDN,"Product ID Qualifier")="03"
  1. S NDC=$P(^BPST(IEN59,1),U,2)
  1. I NDC="" S NDC=$$GETNDC^PSONDCUT(RXIEN,RXRFIEN) D LOG^BPSOSL(IEN59,RTN_"-NDC sent as "_NDC)
  1. S BPS("RX",MEDN,"NDC")=NDC
  1. ;
  1. ; Prescription Data dependent on original vs. refill
  1. D:'RXRFIEN ; 1st fill
  1. .S BPS("RX",MEDN,"Days Supply")=$$RXAPI1^BPSUTIL1(RXIEN,8,"I")
  1. .S BPS("RX",MEDN,"DAW")=$$RXAPI1^BPSUTIL1(RXIEN,81,"I")
  1. .;Use FINISHING PERSON field as pharmacist identifier for Initials and ID - BPS*1*15 - DBIA 10112 for $$SITE
  1. .S BPS("Provider",MEDN,"Pharmacist Initials")=$$GET1^DIQ(200,+$$RXAPI1^BPSUTIL1(RXIEN,38,"I"),1)
  1. .S BPS("Provider",MEDN,"Pharmacist ID")=$P($$SITE^VASITE,U,3)_$$RJ^XLFSTR(+$$RXAPI1^BPSUTIL1(RXIEN,38,"I"),15,0)
  1. D:RXRFIEN ; refill
  1. .S BPS("RX",MEDN,"Days Supply")=$$RXSUBF1^BPSUTIL1(RXIEN,52,52.1,RXRFIEN,1.1,"I")
  1. .S BPS("RX",MEDN,"DAW")=$$RXSUBF1^BPSUTIL1(RXIEN,52,52.1,RXRFIEN,81,"I")
  1. .;Use FILLING PERSON field as pharmacist identifier for Initials and ID - BPS*1*15 - DBIA 10112 for $$SITE
  1. .S BPS("Provider",MEDN,"Pharmacist Initials")=$$GET1^DIQ(200,+$$RXSUBF1^BPSUTIL1(RXIEN,52,52.1,RXRFIEN,19,"I"),1)
  1. .S BPS("Provider",MEDN,"Pharmacist ID")=$P($$SITE^VASITE,U,3)_$$RJ^XLFSTR(+$$RXSUBF1^BPSUTIL1(RXIEN,52,52.1,RXRFIEN,19,"I"),15,0)
  1. ;
  1. ; Origin Code, VAOIEN=PLACER ORDER # from file 52, VANATURE=NATURE OF ORDER in sub-file 100.008
  1. S VAOIEN=+$$RXAPI1^BPSUTIL1(RXIEN,39.3,"I"),VANATURE=$$GET1^DIQ(100.008,"1,"_VAOIEN_",","12")
  1. S BPS("RX",MEDN,"Origin Code")=$S(VANATURE="AUTO":2,VANATURE["ELECTRONIC":3,VANATURE="DUPLICATE":0,VANATURE["TELEPHONE":2,1:1)
  1. ;
  1. ; NCPDP field 420-DK Submission Clarification Code, default to "01" for vD.0
  1. ; note: this is a multiple (#9002313.02354), additional codes may be added by other routines
  1. S %=$P($G(^BPST(IEN59,12)),U,3),BPS("RX",MEDN,"Submission Clarif Code",1)=$S(%]"":%,1:"01")
  1. ;
  1. ; Drug Info
  1. S DRUGIEN=$$RXAPI1^BPSUTIL1(RXIEN,6,"I")
  1. D:DRUGIEN'=""
  1. .S BPS("RX",MEDN,"Drug IEN")=DRUGIEN
  1. .S BPS("RX",MEDN,"Drug Name")=$$DRUGDIE^BPSUTIL1(DRUGIEN,.01,"E")
  1. ;
  1. ; Pricing Info
  1. S PRICING=$G(^BPST(IEN59,5))
  1. S BPS("RX",MEDN,"Quantity")=$P(PRICING,U)
  1. S BPS("RX",MEDN,"Unit Price")=$P(PRICING,U,2)
  1. S BPS("RX",MEDN,"Unit of Measure")=$P(PRICING,U,8)
  1. S BPS("RX",MEDN,"Basis of Cost Determination")=$G(VAINFO(9002313.59902,IENS,902.13,"I"))
  1. S BPS("RX",MEDN,"Usual & Customary")=$G(VAINFO(9002313.59902,IENS,902.14,"I"))
  1. S BPS("RX",MEDN,"Gross Amount Due")=$G(VAINFO(9002313.59902,IENS,902.15,"I"))
  1. S BPS("RX",MEDN,"Ingredient Cost")=$G(VAINFO(9002313.59902,IENS,902.2,"I"))
  1. S BPS("RX",MEDN,"Dispensing Fee")=$G(VAINFO(9002313.59902,IENS,902.12,"I"))
  1. S ADFEE=+$G(VAINFO(9002313.59902,IENS,902.16,"I"))
  1. I ADFEE'=0 D
  1. . S BPS("RX",MEDN,"Other Amt Qual",1)="04"
  1. . S BPS("RX",MEDN,"Other Amt Value",1)=ADFEE
  1. ;
  1. Q
  1. ;
  1. ; OVERRIDE - Retrieve OVERRIDE nodes and put into BPS array
  1. ; They will be fetched from BPS("OVERRIDE"
  1. ; during low-level construction of the actual encoded claim packet.
  1. ; BPS("OVERRIDE",field)=value for fields 101-401
  1. ; BPS("OVERRIDE","RX",MEDN,field) for med #N, fields 402+
  1. ; Note that if you have multiple transactions bundled, the
  1. ; union of overrides from 101-401 apply to all; and if there's a
  1. ; conflict, the last one overwrites the previous ones.
  1. OVERRIDE(IEN59,MEDN) ;
  1. N IEN511,RETVAL
  1. S IEN511=$P(^BPST(IEN59,1),U,13) Q:'IEN511
  1. S RETVAL=$$GET511^BPSOSO2(IEN511,"BPS(""OVERRIDE"")","BPS(""OVERRIDE"",""RX"","_MEDN_")")
  1. Q
  1. ;
  1. ; DURVALUE - Will read in the DUR data from the DUR multiple
  1. ; in BPS Transactions and store the values into BPS("RX",MEDN,DUR,....)
  1. ; NOTE - unlike most values, these fields are stored by their
  1. ; field number. Since they are repeating, it will ease the
  1. ; retrieval of them, when we populate the claim.
  1. DURVALUE(IEN59,MEDN) ;
  1. N DUR,DCNT,DURREC
  1. ;
  1. S (DUR,DCNT)=0
  1. F S DCNT=$O(^BPST(IEN59,13,DCNT)) Q:'DCNT D
  1. .S DURREC=$G(^BPST(IEN59,13,DCNT,0))
  1. .I DURREC="" Q
  1. .S DUR=DUR+1
  1. .S BPS("RX",MEDN,"DUR",DUR,473)=DUR ;473-7E DUR/PPS Code Counter
  1. .S BPS("RX",MEDN,"DUR",DUR,439)=$P(DURREC,U,3) ;439-E4 Reason For Service Code
  1. .S BPS("RX",MEDN,"DUR",DUR,440)=$P(DURREC,U,2) ;440-E5 Professional Service Code
  1. .S BPS("RX",MEDN,"DUR",DUR,441)=$P(DURREC,U,4) ;441-E6 Result of Service Code
  1. .S BPS("RX",MEDN,"DUR",DUR,474)="" ;474-8E DUR/PPS Level Of Effort
  1. .Q:$G(BPS("NCPDP","Version"))'=51 ; fields 475&476 not used in vD.0
  1. .S BPS("RX",MEDN,"DUR",DUR,475)="" ;475-J9 DUR Co-Agent ID Qualifier
  1. .S BPS("RX",MEDN,"DUR",DUR,476)="" ;476-H6 DUR Co-Agent ID
  1. ;
  1. Q
  1. ;
  1. COB(IEN59,MEDN) ; process the COB fields and build the COB array
  1. ; Code for Benefit Stages multiple not implemented yet (except by
  1. ; certification)
  1. ;
  1. ; build array of COB secondary claim data from the BPS Transaction file - esg - 6/16/10
  1. N COBPIEN,APDIEN,REJIEN,DATA
  1. K BPS("RX",MEDN,"OTHER PAYER")
  1. ;
  1. ; Field 337-4C COB OTHER PAYMENTS COUNT (9002313.59,1204) moved into [1] below
  1. S BPS("RX",MEDN,"OTHER PAYER",0)=$P($G(^BPST(IEN59,12)),U,4)
  1. ;
  1. S COBPIEN=0 F S COBPIEN=$O(^BPST(IEN59,14,COBPIEN)) Q:'COBPIEN D
  1. . ; Note that this will set pieces 1-7 and 11. Piece 9 is reserved for
  1. . ; Benefit Stage Count and is set by the certification code
  1. . S BPS("RX",MEDN,"OTHER PAYER",COBPIEN,0)=$G(^BPST(IEN59,14,COBPIEN,0))
  1. . ;
  1. . ; retrieve data from other payer amount paid multiple
  1. . S APDIEN=0 F S APDIEN=$O(^BPST(IEN59,14,COBPIEN,1,APDIEN)) Q:'APDIEN D
  1. .. S DATA=$G(^BPST(IEN59,14,COBPIEN,1,APDIEN,0))
  1. .. S BPS("RX",MEDN,"OTHER PAYER",COBPIEN,"P",APDIEN,0)=$P(DATA,"^",1)_"^"_$$GET1^DIQ(9002313.2,$P(DATA,"^",2),.01)
  1. .. S BPS("RX",MEDN,"OTHER PAYER",COBPIEN,"PP",APDIEN,0)=$P(DATA,"^",3)
  1. .. I +$P(DATA,"^",3) S $P(BPS("RX",MEDN,"OTHER PAYER",COBPIEN,"PP",APDIEN,0),"^",2)="06"
  1. .. Q
  1. . ;
  1. . ; retrieve data from other payer reject multiple
  1. . S REJIEN=0 F S REJIEN=$O(^BPST(IEN59,14,COBPIEN,2,REJIEN)) Q:'REJIEN D
  1. .. S BPS("RX",MEDN,"OTHER PAYER",COBPIEN,"R",REJIEN,0)=$G(^BPST(IEN59,14,COBPIEN,2,REJIEN,0))
  1. Q
  1. ;
  1. PRVADRS(IEN59,PRVIEN) ; site address for a provider
  1. ; returns "street address^city^st^zip"
  1. ; IEN59=BPS TRANSACTION (#9002313.59) ien
  1. ; PRVIEN=provider IEN in NEW PERSON file (#200)
  1. ;
  1. I '$G(IEN59) Q ""
  1. I '$G(PRVIEN) Q ""
  1. ;
  1. N BPSND,F,IPTR,IEN,OPSITE,PRVADDR,PRVNVA,RSLT,AD2
  1. S RSLT=""
  1. ;
  1. S PRVNVA=+$$GET1^DIQ(200,PRVIEN_",",53.91,"I") ; NON-VA PRESCRIBER
  1. ;
  1. ; if false, it's a VA prescriber - address data found in file 4 for the VA pharmacy
  1. I 'PRVNVA D G PRVADX
  1. .S OPSITE=$P($G(^BPST(IEN59,1)),U,4) ; OUTPATIENT SITE ptr
  1. .Q:'OPSITE
  1. .S BPSND="BPS59" K ^TMP($J,BPSND)
  1. .D PSS^PSO59(OPSITE,"",BPSND)
  1. .S IPTR=$P($G(^TMP($J,BPSND,OPSITE,101)),U) ; INSTITUTION ptr
  1. .S:IPTR RSLT=$$MADD^XUAF4(IPTR)_U_$$GET1^DIQ(4,IPTR_",",4.02)_U_$$GET1^DIQ(4,IPTR_",",4.04,"I")
  1. .K ^TMP($J,BPSND)
  1. ;
  1. ; Non-VA prescriber - address data found in file 200
  1. F F=.111,.112,.113,.114,.115,.116 S PRVADDR(F)=$$GET1^DIQ(200,PRVIEN_",",F)
  1. ; Get State info
  1. S PRVADDR(.115,"ABBR")="",IEN=$$GET1^DIQ(200,PRVIEN_",",.115,"I"),PRVADDR(.115,"ABBR")=$$GET1^DIQ(5,+IEN_",",1)
  1. ; Build Address Line 2
  1. S AD2=PRVADDR(.112) I PRVADDR(.113)]"" S AD2=AD2_$S(AD2]"":" ",1:"")_PRVADDR(.113)
  1. ; Build result string
  1. S RSLT=PRVADDR(.111)_U_PRVADDR(.114)_U_PRVADDR(.115,"ABBR")_U_PRVADDR(.116)_U_AD2_U_IEN
  1. ;
  1. PRVADX ;
  1. Q RSLT
  1. ;
  1. COUNTRY(STATE,IEN) ;
  1. ; Convert STATE abbreviation into a ISO-3166-1 country code
  1. ; Input:
  1. ; STATE: State Abbreviation
  1. ; Output: ISO-3166-1 Country Code
  1. ;
  1. I $G(STATE)="" Q ""
  1. I '$G(IEN) Q ""
  1. I ",BC,MB,NB,NF,NS,NT,ON,PE,QC,SK,YT,CANAD,NU,"[(","_STATE_",") Q "CA" ; Canada
  1. I STATE="FG"!(STATE="EU")!(STATE="UN") Q "" ; Foreign Country, Europe, Unknown
  1. I STATE="AS" Q "AS" ; American Samoa
  1. I STATE="FM" Q "FM" ; Federated States of Micronesia
  1. I STATE="GU" Q "GU" ; Guam
  1. I STATE="MH" Q "MH" ; Marshall Islands
  1. I STATE="MP" Q "MP" ; Northern Mariana Islands
  1. I STATE="MX" Q "MX" ; Mexico
  1. I STATE="PH" Q "PH" ; Philippines
  1. I STATE="PR" Q "PR" ; Puerto Rico
  1. I STATE="PW" Q "PW" ; Palau
  1. I STATE="VI" Q "VI" ; Virgin Islands
  1. I $$GET1^DIQ(5,IEN_",",2.2,"I")=1 Q "US"
  1. Q ""