source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBOAMS.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: 3.6 KB
Line 
1IBOAMS ;ALB/AAS - PRINT REVENUE CODE TOTALS FOR MEANS TEST AMIS ; 10-SEP-91
2 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
3 ;
4 ;MAP TO DGCRAMS1
5 ;
6EN ; - Report of inpatient and nhcu per diems
7 ;***
8 ;S XRTL=$ZU(0),XRTN="IBOAMS-1" D T0^%ZOSV ;start rt clock
9 ;
10 D HOME^%ZIS W @IOF,?19,"Report of Revenue Code Totals by Rate Type",!!!
11 S DIC="^DGCR(399.3,",DIC(0)="AEQMN",DIC("A")="Select Means Test Rate Type: "
12 S IBRT="" F S IBRT=$O(^DGCR(399.3,"B",IBRT)) Q:IBRT="" I IBRT["MEANS TEST" S DIC("B")=$O(^(IBRT,0)) Q
13 D ^DIC K DIC G:+Y<1 ENQ S IBRT=+Y
14 ;
15DATE W ! S %DT="AEPX",%DT("A")="START WITH DATE FIRST PRINTED: " D ^%DT K %DT G ENQ:Y<1 S IBBDT=Y
16DATE1 W ! S %DT="EPX" R !,"GO TO DATE FIRST PRINTED: ",X:DTIME S:X=" " X=IBBDT G ENQ:(X="")!(X["^") D ^%DT K %DT G DATE1:Y<1 S IBEDT=Y I Y<IBBDT W *7," ??",!,"ENDING DATE must follow BEGINNING DATE." G DATE1
17 ;
18 W ! S DIR(0)="Y",DIR("A")="PRINT SUMMARY PAGE ONLY",DIR("B")="YES" D ^DIR K DIR G:$D(DIRUT) ENQ S IBSUM=Y
19 ;
20DEV W ! S %ZIS="QM",%ZIS("A")="Output Device: " D ^%ZIS G:POP ENQ
21 I $D(IO("Q")) K IO("Q") S ZTRTN="DQ^IBOAMS",ZTDESC="Revenue Code Report",ZTSAVE("IB*")="" D ^%ZTLOAD K ZTSK G ENQ
22 U IO
23 ;***
24 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOAMS" D T1^%ZOSV ;stop rt clock
25 ;
26DQ ; - start report here
27 ;***
28 ;S XRTL=$ZU(0),XRTN="IBOAMS-2" D T0^%ZOSV ;start rt clock
29 S (IBCNT,IBQUIT,IBPAG,IBTC)=0 D NOW^%DTC S Y=% D D^DIQ S IBPDT=Y
30 D HDR
31 K IBT S IBDT=IBBDT-.01
32 F S IBDT=$O(^DGCR(399,"AP",IBDT)) Q:'IBDT!(IBDT>(IBEDT+.25))!(IBQUIT) S IBIFN=0 F S IBIFN=$O(^DGCR(399,"AP",IBDT,IBIFN)) Q:'IBIFN!(IBQUIT) D BLD
33 ;
34 D:'IBQUIT TOTALS
35 I '$D(IBT) W !,"No Matches Found"
36 D PAUSE:'IBQUIT
37ENQ ;
38 ;***
39 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOAMS" D T1^%ZOSV ;stop rt clock
40 I $D(ZTQUEUED) S ZTREQ="@" Q
41 K R,X,X2,X3,Y,DFN,IB,IBBDT,IBC,IBDT,IBEDT,IBGT,IBIFN,IBLINE,IBPAG,IBPDT,IBRT,IBSUM,IBT,IBTC,VA,VAERR,DIC,DIR,%DT,IBY,IBQUIT,IBCNT
42 D ^%ZISC
43 Q
44 ;
45BLD ;
46 K IB
47 I $P(^DGCR(399,IBIFN,0),"^",7)'=IBRT!($S('$D(^("S")):1,$P(^("S"),"^",16):1,1:0)) Q
48 S (IBC,R)=0 F S R=$O(^DGCR(399,IBIFN,"RC",R)) Q:'R I $D(^DGCR(399,IBIFN,"RC",R,0)) D BLD1
49 S IBCNT=IBCNT+1,R=0 F S R=$O(^DGCR(399,IBIFN,"RC","B",R)) Q:'R S:'$D(IBCNT(R)) IBCNT(R)=0 S IBCNT(R)=IBCNT(R)+1
50 Q:IBSUM
51 I ($Y+4+IBC)>IOSL D PAUSE Q:IBQUIT D HDR
52 S DFN=$P(^DGCR(399,IBIFN,0),"^",2) D PID^VADPT W !,$E($P(^DPT(DFN,0),"^"),1,20),?23,VA("PID"),?38,$P(^DGCR(399,IBIFN,0),"^")
53 S R=0 F S R=$O(IB(R)) Q:'R W ?59,$S($D(^DGCR(399.2,+R,0)):$P(^(0),"^"),1:R),?67 S X=IB(R),X2="2$",X3=12 D COMMA^%DTC W X,!
54 Q
55 ;
56BLD1 S IB=^DGCR(399,IBIFN,"RC",R,0) S:'$D(IB(+IB)) IB(+IB)=0,IBC=IBC+1 S IB(+IB)=IB(+IB)+$P(IB,"^",4) S:'$D(IBT(+IB)) IBT(+IB)=0,IBTC=IBTC+1 S IBT(+IB)=IBT(+IB)+$P(IB,"^",4)
57 Q
58 ;
59TOTALS ; - print revenue code totals
60 Q:'$D(IBT)
61 I ($Y+4+IBTC)>IOSL S IBSUM=1 D PAUSE Q:IBQUIT D HDR
62 S IBGT=0
63 W:'IBSUM !,"----------------------------------------------",!,"REVENUE CODE TOTALS",!
64 S R=0 F S R=$O(IBT(R)) Q:'R W !,"Revenue Code: ",$S($D(^DGCR(399.2,+R,0)):$P(^(0),"^"),1:R)," .........." S IBGT=IBGT+IBT(R),X=IBT(R),X2="2$",X3=13 D COMMA^%DTC W ?32,X,?50,$J(IBCNT(R),8)," Bills"
65 S X=IBGT,X2="2$",X3=13 D COMMA^%DTC W !,?31,"--------------",!," ",?32,X,?50,$J(IBCNT,8)," Bills"
66 Q
67HDR ; - patient data header
68 S IBPAG=IBPAG+1
69 W:$E(IOST,1,2)["C-"!(IBPAG>1) @IOF
70 W "Revenue Code Totals for ",$P(^DGCR(399.3,IBRT,0),"^",1),?(IOM-32),IBPDT," PAGE ",IBPAG
71 W !,"For Bills First Printed " S Y=IBBDT D DT^DIQ W " to " S Y=IBEDT D DT^DIQ
72 W:'IBSUM !,"Patient",?25,"Pt. ID.",?38,"Bill No.",?56,"Rev. Code",?72,"Amount"
73 S IBLINE="",$P(IBLINE,"-",IOM)="" W !,IBLINE
74 Q
75PAUSE Q:$E(IOST,1,2)'["C-"
76 F IBY=$Y:1:(IOSL-4) W !
77 S DIR(0)="E" D ^DIR K DIR I $D(DIRUT)!($D(DUOUT)) S IBQUIT=1 K DIRUT,DTOUT,DUOUT
78 Q
Note: See TracBrowser for help on using the repository browser.