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

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

initial load of WorldVistAEHR

File size: 3.6 KB
Line 
1IBORT ;ALB/MRL,SGD - MAS BILLING TOTALS REPORT ;25 MAY 88 09:10
2 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
3 ;
4 ;MAP TO DGCRORT
5 ;
6 ;***
7 ;S XRTL=$ZU(0),XRTN="IBORT-1" D T0^%ZOSV ;start rt clock
8 N IBDTP,IBIDX
9 S:'$D(U) U="^" S:'$D(DTIME) DTIME=600 I '$D(DT) S X="T",DT="" D ^%DT S DT=Y K X,Y,^UTILITY($J)
10SELECT ; chose the date type to select by
11 S DIR(0)="S^1:EVENT DATE;2:BILL DATE"
12 S DIR("A")="SELECT BILLS BY",DIR("B")=1,DIR("?")="^D HELP^IBORT"
13 D ^DIR K DIR Q:$D(DIRUT)
14 S IBDTP=$S(Y=1:"EVENT",Y=2:"BILL",1:"") Q:IBDTP=""
15DATE S %DT="AEPX",%DT("A")="Start with "_IBDTP_" DATE: " D ^%DT G Q:Y<0 S IBBEG=Y I IBBEG>DT W *7," ??",!,"Date must be in the past." G DATE
16DATE1 S %DT="EPX" R !,"Go to DATE: ",X:DTIME S:X=" " X=IBBEG G Q:(X="")!(X["^") D ^%DT G DATE1:Y<0 S IBEND=Y I IBEND<IBBEG W *7," ??",!,"ENDING DATE must follow BEGINNING DATE." G DATE1
17 I IBEND>DT W *7," ??",!,"Date must be in the past." G DATE1
18 ;
19 W !!,*7,"*** Margin width of this output is 132 ***"
20 ;S DGPGM="BEGIN^IBORT",DGVAR="IBBEG^IBEND^DUZ^IBDTP" D ZIS^DGUTQ G Q:POP U IO
21 S %ZIS="QM" D ^%ZIS G:POP Q
22 ;
23 I $D(IO("Q")) K IO("Q") D G Q
24 .S ZTRTN="BEGIN^IBORT",ZTSAVE("IB*")="",ZTDESC="IB - BILLING TOTALS REPORT"
25 .D ^%ZTLOAD K ZTSK D HOME^%ZIS
26 ;
27 U IO
28 ;
29 ;***
30 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBORT" D T1^%ZOSV ;stop rt clock
31BEGIN ;
32 ;***
33 ;S XRTL=$ZU(0),XRTN="IBORT-2" D T0^%ZOSV ;start rt clock
34 S (IBL,IBL1)="",$P(IBL,"_",131)="",$P(IBL1,"=",131)="",Y=IBBEG X ^DD("DD") S IBHD="for "_$S(IBBEG'=IBEND:"period covering ",1:"")_Y I IBBEG<IBEND S Y=IBEND X ^DD("DD") S IBHD=IBHD_" through "_Y
35 S X1=IBBEG,X2=-1 D C^%DTC S IBD=X_.9999,IBD1=IBEND_.2359,IBNEX=0
36 F I=0:0 S IBNEX=$O(^DGCR(399.3,IBNEX)) Q:'IBNEX S IBX=$P(^(IBNEX,0),"^",1),^UTILITY($J,"IB","T",IBX)="",^UTILITY($J,"IB","T1",IBX)=""
37 S ^UTILITY($J,"IB","TT")="",^("TS")="",^UTILITY($J,"IB","T","UNKNOWN")="",^UTILITY($J,"IB","T1","UNKNOWN")=""
38 S IBIDX=$S(IBDTP="BILL":"AP",1:"D")
39 F I=0:0 S IBD=$O(^DGCR(399,IBIDX,IBD)) Q:'IBD!(IBD>IBD1) S DFN="" F J=0:0 S DFN=$O(^DGCR(399,IBIDX,IBD,DFN)) Q:'DFN I $D(^DGCR(399,+DFN,0)) S IB=^(0) I $P(IB,"^",1)'="",$P(IB,"^",3) D SET^IBORT1
40 S IBB=1,X=132 X ^%ZOSF("RM") D HEAD S IBNEX=0 F I=0:0 S IBNEX=$O(^UTILITY($J,"IB","T",IBNEX)) Q:IBNEX="" S IBP=^(IBNEX) W !,IBNEX F I1=1:2:7 D WRITE
41 W !,IBL,!,"TOTALS" S IBP=^UTILITY($J,"IB","TT") F I1=1:2:7 D WRITE
42 S IBB=0 D HEAD S IBNEX=0 F I=0:0 S IBNEX=$O(^UTILITY($J,"IB","T1",IBNEX)) Q:IBNEX="" S IBP=^(IBNEX) W !,IBNEX F I1=1:2:7 D WRITE
43 W !,IBL,!,"PENDING TOTALS" S IBP=^UTILITY($J,"IB","TS") F I1=1:2:7 D WRITE
44Q K X,X1,X2,Y,I,I1,J,DFN,IB,IBTOT,IBN1,IBN2,%DT,%,IBD,IBD1,IBHD,IBNEX,IBP,IBTAB,IBX,POP,IBBEG,IBEND,IBL,IBL1,IBB,IBS,^UTILITY($J),IBDTP,IBIDX
45 I '$D(ZTQUEUED) D ^%ZISC
46 ;***
47 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBORT" D T1^%ZOSV ;stop rt clock
48 I $D(ZTQUEUED) S ZTREQ="@"
49 Q
50WRITE S IBTAB=$S(I1=1:34,I1=3:59,I1=5:84,1:109),IBN1=+$P(IBP,"^",I1),IBN2=+$P(IBP,"^",I1+1) W ?IBTAB,$J(IBN1,5) S X=IBN2,X2="2$" D COMMA^%DTC S X=X_"|" W ?(IBTAB+7),$J(X,15)
51 Q
52HEAD W !,@IOF,! D NOW^%DTC S Y=$E(%,1,12) X ^DD("DD") W ?94,"Date/Time Printed: ",Y,!!,$S(IBB:"Billing Summary Report ",1:"Summary of Pending Bill Authorizations "),IBHD," (by "_$S(IBDTP="EVENT":"Event Date)",1:"Date Billed)")
53 W !,IBL,!
54 I IBB W ?39,"INITIATED",?55,"|",?65,"PENDING",?80,"|",?89,"PRINTED",?105,"|",?114,"CANCELLED",?130,"|"
55 E W ?38,"TOTAL PENDING",?55,"|",?64,"NO ACTION",?80,"|",?89,"REVIEWED",?105,"|",?114,"AUTHORIZED",?130,"|"
56 W !,"BILL TYPE" F IBTAB=33,58,83,108 W ?IBTAB,"Number Dollars|"
57 W !,IBL1 Q
58HELP ; help for date type selection
59 W !!,"EVENT DATE is the date beginning the bill's episode of care"
60 W !!,"BILL DATE is the date the bill was initially printed"
61 Q
Note: See TracBrowser for help on using the repository browser.