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

BPSOSCC.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; GETINFO - Create BPS array for non-repeating data
  1. ; IEN59 - Pointer to BPS Transactions
  1. ; IEN5902 - IEN for Insurance multiple of BPS Transactions
  1. ;
  1. ; BPS array is shared by all of the BPSOSC* routines, created in BPSOSCA
  1. ; VAINFO is created in BPSOSCB
  1. Q
  1. ;
  1. GETINFO(IEN59,IEN5902) ; EP - BPSOSCB
  1. ; both parameters required
  1. Q:$G(IEN59)=""
  1. Q:$G(IEN5902)=""
  1. ;
  1. N BPPAYSEQ,BPSCS,BPSSEX,BPSSIG,BPSRF,BPSRX,DFN,IENS,NPI,SITE,VADM,VAPA,X
  1. ;
  1. S BPPAYSEQ=$$COB59^BPSUTIL2(IEN59) ; COB payer sequence
  1. ; Setup IENS for transaction multiple
  1. S IENS=IEN5902_","_IEN59_","
  1. ; Site Information
  1. S SITE=$P($G(^BPST(IEN59,1)),U,4)
  1. S NPI=$$NPI^BPSNPI("Pharmacy_ID",SITE)
  1. I +NPI=-1 S NPI=""
  1. S BPS("Site","NPI")=$P(NPI,U)
  1. ;
  1. ; Check for Controlled Substance Drug and if BPS Pharmacy for CS
  1. ; has been defined. If so, use NPI for the CS Pharmacy.
  1. S BPSRX=$$GET1^DIQ(9002313.59,IEN59,1.11,"I")
  1. S BPSRF=$$GET1^DIQ(9002313.59,IEN59,9)
  1. S BPSCS=$$CSNPI^BPSUTIL(BPSRX,BPSRF)
  1. I +$P(BPSCS,"^",2) S BPS("Site","NPI")=$P(BPSCS,"^",2)
  1. ;
  1. ; Get Transaction Code
  1. S BPS("Transaction Code")=$S($P($G(^BPST(IEN59,0)),U,15)="E":"E1",1:"B1")
  1. ;
  1. ; Transaction Header Data
  1. S BPS("NCPDP","IEN")=$G(VAINFO(9002313.59902,IENS,$S(BPS("Transaction Code")="E1":902.34,1:902.02),"I"))
  1. S BPS("NCPDP","BIN Number")=$G(VAINFO(9002313.59902,IENS,902.03,"I"))
  1. S BPS("NCPDP","PCN")=$G(VAINFO(9002313.59902,IENS,902.04,"I"))
  1. S BPS("NCPDP","Software Vendor/Cert ID")=$G(VAINFO(9002313.59902,IENS,902.18,"I"))
  1. I BPS("NCPDP","IEN")="" D IMPOSS^BPSOSUE("P","TI","Payer Sheet pointer missing from multiple",,1,$T(+0))
  1. I BPS("NCPDP","IEN") S BPS("NCPDP","Version")=$P($G(^BPSF(9002313.92,BPS("NCPDP","IEN"),1)),U,2)
  1. I $G(BPS("NCPDP","Version"))="" D IMPOSS^BPSOSUE("DB","TI","Payer sheet version missing.",,2,$T(+0))
  1. S BPS("NCPDP","# Meds/Claim")=$G(VAINFO(9002313.59902,IENS,902.32,"I"))
  1. I BPS("Transaction Code")="E1"!('BPS("NCPDP","# Meds/Claim")) S BPS("NCPDP","# Meds/Claim")=1
  1. S BPS("NCPDP","DOS")=$$FMTHL7^XLFDT($P($G(^BPST(IEN59,12)),U,2))
  1. ;
  1. ; Patient Data
  1. S DFN=$P(^BPST(IEN59,0),U,6)
  1. I 'DFN D IMPOSS^BPSOSUE("DB","TI","DFN",,,$T(+0))
  1. I DFN,'$D(^DPT(DFN,0)) D IMPOSS^BPSOSUE("DB","TI","^DPT(DFN)",,,$T(+0))
  1. D DEM^VADPT,ADD^VADPT
  1. S BPS("Patient","IEN")=DFN
  1. S (X,BPS("Patient","Name"))=$G(VADM(1))
  1. D SETNAME^PSOSPMUT(DFN)
  1. S BPS("Patient","Last Name")=$G(PSONAME("LAST"))
  1. S BPS("Patient","First Name")=$G(PSONAME("FIRST"))
  1. S BPS("Patient","Middle Name")=$G(PSONAME("MIDDLE"))
  1. S BPS("Patient","Prefix")=$G(PSONAME("PREFIX"))
  1. S BPS("Patient","Suffix")=$G(PSONAME("SUFFIX"))
  1. S BPS("Patient","Gender Code")=$$GENDER(IEN59)
  1. S X=$P($G(VADM(3)),"^") ; date of birth, FM format
  1. S BPS("Patient","DOB")=($E(X,1,3)+1700)_$E(X,4,7)
  1. S BPS("Patient","SSN")=$P($G(VADM(2)),"^",1)
  1. S BPS("Patient","State")=$P($G(VAPA(5)),"^",1)
  1. I BPS("Patient","State")'="" S BPS("Patient","State")=$P($G(^DIC(5,BPS("Patient","State"),0)),"^",2)
  1. S BPS("Patient","Street Address")=$G(VAPA(1))
  1. S BPS("Patient","Street Address Line 1")=$G(VAPA(1))
  1. S BPS("Patient","Street Address Line 2")=$G(VAPA(2))
  1. S BPS("Patient","City")=$G(VAPA(4))
  1. S BPS("Patient","Zip")=$G(VAPA(6))
  1. S BPS("Patient","Phone #")=$TR($P($G(VAPA(8)),"^",1),"()-/*# ")
  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
  1. S BPS("Patient","Patient Residence")=1 ; NCPDP field 384-4X, 1 for "Home"
  1. S BPS("Patient","Patient E-Mail Address")=$$GET1^DIQ(2,DFN,.133) ; NCPDP field 350-HN
  1. ;
  1. ; Insurer Data
  1. S BPS("Insurer","IEN")=$G(VAINFO(9002313.59902,IENS,.01,"I"))
  1. S BPS("Patient","Primary Care Prov Location Code")=$G(VAINFO(9002313.59902,IENS,902.11,"I"))
  1. S BPS("Insurer","Relationship")=$G(VAINFO(9002313.59902,IENS,902.07,"I"))
  1. S:BPS("Insurer","Relationship")="" BPS("Insurer","Relationship")=0 ; if null set to unspecified
  1. S BPS("Insurer","Person Code")=$G(VAINFO(9002313.59902,IENS,902.1,"I"))
  1. ;
  1. ; If 303-C3 Person Code has no value from patient insurance policy field, then continue to
  1. ; calculate the value based upon the 306-C6 Patient Relationship Code field
  1. I BPS("Insurer","Person Code")="" D
  1. . N REL S REL=BPS("Insurer","Relationship")
  1. . S BPS("Insurer","Person Code")=$S(REL=1:"01",REL=2:"02",REL=3:"03",1:"")
  1. . Q
  1. ;
  1. S BPS("Insurer","Plan ID")=$G(VAINFO(9002313.59902,IENS,902.24,"I"))
  1. S BPS("Insurer","Group #")=$G(VAINFO(9002313.59902,IENS,902.05,"I"))
  1. S BPS("Insurer","Policy #")=$G(VAINFO(9002313.59902,IENS,902.06,"I")) ;CARDHOLDER ID
  1. S BPS("Insurer","Full Policy #")=BPS("Insurer","Policy #")
  1. S BPS("Insurer","Percent Sales Tax Rate Sub")="" ; 483-HE Percentage Sales Tax Rate Submitted
  1. S BPS("Insurer","Percent Sales Tax Basis Sub")="" ; 484-JE Percentage Sales Tax Basis Submitted
  1. S BPS("Insurer","Percentage Sales Tax Amt Sub")=0 ; 482-GE Percentage Sales Tax Amount Submitted
  1. S BPS("Insurer","Flat Sales Tax Amount Sub")=0 ; 481-HA Flat Sales Tax Amount Submitted
  1. ;
  1. ; Cardholder Data
  1. S BPS("Cardholder","First Name")=$G(VAINFO(9002313.59902,IENS,902.08,"I"))
  1. S BPS("Cardholder","Last Name")=$G(VAINFO(9002313.59902,IENS,902.09,"I"))
  1. S BPS("Home Plan")=$G(VAINFO(9002313.59902,IENS,902.11,"I"))
  1. ;
  1. ; set additional fields for secondary claim
  1. S:BPPAYSEQ>1 BPS("Patient","Other Coverage Code")=$P($G(^BPST(IEN59,12)),U,5) ; NCPDP field 308-C8 Other Coverage Code
  1. ;
  1. Q
  1. ;
  1. GENDER(IEN59) ; Determine the value for Patient Gender Code (305-C5).
  1. ;
  1. N BPSGENDER,BPSPREVCL,BPSPREVTRAN,BPSSEX,BPSSIG
  1. ;
  1. ; If a previous claim exists, use the Patient Gender Code sent on
  1. ; that claim. At this point in the process, an entry will exist in
  1. ; ^BPSTL only if there has been a previous claim.
  1. ;
  1. S BPSGENDER=""
  1. S BPSPREVTRAN=""
  1. F S BPSPREVTRAN=$O(^BPSTL("B",IEN59,BPSPREVTRAN),-1) Q:'BPSPREVTRAN D I BPSGENDER'="" Q
  1. . I $$GET1^DIQ(9002313.57,BPSPREVTRAN,19,"I")'="C" Q
  1. . S BPSPREVCL=$$GET1^DIQ(9002313.57,BPSPREVTRAN,3,"I")
  1. . I BPSPREVCL="" Q
  1. . S BPSGENDER=$$GET1^DIQ(9002313.02,BPSPREVCL,305,"I")
  1. . S BPSGENDER=$E(BPSGENDER,3)
  1. . Q
  1. I BPSGENDER'="" Q BPSGENDER
  1. ;
  1. ; If no previous claim, determine the value based on Self Identified
  1. ; Gender, and if that field is blank, use the field Sex.
  1. ;
  1. S BPSSEX=$P($G(VADM(5)),"^",1) ; SEX, field# .02
  1. S BPSSIG=$P($G(VADM(14,5)),"^",2) ; SELF IDENTIFIED GENDER, field# .024
  1. I BPSSIG'="" S BPSGENDER=$S(BPSSIG="M":1,BPSSIG="F":2,BPSSIG="N":0,1:3)
  1. E S BPSGENDER=$S(BPSSEX="M":1,BPSSEX="F":2,1:0)
  1. ;
  1. Q BPSGENDER
  1. ;