source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBJDF1.m

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

initial load of WorldVistAEHR

File size: 5.8 KB
Line 
1IBJDF1 ;ALB/CPM - THIRD PARTY FOLLOW-UP REPORT ; 09-JAN-97
2 ;;2.0;INTEGRATED BILLING;**69,118,128,205**;21-MAR-94
3 ;
4EN ; - Option entry point.
5 ;
6 W !!,"This report provides a tool for sites to use to perform follow-up"
7 W !,"activities for Third Party receivables.",!
8 ;
9DATE ; - Choose date to use for calculation
10 W !!,"Calculate report using (D)ATE OF CARE or (A)CTIVE IN AR (days): (A)CTIVE IN AR// " R X:DTIME
11 G:'$T!(X["^") ENQ S:X="" X="A" S X=$E(X)
12 I "ADad"'[X S IBOFF=99 D HELP^IBJDF1H G DATE
13 W " ",$S("Dd"[X:"DATE OF CARE",1:"(DAYS) ACTIVE IN AR")
14 S IBSDATE=$S("Dd"[X:"D",1:"A")
15 ;
16 ; - Sort by division.
17 S DIR(0)="Y",DIR("B")="NO"
18 S DIR("A")="Do you wish to sort this report by division"
19 S DIR("?")="^S IBOFF=1 D HELP^IBJDF1H"
20 D ^DIR K DIR I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) G ENQ
21 S IBSD=+Y K DIROUT,DTOUT,DUOUT,DIRUT
22 ;
23 ; - Issue prompt for division.
24 I IBSD D PSDR^IBODIV G:Y<0 ENQ
25 ;
26INS ; - Determine range of carriers.
27 W !!,"Run report for (S)PECIFIC insurance companies or a (R)ANGE: RANGE// "
28 R X:DTIME G:'$T!(X["^") ENQ S:X="" X="R" S X=$E(X)
29 I "RSrs"'[X S IBOFF=8 D HELP^IBJDF1H G INS
30 W " ",$S("Ss"[X:"SPECIFIC",1:"RANGE") G:"Rr"[X INS1 K IBSI
31INS0 S DIC="^DIC(36,",DIC(0)="AEQMZ",DIC("S")="I '$G(^(5))"
32 S DIC("A")=" Select "_$S($G(IBSI):"another ",1:"")_"INSURANCE CO.: "
33 D ^DIC K DIC I Y'>0 G ENQ:'$G(IBSI),NAM
34 I $D(IBSI(+Y)) D G INS0
35 .W !!?3,"Already selected. Choose another insurance company.",!,*7
36 S IBSI(+Y)="" S:'$G(IBSI) IBSI=1 G INS0
37INS1 R !?3,"START WITH INSURANCE COMPANY: FIRST// ",X:DTIME G:'$T!(X["^") ENQ
38 I $E(X)="?" S IBOFF=14 D HELP^IBJDF1H G INS1
39 S IBSIF=X
40INS2 R !?8,"GO TO INSURANCE COMPANY: LAST// ",X:DTIME G:'$T!(X["^") ENQ
41 I $E(X)="?" S IBOFF=21 D HELP^IBJDF1H G INS2
42 I X="" S IBSIL="zzzzz" S:IBSIF="" IBSIA="ALL" G NAM
43 I X="@",IBSIF="@" S IBSIL="@",IBSIA="NULL" G NAM
44 I IBSIF'="@",IBSIF]X D G INS2
45 .W *7,!!?4,"The LAST value must follow the FIRST.",!
46 S IBSIL=X
47 ;
48NAM ; - Determine range of patients.
49 S DIR(0)="SA^N:NAME;L:LAST 4"
50 S DIR("A")="Sort Patients by (N)AME or (L)AST of the SSN: "
51 S DIR("B")="NAME",DIR("T")=20,DIR("?")="^S IBOFF=29 D HELP^IBJDF1H"
52 W ! D ^DIR K DIR G:Y=""!(X="^") ENQ S IBSN=Y,IBI=Y(0)
53NAM1 W !?3,"START WITH PATIENT ",IBI,": FIRST// " R X:DTIME G:'$T!(X["^") ENQ
54 I $E(X)="?" S IBOFF=36 D HELP^IBJDF1H G NAM1
55 S IBSNF=X
56NAM2 W !?8,"GO TO PATIENT ",IBI,": LAST// " R X:DTIME G:'$T!(X["^") ENQ
57 I $E(X)="?" S IBOFF=43 D HELP^IBJDF1H G NAM2
58 I X="" S IBSNL="zzzzz" S:IBSNF="" IBSNA="ALL" G TYP
59 I X="@",IBSNF="@" S IBSNL="@",IBSNA="NULL" G TYP
60 I IBSNF'="@",IBSNF]X D G NAM2
61 .W *7,!!?7,"The LAST value must follow the FIRST.",!
62 S IBSNL=X
63 ;
64TYP ; - Select type of receivables to print.
65 W !!,"Choose which type of receivables to print:",!
66 S DIR(0)="LO^1:4^K:+$P(X,""-"",2)>4 X"
67 S DIR("A",1)=" 1 - INPATIENT"
68 S DIR("A",2)=" 2 - OUTPATIENT"
69 S DIR("A",3)=" 3 - PHARMACY REFILL"
70 S DIR("A",4)=" 4 - ALL RECEIVABLES"
71 S DIR("A",5)="",DIR("A")="Select",DIR("B")=4
72 D ^DIR K DIR I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) G ENQ
73 S IBSEL=Y K DIROUT,DTOUT,DUOUT,DIRUT
74 ;
75AR ; - Determine if the active receivable must be within an age range.
76 W !!,"Include (A)LL active AR's or those within an AGE (R)ANGE: ALL// " R X:DTIME
77 G:'$T!(X["^") ENQ S:X="" X="A" S X=$E(X)
78 I "ARar"'[X S IBOFF=51 D HELP^IBJDF1H G AR
79 W " ",$S("Rr"[X:"RANGE",1:"ALL")
80 S IBSMN=$S("Rr"[X:"R",1:"A") I IBSMN="A" G AMT
81 ;
82AGE ;-Determine the active receivable age range.
83 S DIR(0)="NA^1:99999",DIR("?")="^S IBOFF=59 D HELP^IBJDF1H"
84 S DIR("A")=" Enter the minimum age of the active receivable: "
85 D ^DIR K DIR I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) G ENQ
86 S IBSMN=+Y W " ",IBSMN," DAYS" K DIROUT,DTOUT,DUOUT,DIRUT
87 ;
88 S DIR(0)="NA^"_IBSMN_":99999",DIR("?")="^S IBOFF=64 D HELP^IBJDF1H"
89 S DIR("A")=" Enter the maximum age of the active receivable: "
90 S DIR("B")=IBSMN D ^DIR K DIR
91 I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) G ENQ
92 S IBSMX=+Y W " ",IBSMX," DAYS" K DIROUT,DTOUT,DUOUT,DIRUT
93 ;
94AMT ; - Print receivables with a minimum balance.
95 S DIR(0)="Y",DIR("B")="NO" W !
96 S DIR("A")="Print receivables with a minimum balance"
97 S DIR("?")="^S IBOFF=69 D HELP^IBJDF1H"
98 D ^DIR K DIR I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) G ENQ
99 S IBSAM=+Y K DIROUT,DTOUT,DUOUT,DIRUT I 'IBSAM G BCH
100 ;
101AMT1 ; - Determine the minimum balance amount.
102 S DIR(0)="NA^1:9999999",DIR("?")="^S IBOFF=76 D HELP^IBJDF1H"
103 S DIR("A")=" Enter the minimum balance amount of the receivable: "
104 D ^DIR K DIR I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) G ENQ
105 S IBSAM=+Y K DIROUT,DTOUT,DUOUT,DIRUT
106 ;
107BCH ; - Determine whether to include the bill comment history.
108 S DIR(0)="Y",DIR("B")="NO" W !
109 S DIR("A")="Include the Bill Comment history with each receivable"
110 S DIR("?")="^S IBOFF=81 D HELP^IBJDF1H"
111 D ^DIR K DIR I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) G ENQ
112 S IBSH=+Y K DIROUT,DTOUT,DUOUT,DIRUT
113 ;
114RC ; - Include receivables referred to Regional Counsel?
115 S DIR(0)="Y",DIR("B")="NO" W !
116 S DIR("A")="Include receivables referred to Regional Counsel"
117 S DIR("?")="^S IBOFF=90 D HELP^IBJDF1H"
118 D ^DIR I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) G ENQ
119 S IBSRC=+Y K DIROUT,DTOUT,DUOUT,DIRUT
120 ;
121 W !!,"This report requires a 132 column printer."
122 W !!,"Note: This report will search through all active receivables."
123 W !?6,"You should queue this report to run after normal business hours."
124 ;
125 ; - Select a device.
126 W ! S %ZIS="QM" D ^%ZIS G:POP ENQ
127 I $D(IO("Q")) D G ENQ
128 .S ZTRTN="DQ^IBJDF11",ZTDESC="IB - THIRD PARTY FOLLOW-UP REPORT"
129 .F I="IBS*","VAUTD","VAUTD(" S ZTSAVE(I)=""
130 .D ^%ZTLOAD
131 .W !!,$S($D(ZTSK):"This job has been queued. The task number is "_ZTSK_".",1:"Unable to queue this job.")
132 .K ZTSK,IO("Q") D HOME^%ZIS
133 ;
134 U IO
135 ;
136 D DQ^IBJDF11 ; Compile and print the report.
137 ;
138ENQ K IBSD,IBSEL,IBSI,IBSIF,IBSIL,IBSIA,IBSN,IBSNF,IBSNL,IBOFF,IBSNA,IBSH
139 K IBSAM,IBSDATE,IBSMN,IBSMX,IBSRC,IBTEXT,IBI,POP,VAUTD,%ZIS,ZTDESC,ZTRTN,ZTSAVE,DIR
140 K DIROUT,DTOUT,DUOUT,DIRUT
141 Q
Note: See TracBrowser for help on using the repository browser.