source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBJDB1.m@ 868

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

initial load of FOIAVistA 6/30/08 version
File size: 4.4 KB
Line 
1IBJDB1 ;ALB/CPM - BILLING LAG TIME REPORT ; 27-DEC-96
2 ;;2.0;INTEGRATED BILLING;**69,80,100,118,165**;21-MAR-94
3 ;
4EN ; - Option entry point.
5 ;
6 W !!,"This report measures the amount of time between significant"
7 W !,"milestones which occur from the time treatment has been provided"
8 W !,"to the time that the claim to the insurer for that treatment has"
9 W !,"been closed out.",!
10 ;
11DATE D DATE^IBOUTL I IBBDT=""!(IBEDT="") G ENQ
12 ;
13 ; - Sort by division.
14 S DIR(0)="Y",DIR("B")="NO"
15 S DIR("A")="Do you wish to sort this report by division"
16 S DIR("?")="^D HLP1^IBJDB1" W !
17 D ^DIR K DIR I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) G ENQ
18 S IBSORT=+Y K DIROUT,DTOUT,DUOUT,DIRUT
19 ;
20 ; - Issue prompt for division.
21 I IBSORT D PSDR^IBODIV G:Y<0 ENQ
22 ;
23 ; - Select a Detailed or Summary report.
24DS D DS^IBJD I "^"[IBRPT G ENQ
25 I IBRPT="S" S IBSEL=",1,2,3,4,5,6,7,8,9,10,11," G DEV
26 ;
27SEL ; - Select main report or line item reports.
28 W ! S DIR(0)="LO^1:11^K:+$P(X,""-"",2)>11 X"
29 F X=1:1:11 S DIR("A",X)=$S(X<10:" ",1:"")_X_" - Print "_$$TITLE(X,1)
30 S DIR("A",12)="",DIR("A")="Select",DIR("B")=1
31 S DIR("?")="^D HLP2^IBJDB1" D ^DIR K DIR G:Y["^" ENQ S IBSEL=Y
32 S DIR(0)="Y",DIR("A",1)="You have selected"
33 I IBSEL="1,2,3,4,5,6,7,8,9,10,11," D
34 .S DIR("A",1)=DIR("A",1)_" ALL the above reports."
35 E F X=1:1 S X1=$P(IBSEL,",",X) Q:'X1 S DIR("A",X+1)=" "_$$TITLE(X1,1)
36 S DIR("A")="Are you sure",DIR("B")="NO"
37 W ! D ^DIR K DIR G ENQ:Y["^",SEL:'Y S IBSEL=","_IBSEL
38 ;
39DEV W !!,"This report only requires an 80 column printer."
40 ;
41 W !!,"Note: This report searches through all Reimb. Insurance claims."
42 W !?6,"You should queue this report to run after normal business hours."
43 ;
44 ; - Select a device.
45 W ! S %ZIS="QM" D ^%ZIS G:POP ENQ
46 I $D(IO("Q")) D G ENQ
47 .S ZTRTN="DQ^IBJDB1",ZTDESC="IB - BILLING LAG TIME REPORT"
48 .F X="IB*","VAUTD","VAUTD(" S ZTSAVE(X)=""
49 .D ^%ZTLOAD W !!,$S($D(ZTSK):"This job has been queued. The task number is "_ZTSK_".",1:"Unable to queue this job.")
50 .K ZTSK,IO("Q") D HOME^%ZIS
51 ;
52 U IO
53 ;
54DQ ; - Tasked entry point.
55 ;
56 I $G(IBXTRACT) D E^IBJDE(10,1) ; Change extract status.
57 ;
58 K IBCT,IBTL,^TMP("IBJDB1",$J)
59 S IBQ=0 D ^IBJDB11 I IBQ G ENQ ; Compile data for reports.
60 ;
61 ; - Extract summary data.
62 I $G(IBXTRACT) D G ENQ
63 .S X=0 F Y=1:1:4,9,10,11,"2I","3I","4I" D
64 ..S X=X+1,IB(X)=$J($S('IBCT(0,"OP",Y):0,1:IBTL(0,"OP",Y)/IBCT(0,"OP",Y)),0,2)
65 .F Y=5:1:11,"6I","7I","8I" D
66 ..S X=X+1,IB(X)=$J($S('IBCT(0,"IN",Y):0,1:IBTL(0,"IN",Y)/IBCT(0,"IN",Y)),0,2)
67 .D E^IBJDE(10,0)
68 ;
69 ; - Print the reports.
70 S IBQ=0
71 S IBDIV="" F S IBDIV=$S(IBRPT="D":$O(^TMP("IBJDB1",$J,IBDIV)),1:$O(IBCT(IBDIV))) Q:IBDIV="" D Q:IBQ
72 .S IBPAG=0 D NOW^%DTC S IBRUN=$$DAT2^IBOUTL(%)
73 .I IBRPT="D" D OPT^IBJDB12 I 'IBQ D INP^IBJDB13
74 .I IBRPT="S" D SUM^IBJDB12
75 ;
76ENQ K ^TMP("IBJDB1",$J)
77 I $D(ZTQUEUED) S ZTREQ="@" G ENQ1
78 ;
79 D ^%ZISC
80ENQ1 K IB,IBBDT,IBBN,IBEDT,IBCK,IBN,IBN0,IBRPT,IBPAG,IBQ,IBRUN,IBX,IBX1,IBX2
81 K IBX3,IBAUTH,IBDAT,IBDFN,IBNU,IBPTF,IBPOL,IBPOL1,IBTY,IBS,IBSEL,IBSEL1
82 K IBCT,IBDIV,IBSORT,IBTL,IBCHK,IBDCHK,DFN,POP,VAUTD,ZTDESC,ZTRTN,ZTSAVE
83 K IBDR,IBH,DIROUT,DTOUT,DUOUT,DIRUT,%,%ZIS,D,X,X1,X2,Y,Y1,Z,Z1,Z2,Z3
84 Q
85 ;
86HLP1 ; - 'Sort by Division?' prompt.
87 W !?1,"Enter a <CR> to print the report without regard to division,"
88 W !?1,"or 'Y' to select those divisions for which a separate report"
89 W !?1,"should be created. To quit this option, enter '^'."
90 Q
91 ;
92HLP2 ; - Line item report prompt.
93 W !?1,"Select '1-11' (Response can be a single number, list or range,"
94 W !?1,"e.g.: 1,3,5 or 2-6,10) to print up to 11 lag time reports based"
95 W !?1,"on the line items of the lag time summary reports. To quit this"
96 W !?1,"option, enter '^'."
97 Q
98 ;
99TITLE(X,Y) ; - Display/print report titles.
100 Q $P($T(TITLE1+X),";;",2)_$S(Y:$P($T(TITLE1+X),";;",3),1:"")
101 ;
102TITLE1 ; - Line item titles.
103 ;;Date of Care to Date of Check Out;; (Outpatient claims)
104 ;;Date of Check Out to Date Claim Authorized;; (Outpatient claims)
105 ;;Date of Care to Date of First Payment;; (Outpatient claims)
106 ;;Date of Care to Date Receivable Closed;; (Outpatient claims)
107 ;;Date of Discharge to Date PTF Transmitted;; (Inpatient claims)
108 ;;Date PTF Transmitted to Date Claim Authorized;; (Inpatient claims)
109 ;;Date of Discharge to Date of First Payment;; (Inpatient claims)
110 ;;Date of Discharge to Date Receivable Closed;; (Inpatient claims)
111 ;;Date Claim Authorized to Date Claim Activated
112 ;;Date Claim Activated to Date of First Payment
113 ;;Date of First Payment to Date Receivable Closed
Note: See TracBrowser for help on using the repository browser.