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

IBCNRU1.m

Go to the documentation of this file. 
  1. IBCNRU1 ;BHAM ISC/CMW - IB Utilities ;15-OCT-04
  1.  ;;2.0;INTEGRATED BILLING;**251,276,435,550**;21-MAR-94;Build 25
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  Q
  1.  ;
  1.  ;return array definition
  1.  ;(1) - "A"ctive or "I"nactive flag.
  1.  ;(2) - BIN #.
  1.  ;(3) - PCN #.
  1.  ;(4) - Vender Cert ID.
  1.  ;(5) - Payer Sheets. (B1,B2,B3,E1) (comma separated string).
  1.  ;(6) - Status codes (comma separated string).
  1.  ;
  1. STCHK(PIEN,IBARAY,ELIG) ;Review status flags for all files related to this pharmacy plan
  1.  ;
  1.  ;   PIEN - plan ien to file# 366.03
  1.  ; IBARAY - output array pass by reference
  1.  ;   ELIG - eligibility request flag
  1.  ;          1=eligibility request
  1.  ;          0=claim request (default)
  1.  ;
  1.  NEW I,IBBIN,IBPCN,IBPBM,IBPRO,IBSTA,IBPAY
  1.  NEW IBAPP,IBCODE,IBCERT
  1.  NEW PLN0,PLN10,AIEN,APDAT,APIEN
  1.  NEW NA1,NA2,NA3,NA4,LA1,LA2,LA3,LA4,DA1,DA2,DA3,DA4
  1.  ;
  1.  K IBARAY
  1.  S ELIG=$G(ELIG,0)
  1.  ;
  1.  I '$G(PIEN) S IBSTA="" D IBC(299) G EXT
  1.  I '$D(^IBCNR(366.03,PIEN)) S IBSTA="" D IBC(299) G EXT
  1.  ;
  1.  S IBAPP="E-PHARM",IBSTA=1,IBCODE=""
  1.  S PLN0=$G(^IBCNR(366.03,PIEN,0)) D
  1.  . ; check Plan active
  1.  . S AIEN=$O(^IBCNR(366.13,"B",IBAPP,"")) I AIEN="" Q
  1.  . S APIEN=$O(^IBCNR(366.03,PIEN,3,"B",AIEN,"")) I APIEN="" Q
  1.  . S APDAT=$G(^IBCNR(366.03,PIEN,3,APIEN,0))
  1.  . S NA2=$P(APDAT,U,2) I NA2=0 S IBSTA="" D IBC(201)
  1.  . S LA2=$P(APDAT,U,3) I LA2=0 S IBSTA="" D IBC(202)
  1.  . S DA2=$P(APDAT,U,11) I DA2=1 S IBSTA="" D IBC(203)
  1.  . ;
  1.  . ; check pharmacy data
  1.  . I '$D(^IBCNR(366.03,PIEN,10)) S IBSTA="" D IBC(599)
  1.  . ;
  1.  . S PLN10=$G(^IBCNR(366.03,PIEN,10)) D
  1.  .. ;
  1.  .. ; get BIN
  1.  .. S IBBIN=$P(PLN10,U,2)
  1.  .. S IBARAY(2)=IBBIN
  1.  .. ;
  1.  .. ; get PCN
  1.  .. S IBPCN=$P(PLN10,U,3)
  1.  .. S IBARAY(3)=IBPCN
  1.  .. ;
  1.  .. ; get PBM
  1.  .. S IBPBM=$P(PLN10,U,1) D
  1.  ... I 'IBPBM Q
  1.  ... ;check PBM active
  1.  ... S AIEN=$O(^IBCNR(366.12,"B",IBAPP,"")) I AIEN="" Q
  1.  ... S APIEN=$O(^IBCNR(366.02,IBPBM,3,"B",AIEN,"")) I APIEN="" Q
  1.  ... S APDAT=$G(^IBCNR(366.02,IBPBM,3,APIEN,0))
  1.  ... S NA3=$P(APDAT,U,2) I NA3=0 D IBC(301) S IBSTA=""
  1.  ... S LA3=$P(APDAT,U,3) I LA3=0 D IBC(302) S IBSTA=""
  1.  ... S DA3=$P(APDAT,U,11) I DA3=1 D IBC(303) S IBSTA=""
  1.  ... Q
  1.  .. ;
  1.  .. ; get Processor
  1.  .. S IBPRO=$P(PLN10,U,4) D
  1.  ... I 'IBPRO Q
  1.  ... ;check Processor active flags here
  1.  ... S AIEN=$O(^IBCNR(366.11,"B",IBAPP,"")) I AIEN="" Q
  1.  ... S APIEN=$O(^IBCNR(366.01,IBPRO,3,"B",AIEN,"")) I APIEN="" Q
  1.  ... S APDAT=$G(^IBCNR(366.01,IBPRO,3,APIEN,0))
  1.  ... S NA4=$P(APDAT,U,2) I NA4=0 D IBC(401) S IBSTA=""
  1.  ... S LA4=$P(APDAT,U,3) I LA4=0 D IBC(402) S IBSTA=""
  1.  ... S DA4=$P(APDAT,U,11) I DA4=1 D IBC(403) S IBSTA=""
  1.  ... Q
  1.  .. ;
  1.  .. ; get Vender Cert
  1.  .. S IBCERT=$P(PLN10,U,6)
  1.  .. S IBARAY(4)=IBCERT
  1.  .. ;
  1.  .. ; Check payer sheets
  1.  .. N BPS,PST,PSP
  1.  .. N B1,B2,B3,E1
  1.  .. S PST=""
  1.  .. ;
  1.  .. ; check for test/production sheets
  1.  .. ; get the test payer sheet first.  If nil, then get the regular payer sheet
  1.  .. S (B1,B2,B3,E1)=""
  1.  .. S B1=$P(PLN10,U,11),B2=$P(PLN10,U,12),B3=$P(PLN10,U,13),E1=$P(PLN10,U,14)
  1.  .. I 'B1 S B1=$P(PLN10,U,7)         ; billing
  1.  .. I 'B2 S B2=$P(PLN10,U,8)         ; reversal
  1.  .. I 'B3 S B3=$P(PLN10,U,9)         ; rebill (not currently validated)
  1.  .. I 'E1 S E1=$P(PLN10,U,15)        ; eligibility
  1.  .. S PST=B1_","_B2_","_B3_","_E1
  1.  .. S IBARAY(5)=PST                ; save the payer sheet iens
  1.  .. ;
  1.  .. ; perform payer sheet validation for claim request
  1.  .. I 'ELIG D
  1.  ... I 'B1,'B2 S IBSTA="" D IBC(699) Q
  1.  ... I B1 D PSD(B1) I PSP=0 S IBSTA="" D IBC(601)
  1.  ... I B2 D PSD(B2) I PSP=0 S IBSTA="" D IBC(602)
  1.  ... I 'B1 S IBSTA="" D IBC(603)
  1.  ... I 'B2 S IBSTA="" D IBC(604)
  1.  ... Q
  1.  .. ;
  1.  .. ; perform payer sheet validation for eligibility request
  1.  .. I ELIG D
  1.  ... I E1 D PSD(E1) I PSP=0 S IBSTA="" D IBC(605)
  1.  ... I 'E1 S IBSTA="" D IBC(606)
  1.  ... Q
  1.  .. Q
  1.  . ;
  1.  . ;check HIPAA NCPDP flag
  1.  . I '$P($G(^IBE(350.9,1,11)),U,1) S IBSTA="" D IBC(999)
  1.  . Q
  1.  ;
  1. EXT ;
  1.  S IBARAY(1)=$S(IBSTA="":"I",1:"A")
  1.  I IBCODE="" S IBCODE=200      ; all is well
  1.  S IBARAY(6)=IBCODE
  1.  Q
  1.  ;
  1. PSD(PS) ; check for disabled payersheet
  1.  S PSP=1
  1.  S BPS=$G(^BPSF(9002313.92,PS,1)) I $P(BPS,U,6)=0 S PSP=0
  1.  Q
  1.  ;
  1. IBC(CD) ;set IBCODE
  1.  I '$G(IBCODE) S IBCODE=CD Q
  1.  S IBCODE=IBCODE_","_CD
  1.  Q
  1.  ;
  1. STATAR(AR) ;
  1.  ; setup status code definition array
  1.  K AR
  1.  ; plan
  1.  S AR(200)="Plan Active"
  1.  S AR(201)="Plan not active, national."
  1.  S AR(202)="Plan not active, local."
  1.  S AR(203)="Plan Deactivated."
  1.  S AR(299)="Plan not found."
  1.  ; pbm
  1.  S AR(301)="PBM not active, national."
  1.  S AR(302)="PBM not active, local."
  1.  S AR(303)="PBM Deactivated."
  1.  ; processor
  1.  S AR(401)="Processor not active, national."
  1.  S AR(402)="Processor not active, local."
  1.  S AR(403)="Processor Deactivated."
  1.  ; pharmacy plan
  1.  S AR(599)="Pharmacy Plan not found."
  1.  ; payer sheets
  1.  S AR(601)="Billing PayerSheet Disabled."
  1.  S AR(602)="Reversal PayerSheet Disabled."
  1.  S AR(603)="Billing PayerSheet Not Found."
  1.  S AR(604)="Reversal PayerSheet Not Found."
  1.  S AR(605)="Eligibility PayerSheet Disabled."
  1.  S AR(606)="Eligibility PayerSheet Not Found."
  1.  S AR(699)="No Payer Sheets found."
  1.  ;
  1.  S AR(999)="HIPAA NCPDP Inactive."
  1.  ;
  1.  Q