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

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

initial load of WorldVistAEHR

File size: 5.1 KB
Line 
1IBTUBO ;ALB/AAS - UNBILLED AMOUNTS - GENERATE UNBILLED REPORTS ;29-SEP-94
2 ;;2.0;INTEGRATED BILLING;**19,31,32,91,123,159,192,235,248,155**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5% ; - Entry point for manual option.
6 N IBBDT,IBCOMP,IBDET,IBEDT,IBOPT,IBPRT,IBTIMON,IBQUIT,IBSEL
7 S IBQUIT=0 D:'$D(DT) DT^DICRW
8 W !!,"Re-Generate Unbilled Amounts Report",!
9 ;
10 ; - Ask to re-compile Unbilled Amounts data.
11 S DIR(0)="Y",DIR("B")="NO"
12 S DIR("A")="Do you want to store Unbilled Amounts figures"
13 S DIR("?",1)="Enter 'YES' if you wish to store the Unbilled Amounts summary"
14 S DIR("?",2)="figures in your system for a specific month/year in the past."
15 S DIR("?",3)="Once stored, these figures will be available for inquiry through"
16 S DIR("?",4)="the View Unbilled Amounts option [IBT VIEW UNBILLED AMOUNTS]."
17 S DIR("?",5)="These summary figures are normally calculated and stored"
18 S DIR("?",6)="automatically by the system at the beginning of each month for"
19 S DIR("?",7)="the previous month."
20 S DIR("?",8)=" "
21 S DIR("?",9)="If you enter 'NO', the Unbilled Amounts summary figures will"
22 S DIR("?",10)="NOT be stored in your system, and the report may be run for"
23 S DIR("?")="any date range."
24 D ^DIR K DIR G:$D(DIRUT) END S IBCOMP=Y
25 I IBCOMP G RDATE
26 ;
27 ; - Select date(s) to build report.
28 W ! D DT1^IBTUBOU G:IBBDT="^" END
29 ;
30 ; - Select report(s).
31 S IBPRT="Choose report type(s) to print:"
32 S IBOPT(1)="INPATIENT UNBILLED"
33 S IBOPT(2)="OUTPATIENT UNBILLED"
34 S IBOPT(3)="PRESCRIPTION UNBILLED"
35 S IBOPT(4)="ALL OF THE ABOVE"
36 S IBSEL=$$MLTP^IBJD(IBPRT,.IBOPT,1) I 'IBSEL G END
37 S $E(IBSEL,$L(IBSEL))=""
38 ;
39RDATE ; - Select re-compile date, if necessary.
40 I IBCOMP D G END:IBTIMON="^",DET
41 . W ! D DT2("Unbilled Amounts") Q:IBTIMON="^"
42 . W !!,"NOTE: Just a reminder that by entering the above month/year this"
43 . W !," report will re-calculate and update the Unbilled Amounts"
44 . W !," data on file in your system.",*7
45 . ;
46 . ; - Initialize variables
47 . I IBTIMON<3030900 N X S X=$$M2^IBJDE(IBTIMON,11,11) D
48 .. S IBBDT=+X,IBEDT=$P(X,U,2)+.9,IBSEL="1,2,3"
49 . I IBTIMON'<3030900 S IBBDT=$$M3^IBJDE($$LDATE^IBJDE(IBTIMON)+1),IBEDT=$$LDATE^IBJDE(IBTIMON)+.9,IBSEL="1,2,3"
50 . D MSG W !
51 ;
52 S IBTIMON=IBEDT\100*100
53 ;
54DET ; - Ask to print detail report.
55 S DIR(0)="Y",DIR("B")="NO" W !
56 S DIR("A")="Print detail report with the Unbilled Amounts summary"
57 S DIR("?",1)="Answer YES if you want a detailed listing of the patients"
58 S DIR("?",2)="and events that are unbilled. Answer NO if you just want"
59 S DIR("?")="the summary, or '^' to quit this option."
60 D ^DIR K DIR G:$D(DIRUT) END S IBDET=Y G:'IBDET QUE
61 ;
62 ; Ask to include REQUEST MRA Status
63 S DIR(0)="YA",DIR("A")="Do you want to include MRA claims?: ",DIR("B")="NO" W ! D ^DIR K DIR G:$D(DIRUT) END
64 S IBINMRA=+Y
65 ;
66 ; - Select device to print.
67 W !!,"This report takes a while to run, so you should queue it to run"
68 W !,"after normal business hours."
69 W !!,"You will need a 132 column printer for this report!",!
70 S %ZIS="QM" D ^%ZIS G END:POP,QUE:$D(IO("Q"))
71 ;
72 U IO G STR
73 ;
74QUE ; - Queue report/summary, if necessary.
75 W ! I 'IBDET S ZTIO=""
76 S ZTRTN="IBTUBOA",ZTSAVE("IB*")=""
77 S ZTDESC="IB - Unbilled Amounts Report"
78 D ^%ZTLOAD K IO("Q"),ZTSK
79 D HOME^%ZIS G END
80 ;
81AUTO ; - Entry point for scheduled option.
82 Q ;;**NO LONGER USED**
83 ;
84DQ ; - Entry point for DM extract.
85 ; - If AUTO PRINT UNBILLED LIST=yes and default report printer then
86 ; automatically requeue to device.
87 I $P(^IBE(350.9,1,6),U,24) D G END:'$G(IBXTRACT)
88 . N X S X=$O(^IBE(353,"B","IB REPORTS",0))
89 . S ZTIO=$P($G(^IBE(353,+X,0)),U,2) Q:ZTIO=""
90 . S IBDET=1,IBXTRACT=0,ZTDTH=$H,ZTRTN="IBTUBOA",ZTSAVE("IB*")=""
91 . S ZTDESC="IB - Unbilled Amounts Report" D ^%ZTLOAD
92 . S IBDET=0,IBXTRACT=1
93 . K ZTDESC,ZTDTH,ZTRTN,ZTSAVE,ZTSK
94 ;
95STR D ^IBTUBOA ; Start report.
96 ;
97END K DIRUT Q
98 ;
99MSG ; - Compile message.
100 W !!,"NOTE: After this report is run, the Unbilled Amounts totals for"
101 W !?6,"the month of "_$$DAT2^IBOUTL(IBTIMON)_" will be updated."
102 Q
103DT2(STR) ; - Select re-compile date (returns variable IBTIMON).
104 ; Input: STR - String that describe the type of data that will be
105 ; re-compiled: "Unbilled Amounts", "Average Bill Amounts", etc...
106 ;
107 ; This code is very the same code as is in DT2^IBTUBOU... that is
108 ; a utility routine, so code was copied and altered to accommodate
109 ; EOAM changes.
110 N DIRUT,DT0,DT1,DT2,Y
111 ; - AUG 1993 is the first month on file with Unbilled Amounts data
112 S DT0=2930800,DT1=$$DAT2^IBOUTL(DT0)
113 I $E(DT,6,7)'>$E($$LDATE^IBJDE(DT),6,7) S DT2=DT
114 I $E(DT,6,7)>$E($$LDATE^IBJDE(DT),6,7) S DT2=DT+100 I $E(DT2,4,5)=13 S DT2=DT+8900
115 S DT2=$$M1^IBJDE(DT2,1),DIR("B")=$$DAT2^IBOUTL(DT2)
116 S DIR(0)="DA^"_$E(DT0,1,5)_"00:"_DT2_":AE^K:$E(Y,6,7)'=""00"" X"
117 S DIR("A")="Re-compile "_$G(STR)_" through MONTH/YEAR: "
118 S DIR("?",1)="Enter a past month/year (ex. Oct 2000).",DIR("?",2)=""
119 S DIR("?",3)="NOTE: The earliest month/year that can be entered is "_DT1_", and"
120 S DIR("?")=" it is NOT possible to enter the current or a future month/year."
121 D ^DIR K DIR I $D(DIRUT) S IBTIMON="^" G DT2Q
122 I $E(Y,6,7)'="00"!($E(Y,4,7)="0000") W " ??" G DT2
123 S IBTIMON=Y
124 ;
125DT2Q Q
Note: See TracBrowser for help on using the repository browser.