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

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

initial load of WorldVistAEHR

File size: 3.6 KB
Line 
1IBOHPT2 ;ALB/EMG - ON HOLD CHARGE INFO/PT CONT. ;JULY 22,1997
2 ;;2.0; INTEGRATED BILLING ;**70,95,347**; 21-MAR-94;Build 24
3REPORT ;
4 N IBQUIT,IBPAGE,IBNOW,IBLINE,IBLINE2,IBCRT,IBBOT,IBNAME,IBN,IBDT,IBIFN
5 S IBCRT=0,IBBOT=6,IBQUIT=0 I $E(IOST,1,2)="C-" S IBCRT=1,IBBOT=4
6 S IBLINE="",$P(IBLINE,"=",86)="||",IBLINE=IBLINE_$E(IBLINE,1,45)
7 S IBLINE2="",$P(IBLINE2,"-",75)="--"
8 D NOW^%DTC S Y=X X ^DD("DD") S IBNOW=Y
9 S IBNAME=$$PT^IBEFUNC(DFN)
10 I IBCRT W @IOF
11LOOP ;
12 ;
13 S IBPAGE=1 D HEADER Q:IBQUIT
14 S IBDT="" F S IBDT=$O(^TMP($J,"IB",IBDT)) Q:IBDT=""!(IBDT>0)!(IBQUIT) D
15 .S IBIFN=0 F S IBIFN=$O(^TMP($J,"IB",IBDT,IBIFN)) Q:'IBIFN!(IBQUIT) D
16 ..D PRNTCHG,PRNTBILL:'IBQUIT
17 Q
18PRNTBILL ; prints bills for a charge
19 N IB,IB0,IBSTAT,IBCHG,IBPD,C,Y,I,IBT,IBPCT
20 D:$Y-IBBOT+1>IOSL HEADER Q:IBQUIT
21 S IB="" F I=1:1 S IB=$O(^TMP($J,"IB",IBDT,IBIFN,IB)) W:'IB&(I=1) ?85,$S(IBCN:"",1:"||"),! D:$Y+IBBOT>IOSL HEADER Q:'IB!(IBQUIT) D
22 .W ?85,"||"
23 .S IB0=$G(^DGCR(399,IB,0)) Q:IB0=""
24 .W ?88,$P(IB0,"^",1) ; bill #
25 .W ?97,$$BCHGTYPE^IBCU(+IB)
26 .S IBSTAT=$P($$ARSTATA^IBJTU4(+IB),U,2)
27 .W ?110,IBSTAT
28 .S IBT=$J((+^DGCR(399,IB,"U1")-$P(^("U1"),"^",2)),9,2)
29 .W ?113,IBT ; total charges
30 .S IBPCT=$P($$BILL^RCJIBFN2(IB),"^",5) W ?128,$J(IBPCT,3,0)_"%",! D:$Y+IBBOT>IOSL HEADER
31 Q
32 ;
33PRNTCHG ; prints a charge
34 N IBACT,IBAR,IBARIFN,IBARST,IBARTR,IBTYPE,IBBILL,IBFR,IBTO,IBCHG,IBND,IBND1,IBST,IBARBN,IBAREN
35 N IBRX,IBRXN,IBRF,IBRDT,IBX,IENS
36 S IBND=$G(^IB(IBIFN,0)),IBND1=$G(^IB(IBIFN,1)),(IBCN,IBX)=0
37 S (IBRX,IBRXN,IBRF,IBRDT)=0
38 ; action id
39 S IBACT=+IBND
40 ; type
41 S X=$P($P($G(^IBE(350.1,+$P(IBND,"^",3),0)),"^")," ",2,99)
42 S IBTYPE=$E($P(X," ",1,$L(X," ")-1),1,6)
43 ; bill #
44 S IBBILL=$P($P(IBND,"^",11),"-",2)
45 S IBARBN=$P(IBND,"^",11)
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 S IENS=+IBRXN,IBRDT=$$FILE^IBRXUTL(+IENS,22)
51 S IBX=$$APPT^IBCU3(IBRDT,DFN)
52 ; service date
53 S IBFR=$$DAT1^IBOUTL($S(IBRXN>0:IBRDT,1:$P(IBND,"^",15)))
54 ; release to ar date
55 ;S IBAR=$$DAT1^IBOUTL($S($P(IBND,"^",14)'="":$P(IBND,"^",14),1:$P(IBND1,"^",4)))
56 S IBAR=$S($P(IBND,"^",11):$$DAT1^IBOUTL($P(IBND1,"^",4)),1:"")
57 ; ib status
58 S IBST=$E($P($G(^IBE(350.21,+$P(IBND,"^",5),0)),"^",2),1,6)
59 ; charge$
60 S IBCHG=$J(+$P(IBND,"^",7),9,2)
61 S IBARTR=$S($P(IBND,"^",12):$P(IBND,"^",12),1:"")
62 ; ar status
63 ;S IBARST=$S(IBARTR]"":$E($P($$STNO^RCJIBFN2($$STAT^RCJIBFN2(IBIFN)),"^"),1,6),1:"")
64 S IBAREN=$S(IBARTR]"":$O(^PRCA(430,"B",IBARBN,0)),1:"")
65 S IBARST=$S(IBAREN]"":$E($P($$STNO^RCJIBFN2($$STAT^RCJIBFN2(IBAREN)),"^"),1,6),1:"")
66 ;
67 ; write data
68 W IBACT,?15,IBTYPE,?28,IBBILL W:IBRX>0 ?38,"Rx #: "_IBRX_$S(IBRF>0:"("_IBRF_")",1:""),?85,"||",!
69 W:IBX=1 ?37,"*"
70 W ?38,IBFR,?48,IBAR,?58,IBCHG,?70,IBARST,?79,IBST
71 I $P(IBND,"^",5)=10 S IBCN=1 W ?85,"|| REASON: ",$P($G(^IBE(350.3,+$P(IBND,"^",10),0)),"^"),!
72 Q
73HEADER ; writes the report header
74 Q:IBQUIT
75 I IBCRT,$Y>1 D Q:IBQUIT
76 .F Q:$Y>(IOSL-3) W !
77 .N T R " Press RETURN to continue",T:DTIME I '$T!(T["^") S IBQUIT=1 Q
78 I IBPAGE>1 W !,@IOF
79 W "List of all HELD bills for ",$P(IBNAME,"^")," SSN: ",$P(IBNAME,"^",2),?110,IBNOW," PAGE ",IBPAGE,!,"PATIENT CHARGES",?87,"CORRESPONDING THIRD PARTY BILLS",!,IBLINE
80 W !,?38,"From/",?48,"Date",?70,"AR",?79,"IB",?85,"||",?110,"AR"
81 W !,"Action ID",?15,"Type",?28,"Bill#",?38,"Fill Dt",?48,"to AR",?61,"Charge",?70,"Status",?79,"Status",?85,"||",?88,"Bill#",?97,"Classf($Typ)",?110,"ST",?116,"Charge",?126,"% Paid"
82 W !,IBLINE,!
83 W:IBIBRX ?36,"'*' = outpt visit on same day as Rx fill date",?85,"||",!,IBLINE,!
84 S IBPAGE=IBPAGE+1
85 Q
Note: See TracBrowser for help on using the repository browser.