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

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

initial load of WorldVistAEHR

File size: 4.5 KB
Line 
1IBTOPW ;ALB/AAS - CLAIMS TRACKING PENDING REVIEWS REPORT ; 27-OCT-93
2 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
3 ;
4% I '$D(DT) D DT^DICRW
5 W !!,"Pending Reviews Report",!!!
6 ;
7SORT D SORT^IBTRPR0
8 ;
9REVS ; -- ask if hospital review, insurance reviews or both
10 N DIR W !
11 S DIR(0)="SOBA^H:HOSPITAL REVIEWS;I:INSURANCE REVIEWS;B:BOTH;"
12 S DIR("A")="Print [H]ospital Reviews [I]Insurance Reviews [B]oth: "
13 S DIR("B")="B"
14 S DIR("?",1)="Select if you would like to print pending Hospital Reviews, Insurance"
15 S DIR("?",2)="Reviews or both."
16 S DIR("?",3)=" ",DIR("?")="The default is both. This will print first the hospital reviews, then the insurance reviews."
17 D ^DIR K DIR
18 I "HIB"'[Y!($D(DIRUT)) G END
19 S IBTRPRF=$S(Y="B":12,Y="I":2,1:1)
20 ;
21 S IBTWHO="A" I IBSORT="A" D WHOSE^IBTRPR0 G:$D(VALMQUIT) END
22 S IBTPRT="B",VAUTD=1 I IBSORT="T" D TYPE^IBTRPR0 G:$D(VALMQUIT) END
23 I IBSORT="T"!(IBSORT="W") W ! D PSDR^IBODIV G:Y<0 END
24 ;
25DATE ; -- select date
26 W !! D DATE^IBOUTL
27 I IBBDT=""!(IBEDT="") G END
28 S IBTPBDT=IBBDT,IBTPEDT=IBEDT
29 ;
30DEV ; -- select device, run option
31 W !!,"You will need a 132 column printer for this report!",!
32 S %ZIS="QM" D ^%ZIS G:POP END
33 I $D(IO("Q")) S ZTRTN="DQ^IBTOPW",ZTSAVE("IB*")="",ZTSAVE("VAUTD")="",ZTSAVE("VAUTD(")="",ZTDESC="IB - Pending Reviews Report" D ^%ZTLOAD K IO("Q"),ZTSK D HOME^%ZIS G END
34 ;
35 D DQ G END
36 Q
37 ;
38END ; -- Clean up
39 W !
40 K ^TMP("IBSRT",$J),^TMP("IBSRT1",$J) W !
41 I $D(ZTQUEUED) S ZTREQ="@" Q
42 D ^%ZISC
43 K I,J,X,Y,DFN,DUOUT,DIRUT,%ZIS,VA,VAERR,IBTRN,IBTRND,IBTRND1,IBPAG,IBHDT,IBDISDT,IBETYP,IBQUIT,IBTAG,IBTRPRF,IBTSORT,IBTOPW,IBTWHO,IBTPRT,IBDIV
44 K ENTRY,FILE,IBDATE,IBJ,IBNEXT,IBREV,IBSTATUS,IBTPEDT,IBTPBDT,IBTRC,IBTRV,TYPE,IBASSIGN,IBCNT,IBDATA,IBFLAG,IBK,IBL,IBSORT,IBWARD,IBEDT,IBBDT,IBDV,VAUTD
45 Q
46 ;
47DQ ; -- print one billing report from ct
48 ; -- run the scheduled admissions list
49 ;
50 S IBPAG=0,IBHDT=$$HTE^XLFDT($H,1),IBQUIT=0
51 ;
52 ; -- put division in array by name
53 I '$D(VAUTD) S VAUTD=1
54 I VAUTD'=1 S I="" F S I=$O(VAUTD(I)) Q:'I S IBDIV(VAUTD(I))=I
55 ;
56 ; -- run the scheduled admissions list
57 D ^IBTRKR2 ;W:'$D(ZTQUEUED) !!,"Building your work list..."
58 U IO
59 D BLD
60 I IBCNT<1 D HDR W !!,"No Pending Reviews found."
61 I $D(ZTQUEUED) G END
62 Q
63 ;
64HDR ; -- Print header for billing report
65 I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1,IBQUIT=1 W !!,"....task stoped at user request"
66 Q:IBQUIT
67 I $E(IOST,1,2)="C-",IBPAG D PAUSE^VALM1 I $D(DIRUT) S IBQUIT=1 Q
68 I $E(IOST,1,2)="C-"!(IBPAG) W @IOF
69 S IBPAG=IBPAG+1
70 W !,"Pending Reviews Report for Division ",$G(IBDV),?(IOM-33),"Page ",IBPAG," ",IBHDT
71 W !,"For Period ",$$FMTE^XLFDT(IBBDT)," to ",$$FMTE^XLFDT(IBEDT)
72 W !,"Patient",?23,"Pt. ID",?30,"Ward",?42,"Review Type",?65,"Due Date",?75,"Status",?85,"Assigned to",?105,"Visit",?115,"Date"
73 W !,$TR($J(" ",IOM)," ","-")
74 Q
75 ;
76BLD ; -- build list
77 ; 1. build pending hospital reviews
78 ; 2. build pending insurance reviews
79 ;
80 K ^TMP("IBSRT",$J),^TMP("IBSRT1",$J)
81 N IBI,IBJ
82 S IBCNT=0,IBI="",IBTOPW=1
83 I '$G(IBTRPRF) S IBTRPRF=12
84 ;
85 D STOP G BLDQ:IBQUIT D:IBTRPRF[1 1^IBTRPR01 S IBQUIT=0
86 ;
87 D STOP G BLDQ:IBQUIT D:IBTRPRF[2 2^IBTRPR01 S IBQUIT=0
88 ;
89 ; -- go through sorted list
90 S IBDV="" F S IBDV=$O(^TMP("IBSRT",$J,IBDV)) Q:IBDV=""!(IBQUIT) D
91 .I 'VAUTD,'$D(IBDIV(IBDV)) Q
92 .D HDR
93 .S TYPE="" F S TYPE=$O(^TMP("IBSRT",$J,IBDV,TYPE)) Q:TYPE=""!(IBQUIT) D
94 ..S IBI="" F S IBI=$O(^TMP("IBSRT",$J,IBDV,TYPE,IBI)) Q:IBI=""!(IBQUIT) S IBJ="" F S IBJ=$O(^TMP("IBSRT",$J,IBDV,TYPE,IBI,IBJ)) Q:IBJ=""!(IBQUIT) D
95 ...S IBK="" F S IBK=$O(^TMP("IBSRT",$J,IBDV,TYPE,IBI,IBJ,IBK)) Q:IBK=""!(IBQUIT) S IBL="" F S IBL=$O(^TMP("IBSRT",$J,IBDV,TYPE,IBI,IBJ,IBK,IBL)) Q:IBL=""!(IBQUIT) D ONE
96 ;
97BLDQ Q
98 ;
99ONE ; -- print one patients data
100 I ($Y+5)>IOSL D HDR Q:IBQUIT
101 S IBDATA=^TMP("IBSRT",$J,IBDV,TYPE,IBI,IBJ,IBK,IBL)
102 S IBTRN=+IBDATA,ENTRY=$P(IBDATA,"^",2)
103 S DFN=$P(IBDATA,"^",4)
104 S IBSTATUS=$P(IBDATA,"^",6),IBREV=$P(IBDATA,"^",7)
105 S IBASSIGN=$P(IBDATA,"^",9)
106 S IBFLAG=$O(^TMP("IBSRT1",$J,DFN,"")),IBFLAG=$O(^TMP("IBSRT1",$J,DFN,IBFLAG)) I IBFLAG'="" S IBFLAG="+"
107 S FILE=$P(IBDATA,"^",8)
108 D PID^VADPT
109 S IBCNT=IBCNT+1
110 W !,IBFLAG,$E($P(^DPT(DFN,0),"^"),1,20),?23,VA("BID"),?30,$E($G(^DPT(DFN,.1)),1,11)
111 W ?42,$E(TYPE,1,11),"-",$P($G(^IBE(356.11,+IBREV,0)),"^",3)
112 W ?65,$$DAT1^IBOUTL($P(IBDATA,"^",3)),?75,IBSTATUS,?85,$E(IBASSIGN,1,18)
113 W ?105,$P($G(^IBE(356.6,+$P(^IBT(356,+IBTRN,0),U,18),0)),U,2)
114 W ?115,$$DAT1^IBOUTL($P(^IBT(356,+IBTRN,0),U,6),"2P")
115 Q
116 ;
117STOP ; -- see if should stop
118 I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1,IBQUIT=1 D HDR W !!,"....task stoped at user request"
119 Q
Note: See TracBrowser for help on using the repository browser.