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

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

initial load of WorldVistAEHR

File size: 5.0 KB
Line 
1IBJDF5 ;ALB/RB - CHAMPVA/TRICARE FOLLOW-UP REPORT;15-APR-00
2 ;;2.0;INTEGRATED BILLING;**123,185,240**;21-MAR-94
3 ;
4EN ; - Option entry point.
5 ;
6 ; - Select AR categories to print.
7 S IBPRT="Choose which category of receivables to print:"
8 K IBCTG
9 S IBCTG(1)="TRICARE PATIENT"
10 S IBCTG(2)="SHARING AGREEMENTS"
11 S IBCTG(3)="TRICARE"
12 S IBCTG(4)="TRICARE THIRD PARTY"
13 S IBCTG(5)="CHAMPVA"
14 S IBCTG(6)="CHAMPVA THIRD PARTY"
15 S IBCTG(7)="ALL OF THE ABOVE"
16 S IBSEL=$$MLTP^IBJD(IBPRT,.IBCTG,1) I 'IBSEL G ENQ
17 ;
18 S IBSD=0 I IBSEL="1," G TYP
19 ;
20 ; - Sort by division, if necessary.
21 S IBSD=$$SDIV^IBJD() G:IBSD["^" ENQ G:'IBSD TYP
22 ;
23 ; - Issue prompt for division.
24 I IBSD,IBSEL[1 D
25 . W !!,"NOTE: Tricare Patient receivables will NOT be sorted"
26 . W !?6,"by division!",!,*7
27 ;
28TYP ; - Select type of receivables to print.
29 ; - Select AR categories to print.
30 S IBPRT="Choose which type of receivables to print:"
31 K IBTPR
32 S IBTPR(1)="INPATIENT"
33 S IBTPR(2)="OUTPATIENT"
34 S IBTPR(3)="PHARMACY REFILL"
35 S IBTPR(4)="ALL RECEIVABLES"
36 S IBSEL1=$$MLTP^IBJD(IBPRT,.IBTPR,1) I 'IBSEL1 G ENQ
37 ;
38 ; - Select a detailed or summary report.
39 D DS^IBJD G ENQ:IBRPT["^",DEV:IBRPT="S"
40 ;
41 ; - Determine sorting (By name or Last 4 SSN)
42 S IBSN=$$SNL^IBJD() G ENQ:IBSN="^"
43 ;
44 ; - Determine the range
45 S X=$$INTV^IBJD("PATIENT "_$S(IBSN="N":"NAME",1:"LAST 4")) G ENQ:X="^"
46 S IBSNF=$P(X,"^",1),IBSNL=$P(X,"^",2),IBSNA=$P(X,"^",3)
47 ;
48AGE ; - Determine if the active receivable must be within an age range.
49 W !!,"Include (A)LL active AR's or those within an AGE (R)ANGE: ALL// "
50 R X:DTIME G:'$T!(X["^") ENQ S:X="" X="A" S X=$E(X)
51 I "ARar"'[X S IBOFF=1 D HELP^IBJDF5H G AGE
52 W " ",$S("Rr"[X:"RANGE",1:"ALL")
53 S IBSMN=$S("Rr"[X:"R",1:"A") G:IBSMN="A" AMT
54 ;
55 ; - Determine the active receivable age range.
56 S DIR(0)="NA^1:99999"
57 S DIR("A")="Enter the minimum age of the active receivable: "
58 S DIR("T")=DTIME,DIR("?")="^S IBOFF=9 D HELP^IBJDF5H"
59 D ^DIR K DIR G:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ
60 S IBSMN=+Y W " ",IBSMN," DAYS" K DIROUT,DTOUT,DUOUT,DIRUT
61 ;
62 S DIR(0)="NA^"_IBSMN_":99999"
63 S DIR("A")="Enter the maximum age of the active receivable: "
64 S DIR("B")=IBSMN,DIR("T")=DTIME,DIR("?")="^S IBOFF=14 D HELP^IBJDF5H"
65 D ^DIR K DIR G:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ
66 S IBSMX=+Y W " ",IBSMX," DAYS" K DIROUT,DTOUT,DUOUT,DIRUT
67 ;
68AMT ; - Print receivables with a minimum balance.
69 S DIR(0)="Y",DIR("B")="NO" W !
70 S DIR("A")="Print receivables with a minimum balance"
71 S DIR("T")=DTIME,DIR("?")="^S IBOFF=19 D HELP^IBJDF5H"
72 D ^DIR K DIR G:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ
73 S IBSAM=+Y K DIROUT,DTOUT,DUOUT,DIRUT G:'IBSAM EXCEL
74 ;
75AMT1 ; - Determine the minimum balance amount.
76 S DIR(0)="NA^1:9999999"
77 S DIR("A")="Enter the minimum balance amount of the receivable: "
78 S DIR("T")=DTIME,DIR("?")="^S IBOFF=26 D HELP^IBJDF5H"
79 D ^DIR K DIR G:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ
80 S IBSAM=+Y K DIROUT,DTOUT,DUOUT,DIRUT
81 ;
82EXCEL ; - Determine whether to gather data for Excel report.
83 S IBEXCEL=$$EXCEL^IBJD() I Y S (IBEXCEL,IBSH)=1,IBSH1="M" G DEV
84 ;
85BCH ; - Determine whether to include the bill comment history.
86 S DIR(0)="Y",DIR("B")="NO" W !
87 S DIR("A")="Include the bill comment history with each receivable"
88 S DIR("T")=DTIME,DIR("?")="^S IBOFF=31 D HELP^IBJDF5H"
89 D ^DIR K DIR G:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ
90 S IBSH=+Y K DIROUT,DTOUT,DUOUT,DIRUT G:'IBSH DEV
91 ;
92 S DIR(0)="SA^A:ALL;M:MOST RECENT"
93 S DIR("A")="Print (A)LL comments or the (M)OST RECENT comment: "
94 S DIR("B")="ALL",DIR("T")=DTIME,DIR("?")="^S IBOFF=40 D HELP^IBJDF5H"
95 D ^DIR K DIR G:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ
96 S IBSH1=Y K DIROUT,DTOUT,DUOUT,DIRUT G:IBSH1="A" DEV
97 ;
98 S DIR(0)="NAO^1:999"
99 S DIR("A")="Minimum age of most recent bill comment (optional): "
100 S DIR("T")=DTIME,DIR("?")="^S IBOFF=47 D HELP^IBJDF5H"
101 D ^DIR K DIR G:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ
102 S IBSH2=+Y W:IBSH2 " days" K DIROUT,DTOUT,DUOUT
103 ;
104DEV ; - Select a device.
105 I '$G(IBEXCEL) D
106 . S X=$S(IBRPT="S":80,1:132)
107 . W !!,"You will need a ",X," column printer for this report!",!
108 . W !,"Note: This report will search through all active receivables."
109 . W !," You should queue it to run after normal business hours.",!
110 ;
111 I $G(IBEXCEL) D EXMSG^IBJD
112 ;
113 W ! S %ZIS="QM" D ^%ZIS G:POP ENQ
114 I $D(IO("Q")) D G ENQ
115 .S ZTRTN="DQ^IBJDF5",ZTDESC="IB - CHAMPVA/TRICARE FOLLOW-UP REPORT"
116 .F I="IB*","VAUTD","VAUTD(" S ZTSAVE(I)=""
117 .D ^%ZTLOAD
118 .I $G(ZTSK) W !!,"This job has been queued. The task no. is ",ZTSK,"."
119 .E W !!,"Unable to queue this job."
120 .K ZTSK,IO("Q") D HOME^%ZIS
121 ;
122 U IO
123 ;
124 ; If called by the Extraction Module, change extract status for the 6
125 ; reports: Tricare Patient, Sharing Agreements, TRICARE, TRICARE 3rd
126 ; Party, CHAMPVA and CHAMPVA 3rd Party
127DQ I $G(IBXTRACT) F I=17:1:21 D E^IBJDE(I,1)
128 ;
129 D ST^IBJDF51 ; Compile and print the report.
130 ;
131ENQ K IBSD,IBSEL,IBSEL1,IBSN,IBSNF,IBSNL,IBSNA,IBOFF,IBSH,IBSH1,IBSH2,IBSAM
132 K IBPRT,IBCTG,IBRPT,IBTPR,IBSMN,IBSMX,IBTEXT,IBI,IBEXCEL,DIROUT,DTOUT
133 K DTOUT,DIRUT,POP,VAUTD,%ZIS,ZTDESC,ZTRTN,ZTSAVE,I,X,Y
134 Q
Note: See TracBrowser for help on using the repository browser.