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

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

initial load of WorldVistAEHR
File size: 5.1 KB
RevLine 
[613]1IBJDF4 ;ALB/RB - FIRST PARTY FOLLOW-UP REPORT ;15-APR-00
2 ;;2.0;INTEGRATED BILLING;**123,204,220**;21-MAR-94
3 ;
4EN ; - Option entry point.
5 S IBEXCEL=0
6 ;
7 ; - Select AR categories to print.
8 S IBPRT="Choose which type of receivables to print:"
9 K IBOPT
10 S IBOPT(1)="EMERGENCY/HUMANITARIAN"
11 S IBOPT(2)="INELIGIBLE"
12 S IBOPT(3)="C-MEANS TEST & RX COPAY"
13 S IBOPT(4)="LONG TERM CARE COPAY"
14 S IBOPT(5)="ALL OF THE ABOVE"
15 S IBSEL=$$MLTP^IBJD(IBPRT,.IBOPT,1) I 'IBSEL G ENQ
16 ;
17STA ; - Choose bill status.
18 W !!,"Run report for (A)CTIVE ARs, (S)USPENDED ARs, or (B)OTH: B// "
19 R X:DTIME G:'$T!(X["^") ENQ S:X="" X="B" S X=$E(X)
20 I "AaBbSs"'[X S IBOFF=1 D HELP^IBJDF4H G STA
21 S IBSTA=$S("Aa"[X:"A","Ss"[X:"S",1:"B")
22 W " ",$S(IBSTA="A":"ACTIVE",IBSTA="S":"SUSPENDED",1:"BOTH")
23 ;
24 ; - Select a detailed or summary report.
25 D DS^IBJD G ENQ:IBRPT["^"
26 I IBRPT="S" D G RC
27 . S IBSN="N",IBSNA="ALL",IBSNF="",IBSNL="zzzzz",IBSMN="A"
28 ;
29 ; - Determine sorting (By name or Last 4 SSN)
30 S IBSN=$$SNL^IBJD() G ENQ:IBSN="^"
31 ;
32 ; - Determine the range
33 S X=$$INTV^IBJD("PATIENT "_$S(IBSN="N":"NAME",1:"LAST 4")) G ENQ:X="^"
34 S IBSNF=$P(X,"^",1),IBSNL=$P(X,"^",2),IBSNA=$P(X,"^",3)
35 ;
36AGE ; - Determine if the active receivable must be within an age range.
37 W !!,"Include (A)LL ",$S(IBSTA="A":"active ",IBSTA="S":"suspended ",1:""),"ARs or those within an AGE (R)ANGE: ALL// "
38 R X:DTIME G:'$T!(X["^") ENQ S:X="" X="A" S X=$E(X)
39 I "ARar"'[X S IBOFF=9 D HELP^IBJDF4H G AGE
40 S IBSMN=$S("Rr"[X:"R",1:"A") W " ",$S(IBSMN="R":"RANGE",1:"ALL")
41 I IBSMN="A" G AMT
42 ;
43 ; - Determine the active receivable age range.
44 W !,"EXAMPLE Range: 31-60 days"
45 S DIR(0)="NA^1:99999"
46 S DIR("A")="Enter the minimum age of the receivable: "
47 S DIR("T")=DTIME,DIR("?")="^S IBOFF=16 D HELP^IBJDF4H"
48 D ^DIR K DIR G:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ
49 S IBSMN=+Y W " ",IBSMN," DAYS" K DIROUT,DTOUT,DUOUT,DIRUT
50 ;
51 S DIR(0)="NA^"_IBSMN_":99999"
52 S DIR("A")="Enter the maximum age of the receivable: "
53 S DIR("B")=IBSMN,DIR("T")=DTIME,DIR("?")="^S IBOFF=21 D HELP^IBJDF4H"
54 D ^DIR K DIR G:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ
55 S IBSMX=+Y W " ",IBSMX," DAYS" K DIROUT,DTOUT,DUOUT,DIRUT
56 ;
57AMT ; - Print receivables with a minimum balance.
58 S DIR(0)="Y",DIR("B")="NO" W !
59 S DIR("A")="Print receivables with a minimum balance"
60 S DIR("T")=DTIME,DIR("?")="^S IBOFF=26 D HELP^IBJDF4H"
61 D ^DIR K DIR G:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ
62 S IBSAM=+Y K DIROUT,DTOUT,DUOUT,DIRUT G:'IBSAM EXCEL
63 ;
64AMT1 ; - Determine the minimum balance amount.
65 S DIR(0)="NA^1:9999999"
66 S DIR("A")="Enter the minimum balance amount of the receivable: "
67 S DIR("T")=DTIME,DIR("?")="^S IBOFF=33 D HELP^IBJDF4H"
68 D ^DIR K DIR G:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ
69 S IBSAM=+Y K DIROUT,DTOUT,DUOUT,DIRUT
70 ;
71EXCEL ; - Determine whether to gather data for Excel report.
72 S IBEXCEL=$$EXCEL^IBJD() G ENQ:IBEXCEL="^"
73 I IBEXCEL S IBSH=1,IBSH1="M" G RC
74 ;
75BCH ; - Determine whether to include the bill comment history.
76 S DIR(0)="Y",DIR("B")="NO" W !
77 S DIR("A")="Include the bill comment history with each receivable"
78 S DIR("T")=DTIME,DIR("?")="^S IBOFF=38 D HELP^IBJDF4H"
79 D ^DIR K DIR G:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ
80 S IBSH=+Y K DIROUT,DTOUT,DUOUT,DIRUT G:'IBSH RC
81 ;
82 S DIR(0)="SA^A:ALL;M:MOST RECENT"
83 S DIR("A")="Print (A)LL comments or the (M)OST RECENT comment: "
84 S DIR("B")="ALL",DIR("T")=DTIME,DIR("?")="^S IBOFF=47 D HELP^IBJDF4H"
85 D ^DIR K DIR G:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ
86 S IBSH1=Y K DIROUT,DTOUT,DUOUT,DIRUT G:IBSH1="A" RC
87 ;
88 S DIR(0)="NAO^1:999"
89 S DIR("A")="Minimum age of most recent bill comment (optional): "
90 S DIR("T")=DTIME,DIR("?")="^S IBOFF=54 D HELP^IBJDF4H"
91 D ^DIR K DIR G:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ
92 S IBSH2=+Y W:IBSH2 " days" K DIROUT,DTOUT,DUOUT
93 ;
94RC ; - Include receivables referred to Regional Counsel?
95 S DIR(0)="Y",DIR("B")="NO",DIR("T")=DTIME W !
96 S DIR("A")="Include ARs referred to Regional Counsel"
97 S DIR("?")="^S IBOFF=61 D HELP^IBJDF4H"
98 D ^DIR K DIR G:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ
99 S IBSRC=+Y K DIROUT,DTOUT,DUOUT,DIRUT
100 ;
101DEV ; - Select a device.
102 I '$G(IBEXCEL) D
103 . W !!,"Note: This report will search through all "
104 . W $S(IBSTA="A":"active",IBSTA="S":"suspended",1:"active & suspended")," receivables."
105 . W !?6,"It is recommended that you queue it to run after normal business hours."
106 ;
107 I $G(IBEXCEL) D EXMSG^IBJD
108 ;
109 W ! S %ZIS="QM" D ^%ZIS G:POP ENQ
110 I $D(IO("Q")) D G ENQ
111 .S ZTRTN="DQ^IBJDF4",ZTDESC="IB - FIRST PARTY FOLLOW-UP REPORT"
112 .S ZTSAVE("IB*")="" D ^%ZTLOAD
113 .I $G(ZTSK) W !!,"This job has been queued. The task no. is ",ZTSK,"."
114 .E W !!,"Unable to queue this job."
115 .K ZTSK,IO("Q") D HOME^%ZIS
116 ;
117 U IO
118 ;
119 ; If called by the Extraction Module, change extract status for the 5
120 ; reports: Emergency/Humanitarian, Ineligible receivables, C-Means Test,
121 ; RX Copay/SC VET and RX Copay/NSC VET
122DQ I $G(IBXTRACT) F I=12:1:16 D E^IBJDE(I,1)
123 ;
124 D ST^IBJDF41 ; Compile and print the report.
125 ;
126ENQ K IBSEL,IBSN,IBSNF,IBSNL,IBOFF,IBSNA,IBSH,IBSH1,IBSH2,IBSAM,IBSRC,IBTEXT
127 K IBI,IBOPT,IBPRT,IBSTA,IBEXCEL,IBRPT,IBSMN,IBSMX,POP,DIROUT,DTOUT,DUOUT
128 K DIRUT,%ZIS,ZTDESC,ZTRTN,ZTSAVE,I,X,Y
129 Q
Note: See TracBrowser for help on using the repository browser.