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

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

initial load of FOIAVistA 6/30/08 version

File size: 3.8 KB
Line 
1IBOST ;ALB/AAS - INTEGRATED BILLING STATISTICAL REPORT ; 8-MAR-91
2 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
3 ;
4EN ;
5 ;***
6 ;S XRTL=$ZU(0),XRTN="IBOST-1" D T0^%ZOSV ;start rt clock
7 D HOME^%ZIS W @IOF,*13,?20,"Integrated Billing Statistical Report"
8 W !! D DATE^IBOUTL I IBEDT="" G END
9DEV S %ZIS="QM",%ZIS("A")="Output Device: " D ^%ZIS G:POP END
10 I $D(IO("Q")) S ZTRTN="DQ^IBOST",ZTDESC="IB Statistical Report",ZTSAVE("IB*")="" D ^%ZTLOAD K IO("Q"),ZTSK G END
11 U IO
12 ;***
13 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOST" D T1^%ZOSV ;stop rt clock
14 W !!
15 ;
16DQ ; -entry from tasked job
17 ;***
18 ;S XRTL=$ZU(0),XRTN="IBOST-2" D T0^%ZOSV ;start rt clock
19 K ^TMP($J)
20 S IBN="" F IBDT=IBBDT:0 S IBDT=$O(^IB("D",IBDT)) Q:'IBDT!(IBDT>(IBEDT+.24)) F IBN=0:0 S IBN=$O(^IB("D",IBDT,IBN)) Q:'IBN I $D(^IB(IBN,0)) D GROSS,NET:$P(^IB(IBN,0),"^",9)=IBN
21 ;
22 D PRINT W !
23 G END
24 ;
25GROSS ; -gross count of action types, total charges
26 ; -^tmp($j,"ib",ibaction type,"gcnt")=count
27 ; ^tmp($j,"ib",ibaction type,"gtot")=sum of charges
28 ;
29 S IBND=^IB(IBN,0)
30 S IBATYP=$S($D(^IBE(350.1,+$P(IBND,"^",3),0)):$P(^(0),"^"),1:"UNKNOWN"),IBSEQNO=$S($D(^IBE(350.1,+$P(IBND,"^",3),0)):$P(^(0),"^",5),1:0)
31 S:'$D(^TMP($J,"IB",IBSEQNO,IBATYP,"GCNT")) ^("GCNT")=0 S ^("GCNT")=^("GCNT")+1
32 S:'$D(^TMP($J,"IB",IBSEQNO,IBATYP,"GTOT")) ^("GTOT")=0 S ^("GTOT")=^("GTOT")+$P(IBND,"^",7)
33 Q
34 ;
35NET ; -net count of new actions that aren't cancelled
36 ; -^tmp($j,"ib",ibaction type,"ncnt")=net count
37 ; ^tmp($j,"ib",ibaction type,"ntot")=net total
38 S IBLAST="",IBLDT=$O(^IB("APDT",IBN,"")) I +IBLDT F IBL=0:0 S IBL=$O(^IB("APDT",IBN,IBLDT,IBL)) Q:'IBL S IBLAST=IBL
39 Q:'IBLAST
40 Q:'$D(^IB(IBLAST,0))
41 S IBCHRG=$P(^IB(IBLAST,0),"^",7),IBSEQNOL=$S($D(^IBE(350.1,$P(^IB(IBLAST,0),"^",3),0)):$P(^(0),"^",5),1:"")
42 S:IBSEQNOL=2 IBCHRG=0
43 S:'$D(^TMP($J,"IB",IBSEQNO,IBATYP,"NTOT")) ^("NTOT")=0 S ^("NTOT")=^("NTOT")+(IBCHRG)
44 S:'$D(^TMP($J,"IB",IBSEQNO,IBATYP,"NCNT")) ^("NCNT")=0 S ^("NCNT")=^("NCNT")+$S(IBSEQNOL=2:0,1:1)
45 Q
46 ;
47PRINT ; -output data
48 S IBQUIT=0,IBPAG=0,Y=DT D D^DIQ S IBHDT=Y D HDR
49 W !!?((IOM-25)/2),"NET TOTALS BY ACTION TYPE"
50 F IBSEQNO=0:0 S IBSEQNO=$O(^TMP($J,"IB",IBSEQNO)) Q:'IBSEQNO!(IBQUIT) S IBATYP="" F IBT=0:0 S IBATYP=$O(^TMP($J,"IB",IBSEQNO,IBATYP)) Q:IBATYP=""!(IBQUIT) D NETLIN
51 ;
52 W !!?((IOM-27)/2),"GROSS TOTALS BY ACTION TYPE"
53 F IBSEQNO=0:0 S IBSEQNO=$O(^TMP($J,"IB",IBSEQNO)) Q:'IBSEQNO!(IBQUIT) S IBATYP="" F IBT=0:0 S IBATYP=$O(^TMP($J,"IB",IBSEQNO,IBATYP)) Q:IBATYP=""!(IBQUIT) D LINE
54 Q
55 ;
56LINE ;
57 I $Y>(IOSL-5) D PAUSE^IBOUTL Q:IBQUIT D HDR
58 W !!?((IOM/2)-$L($P(IBATYP," ",2,99))),$P(IBATYP," ",2,99)
59 W !?((IOM/2)-12),"NUMBER ENTRIES: ",$S($D(^TMP($J,"IB",IBSEQNO,IBATYP,"GCNT")):^("GCNT"),1:0)
60 W !?((IOM/2)-12),"DOLLAR AMOUNT: $",$S($D(^TMP($J,"IB",IBSEQNO,IBATYP,"GTOT")):^("GTOT"),1:0)
61 Q
62 ;
63NETLIN ;
64 I $Y>(IOSL-5) D PAUSE^IBOUTL Q:IBQUIT D HDR
65 Q:'$D(^TMP($J,"IB",IBSEQNO,IBATYP,"NCNT"))
66 W !!?((IOM/2)-$L($P(IBATYP," ",2,99))),$P(IBATYP," ",2,99)
67 W !?((IOM/2)-12),"NUMBER ENTRIES: ",$S($D(^TMP($J,"IB",IBSEQNO,IBATYP,"NCNT")):^("NCNT"),1:0)
68 W !?((IOM/2)-12),"DOLLAR AMOUNT: $",$S($D(^TMP($J,"IB",IBSEQNO,IBATYP,"NTOT")):^("NTOT"),1:0)
69 Q
70HDR ;
71 W:$E(IOST,1,2)["C-"!(IBPAG>0) @IOF,*13
72 W ?((IOM-37)/2),"INTEGRATED BILLING STATISTICAL REPORT"
73 W !?((IOM-3)/2),"for"
74 D SITE^IBAUTL S IBSNM=$S($D(^DIC(4,IBFAC,0)):$P(^(0),"^"),1:"")
75 W !?((IOM-($L(IBSNM)+6))/2),IBSNM_" ("_IBSITE_")"
76 W !!?(IOM-18/2),"From: " S Y=IBBDT D DT^DIQ
77 W !?((IOM-16)/2),"To: " S Y=IBEDT D DT^DIQ
78 W !!?(IOM-26/2),"Date Printed: ",IBHDT
79 S IBPAG=IBPAG+1 W !?(IOM-8/2),"Page: ",IBPAG
80 W !?(IOM-26/2),"--------------------------"
81 Q
82 ;
83END K ^TMP($J)
84 ;***
85 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOST" D T1^%ZOSV ;stop rt clock
86 I $D(ZTQUEUED) S ZTREQ="@" Q
87 K DUOUT,IBT,IBBDT,IBEDT,IBATYP,IBSEQNO,IBHDT,IBPAG,IBSNM,IBFAC,IBSITE,IBSEQNOL,IBLAST,IBL,IBCHRG,IBDT,IBJ,IBLDT,IBN,IBND,IBQUIT,X,Y
88 D ^%ZISC
89 Q
Note: See TracBrowser for help on using the repository browser.