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