- 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 Feb 18, 2025@23:18 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 ;