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

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

initial load of WorldVistAEHR

File size: 5.1 KB
Line 
1IBOHLD2 ;ALB/CJM - REPORT OF CHARGES ON HOLD W/INS ;MAR 6,1991
2 ;;2.0;INTEGRATED BILLING;**70,95,133,153,347**;21-MAR-94;Build 24
3REPORT ;
4 N IBQUIT,IBPAGE,IBNOW,IBLINE,IBLINE2,IBCRT,IBBOT,DFN,IBNAME,IBN
5 S IBCRT=0,IBBOT=7,IBQUIT=0 I $E(IOST,1,2)="C-" S IBCRT=1,IBBOT=7
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 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=""!(IBQUIT) S DFN=0 F S DFN=$O(^TMP($J,"HOLD",IBNAME,DFN)) Q:'DFN!(IBQUIT) D
13 .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
14 ..D PRNTCHG,PRNTBILL:'IBQUIT
15 Q
16PRNTBILL ; prints bills for a charge
17 N IB,IB0,IBSTAT,IBCHG,IBPD,C,Y,I,IBT
18 D:$Y+IBBOT>IOSL HEADER Q:IBQUIT
19 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
20 .W ?85,"||"
21 .S IB0=$G(^DGCR(399,IB,0)) Q:IB0=""
22 .W ?88,$P(IB0,"^",1) ; bill #
23 .S IBSTAT=$$STA^PRCAFN(IB)
24 .W:+IBSTAT>0 ?97,$E($P(IBSTAT,"^",2),1,14)
25 .S IBT=$J((+^DGCR(399,IB,"U1")-$P(^("U1"),"^",2)),9,2)
26 .W ?112,IBT ; total charges
27 .S IBPD=$$TPR^PRCAFN(IB) S:IBPD<0 IBPD="" S IBPD=$J(IBPD,9,2) W ?123,IBPD,! D:$Y+IBBOT>IOSL HEADER
28 Q
29PRNTPAT ; prints patient data
30 N VAERR,VADM,IBSSN D DEM^VADPT S:'VAERR IBSSN=VA("BID") ; pt id,brief
31 D:$Y+IBBOT>IOSL HEADER Q:IBQUIT
32 W IBLINE,!
33 W $E(IBNAME,1,20),?22,IBSSN
34 W:IBII ?35,"Insurance Co.",?53,"Subscriber ID",?71,"Group",?88,"Eff Dt",?102,"Exp Dt",!
35 Q
36PRNTINS ; prints insurance information
37 Q:'$D(DFN)!(IBII=0)
38 N X,IBINS,IBX
39 D ALL^IBCNS1(DFN,"IBINS")
40 D:$Y+IBBOT>IOSL HEADER Q:IBQUIT
41 W IBLINE,!
42 I '$D(IBINS) W ?35,"No Insurance Information"
43 S X=0 F S X=$O(IBINS(X)) Q:'X S IBINS=IBINS(X,0) D
44 .D:$Y+IBBOT>IOSL HEADER Q:IBQUIT
45 .N COV,COVD,COVFN,IBCNT,LEDT,LIM,PLN,SP,X,X1,X2,Z0 Q:'$D(IBINS)
46 .W ?36,$S($D(^DIC(36,+IBINS,0)):$E($P(^(0),"^",1),1,16),1:"UNKNOWN")
47 .W ?54,$E($P(IBINS,"^",2),1,16)
48 .W ?72,$E($$GRP($P(IBINS,"^",18)),1,10) S PLN=$P(IBINS,"^",18)
49 .W ?88,$$DAT1^IBOUTL($P(IBINS,"^",8)),?102,$$DAT1^IBOUTL($P(IBINS,"^",4))
50 .I PLN="" W !,?38,"* No Group Plan Information for this Patient - Verify Insurance Info!",! Q
51 .W !,?40,"Plan Coverage Effective Date Covered? Limit Comments",!
52 .W ?40,"------------- -------------- -------- --------------",!
53 .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=""
54 ..D:$Y+IBBOT>IOSL HEADER Q:IBQUIT
55 ..S COVFN=+$O(^IBA(355.32,"APCD",PLN,LIM,+LEDT,"")),COVD=$G(^IBA(355.32,+COVFN,0))
56 ..I COVD="" W ?40,COV,?86,"BY DEFAULT",! Q
57 ..S IBCNT=IBCNT+1
58 ..S X1=" "_$S(IBCNT=1:COV,1:"") ;Don't duplicate category
59 ..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)
60 ..I '$O(^IBA(355.32,COVFN,2,0)) W ?40,X2,! Q
61 ..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))),!
62 Q
63GRP(IBCPOL) ; get group name/group policy
64 N X,Y S X=""
65 S X=$G(^IBA(355.3,+$G(IBCPOL),0))
66 S Y=$S($P(X,"^",4)'="":$P(X,"^",4),1:$P(X,"^",3))
67 I $P(X,"^",10) S Y="Ind Plan "_Y
68GRPQ Q Y
69PR(STR,LEN) ; pad right
70 N B S STR=$E(STR,1,LEN),$P(B," ",LEN-$L(STR))=" "
71 Q STR_$G(B)
72PRNTCHG ; prints a charge
73 N IBACT,IBTYPE,IBBILL,IBFR,IBTO,IBCHG,IBND,IBND1
74 N IBRX,IBRXN,IBRF,IBRDT,IBX,IENS
75 S IBND=$G(^IB(IBN,0))
76 S IBND1=$G(^IB(IBN,1))
77 S (IBRX,IBRXN,IBRF,IBRDT,IBX)=0
78 ; action id
79 S IBACT=+IBND
80 ; type
81 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))
82 ; bill #
83 S IBBILL=$P($P(IBND,"^",11),"-",2)
84 ; rx info
85 I $P(IBND,"^",4)["52:" S IBRXN=$P($P(IBND,"^",4),":",2),IBRX=$P($P(IBND,"^",8),"-"),IBRF=$P($P(IBND,"^",4),":",3)
86 I $P(IBND,"^",4)["52:" D
87 .I +IBRF>0 D
88 ..S IENS=+IBRF
89 ..S IBRDT=$$SUBFILE^IBRXUTL(+IBRXN,+IENS,52,.01)
90 .I +IBRF=0 D
91 ..S IENS=+IBRXN
92 ..S IBRDT=$$FILE^IBRXUTL(+IENS,22)
93 S IBX=$$APPT^IBCU3(IBRDT,DFN)
94 ; from/rx fill date
95 S IBFR=$$DAT1^IBOUTL($S(IBRXN>0:IBRDT,1:$P(IBND,"^",15)))
96 ; to date
97 S IBTO=$$DAT1^IBOUTL($S($P(IBND,"^",15)'="":($P(IBND,"^",15)),1:$P(IBND1,"^",2)))
98 ; charge$
99 S IBCHG=$J(+$P(IBND,"^",7),9,2)
100 W ?29,IBACT,?39,IBTYPE,?46,IBBILL W:IBRX>0 ?55,"Rx #: "_IBRX_$S(IBRF>0:"("_IBRF_")",1:""),?85,"||",!
101 W:IBX=1 ?54,"*"
102 W ?55,IBFR,?66,IBTO,?75,IBCHG
103 Q
104HEADER ; writes the report header
105 Q:IBQUIT
106 I IBCRT,$Y>1 D Q:IBQUIT ;F Q:$Y>(IOSL-1) W !
107 .W ! N T R " Press RETURN to continue",T:DTIME I '$T!(T["^") S IBQUIT=1 Q
108 I IBPAGE>1 W !,@IOF
109 W ?53,"MEANS TEST CHARGES ON HOLD",?110,IBNOW," PAGE ",IBPAGE,!,"HELD CHARGES",?87,"CORRESPONDING THIRD PARTY BILLS",!,IBLINE
110 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"
111 W !,IBLINE,!
112 W ?20,"'*' = outpt visit on same day as Rx fill date",?85,"||",!,IBLINE,!
113 S IBPAGE=IBPAGE+1
114 Q
Note: See TracBrowser for help on using the repository browser.