source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBOHDT1.m@ 1766

Last change on this file since 1766 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.4 KB
Line 
1IBOHDT1 ;ALB/EMG - REPORT OF CHARGES ON HOLD > 60 DAYS-CONT ;FEB 18 1997
2 ;;2.0; INTEGRATED BILLING ;**70,95,347**; 21-MAR-94;Build 24
3 ;
4REPORT ;
5 N IBQUIT,IBPAGE,IBNOW,IBLINE,IBCRT,IBBOT,DFN,IBNAME,IBATYPE,IBN,X
6 S IBCRT=0,IBBOT=6,IBQUIT=0 I $E(IOST,1,2)="C-" S IBCRT=1,IBBOT=4
7 S IBLINE="",$P(IBLINE,"=",96)="||",IBLINE=IBLINE_$E(IBLINE,1,32)
8 S IBNOW=$$FMTE^XLFDT($$NOW^XLFDT)
9 I IBCRT W @IOF
10LOOP ;
11 S IBPAGE=1 D HEADER Q:IBQUIT
12 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
13 .S IBN=0 F S IBN=$O(^TMP($J,"HOLD",IBNAME,DFN,IBATYPE,IBN)) Q:'IBN!(IBQUIT) D
14 ..D PRNTCHG,PRNTBILL:'IBQUIT
15 Q
16PRNTBILL ; prints bills for a charge
17 N IB,IB0,IBSTAT,IBCHG,IBPD,Y,I,IBT
18 D:$Y-IBBOT+1>IOSL HEADER Q:IBQUIT
19 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
20 .W ?95,"||"
21 .S IB0=$G(^DGCR(399,IB,0)) Q:IB0=""
22 .W ?98,$P(IB0,"^",1) ; bill #
23 .S IBSTAT=$$STA^PRCAFN(IB)
24 .W:+IBSTAT>0 ?106,$E($P(IBSTAT,"^",2),1,3)
25 .S IBT=$J((+^DGCR(399,IB,"U1")-$P(^("U1"),"^",2)),9,2)
26 .W ?113,IBT ; total charges
27 .S IBPD=$$TPR^PRCAFN(IB) S:IBPD<0 IBPD="" S IBPD=$J(IBPD,9,2) W ?122,IBPD,! D:$Y+IBBOT>IOSL HEADER
28 Q
29PRNTPAT ; prints patient data
30 N VAERR,VADM,IBSSN D DEM^VADPT S:'VAERR IBNAME=$G(VADM(1)),IBSSN=VA("BID") ; pt id,brief
31 D:$Y+IBBOT>IOSL HEADER Q:IBQUIT
32 W $E(IBNAME,1,20),?22,IBSSN
33 Q
34PRNTCHG ; prints a charge
35 N IBACT,IBTYPE,IBBILL,IBFR,IBTO,IBCHG,IBND,IBND1,IBDAY,IBOHDT,X1,X2
36 N IBRX,IBRXN,IBRF,IBRDT,IBX,IENS
37 S IBND=$G(^IB(IBN,0))
38 S IBND1=$G(^IB(IBN,1))
39 S (IBRX,IBRXN,IBRF,IBRDT,IBX)=0
40 ; action id
41 S IBACT=+IBND
42 ; type
43 S IBTYPE=$P(IBND,"^",3),IBTYPE=$P($G(^IBE(350.1,IBTYPE,0)),"^",1),IBTYPE=$S(IBTYPE["PSO NSC":"RXNSC",IBTYPE["PSO SC":"RX SC",1:$E(IBTYPE,4,7))
44 ; bill #
45 ; S IBBILL=$P($P(IBND,"^",11),"-",2)
46 ; rx info
47 I $P(IBND,"^",4)["52:" S IBRXN=$P($P(IBND,"^",4),":",2),IBRX=$P($P(IBND,"^",8),"-"),IBRF=$P($P(IBND,"^",4),":",3)
48 I $P(IBND,"^",4)["52:" D
49 .I IBRF>0 S IENS=+IBRF,IBRDT=$$SUBFILE^IBRXUTL(+IBRXN,+IENS,52,.01)
50 .E D
51 ..S IENS=+IBRXN
52 ..S IBRDT=$$FILE^IBRXUTL(IENS,22)
53 S IBX=$$APPT^IBCU3(IBRDT,DFN)
54 ; from/fill date
55 S IBFR=$$DAT1^IBOUTL($S(+IBRXN>0:IBRDT,1:$P(IBND,"^",14)))
56 ; to date
57 S IBTO=$$DAT1^IBOUTL($S($P(IBND,"^",15)'="":$P(IBND,"^",15),1:$P(IBND1,"^",2)))
58 ; on hold date
59 S IBOHDT=$$DAT1^IBOUTL($P(IBND1,"^",6))
60 ; number of days on hold
61 S X1=DT,X2=$P(IBND1,"^",6) D ^%DTC S IBDAY=$J(X,7)
62 ; charge$
63 S IBCHG=$J(+$P(IBND,"^",7),9,2)
64 W ?29,IBACT,?39,IBTYPE W:IBRX>0 ?46,"Rx #: "_IBRX_$S(IBRF>0:"("_IBRF_")",1:""),?95,"||",!
65 W:IBX=1 ?45,"*"
66 W ?46,IBFR,?55,IBTO,?66,IBOHDT,?77,IBDAY,?86,IBCHG
67 Q
68HEADER ; writes the report header
69 Q:IBQUIT
70 I IBCRT,$Y>1 D Q:IBQUIT
71 .F Q:$Y>(IOSL-3) W !
72 .N T R " Press RETURN to continue",T:DTIME I '$T!(T["^") S IBQUIT=1 Q
73 I IBPAGE>1 W !,@IOF
74 W ?53,"CHARGES ON HOLD LONGER THAN "_IBNUM_" DAYS",?110,IBNOW," PAGE ",IBPAGE,!,"HELD CHARGES",?98,"CORRESPONDING THIRD PARTY BILLS",!,IBLINE
75 W !,?46,"From/",?55,"To/",?66,"On Hold",?77,"# Days",?95,"||",?105,"AR"
76 W !,"Name",?22,"Pt.ID",?29,"Act.ID",?39,"Type",?46,"Fill Dt",?55,"Rls Dt",?66,"Date",?77,"On Hold",?89,"Charge",?95,"||",?98,"Bill#",?105,"Status",?113,"Charge",?125,"Paid"
77 W !,IBLINE,!
78 W ?44,"'*' = outpt visit on same day as Rx fill date",?95,"||",!,IBLINE,!
79 S IBPAGE=IBPAGE+1
80 Q
Note: See TracBrowser for help on using the repository browser.