BPSOSCC ;BHAM ISC/FCS/DRS/DLF - Set up BPS() ;06/01/2004
;;1.0;E CLAIMS MGMT ENGINE;**1,2,5,8,10,11,19,27,32,33,37**;JUN 2004;Build 16
;;Per VA Directive 6402, this routine should not be modified.
;
; GETINFO - Create BPS array for non-repeating data
; IEN59 - Pointer to BPS Transactions
; IEN5902 - IEN for Insurance multiple of BPS Transactions
;
; BPS array is shared by all of the BPSOSC* routines, created in BPSOSCA
; VAINFO is created in BPSOSCB
Q
;
GETINFO(IEN59,IEN5902) ; EP - BPSOSCB
; both parameters required
Q:$G(IEN59)=""
Q:$G(IEN5902)=""
;
N BPPAYSEQ,BPSCS,BPSSEX,BPSSIG,BPSRF,BPSRX,DFN,IENS,NPI,SITE,VADM,VAPA,X
;
S BPPAYSEQ=$$COB59^BPSUTIL2(IEN59) ; COB payer sequence
; Setup IENS for transaction multiple
S IENS=IEN5902_","_IEN59_","
; Site Information
S SITE=$P($G(^BPST(IEN59,1)),U,4)
S NPI=$$NPI^BPSNPI("Pharmacy_ID",SITE)
I +NPI=-1 S NPI=""
S BPS("Site","NPI")=$P(NPI,U)
;
; Check for Controlled Substance Drug and if BPS Pharmacy for CS
; has been defined. If so, use NPI for the CS Pharmacy.
S BPSRX=$$GET1^DIQ(9002313.59,IEN59,1.11,"I")
S BPSRF=$$GET1^DIQ(9002313.59,IEN59,9)
S BPSCS=$$CSNPI^BPSUTIL(BPSRX,BPSRF)
I +$P(BPSCS,"^",2) S BPS("Site","NPI")=$P(BPSCS,"^",2)
;
; Get Transaction Code
S BPS("Transaction Code")=$S($P($G(^BPST(IEN59,0)),U,15)="E":"E1",1:"B1")
;
; Transaction Header Data
S BPS("NCPDP","IEN")=$G(VAINFO(9002313.59902,IENS,$S(BPS("Transaction Code")="E1":902.34,1:902.02),"I"))
S BPS("NCPDP","BIN Number")=$G(VAINFO(9002313.59902,IENS,902.03,"I"))
S BPS("NCPDP","PCN")=$G(VAINFO(9002313.59902,IENS,902.04,"I"))
S BPS("NCPDP","Software Vendor/Cert ID")=$G(VAINFO(9002313.59902,IENS,902.18,"I"))
I BPS("NCPDP","IEN")="" D IMPOSS^BPSOSUE("P","TI","Payer Sheet pointer missing from multiple",,1,$T(+0))
I BPS("NCPDP","IEN") S BPS("NCPDP","Version")=$P($G(^BPSF(9002313.92,BPS("NCPDP","IEN"),1)),U,2)
I $G(BPS("NCPDP","Version"))="" D IMPOSS^BPSOSUE("DB","TI","Payer sheet version missing.",,2,$T(+0))
S BPS("NCPDP","# Meds/Claim")=$G(VAINFO(9002313.59902,IENS,902.32,"I"))
I BPS("Transaction Code")="E1"!('BPS("NCPDP","# Meds/Claim")) S BPS("NCPDP","# Meds/Claim")=1
S BPS("NCPDP","DOS")=$$FMTHL7^XLFDT($P($G(^BPST(IEN59,12)),U,2))
;
; Patient Data
S DFN=$P(^BPST(IEN59,0),U,6)
I 'DFN D IMPOSS^BPSOSUE("DB","TI","DFN",,,$T(+0))
I DFN,'$D(^DPT(DFN,0)) D IMPOSS^BPSOSUE("DB","TI","^DPT(DFN)",,,$T(+0))
D DEM^VADPT,ADD^VADPT
S BPS("Patient","IEN")=DFN
S (X,BPS("Patient","Name"))=$G(VADM(1))
D SETNAME^PSOSPMUT(DFN)
S BPS("Patient","Last Name")=$G(PSONAME("LAST"))
S BPS("Patient","First Name")=$G(PSONAME("FIRST"))
S BPS("Patient","Middle Name")=$G(PSONAME("MIDDLE"))
S BPS("Patient","Prefix")=$G(PSONAME("PREFIX"))
S BPS("Patient","Suffix")=$G(PSONAME("SUFFIX"))
S BPS("Patient","Gender Code")=$$GENDER(IEN59)
S X=$P($G(VADM(3)),"^") ; date of birth, FM format
S BPS("Patient","DOB")=($E(X,1,3)+1700)_$E(X,4,7)
S BPS("Patient","SSN")=$P($G(VADM(2)),"^",1)
S BPS("Patient","State")=$P($G(VAPA(5)),"^",1)
I BPS("Patient","State")'="" S BPS("Patient","State")=$P($G(^DIC(5,BPS("Patient","State"),0)),"^",2)
S BPS("Patient","Street Address")=$G(VAPA(1))
S BPS("Patient","Street Address Line 1")=$G(VAPA(1))
S BPS("Patient","Street Address Line 2")=$G(VAPA(2))
S BPS("Patient","City")=$G(VAPA(4))
S BPS("Patient","Zip")=$G(VAPA(6))
S BPS("Patient","Phone #")=$TR($P($G(VAPA(8)),"^",1),"()-/*# ")
S BPS("Patient","Place of Service")=$S($G(BPS("NCPDP","Version"))=51:0,1:1) ; NCPDP field 307-C7 default to 1 for vD.0
S BPS("Patient","Patient Residence")=1 ; NCPDP field 384-4X, 1 for "Home"
S BPS("Patient","Patient E-Mail Address")=$$GET1^DIQ(2,DFN,.133) ; NCPDP field 350-HN
;
; Insurer Data
S BPS("Insurer","IEN")=$G(VAINFO(9002313.59902,IENS,.01,"I"))
S BPS("Patient","Primary Care Prov Location Code")=$G(VAINFO(9002313.59902,IENS,902.11,"I"))
S BPS("Insurer","Relationship")=$G(VAINFO(9002313.59902,IENS,902.07,"I"))
S:BPS("Insurer","Relationship")="" BPS("Insurer","Relationship")=0 ; if null set to unspecified
S BPS("Insurer","Person Code")=$G(VAINFO(9002313.59902,IENS,902.1,"I"))
;
; If 303-C3 Person Code has no value from patient insurance policy field, then continue to
; calculate the value based upon the 306-C6 Patient Relationship Code field
I BPS("Insurer","Person Code")="" D
. N REL S REL=BPS("Insurer","Relationship")
. S BPS("Insurer","Person Code")=$S(REL=1:"01",REL=2:"02",REL=3:"03",1:"")
. Q
;
S BPS("Insurer","Plan ID")=$G(VAINFO(9002313.59902,IENS,902.24,"I"))
S BPS("Insurer","Group #")=$G(VAINFO(9002313.59902,IENS,902.05,"I"))
S BPS("Insurer","Policy #")=$G(VAINFO(9002313.59902,IENS,902.06,"I")) ;CARDHOLDER ID
S BPS("Insurer","Full Policy #")=BPS("Insurer","Policy #")
S BPS("Insurer","Percent Sales Tax Rate Sub")="" ; 483-HE Percentage Sales Tax Rate Submitted
S BPS("Insurer","Percent Sales Tax Basis Sub")="" ; 484-JE Percentage Sales Tax Basis Submitted
S BPS("Insurer","Percentage Sales Tax Amt Sub")=0 ; 482-GE Percentage Sales Tax Amount Submitted
S BPS("Insurer","Flat Sales Tax Amount Sub")=0 ; 481-HA Flat Sales Tax Amount Submitted
;
; Cardholder Data
S BPS("Cardholder","First Name")=$G(VAINFO(9002313.59902,IENS,902.08,"I"))
S BPS("Cardholder","Last Name")=$G(VAINFO(9002313.59902,IENS,902.09,"I"))
S BPS("Home Plan")=$G(VAINFO(9002313.59902,IENS,902.11,"I"))
;
; set additional fields for secondary claim
S:BPPAYSEQ>1 BPS("Patient","Other Coverage Code")=$P($G(^BPST(IEN59,12)),U,5) ; NCPDP field 308-C8 Other Coverage Code
;
Q
;
GENDER(IEN59) ; Determine the value for Patient Gender Code (305-C5).
;
N BPSGENDER,BPSPREVCL,BPSPREVTRAN,BPSSEX,BPSSIG
;
; If a previous claim exists, use the Patient Gender Code sent on
; that claim. At this point in the process, an entry will exist in
; ^BPSTL only if there has been a previous claim.
;
S BPSGENDER=""
S BPSPREVTRAN=""
F S BPSPREVTRAN=$O(^BPSTL("B",IEN59,BPSPREVTRAN),-1) Q:'BPSPREVTRAN D I BPSGENDER'="" Q
. I $$GET1^DIQ(9002313.57,BPSPREVTRAN,19,"I")'="C" Q
. S BPSPREVCL=$$GET1^DIQ(9002313.57,BPSPREVTRAN,3,"I")
. I BPSPREVCL="" Q
. S BPSGENDER=$$GET1^DIQ(9002313.02,BPSPREVCL,305,"I")
. S BPSGENDER=$E(BPSGENDER,3)
. Q
I BPSGENDER'="" Q BPSGENDER
;
; If no previous claim, determine the value based on Self Identified
; Gender, and if that field is blank, use the field Sex.
;
S BPSSEX=$P($G(VADM(5)),"^",1) ; SEX, field# .02
S BPSSIG=$P($G(VADM(14,5)),"^",2) ; SELF IDENTIFIED GENDER, field# .024
I BPSSIG'="" S BPSGENDER=$S(BPSSIG="M":1,BPSSIG="F":2,BPSSIG="N":0,1:3)
E S BPSGENDER=$S(BPSSEX="M":1,BPSSEX="F":2,1:0)
;
Q BPSGENDER
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSOSCC 6781 printed Oct 16, 2024@17:52:25 Page 2
BPSOSCC ;BHAM ISC/FCS/DRS/DLF - Set up BPS() ;06/01/2004
+1 ;;1.0;E CLAIMS MGMT ENGINE;**1,2,5,8,10,11,19,27,32,33,37**;JUN 2004;Build 16
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; GETINFO - Create BPS array for non-repeating data
+5 ; IEN59 - Pointer to BPS Transactions
+6 ; IEN5902 - IEN for Insurance multiple of BPS Transactions
+7 ;
+8 ; BPS array is shared by all of the BPSOSC* routines, created in BPSOSCA
+9 ; VAINFO is created in BPSOSCB
+10 QUIT
+11 ;
GETINFO(IEN59,IEN5902) ; EP - BPSOSCB
+1 ; both parameters required
+2 if $GET(IEN59)=""
QUIT
+3 if $GET(IEN5902)=""
QUIT
+4 ;
+5 NEW BPPAYSEQ,BPSCS,BPSSEX,BPSSIG,BPSRF,BPSRX,DFN,IENS,NPI,SITE,VADM,VAPA,X
+6 ;
+7 ; COB payer sequence
SET BPPAYSEQ=$$COB59^BPSUTIL2(IEN59)
+8 ; Setup IENS for transaction multiple
+9 SET IENS=IEN5902_","_IEN59_","
+10 ; Site Information
+11 SET SITE=$PIECE($GET(^BPST(IEN59,1)),U,4)
+12 SET NPI=$$NPI^BPSNPI("Pharmacy_ID",SITE)
+13 IF +NPI=-1
SET NPI=""
+14 SET BPS("Site","NPI")=$PIECE(NPI,U)
+15 ;
+16 ; Check for Controlled Substance Drug and if BPS Pharmacy for CS
+17 ; has been defined. If so, use NPI for the CS Pharmacy.
+18 SET BPSRX=$$GET1^DIQ(9002313.59,IEN59,1.11,"I")
+19 SET BPSRF=$$GET1^DIQ(9002313.59,IEN59,9)
+20 SET BPSCS=$$CSNPI^BPSUTIL(BPSRX,BPSRF)
+21 IF +$PIECE(BPSCS,"^",2)
SET BPS("Site","NPI")=$PIECE(BPSCS,"^",2)
+22 ;
+23 ; Get Transaction Code
+24 SET BPS("Transaction Code")=$SELECT($PIECE($GET(^BPST(IEN59,0)),U,15)="E":"E1",1:"B1")
+25 ;
+26 ; Transaction Header Data
+27 SET BPS("NCPDP","IEN")=$GET(VAINFO(9002313.59902,IENS,$SELECT(BPS("Transaction Code")="E1":902.34,1:902.02),"I"))
+28 SET BPS("NCPDP","BIN Number")=$GET(VAINFO(9002313.59902,IENS,902.03,"I"))
+29 SET BPS("NCPDP","PCN")=$GET(VAINFO(9002313.59902,IENS,902.04,"I"))
+30 SET BPS("NCPDP","Software Vendor/Cert ID")=$GET(VAINFO(9002313.59902,IENS,902.18,"I"))
+31 IF BPS("NCPDP","IEN")=""
DO IMPOSS^BPSOSUE("P","TI","Payer Sheet pointer missing from multiple",,1,$TEXT(+0))
+32 IF BPS("NCPDP","IEN")
SET BPS("NCPDP","Version")=$PIECE($GET(^BPSF(9002313.92,BPS("NCPDP","IEN"),1)),U,2)
+33 IF $GET(BPS("NCPDP","Version"))=""
DO IMPOSS^BPSOSUE("DB","TI","Payer sheet version missing.",,2,$TEXT(+0))
+34 SET BPS("NCPDP","# Meds/Claim")=$GET(VAINFO(9002313.59902,IENS,902.32,"I"))
+35 IF BPS("Transaction Code")="E1"!('BPS("NCPDP","# Meds/Claim"))
SET BPS("NCPDP","# Meds/Claim")=1
+36 SET BPS("NCPDP","DOS")=$$FMTHL7^XLFDT($PIECE($GET(^BPST(IEN59,12)),U,2))
+37 ;
+38 ; Patient Data
+39 SET DFN=$PIECE(^BPST(IEN59,0),U,6)
+40 IF 'DFN
DO IMPOSS^BPSOSUE("DB","TI","DFN",,,$TEXT(+0))
+41 IF DFN
IF '$DATA(^DPT(DFN,0))
DO IMPOSS^BPSOSUE("DB","TI","^DPT(DFN)",,,$TEXT(+0))
+42 DO DEM^VADPT
DO ADD^VADPT
+43 SET BPS("Patient","IEN")=DFN
+44 SET (X,BPS("Patient","Name"))=$GET(VADM(1))
+45 DO SETNAME^PSOSPMUT(DFN)
+46 SET BPS("Patient","Last Name")=$GET(PSONAME("LAST"))
+47 SET BPS("Patient","First Name")=$GET(PSONAME("FIRST"))
+48 SET BPS("Patient","Middle Name")=$GET(PSONAME("MIDDLE"))
+49 SET BPS("Patient","Prefix")=$GET(PSONAME("PREFIX"))
+50 SET BPS("Patient","Suffix")=$GET(PSONAME("SUFFIX"))
+51 SET BPS("Patient","Gender Code")=$$GENDER(IEN59)
+52 ; date of birth, FM format
SET X=$PIECE($GET(VADM(3)),"^")
+53 SET BPS("Patient","DOB")=($EXTRACT(X,1,3)+1700)_$EXTRACT(X,4,7)
+54 SET BPS("Patient","SSN")=$PIECE($GET(VADM(2)),"^",1)
+55 SET BPS("Patient","State")=$PIECE($GET(VAPA(5)),"^",1)
+56 IF BPS("Patient","State")'=""
SET BPS("Patient","State")=$PIECE($GET(^DIC(5,BPS("Patient","State"),0)),"^",2)
+57 SET BPS("Patient","Street Address")=$GET(VAPA(1))
+58 SET BPS("Patient","Street Address Line 1")=$GET(VAPA(1))
+59 SET BPS("Patient","Street Address Line 2")=$GET(VAPA(2))
+60 SET BPS("Patient","City")=$GET(VAPA(4))
+61 SET BPS("Patient","Zip")=$GET(VAPA(6))
+62 SET BPS("Patient","Phone #")=$TRANSLATE($PIECE($GET(VAPA(8)),"^",1),"()-/*# ")
+63 ; NCPDP field 307-C7 default to 1 for vD.0
SET BPS("Patient","Place of Service")=$SELECT($GET(BPS("NCPDP","Version"))=51:0,1:1)
+64 ; NCPDP field 384-4X, 1 for "Home"
SET BPS("Patient","Patient Residence")=1
+65 ; NCPDP field 350-HN
SET BPS("Patient","Patient E-Mail Address")=$$GET1^DIQ(2,DFN,.133)
+66 ;
+67 ; Insurer Data
+68 SET BPS("Insurer","IEN")=$GET(VAINFO(9002313.59902,IENS,.01,"I"))
+69 SET BPS("Patient","Primary Care Prov Location Code")=$GET(VAINFO(9002313.59902,IENS,902.11,"I"))
+70 SET BPS("Insurer","Relationship")=$GET(VAINFO(9002313.59902,IENS,902.07,"I"))
+71 ; if null set to unspecified
if BPS("Insurer","Relationship")=""
SET BPS("Insurer","Relationship")=0
+72 SET BPS("Insurer","Person Code")=$GET(VAINFO(9002313.59902,IENS,902.1,"I"))
+73 ;
+74 ; If 303-C3 Person Code has no value from patient insurance policy field, then continue to
+75 ; calculate the value based upon the 306-C6 Patient Relationship Code field
+76 IF BPS("Insurer","Person Code")=""
Begin DoDot:1
+77 NEW REL
SET REL=BPS("Insurer","Relationship")
+78 SET BPS("Insurer","Person Code")=$SELECT(REL=1:"01",REL=2:"02",REL=3:"03",1:"")
+79 QUIT
End DoDot:1
+80 ;
+81 SET BPS("Insurer","Plan ID")=$GET(VAINFO(9002313.59902,IENS,902.24,"I"))
+82 SET BPS("Insurer","Group #")=$GET(VAINFO(9002313.59902,IENS,902.05,"I"))
+83 ;CARDHOLDER ID
SET BPS("Insurer","Policy #")=$GET(VAINFO(9002313.59902,IENS,902.06,"I"))
+84 SET BPS("Insurer","Full Policy #")=BPS("Insurer","Policy #")
+85 ; 483-HE Percentage Sales Tax Rate Submitted
SET BPS("Insurer","Percent Sales Tax Rate Sub")=""
+86 ; 484-JE Percentage Sales Tax Basis Submitted
SET BPS("Insurer","Percent Sales Tax Basis Sub")=""
+87 ; 482-GE Percentage Sales Tax Amount Submitted
SET BPS("Insurer","Percentage Sales Tax Amt Sub")=0
+88 ; 481-HA Flat Sales Tax Amount Submitted
SET BPS("Insurer","Flat Sales Tax Amount Sub")=0
+89 ;
+90 ; Cardholder Data
+91 SET BPS("Cardholder","First Name")=$GET(VAINFO(9002313.59902,IENS,902.08,"I"))
+92 SET BPS("Cardholder","Last Name")=$GET(VAINFO(9002313.59902,IENS,902.09,"I"))
+93 SET BPS("Home Plan")=$GET(VAINFO(9002313.59902,IENS,902.11,"I"))
+94 ;
+95 ; set additional fields for secondary claim
+96 ; NCPDP field 308-C8 Other Coverage Code
if BPPAYSEQ>1
SET BPS("Patient","Other Coverage Code")=$PIECE($GET(^BPST(IEN59,12)),U,5)
+97 ;
+98 QUIT
+99 ;
GENDER(IEN59) ; Determine the value for Patient Gender Code (305-C5).
+1 ;
+2 NEW BPSGENDER,BPSPREVCL,BPSPREVTRAN,BPSSEX,BPSSIG
+3 ;
+4 ; If a previous claim exists, use the Patient Gender Code sent on
+5 ; that claim. At this point in the process, an entry will exist in
+6 ; ^BPSTL only if there has been a previous claim.
+7 ;
+8 SET BPSGENDER=""
+9 SET BPSPREVTRAN=""
+10 FOR
SET BPSPREVTRAN=$ORDER(^BPSTL("B",IEN59,BPSPREVTRAN),-1)
if 'BPSPREVTRAN
QUIT
Begin DoDot:1
+11 IF $$GET1^DIQ(9002313.57,BPSPREVTRAN,19,"I")'="C"
QUIT
+12 SET BPSPREVCL=$$GET1^DIQ(9002313.57,BPSPREVTRAN,3,"I")
+13 IF BPSPREVCL=""
QUIT
+14 SET BPSGENDER=$$GET1^DIQ(9002313.02,BPSPREVCL,305,"I")
+15 SET BPSGENDER=$EXTRACT(BPSGENDER,3)
+16 QUIT
End DoDot:1
IF BPSGENDER'=""
QUIT
+17 IF BPSGENDER'=""
QUIT BPSGENDER
+18 ;
+19 ; If no previous claim, determine the value based on Self Identified
+20 ; Gender, and if that field is blank, use the field Sex.
+21 ;
+22 ; SEX, field# .02
SET BPSSEX=$PIECE($GET(VADM(5)),"^",1)
+23 ; SELF IDENTIFIED GENDER, field# .024
SET BPSSIG=$PIECE($GET(VADM(14,5)),"^",2)
+24 IF BPSSIG'=""
SET BPSGENDER=$SELECT(BPSSIG="M":1,BPSSIG="F":2,BPSSIG="N":0,1:3)
+25 IF '$TEST
SET BPSGENDER=$SELECT(BPSSEX="M":1,BPSSEX="F":2,1:0)
+26 ;
+27 QUIT BPSGENDER
+28 ;
