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

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

initial load of WorldVistAEHR
File size: 4.5 KB
RevLine 
[613]1IBTOUR ;ALB/AAS - CLAIMS TRACKING UR/ACTIVITY REPORT ; 27-OCT-93
2 ;;Version 2.0 ; INTEGRATED BILLING ;**56**; 21-MAR-94
3 ;
4% I '$D(DT) D DT^DICRW
5 W !!,"UR Activity Report",!!
6 ;
7 N DIR
8 S IBQUIT=0
9 D SORT^IBTOLR G:IBQUIT END
10 ;
11SUM S DIR("?")="Answer YES if you only want to print a summary or answer NO if you want a detailed listing plus the summary."
12 S DIR(0)="Y",DIR("A")="Print Summary Only",DIR("B")="YES" D ^DIR K DIR
13 I $D(DIRUT) G END
14 S IBSUM=Y
15 ;
16 I 'IBSUM W ! D HOW G:IBQUIT END
17 ;
18DATE ; -- select date
19 W ! D DATE^IBOUTL
20 I IBBDT=""!(IBEDT="") G END
21 ;
22DEV ; -- select device, run option
23 I 'IBSUM W !!,"You will need a 132 column printer for this report!",!
24 S %ZIS="QM" D ^%ZIS G:POP END
25 I $D(IO("Q")) S ZTRTN="DQ^IBTOUR",ZTSAVE("IB*")="",ZTSAVE("DFN")="",ZTDESC="IB - UR Activity Report" D ^%ZTLOAD K IO("Q"),ZTSK D HOME^%ZIS G END
26 ;
27 U IO
28 D DQ G END
29 Q
30 ;
31END ; -- Clean up
32 K ^TMP($J)
33 I $D(ZTQUEUED) S ZTREQ="@" Q
34 D ^%ZISC
35 K I,J,X,Y,DFN,%ZIS,VA,IBTRN,IBTRND,IBTRND1,IBPAG,IBHDT,IBDISDT,IBETYP,IBQUIT,IBTAG,IBFOL,IBCNT,IBTRC,IBTRCD,IBSUM,IBDT,IBBDT,IBEDT,IBINS,IBCCODE,IBPCODE,DUOUT,DTOUT,DIRUT,IBC,MET,TYPE
36 K IBFAC,IBSNM,IBHDRL,IBTRV,IBTRVD,IBHOW,DGPM,IBI,IBJ,IBSORT,IBAPL,IBCDT,IBP1,IBP2,IBP3,IBP4,IBADM,IBDAYS,IBDAYN,IBCLOSE,IBDA,IBDATA,IBH,IBDIF,IBPREV,IBSITE,IBSPEC,IBTNOD,IBBEG,X2
37 D KVAR^VADPT
38 Q
39 ;
40DQ ; -- print one billing report from ct
41 K ^TMP($J)
42 S IBPAG=0,IBHDT=$$HTE^XLFDT($H,1),IBQUIT=0
43 S:$G(IBHOW)="" IBHOW="P"
44 K IBCNT,^TMP($J)
45 D BLD^IBTOUR1
46 Q:$D(ZTSTOP)
47 ;
48PRINT ; -- print report
49 I IBSORT'="H" S IBHDRL="Insurance" D
50 .I 'IBSUM D INS^IBTOUR4 ; insurance listing
51 .Q:$D(ZTSTOP)
52 .D INS^IBTOUR3 ; insurance summary
53 I IBSORT'="I" S IBHDRL="Hospital" D
54 .Q:$D(ZTSTOP)
55 .I 'IBSUM D HOSP^IBTOUR4 ;hosp rev. listing
56 .Q:$D(ZTSTOP)
57 .D HOSP^IBTOUR3 ; hosp. rev. summary
58 I $D(ZTQUEUED) G END
59 Q
60 ;
61HOW ; -- if not summary only ask how list is to be sorted
62 N DIR
63 S DIR(0)="SOBA^R:REVIEWER;S:SPECIALTY;P:PATIENT"
64 S DIR("A")="Sort By [R]eviewer [S]pecialty [P]atient: "
65 S DIR("B")="P"
66 S DIR("?",1)="When printing the list of patients reviewed, how should this report be"
67 S DIR("?",2)="sorted. It can be sorted by Reviewer or by Specialty or by Patient. "
68 S DIR("?",3)="If sorted by Reviewer it will be sorted within reviewer by type of review."
69 S DIR("?",4)=" ",DIR("?")="The default is Patient."
70 D ^DIR K DIR
71 S IBHOW=Y I "RSP"'[Y!($D(DIRUT)) S IBQUIT=1
72 Q
73 ;
74HDR1 ; -- specialty report header
75 I $E(IOST,1,2)="C-" W ! D PAUSE^VALM1 I $D(DIRUT) S IBQUIT=1 Q
76 W @IOF
77 S IBPAG=IBPAG+1
78 W !,"HOSPITAL REVIEW SPECIALTY SUMMARY REPORT",?IOM-32,IBHDT," Page ",IBPAG
79 W !!,"For Hospital Reviews Dated ",$$DAT1^IBOUTL(IBBDT)," to ",$$DAT1^IBOUTL(IBEDT)
80 W !,?24,"Admissions",?40,"Admissions",?56,"Days",?71,"Days Not"
81 W !,"Specialty",?24,"Met Criteria",?40,"Not Met Crit.",?56,"Met Criteria",?71,"Met Crit."
82 W !,$TR($J(" ",IOM)," ","-")
83 Q
84 ;
85HSPEC ; -- Hospital Review specialty report
86 D HDR1 Q:IBQUIT
87 S (IBP1,IBP2,IBP3,IBP4)=0
88 S IBSPEC="" F S IBSPEC=$O(^TMP($J,"IBTOUR2",IBSPEC)) Q:IBSPEC="" S IBDATA=^(IBSPEC) D
89 .Q:IBDATA="0^0^0^0"
90 .W !,$E(IBSPEC,1,20)
91 .W ?23,$J($P(IBDATA,"^",1),8)
92 .W ?40,$J($P(IBDATA,"^",2),8),?52,$J($P(IBDATA,"^",3),12)
93 .W ?68,$J($P(IBDATA,"^",4),12)
94 .S IBP1=IBP1+$P(IBDATA,"^",1),IBP2=IBP2+$P(IBDATA,"^",2),IBP3=IBP3+$P(IBDATA,"^",3),IBP4=IBP4+$P(IBDATA,"^",4)
95 ;
96 W !,$TR($J(" ",IOM)," ","-")
97 W !,?23,$J(IBP1,8),?40,$J(IBP2,8)
98 W ?52,$J(IBP3,12)
99 W ?68,$J(IBP4,12)
100 Q
101 ;
102IHDR ; -- specialty report header
103 I $E(IOST,1,2)="C-" W ! D PAUSE^VALM1 I $D(DIRUT) S IBQUIT=1 Q
104 W @IOF
105 S IBPAG=IBPAG+1
106 W !,"INSURANCE REVIEW SPECIALTY SUMMARY REPORT",?IOM-32,IBHDT," Page ",IBPAG
107 W !,"For Insurance Reviews Dated ",$$DAT1^IBOUTL(IBBDT)," to ",$$DAT1^IBOUTL(IBEDT)
108 W !!,?25,"Days",?42,"Days",?56,"Amount",?73,"Amount"
109 W !,"Specialty",?25,"Approved",?42,"Denied",?56,"Approved",?73,"Denied"
110 W !,$TR($J(" ",IOM)," ","-")
111 Q
112 ;
113ISPEC ; -- Insurance Review specialty report
114 D IHDR Q:IBQUIT
115 S (IBP1,IBP2,IBP3,IBP4)=0
116 S IBSPEC="" F S IBSPEC=$O(^TMP($J,"IBTOUR1",IBSPEC)) Q:IBSPEC="" S IBDATA=^(IBSPEC) D
117 .Q:IBDATA="0^0^0^0"
118 .W !,$E(IBSPEC,1,20)
119 .W ?23,$J($P(IBDATA,"^",1),8)
120 .W ?38,$J($P(IBDATA,"^",2),8)
121 .S X=$P(IBDATA,"^",3),X2="0$" D COMMA^%DTC W ?50,X
122 .S X=$P(IBDATA,"^",4),X2="0$" D COMMA^%DTC W ?67,X
123 .S IBP1=IBP1+$P(IBDATA,"^",1),IBP2=IBP2+$P(IBDATA,"^",2),IBP3=IBP3+$P(IBDATA,"^",3),IBP4=IBP4+$P(IBDATA,"^",4)
124 ;
125 W !,$TR($J(" ",IOM)," ","-")
126 W !,?23,$J(IBP1,8),?38,$J(IBP2,8)
127 S X=IBP3,X2="0$" D COMMA^%DTC W ?50,X
128 S X=IBP4,X2="0$" D COMMA^%DTC W ?67,X
129 Q
Note: See TracBrowser for help on using the repository browser.