close Warning: Can't use blame annotator: 
svn blame failed on WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBJDF52.m: 'GenericSWIGWrapper' object has no attribute '_wrap'

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

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

initial load of WorldVistAEHR
File size: 5.1 KB
RevLine 
1IBJDF52 ;ALB/RB - CHAMPVA/TRICARE FOLLOW-UP REPORT (PRINT) ;15-APR-00
2 ;;2.0;INTEGRATED BILLING;**123,159,240**;21-MAR-94
3 ;
4EN ; - Print the Follow-up report.
5 S (IBQ,IBFLG)=0 D NOW^%DTC S IBRUN=$$DAT2^IBOUTL(%) G:IBRPT="S" SUM
6 I 'IBSD D DET(0) G SUM
7 I IBSEL["1" D DET(0)
8 S IBDIV=""
9 F S IBDIV=$O(VAUTD(IBDIV)) Q:IBDIV="" D DET(IBDIV) Q:IBQ
10 ;
11SUM I 'IBQ D PRT^IBJDF53 ; Print summary.
12ENQ K I,IB0,IBC,IBCAT,IBCD,IBC1,IBC2,IBDIV,IBFLG,IBIN,IBKEY,IBN,IBPT,IBPAG
13 K IBQ,IBRUN,IBTYP,%
14 Q
15 ;
16DET(IBDIV) ; - Print report for a specific division.
17 ; Input: IBDIV=Pointer to the division in file #40.8 & variable IBSEL1
18 S IBCAT=0
19 F S IBCAT=$O(IBCAT(IBCAT)) Q:'IBCAT D Q:IBQ
20 . S (IB0,IBIN,IBKEY,IBTYP)=""
21 . F IBTYP=1:1:4 D:IBSEL1[IBTYP Q:IBQ
22 . . I IBDIV,IBCAT=31 Q
23 . . I IBSD,'IBDIV,IBCAT'=31 Q
24 . . I '$D(^TMP("IBJDF5",$J,IBDIV,IBCAT,IBTYP)) D HDR1,NAR,PAUSE Q
25 . . S IBFLG=0
26 . . F S IBIN=$O(^TMP("IBJDF5",$J,IBDIV,IBCAT,IBTYP,IBIN)) Q:IBIN="" D Q:IBQ
27 . . . D HDR1,HDR2 Q:IBQ
28 . . . F S IBKEY=$O(^TMP("IBJDF5",$J,IBDIV,IBCAT,IBTYP,IBIN,IBKEY)) Q:IBKEY="" D Q:IBQ
29 . . . . S IBPT=$G(^TMP("IBJDF5",$J,IBDIV,IBCAT,IBTYP,IBIN,IBKEY))
30 . . . . D WPAT
31 . . . . F S IB0=$O(^TMP("IBJDF5",$J,IBDIV,IBCAT,IBTYP,IBIN,IBKEY,IB0)) Q:IB0="" D Q:IBQ
32 . . . . . S IBN=$G(^TMP("IBJDF5",$J,IBDIV,IBCAT,IBTYP,IBIN,IBKEY,IB0))
33 . . . . . I $Y>(IOSL-3) D PAUSE Q:IBQ D HDR1,HDR2 Q:IBQ D WPAT
34 . . . . . W ?59,IB0,?71,$$DAT1^IBOUTL(+IBN)
35 . . . . . W ?80,$$DAT1^IBOUTL($P(IBN,U,2))
36 . . . . . W ?89,$$DAT1^IBOUTL($P(IBN,U,3)),?98,$J($P(IBN,U,4),8,2)
37 . . . . . W ?107,$J($P(IBN,U,5),8,2),?116,$P(IBN,U,6),!
38 . . . . . ;
39 . . . . . ; - Display bill comment history, if necessary.
40 . . . . . I IBSH D WCOM
41 . . . D:'IBQ PAUSE
42 ;
43DETQ Q
44 ;
45DASH(X) ; - Return a dashed line.
46 Q $TR($J("",X)," ","=")
47 ;
48PAUSE ; - Page break.
49 I $E(IOST,1,2)'="C-" Q
50 N IBX,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
51 F IBX=$Y:1:(IOSL-3) W !
52 S DIR(0)="E" D ^DIR S:$D(DIRUT)!($D(DUOUT)) IBQ=1
53 Q
54 ;
55HDR1 ; - Write the primary report header.
56 N FLG,X
57 ;
58 S FLG=1 I $G(IBFLG) S FLG=0
59 I '$G(IBFLG),$E(IOST,1,2)="C-"!$G(IBPAG) D
60 . W @IOF,*13 S IBFLG=0
61 . S IBPAG=$G(IBPAG)+1
62 I $G(IBFLG) D
63 . I $Y'>(IOSL-11) W !!! Q
64 . W @IOF,*13 S IBPAG=$G(IBPAG)+1,FLG=1
65 I '$G(IBPAG) S IBPAG=1
66 I IBDIV!FLG D
67 . W "CHAMPVA/TRICARE Follow-Up Report"
68 . I IBDIV W " for ",$P($G(^DG(40.8,IBDIV,0)),U)," "
69 . W ?75,"Run Date: ",IBRUN W:FLG ?123,"Page: ",$J(IBPAG,3)
70 S X="ALL ACTIVE "_$G(IBCTG(IBCAT(IBCAT)))_" RECEIVABLES "
71 I IBTYP'=4 S X=X_"("_$G(IBTPR(IBTYP))_") "
72 I IBSMN S X=X_"OVER "_IBSMN_" AND UNDER "_IBSMX_" DAYS OLD "
73 S X=X_" / BY PATIENT "_$S(IBSN="N":"NAME",1:"LAST 4 DIGITS OF SSN")
74 S X=X_" ("_$S($G(IBSNA)="ALL":"ALL",1:"From "_$S(IBSNF="":"FIRST",1:IBSNF)_" to "_$S(IBSNL="zzzzz":"LAST",1:IBSNL))_")"
75 S X=X_" / "_$S('IBSAM:"NO ",1:"")_"MINIMUM BALANCE"
76 I IBSAM S X=X_$S(IBSAM:": $"_$FN(IBSAM,",",2),1:"")
77 S X=X_" / "_$S('IBSH:"NO ",IBSH1="A":"ALL ",1:"ONLY ")_"COMMENTS"
78 S X=X_$S($G(IBSH2):" NOT OLDER THAN "_IBSH2_" DAYS",1:"")
79 S X=X_" / '*' AFTER THE PATIENT NAME = VA EMPLOYEE"
80 F I=1:1 W !,$E(X,1,132) S X=$E(X,133,999) I X="" Q
81 ;
82 W !!?71,"Dte Bill",?98,"Original Current"
83 W !,"Patient",?26,"Age SSN" W:IBCAT'=31 ?43,"Other Insurance"
84 W ?59,"Bill Number Prepared",?80,"Bill Frm Bill To Amount Balance"
85 W:IBCAT'=31 ?116,"Subscriber ID"
86 W !,$$DASH(IOM),!
87 S IBQ=$$STOP^IBOUTL("CHAMPVA/TRICARE Follow-Up Report")
88 Q
89 ;
90HDR2 ; - Write the insurance company sub-header.
91 N X,X13
92 I $P(IBIN,"@@")'=0 W ?2,"Carrier: ",$P(IBIN,"@@")
93 S X=$G(^DIC(36,+$P(IBIN,"@@",2),.11)),X13=$G(^(.13))
94 I X]"" D
95 .W ", ",$P(X,U),", ",$P(X,U,4),", ",$P($G(^DIC(5,+$P(X,U,5),0)),U,2)," ",$P(X,U,6)
96 .I $P(X13,U,2)]"" W " Billing Phone: ",$P(X13,U,2) Q
97 .I $P(X13,U)]"" W " Main Phone: ",$P(X13,U)
98 ;
99 Q
100 ;
101NAR ; - Write detail line (if '$D).
102 S IBFLG=1
103 W !!,"There are no active receivables for the parameters above."
104 Q
105 ;
106WPAT ; - Write patient data.
107 W !,$P(IBPT,U),?26,$J($P(IBPT,U,2),3),?30,$P(IBPT,U,3)
108 W ?43,$P(IBPT,U,4)
109 Q
110 ;
111WCOM ; - Write bill comments
112 N CONT,DIWL,DIWR,IBC,IBCD,IBC1,IBC2,X
113 ;
114 S (IBC,CONT,IBCD)=0,IBC1="",DIWL=1,DIWR=104 K ^UTILITY($J)
115 F S IBC=$O(^TMP("IBJDF5",$J,IBDIV,IBCAT,IBTYP,IBIN,IBKEY,IB0,IBC)) Q:'IBC D Q:IBQ
116 . F S IBC1=$O(^TMP("IBJDF5",$J,IBDIV,IBCAT,IBTYP,IBIN,IBKEY,IB0,IBC,IBC1)) Q:IBC1="" D Q:IBQ
117 . . S IBC2=^TMP("IBJDF5",$J,IBDIV,IBCAT,IBTYP,IBIN,IBKEY,IB0,IBC,IBC1)
118 . . I 'IBC1 S IBCD=IBC2 D WCD Q
119 . . I $Y>(IOSL-4) D WCPB Q:IBQ
120 . . S X=IBC2 I $E(X)=" ",$L(X)>1 S $E(X)=""
121 . . D ^DIWP
122 . . I 'CONT,$L(IBC2)<66 D WCTXT Q
123 . . S CONT=$L(IBC2)>65
124 . . I '$O(^TMP("IBJDF5",$J,IBDIV,IBCAT,IBTYP,IBIN,IBKEY,IB0,IBC,IBC1)) D
125 . . . D:$D(^UTILITY($J,"W")) WCTXT
126 K ^UTILITY($J,"W")
127 Q
128 ;
129WCTXT ; - Write comment text
130 N LIN,WLIN
131 S LIN=""
132 F S LIN=$O(^UTILITY($J,"W",1,LIN)) Q:LIN="" D Q:IBQ
133 . S WLIN=$G(^UTILITY($J,"W",1,LIN,0))
134 . I $Y>(IOSL-4) D WCPB Q:IBQ
135 . W:WLIN'="" ?26,WLIN,!
136 K ^UTILITY($J,"W")
137 Q
138 ;
139WCPB ; - Page Break in the middle of Comments
140 ;
141 D PAUSE Q:IBQ D HDR1,HDR2 Q:IBQ
142 W ! D WPAT D WCD W:IBC1>1 ?26,"(continued)",!
143 Q
144 ;
145WCD ; - Write comment date.
146 W !?2,"Comment Date: ",$$DAT1^IBOUTL(IBCD)
147 Q
148 ;
149SSN(X) ; - Format the SSN.
150 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.