source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBJDF12.m@ 1806

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

initial load of FOIAVistA 6/30/08 version

File size: 4.5 KB
Line 
1IBJDF12 ;ALB/CPM - THIRD PARTY FOLLOW-UP REPORT (PRINT) ; 10-JAN-97
2 ;;2.0;INTEGRATED BILLING;**69,118,128,123,204,205**;21-MAR-94
3 ;
4EN ; - Print the Follow-up report.
5 S IBQ=0 D NOW^%DTC S IBRUN=$$DAT2^IBOUTL(%)
6 I 'IBSD D DET(0),PAUSE:'IBQ G ENQ
7 S IBDIV=0 F S IBDIV=$O(VAUTD(IBDIV)) Q:'IBDIV D DET(IBDIV),PAUSE:'IBQ Q:IBQ
8 ;
9ENQ K IBPAG,IBRUN,IBDIV,IBWIN,IBWPT,IBWDP,IBQ,IBH,IBZ,IBC,IBC1,IBC2,IBCD,%
10 Q
11 ;
12DET(IBDIV) ; - Print report for a specific division.
13 ; Input: IBDIV=Pointer to the division in file #40.8
14 S IBPAG=0
15 I '$D(^TMP("IBJDF1",$J,IBDIV)) D G DETQ
16 .S IBTYP=4 D HDR1 I IBQ Q
17 .W !!,"There are no active receivables "
18 .I IBSMN W IBSMN,$S(IBSMX>IBSMN:" to "_IBSMX,1:"")," days old "
19 .I IBDIV W "for this division."
20 ;
21 S IBTYP=0 F S IBTYP=$O(^TMP("IBJDF1",$J,IBDIV,IBTYP)) Q:'IBTYP D Q:IBQ
22 .D HDR1 I IBQ Q
23 .S IBWIN="" F S IBWIN=$O(^TMP("IBJDF1",$J,IBDIV,IBTYP,IBWIN)) Q:IBWIN="" D Q:IBQ
24 ..I $Y>(IOSL-5) D PAUSE Q:IBQ D HDR1 Q:IBQ
25 ..D HDR2
26 ..S IBWPT="" F S IBWPT=$O(^TMP("IBJDF1",$J,IBDIV,IBTYP,IBWIN,IBWPT)) Q:IBWPT="" D Q:IBQ
27 ...S (IBH,IBWDP)="" F S IBWDP=$O(^TMP("IBJDF1",$J,IBDIV,IBTYP,IBWIN,IBWPT,IBWDP)) W:IBWDP="" ! Q:IBWDP="" S IBZ=$G(^(IBWDP)) D Q:IBQ
28 ....I $Y>(IOSL-3) D PAUSE Q:IBQ D HDR1,HDR2 Q:IBQ S IBH=0
29 ....W ! I 'IBH D WPAT S IBH=1
30 ....D WBIL Q:IBQ
31 ....;
32 ....; - Display bill comment history, if necessary.
33 ....I IBSH D WCOM Q:IBQ
34 ;
35DETQ Q
36 ;
37DASH(X) ; - Return a dashed line.
38 Q $TR($J("",X)," ","=")
39 ;
40PAUSE ; - Page break.
41 I $E(IOST,1,2)'="C-" Q
42 N IBX,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
43 F IBX=$Y:1:(IOSL-3) W !
44 S DIR(0)="E" D ^DIR I $D(DIRUT)!($D(DUOUT)) S IBQ=1
45 Q
46 ;
47HDR1 ; - Write the primary report header.
48 I $E(IOST,1,2)="C-"!(IBPAG) W @IOF,*13
49 S IBPAG=IBPAG+1
50 W "Third Party Follow-Up Report"_$S(IBSDATE="D":" ( date of care )",1:" ( days in AR )")
51 I IBDIV W " for ",$P($G(^DG(40.8,IBDIV,0)),U)
52 W ?88,"Run Date: ",IBRUN,?123,"Page: ",$J(IBPAG,3)
53 W !,"All active ",$S(IBTYP=1:"INPATIENT ",IBTYP=2:"OUTPATIENT ",IBTYP=3:"RX REFILL ",1:""),"receivables "
54 I IBSMN W IBSMN,$S(IBSMX>IBSMN:" to "_IBSMX,1:"")," days old "
55 I IBSAM W "with balances of at least $",IBSAM
56 W !!?37,"Other",?51,"Date",?92,"Original",?103,"Current"
57 W !,"Patient (Age)",?24,"SSN",?37,"Carrier",?51,"Prepared",?61,"Bill No.",?73,"Bill Fr. Bill To",?94,"Amount",?103,"Balance",?114,"Subscriber ID"
58 W !,$$DASH(IOM)
59 I IBSRC W !,"Note: '(n)' or '(*)' next to balance means AR was referred to Regional Counsel"
60 W ! S IBQ=$$STOP^IBOUTL("Third Party Follow-Up Report")
61 Q
62 ;
63HDR2 ; - Write the insurance company sub-header.
64 N X,X13 W !?3,"Carrier: ",$P(IBWIN,"@@")
65 S X=$G(^DIC(36,+$P(IBWIN,"@@",2),.11)),X13=$G(^(.13))
66 I X]"" D
67 .W ", ",$P(X,U),", ",$P(X,U,4),", ",$P($G(^DIC(5,+$P(X,U,5),0)),U,2)," ",$P(X,U,6)
68 .I $P(X13,U,2)]"" W " Billing Phone: ",$P(X13,U,2) Q
69 .I $P(X13,U)]"" W " Main Phone: ",$P(X13,U)
70 Q
71 ;
72WPAT ; - Write patient data.
73 W $P(IBZ,U),?24,$$SSN($P(IBZ,U,2)),?37,$P(IBZ,U,3)
74 Q
75 ;
76WBIL ; - Write bill data.
77 W ?51,$$DAT1^IBOUTL(+IBWDP),?60,$P(IBWDP,"@@",2)
78 W ?73,$$DAT1^IBOUTL($P(IBZ,U,4)),?82,$$DAT1^IBOUTL($P(IBZ,U,5))
79 W ?90,$J($P(IBZ,U,6),10,2),?100,$J(+$P(IBZ,U,7),10,2)
80 I $P($P(IBZ,U,7),"~",2) D
81 . I $P($P(IBZ,U,7),"~",2)<6 W "(",$P($P(IBZ,U,7),"~",2),")" Q
82 . W "(*)"
83 W ?114,$E($P(IBZ,U,8),1,18)
84 Q
85 ;
86WCOM ; - Write the comments
87 N CONT,DIWL,DIWR,IBC,IBC1,IBC2,X
88 ;
89 S (IBC,CONT)=0,DIWL=1,DIWR=104 K ^UTILITY($J,"W")
90 F S IBC=$O(^TMP("IBJDF1",$J,IBDIV,IBTYP,IBWIN,IBWPT,IBWDP,IBC)) Q:'IBC D Q:IBQ
91 . I $Y>(IOSL-4) D PAUSE Q:IBQ D HDR1,HDR2 Q:IBQ W ! D WPAT,WBIL
92 . S IBC1=""
93 . F S IBC1=$O(^TMP("IBJDF1",$J,IBDIV,IBTYP,IBWIN,IBWPT,IBWDP,IBC,IBC1)) Q:IBC1="" D Q:IBQ
94 . . S IBC2=^TMP("IBJDF1",$J,IBDIV,IBTYP,IBWIN,IBWPT,IBWDP,IBC,IBC1)
95 . . I $Y>(IOSL-4) D WCPB Q:IBQ
96 . . I 'IBC1 S IBCD=IBC2 D WCD Q
97 . . S X=IBC2 I $E(X)=" ",$L(X)>1 S $E(X)=""
98 . . D ^DIWP
99 . . I 'CONT,$L(IBC2)<66 D WCTXT Q
100 . . S CONT=$L(IBC2)>65
101 . . I '$O(^TMP("IBJDF1",$J,IBDIV,IBTYP,IBWIN,IBWPT,IBWDP,IBC,IBC1)) D
102 . . . D:$D(^UTILITY($J,"W")) WCTXT
103 K ^UTILITY($J,"W")
104 Q
105 ;
106WCD ; - Write comment date.
107 W !?2,"Comment Date: ",$$DAT1^IBOUTL(IBCD)
108 Q
109 ;
110WCTXT ; - Write comment text
111 N LIN,WLIN
112 S LIN=""
113 F S LIN=$O(^UTILITY($J,"W",1,LIN)) Q:LIN="" D Q:IBQ
114 . S WLIN=$G(^UTILITY($J,"W",1,LIN,0))
115 . I $Y>(IOSL-4) D WCPB Q:IBQ
116 . W:WLIN'="" ?26,WLIN,!
117 K ^UTILITY($J,"W")
118 Q
119 ;
120WCPB ; - Page Break in the middle of Comments
121 ;
122 D PAUSE Q:IBQ D HDR1,HDR2 Q:IBQ
123 W ! D WPAT,WBIL D WCD W:IBC1>1 ?26,"(continued)",!
124 Q
125 ;
126SSN(X) ; - Format the SSN.
127 Q $S(X]"":$E(X,1,3)_"-"_$E(X,4,5)_"-"_$E(X,6,10),1:"")
Note: See TracBrowser for help on using the repository browser.