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

IBOHLD2.m

Go to the documentation of this file.
  1. IBOHLD2 ;ALB/CJM - REPORT OF CHARGES ON HOLD W/INS ;MAR 6,1991
  1. ;;2.0;INTEGRATED BILLING;**70,95,133,153,347,452,618,651**;21-MAR-94;Build 9
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; Reference to $$CLAIM^BPSBUTL supported by DBIA# 4719
  1. REPORT ;
  1. N IBQUIT,IBPAGE,IBNOW,IBLINE,IBLINE2,IBCRT,IBBOT,DFN,IBNAME,IBN
  1. S IBCRT=0,IBBOT=7,IBQUIT=0 I $E(IOST,1,2)="C-" S IBCRT=1,IBBOT=7
  1. S IBLINE="",$P(IBLINE,"=",86)="||",IBLINE=IBLINE_$E(IBLINE,1,45)
  1. S IBLINE2="",$P(IBLINE2,"-",75)="--"
  1. D NOW^%DTC S Y=X X ^DD("DD") S IBNOW=Y
  1. I IBCRT W @IOF
  1. LOOP ;
  1. S IBPAGE=1 D HEADER Q:IBQUIT
  1. S IBNAME="" F S IBNAME=$O(^TMP($J,"HOLD",IBNAME)) Q:IBNAME=""!(IBQUIT) S DFN=0 F S DFN=$O(^TMP($J,"HOLD",IBNAME,DFN)) Q:'DFN!(IBQUIT) D
  1. .D PRNTPAT,PRNTINS W:IBII ?35,IBLINE2,! Q:IBQUIT S IBN=0 F S IBN=$O(^TMP($J,"HOLD",IBNAME,DFN,IBN)) Q:'IBN!(IBQUIT) D
  1. ..D PRNTCHG,PRNTBILL:'IBQUIT
  1. Q
  1. PRNTBILL ; prints bills for a charge
  1. N IB,IB0,IBSTAT,IBCHG,IBPD,C,Y,I,IBT
  1. D:$Y+IBBOT>IOSL HEADER Q:IBQUIT
  1. S IB="" F I=1:1 S IB=$O(^TMP($J,"HOLD",IBNAME,DFN,IBN,IB)) W:'IB&(I<2) ?85,"||",! Q:'IB!(IBQUIT) D
  1. .W ?85,"||"
  1. .S IB0=$G(^DGCR(399,IB,0)) Q:IB0=""
  1. .W ?88,$P(IB0,"^",1) ; bill #
  1. .S IBSTAT=$$STA^PRCAFN(IB)
  1. .W:+IBSTAT>0 ?97,$E($P(IBSTAT,"^",2),1,14)
  1. .S IBT=$J((+^DGCR(399,IB,"U1")-$P(^("U1"),"^",2)),9,2)
  1. .W ?112,IBT ; total charges
  1. .S IBPD=$$TPR^PRCAFN(IB) S:IBPD<0 IBPD="" S IBPD=$J(IBPD,9,2) W ?123,IBPD,! D:$Y+IBBOT>IOSL HEADER
  1. Q
  1. PRNTPAT ; prints patient data
  1. N VAERR,VADM,IBSSN D DEM^VADPT S:'VAERR IBSSN=VA("BID") ; pt id,brief
  1. D:$Y+IBBOT>IOSL HEADER Q:IBQUIT
  1. W IBLINE,!
  1. W $E(IBNAME,1,20),?22,IBSSN
  1. W:IBII ?35,"Insurance Co.",?53,"Subscriber ID",?71,"Group",?88,"Eff Dt",?102,"Exp Dt",!
  1. Q
  1. PRNTINS ; prints insurance information
  1. Q:'$D(DFN)!(IBII=0)
  1. N X,IBINS,IBX
  1. D ALL^IBCNS1(DFN,"IBINS")
  1. D:$Y+IBBOT>IOSL HEADER Q:IBQUIT
  1. W IBLINE,!
  1. I '$D(IBINS) W ?35,"No Insurance Information"
  1. S X=0 F S X=$O(IBINS(X)) Q:'X S IBINS=IBINS(X,0) D
  1. .D:$Y+IBBOT>IOSL HEADER Q:IBQUIT
  1. .N COV,COVD,COVFN,IBCNT,LEDT,LIM,PLN,SP,X,X1,X2,Z0 Q:'$D(IBINS)
  1. .W ?36,$S($D(^DIC(36,+IBINS,0)):$E($P(^(0),"^",1),1,16),1:"UNKNOWN")
  1. .W ?54,$E($P(IBINS,"^",2),1,16)
  1. .W ?72,$E($$GRP($P(IBINS,"^",18)),1,10) S PLN=$P(IBINS,"^",18)
  1. .W ?88,$$DAT1^IBOUTL($P(IBINS,"^",8)),?102,$$DAT1^IBOUTL($P(IBINS,"^",4))
  1. .I PLN="" W !,?38,"* No Group Plan Information for this Patient - Verify Insurance Info!",! Q
  1. .W !,?40,"Plan Coverage Effective Date Covered? Limit Comments",!
  1. .W ?40,"------------- -------------- -------- --------------",!
  1. .S LIM=0 F S LIM=$O(^IBE(355.31,LIM)) Q:'LIM S COV=$P($G(^(LIM,0)),U),IBCNT=0,LEDT="" F S LEDT=$O(^IBA(355.32,"APCD",PLN,LIM,LEDT)) Q:$S(LEDT="":IBCNT,1:0) D Q:LEDT=""
  1. ..D:$Y+IBBOT>IOSL HEADER Q:IBQUIT
  1. ..S COVFN=+$O(^IBA(355.32,"APCD",PLN,LIM,+LEDT,"")),COVD=$G(^IBA(355.32,+COVFN,0))
  1. ..I COVD="" W ?40,COV,?86,"BY DEFAULT",! Q
  1. ..S IBCNT=IBCNT+1
  1. ..S X1=" "_$S(IBCNT=1:COV,1:"") ;Don't duplicate category
  1. ..S X2=$$PR(X1,18)_$$PR($$DAT1^IBOUTL($P(LEDT,"-",2)),16)_$$PR($S($P(COVD,U,4):$S($P(COVD,U,4)<2:"YES",$P(COVD,U,4)=2:"CONDITIONAL",1:"UNKNOWN"),1:"NO"),14)
  1. ..I '$O(^IBA(355.32,COVFN,2,0)) W ?40,X2,! Q
  1. ..S Z0=0 F S Z0=$O(^IBA(355.32,COVFN,2,Z0)) Q:'Z0 S SP="" W ?40,$S(Z0=1:X2_$G(^IBA(355.32,COVFN,2,Z0,0)),1:$$PR(SP,48)_$G(^IBA(355.32,COVFN,2,Z0,0))),!
  1. Q
  1. GRP(IBCPOL) ; get group name/group policy
  1. N X,Y S X=""
  1. S X=$G(^IBA(355.3,+$G(IBCPOL),0))
  1. S Y=$S($P(X,"^",4)'="":$P(X,"^",4),1:$P(X,"^",3))
  1. I $P(X,"^",10) S Y="Ind Plan "_Y
  1. GRPQ Q Y
  1. PR(STR,LEN) ; pad right
  1. N B S STR=$E(STR,1,LEN),$P(B," ",LEN-$L(STR))=" "
  1. Q STR_$G(B)
  1. PRNTCHG ; prints a charge
  1. N IBACT,IBTYPE,IBBILL,IBFR,IBTO,IBCHG,IBND,IBND1
  1. N IBRX,IBRXN,IBRF,IBRDT,IBX,IENS,IBECME
  1. S IBND=$G(^IB(IBN,0))
  1. S IBND1=$G(^IB(IBN,1))
  1. S (IBRX,IBRXN,IBRF,IBRDT,IBX,IBECME)=0
  1. ; action id
  1. S IBACT=+IBND
  1. ; type
  1. ; begin of Patch IB*2.0*618 - added community care - action types to HELD CHARGES report
  1. S IBTYPE=$P(IBND,"^",3),IBTYPE=$P($G(^IBE(350.1,IBTYPE,0)),"^",1)
  1. S IBTYPE=$$IBACTYPE(IBTYPE)
  1. ; end of Patch IB*2.0*618
  1. ; bill #
  1. S IBBILL=$P($P(IBND,"^",11),"-",2)
  1. ; rx info
  1. I $P(IBND,"^",4)["52:" D
  1. . S IBRXN=+$P($P(IBND,"^",4),":",2) ; Rx ien
  1. . S IBRX=$P($P(IBND,"^",8),"-") ; external Rx#
  1. . S IBRF=+$P($P(IBND,"^",4),":",3) ; fill# or 0 for original fill
  1. . S IBECME=$P($$CLAIM^BPSBUTL(IBRXN,IBRF),U,6) ; ecme# DBIA# 4719
  1. . I IBRF S IENS=+IBRF,IBRDT=$$SUBFILE^IBRXUTL(+IBRXN,+IENS,52,.01) ; refill date
  1. . I 'IBRF S IENS=+IBRXN,IBRDT=$$FILE^IBRXUTL(+IENS,22) ; orig fill date
  1. . Q
  1. ;
  1. S IBX=$$APPT^IBCU3(IBRDT,DFN)
  1. ; from/rx fill date
  1. S IBFR=$$DAT1^IBOUTL($S(IBRXN>0:IBRDT,1:$P(IBND,"^",15)))
  1. ; to date
  1. S IBTO=$$DAT1^IBOUTL($S($P(IBND,"^",15)'="":($P(IBND,"^",15)),1:$P(IBND1,"^",2)))
  1. ; charge$
  1. S IBCHG=$J(+$P(IBND,"^",7),9,2)
  1. W ?29,IBACT,?39,IBTYPE,?46,IBBILL
  1. I IBRX>0 W ?55,"Rx #: "_IBRX_$S(IBRF>0:"("_IBRF_")",1:""),?85,"||",! I IBECME W ?55,"ECME #: ",IBECME,?85,"||",!
  1. W:IBX=1 ?54,"*"
  1. W ?55,IBFR,?66,IBTO,?75,IBCHG
  1. Q
  1. Q:IBQUIT
  1. I IBCRT,$Y>1 D Q:IBQUIT ;F Q:$Y>(IOSL-1) W !
  1. .W ! N T R " Press RETURN to continue",T:DTIME I '$T!(T["^") S IBQUIT=1 Q
  1. I IBPAGE>1 W !,@IOF
  1. W ?53,"MEANS TEST CHARGES ON HOLD",?110,IBNOW," PAGE ",IBPAGE,!,"HELD CHARGES",?87,"CORRESPONDING THIRD PARTY BILLS",!,IBLINE
  1. W !,"Name",?22,"Pt.ID",?29,"Act.ID",?39,"Type",?46,"Bill#",?55,"Fr/Fl Dt",?66,"To/Rls Dt",?78,"Charge",?85,"||",?88,"Bill#",?97,"AR-Status",?115,"Charge",?128,"Paid"
  1. W !,IBLINE,!
  1. W ?20,"'*' = outpt visit on same day as Rx fill date",?85,"||",!,IBLINE,!
  1. S IBPAGE=IBPAGE+1
  1. Q
  1. IBACTYPE(IBTYPE) ; Patch IB*2.0*618 - added community care - action types to HELD CHARGES report
  1. I IBTYPE["URGENT " Q "NVCUC"
  1. I IBTYPE["CC " Q "NVC"
  1. I IBTYPE["CCN " Q "NVC"
  1. I IBTYPE["CHOICE" Q "NVC"
  1. I IBTYPE["PSO NSC" Q "RXNSC"
  1. I IBTYPE["PSO SC" Q "RX SC"
  1. Q $E(IBTYPE,4,7)
  1. ;