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

IBRUTL.m

Go to the documentation of this file. 
  1. IBRUTL ;ALB/CPM-INTEGRATED BILLING - A/R INTERFACE UTILITIES ;03-MAR-92
  1.  ;;2.0;INTEGRATED BILLING;**70,82,132,142,176,179,202,223,363,554**;21-MAR-94;Build 81
  1.  ;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1. IB(IEN,RETN) ; Are there any IB Actions on hold for this bill?
  1.  ;         Input:   IEN         -- ien of Bill(#399), A/R(#430)
  1.  ;                  RETN (opt)  -- Want array of IB Actions? (1-Yes,0-No)
  1.  ;                                 if yes, returns IBA(num)=ibn
  1.  ;         Returns: 1 -- Yes, 0 -- No
  1.  ;
  1.  N ATYPE,BTYPE,BILLS,DFN,IBFR,IB0,IBTO,IBU,IBN,IBND,IBNUM,IBOK
  1.  S:'$D(RETN) RETN=0 S BILLS=0
  1.  ;
  1.  ; - determine patient, bill type and billing dates
  1.  S IB0=$G(^DGCR(399,IEN,0)),IBU=$G(^("U")),DFN=+$P(IB0,"^",2)
  1.  S BTYPE=$S(+$P(IB0,"^",5)<3:"I",1:"O"),IBFR=+IBU,IBTO=$P(IBU,"^",2)
  1.  ;
  1.  ; - loop through all bills on hold, and set flag if there is an
  1.  ; - IB Action of the same type as the UB-82 which has been billed
  1.  ; - within the statement dates of the UB-82.  Store all actions
  1.  ; - in the array IBA if required.
  1.  S (IBN,IBNUM)=0 F  S IBN=$O(^IB("AH",DFN,IBN)) Q:'IBN  D  I IBOK Q:'RETN  S IBNUM=IBNUM+1,IBA(IBNUM)=IBN
  1.  . S IBOK=0,IBND=$G(^IB(IBN,0)) Q:'IBND
  1.  . S ATYPE=$S($P($G(^IBE(350.1,+$P(IBND,"^",3),0)),"^")["OPT":"O",1:"I") Q:ATYPE'=BTYPE
  1.  . Q:$P(IBND,"^",15)<IBFR!($P(IBND,"^",14)>IBTO)  S (IBOK,BILLS)=1
  1.  ;
  1.  Q BILLS
  1.  ;
  1.  ;
  1. HOLD(X,IBN,IBDUZ,IBSEQNO) ; Place IB Action on hold?
  1.  ;         Input:        X -- Zeroth node of IB Action
  1.  ;                     IBN -- ien of IB Action
  1.  ;                   IBDUZ -- User ID
  1.  ;                 IBSEQNO -- 1 (New Action), 3 (Update Action)
  1.  ;         Returns:      1 -- Yes, 0 -- No
  1.  ;
  1.  N DFN,IBCOV,IBINDT,IBOUTP,HOLD,IBHOLDP,IBDUZ,I,INS,BUF
  1.  N IBVDT,IBAT,IBCAT,IBALTC,TRICHP,J,XX,TYPNAM,COV,RCOV
  1.  ;
  1.  S (HOLD,COV,TRICHP,J)=0
  1.  S IBHOLDP=$P($G(^IBE(350.9,1,1)),"^",20) ; Site parameter - HOLD MT BILLS W/INSURANCE
  1.  S DFN=+$P(X,"^",2)
  1.  ;
  1.  ;check if ECME RX copay needs to be placed on HOLD
  1.  I $$HOLDECME^IBNCPUT1(X)=0 G HOLDQ
  1.  ;
  1.  I $P(X,"^",5)=8 G HOLDQ ; action is already on hold
  1.  I '$P($G(^IBE(350.1,+$P(X,"^",3),0)),"^",10) G HOLDQ ; action can't be placed on hold
  1.  ;
  1.  ; - see if patient has insurance on Charge 'To' Date (otherwise Event date)
  1.  ; - includes check of plan coverage limitation
  1.  S IBINDT=+$P($G(^IB(+$G(IBN),0)),U,15)
  1.  I 'IBINDT S IBINDT=+$P($G(^IB(+$P(X,"^",16),0)),"^",17) I 'IBINDT S IBINDT=DT
  1.  S IBOUTP=1
  1.  D ^IBCNS
  1.  ;
  1.  ; IB*2.0*554 - baa
  1.  ;When placing charges On Hold added check so if only insurance for the 
  1.  ;patient is Tricare or CHAMPVA the charge is Not placed On Hold.  
  1.  ;Previously if the patient had any active insurance the charge was placed On Hold.
  1.  I IBINS D
  1.  . N XX
  1.  . S (J,TRICHP,COV)=0
  1.  . S XX=0 F  S XX=$O(IBDD(XX)) Q:XX=""  D
  1.  .. S INS=+XX_","
  1.  .. S RCOV=$$GET1^DIQ(36,INS,1,"I") S RCOV=$S(RCOV="N":0,1:1)
  1.  .. S TYPNAM=$$GET1^DIQ(36,INS,.13,"E"),J=J+1
  1.  .. I TYPNAM'["TRICARE",TYPNAM'["CHAMPVA",RCOV,'COV S COV=$$IBCOV(XX)
  1.  .. S:TYPNAM["TRICARE" TRICHP=1 S:TYPNAM["CHAMPVA" TRICHP=1
  1.  ;
  1.  S BUF=$$BUFFER^IBCNBU1(DFN)
  1.  I $G(J)=1,TRICHP S (IBCOV,HOLD)=0 G HOLDQ ; don't place on hold if only has TRICARE OR CHAMPVA
  1.  I $G(J)>1,TRICHP  I 'COV,'BUF S (IBCOV,HOLD)=0 G HOLDQ ; don't place on hold if no cov & no buffer entry.
  1.  I 'TRICHP,'COV,'BUF S (IBCOV,HOLD)=0 G HOLDQ  ; don't place on hold if no tricare and no coverage and no buffer entry
  1.  ; IB*2.0*544 - baa
  1.  ;
  1.  S IBVDT=$S(IBINDT'="":IBINDT,1:DT),IBAT=$P(^IBE(350.1,(+$P(X,U,3)),0),U,11)
  1.  S IBCAT=$S(IBAT<4:"INPATIENT",IBAT=4:"OUTPATIENT",IBAT=5:"PHARMACY",IBAT=8:"OUTPATIENT",IBAT=9:"INPATIENT",1:"")
  1.  S IBCOV="" I IBCAT'="" S IBCOV=$$PTCOV^IBCNSU3(DFN,IBVDT,IBCAT),HOLD=IBCOV
  1.  I 'IBCOV,+$$BUFFER^IBCNBU1(DFN) S (IBCOV,HOLD)=1 ; if patient has a buffer entry place charge on hold
  1.  ;
  1.  ; - generate bulletin if patient has insurance, bulletin not suppressed
  1.  I IBCOV,'$P($G(^IBE(350.9,1,0)),"^",15),'$$ECME(IBN) D ^IBRBUL
  1.  ;
  1.  ; - update action to 'Hold' if parameter is set and vet has insurance
  1.  I IBHOLDP,IBCOV S DIE="^IB(",DA=IBN,DR=".05////8" D ^DIE,UP3^IBR:IBSEQNO=3 K DA,DIE,DR
  1.  ;
  1. HOLDQ Q +$G(HOLD)
  1.  ;
  1. ECME(IBN) ; return 1 if ECME billed already and bulleting should not go
  1.  N IBX,IBR,IBZ
  1.  S (IBR,IBX)=0,IBZ=^IB(IBN,0)
  1.  F  S IBX=$O(^IBA(362.4,"B",$P($P(IBZ,"^",8),"-"),IBX)) Q:'IBX!(IBR)  I $P($G(^DGCR(399,+$P(^IBA(362.4,IBX,0),"^",2),0)),"^",13)=4,$$FMDIFF^XLFDT($P(IBZ,"^",17),$P(^(0),"^",3),1)<6 S IBR=1
  1.  Q IBR
  1.  ;
  1. IBCOV(POLCY) ; Check for coverage only on non CHAMPVA and TRICARE ins
  1.  N IBVDT,IBAT,IBCAT,PLAN,CATLIM
  1.  S IBVDT=$S(IBINDT'="":IBINDT,1:DT),IBAT=$P(^IBE(350.1,(+$P(X,U,3)),0),U,11)
  1.  S IBCAT=$S(IBAT<4:"INPATIENT",IBAT=4:"OUTPATIENT",IBAT=5:"PHARMACY",IBAT=8:"OUTPATIENT",IBAT=9:"INPATIENT",1:"")
  1.  S IBCAT=$O(^IBE(355.31,"B",IBCAT,""))
  1.  S PLAN=$P($G(IBDD(POLCY)),U,18)
  1.  I PLAN="" Q 0
  1.  S IBCOV=$$PLCOV^IBCNSU3(PLAN,IBVDT,IBCAT)
  1.  Q IBCOV