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

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

initial load of WorldVistAEHR

File size: 5.5 KB
Line 
1IBJDF6 ;ALB/RB - MISCELLANEOUS BILLS FOLLOW-UP REPORT ;15-APR-00
2 ;;2.0;INTEGRATED BILLING;**123,159**;21-MAR-94
3 ;
4EN ; - Option entry point.
5 ;
6SEL ; - Select type of receivables to print.
7 K IBCTG S IBPRT="Choose which type of receivables to print:"
8 S IBCTG(1)="MEDICARE"
9 S IBCTG(2)="NO-FAULT AUTO ACCIDENT"
10 S IBCTG(3)="TORT FEASOR"
11 S IBCTG(4)="WORKMEN'S COMP"
12 S IBCTG(5)="CURRENT EMPLOYEE"
13 S IBCTG(6)="EX-EMPLOYEE"
14 S IBCTG(7)="FEDERAL AGENCIES-REFUND"
15 S IBCTG(8)="FEDERAL AGENCIES-REIMBURSEMENT"
16 S IBCTG(9)="MILITARY"
17 S IBCTG(10)="INTERAGENCY"
18 S IBCTG(11)="VENDOR"
19 S IBCTG(12)="ALL OF THE ABOVE"
20 ;
21 S IBSEL=$$MLTP^IBJD(IBPRT,.IBCTG,1) I 'IBSEL G ENQ
22 S (IB0,IB1)=0
23 F X=1:1 S Y=$P(IBSEL,",",X) Q:'Y D
24 . I Y=1!(Y=2)!(Y=3)!(Y=4) S IB0=1 Q
25 . S IB1=1
26 G ENQ:'IBSEL S IBSEL=","_IBSEL
27 ;
28 ; - Sort by division.
29 S IBSDV=0 I IB0 S IBSDV=$$SDIV^IBJD() I IBSDV["^" G ENQ
30 ;
31 ; - Select a detailed or summary report.
32 D DS^IBJD I IBRPT["^" G ENQ
33 ;
34 I IBSDV S IB2=0 F X=2:1 S Y=$P(IBSEL,",",X) Q:'Y D:Y>4
35 . I 'IB2 D S IB2=1
36 . . W !!,"NOTE: The receivables of these types will NOT be sorted by division:",!,*7
37 . W !?6,IBCTG(Y)
38 ;
39 G DEV:IBRPT="S"
40 ;
41 ; - Determine sorting (By name or Last 4 SSN)
42 S (IBSN,X)=""
43 I IB0 D I IBSN="^"!(X="^") G ENQ
44 . S IBSN=$$SNL^IBJD() Q:IBSN="^"
45 . W !!,"These receivables will be sorted by PATIENT/SSN:",!
46 . F X=2:1 S Y=$P(IBSEL,",",X) Q:'Y I Y<5 W !?6,IBCTG(Y)
47 . ; - Determine the PATIENT range
48 . S X=$$INTV^IBJD("PATIENT "_$S(IBSN="N":"NAME",1:"LAST 4")) Q:X="^"
49 . S IBSNF=$P(X,"^",1),IBSNL=$P(X,"^",2),IBSNA=$P(X,"^",3)
50 ;
51 ; - Determine range of debtors.
52 I 'IB1 G AGE
53 ;
54 I IB0 D
55 . W !!,"These receivables will be sorted by DEBTOR:",!
56 . F X=2:1 S Y=$P(IBSEL,",",X) Q:'Y I Y>4 W !?6,IBCTG(Y)
57 S VAUTD(0)=""
58 ;
59 ; - Determine the DEBTOR range
60 S X=$$INTV^IBJD("DEBTOR") G ENQ:X="^"
61 S IBSDF=$P(X,"^",1),IBSDL=$P(X,"^",2),IBSDA=$P(X,"^",3)
62 ;
63AGE ; - Determine if the active receivable must be within an age range.
64 W !!,"Include (A)LL active AR's or those within an AGE (R)ANGE: ALL// "
65 R X:DTIME G:'$T!(X["^") ENQ S:X="" X="A" S X=$E(X)
66 I "ARar"'[X S IBOFF=1 D HELP^IBJDF6H G AGE
67 W " ",$S("Rr"[X:"RANGE",1:"ALL")
68 S IBSMN=$S("Rr"[X:"R",1:"A") G:IBSMN="A" AMT
69 ;
70 ; - Determine the active receivable age range.
71 S DIR(0)="NA^1:99999"
72 S DIR("A")="Enter the minimum age of the active receivable: "
73 S DIR("T")=DTIME,DIR("?")="^S IBOFF=9 D HELP^IBJDF6H"
74 D ^DIR K DIR G:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ
75 S IBSMN=+Y W " ",IBSMN," DAYS" K DIROUT,DTOUT,DUOUT,DIRUT
76 ;
77 S DIR(0)="NA^"_IBSMN_":99999",DIR("B")=IBSMN
78 S DIR("A")="Enter the maximum age of the active receivable: "
79 S DIR("T")=DTIME,DIR("?")="^S IBOFF=14 D HELP^IBJDF6H"
80 D ^DIR K DIR G:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ
81 S IBSMX=+Y W " ",IBSMX," DAYS" K DIROUT,DTOUT,DUOUT,DIRUT
82 ;
83AMT ; - Print receivables with a minimum balance.
84 S DIR(0)="Y",DIR("B")="NO" W !
85 S DIR("A")="Print receivables with a minimum balance"
86 S DIR("T")=DTIME,DIR("?")="^S IBOFF=19 D HELP^IBJDF6H"
87 D ^DIR K DIR G:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ
88 S IBSAM=+Y K DIROUT,DTOUT,DUOUT,DIRUT G:'IBSAM EXCEL
89 ;
90AMT1 ; - Determine the minimum balance amount.
91 S DIR(0)="NA^1:9999999"
92 S DIR("A")="Enter the minimum balance amount of the receivable: "
93 S DIR("T")=DTIME,DIR("?")="^S IBOFF=26 D HELP^IBJDF6H"
94 D ^DIR K DIR G:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ
95 S IBSAM=+Y K DIROUT,DTOUT,DUOUT,DIRUT
96 ;
97EXCEL ; - Determine whether to gather data for Excel report.
98 S IBEXCEL=$$EXCEL^IBJD() G ENQ:IBEXCEL="^"
99 I IBEXCEL S IBSH=1,IBSH1="M" G DEV
100 ;
101BCH ; - Determine whether to include the bill comment history.
102 S DIR(0)="Y",DIR("B")="NO" W !
103 S DIR("A")="Include the bill comment history with each receivable"
104 S DIR("T")=DTIME,DIR("?")="^S IBOFF=31 D HELP^IBJDF6H"
105 D ^DIR K DIR G:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ
106 S IBSH=+Y K DIROUT,DTOUT,DUOUT,DIRUT G:'IBSH DEV
107 ;
108 S DIR(0)="SA^A:ALL;M:MOST RECENT"
109 S DIR("A")="Print (A)LL comments or the (M)OST RECENT comment: "
110 S DIR("B")="ALL",DIR("T")=DTIME,DIR("?")="^S IBOFF=40 D HELP^IBJDF6H"
111 D ^DIR K DIR G:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ
112 S IBSH1=Y K DIROUT,DTOUT,DUOUT,DIRUT G:IBSH1="A" DEV
113 ;
114 S DIR(0)="NAO^1:999"
115 S DIR("A")="Minimum age of most recent bill comment (optional): "
116 S DIR("T")=DTIME,DIR("?")="^S IBOFF=47 D HELP^IBJDF6H"
117 D ^DIR K DIR G:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ
118 S IBSH2=+Y W:IBSH2 " DAYS" K DIROUT,DTOUT,DUOUT,DIRUT
119 ;
120DEV ; - Select a device.
121 K IB0,IB1,IB2
122 I '$G(IBEXCEL) D
123 . S X=$S(IBRPT="S":80,1:132)
124 . W !!,"You will need a ",X," column printer for this report!",!
125 . W !,"Note: This report will search through all active receivables."
126 . W !," You should queue it to run after normal business hours.",!
127 ;
128 I $G(IBEXCEL) D EXMSG^IBJD
129 ;
130 W ! S %ZIS="QM" D ^%ZIS G:POP ENQ
131 I $D(IO("Q")) D G ENQ
132 . S ZTRTN="DQ^IBJDF6",ZTDESC="IB - MISC. BILLS FOLLOW-UP REPORT"
133 . F I="IB*","VAUTD","VAUTD(" S ZTSAVE(I)=""
134 . D ^%ZTLOAD
135 . I $D(ZTSK) W !!,"This job has been queued. Task number is ",ZTSK,"."
136 . E W !!,"Unable to queue this job."
137 . K ZTSK,IO("Q") D HOME^%ZIS
138 ;
139 U IO
140 ;
141 ; If called by the Extraction Module, change extract status for the 3
142 ; reports: No-fault auto accident, Tort Feasor and Workman's Comp
143DQ I $G(IBXTRACT) F I=22:1:24 D E^IBJDE(I,1)
144 ;
145 D ST^IBJDF61 ; Compile and print the report.
146 ;
147ENQ K IBSDA,IBSDF,IBSDL,IBSDV,IBSEL,IBSN,IBSNA,IBSNF,IBSNL,IBSH,IBSH1,IBSH2
148 K IBCTG,IBCTS,IBOFF,IBPRT,IBRPT,IBSAM,IBSMN,IBSMX,IBTEXT,IBI,DIROUT
149 K DTOUT,DUOUT,DIRUT,POP,VAUTD,%ZIS,ZTDESC,ZTRTN,ZTSAVE,I,X,Y,Z
150 Q
Note: See TracBrowser for help on using the repository browser.