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

IBOHDT1.m

Go to the documentation of this file.
  1. IBOHDT1 ;ALB/EMG - REPORT OF CHARGES ON HOLD > 60 DAYS-CONT ;FEB 18 1997
  1. ;;2.0;INTEGRATED BILLING;**70,95,347,452,618**;21-MAR-94;Build 61
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. REPORT ;
  1. N IBQUIT,IBPAGE,IBNOW,IBLINE,IBCRT,IBBOT,DFN,IBNAME,IBATYPE,IBN,X
  1. S IBCRT=0,IBBOT=6,IBQUIT=0 I $E(IOST,1,2)="C-" S IBCRT=1,IBBOT=4
  1. S IBLINE="",$P(IBLINE,"=",96)="||",IBLINE=IBLINE_$E(IBLINE,1,32)
  1. S IBNOW=$$FMTE^XLFDT($$NOW^XLFDT)
  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="" S DFN=0 F S DFN=$O(^TMP($J,"HOLD",IBNAME,DFN)) Q:DFN="" D PRNTPAT Q:IBQUIT S IBATYPE="" F S IBATYPE=$O(^TMP($J,"HOLD",IBNAME,DFN,IBATYPE)) Q:IBATYPE="" D
  1. .S IBN=0 F S IBN=$O(^TMP($J,"HOLD",IBNAME,DFN,IBATYPE,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,Y,I,IBT
  1. D:$Y-IBBOT+1>IOSL HEADER Q:IBQUIT
  1. S IB="" F I=1:1 S IB=$O(^TMP($J,"HOLD",IBNAME,DFN,IBATYPE,IBN,IB)) W:'IB&(I<2) ?90,"||",! D:$Y+IBBOT>IOSL HEADER Q:'IB!(IBQUIT) D
  1. .W ?95,"||"
  1. .S IB0=$G(^DGCR(399,IB,0)) Q:IB0=""
  1. .W ?98,$P(IB0,"^",1) ; bill #
  1. .S IBSTAT=$$STA^PRCAFN(IB)
  1. .W:+IBSTAT>0 ?106,$E($P(IBSTAT,"^",2),1,3)
  1. .S IBT=$J((+^DGCR(399,IB,"U1")-$P(^("U1"),"^",2)),9,2)
  1. .W ?113,IBT ; total charges
  1. .S IBPD=$$TPR^PRCAFN(IB) S:IBPD<0 IBPD="" S IBPD=$J(IBPD,9,2) W ?122,IBPD,! D:$Y+IBBOT>IOSL HEADER
  1. Q
  1. PRNTPAT ; prints patient data
  1. N VAERR,VADM,IBSSN D DEM^VADPT S:'VAERR IBNAME=$G(VADM(1)),IBSSN=VA("BID") ; pt id,brief
  1. D:$Y+IBBOT>IOSL HEADER Q:IBQUIT
  1. W $E(IBNAME,1,20),?22,IBSSN
  1. Q
  1. PRNTCHG ; prints a charge
  1. N IBACT,IBTYPE,IBBILL,IBFR,IBTO,IBCHG,IBND,IBND1,IBDAY,IBOHDT,X1,X2
  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. ; Patch IB*2.0*618 - added community care - action types to DAYS ON HOLD report
  1. S IBTYPE=$P(IBND,"^",3),IBTYPE=$P($G(^IBE(350.1,IBTYPE,0)),"^",1)
  1. S IBTYPE=$$IBACTYPE^IBOHLD2(IBTYPE)
  1. ; end of Patch IB*2.0*618
  1. ; bill #
  1. ; S IBBILL=$P($P(IBND,"^",11),"-",2)
  1. ;
  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) ; fill date
  1. . Q
  1. ;
  1. S IBX=$$APPT^IBCU3(IBRDT,DFN)
  1. ; from/fill date
  1. S IBFR=$$DAT1^IBOUTL($S(+IBRXN>0:IBRDT,1:$P(IBND,"^",14)))
  1. ; to date
  1. S IBTO=$$DAT1^IBOUTL($S($P(IBND,"^",15)'="":$P(IBND,"^",15),1:$P(IBND1,"^",2)))
  1. ; on hold date
  1. S IBOHDT=$$DAT1^IBOUTL($P(IBND1,"^",6))
  1. ; number of days on hold
  1. S X1=DT,X2=$P(IBND1,"^",6) D ^%DTC S IBDAY=$J(X,7)
  1. ; charge$
  1. S IBCHG=$J(+$P(IBND,"^",7),9,2)
  1. W ?29,IBACT,?40,IBTYPE W:IBRX>0 ?46,"Rx #: "_IBRX_$S(IBRF>0:"("_IBRF_")",1:""),?68,$S(IBECME:"ECME #: "_IBECME,1:""),?95,"||",!
  1. W:IBX=1 ?45,"*"
  1. W ?46,IBFR,?55,IBTO,?66,IBOHDT,?77,IBDAY,?86,IBCHG
  1. Q
  1. Q:IBQUIT
  1. I IBCRT,$Y>1 D Q:IBQUIT
  1. .F Q:$Y>(IOSL-3) W !
  1. .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,"CHARGES ON HOLD LONGER THAN "_IBNUM_" DAYS",?110,IBNOW," PAGE ",IBPAGE,!,"HELD CHARGES",?98,"CORRESPONDING THIRD PARTY BILLS",!,IBLINE
  1. W !,?46,"From/",?55,"To/",?66,"On Hold",?77,"# Days",?95,"||",?105,"AR"
  1. W !,"Name",?22,"Pt.ID",?29,"Act.ID",?40,"Type",?46,"Fill Dt",?55,"Rls Dt",?66,"Date",?77,"On Hold",?89,"Charge",?95,"||",?98,"Bill#",?105,"Status",?113,"Charge",?125,"Paid"
  1. W !,IBLINE,!
  1. W ?44,"'*' = outpt visit on same day as Rx fill date",?95,"||",!,IBLINE,!
  1. S IBPAGE=IBPAGE+1
  1. Q