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

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

initial load of WorldVistAEHR

File size: 3.0 KB
RevLine 
[613]1IBOCPD ;ALB/ARH - CLERK PRODUCTIVITY REPORTS ;10/8/91
2 ;;2.0;INTEGRATED BILLING;**44,63,118,155**;21-MAR-94
3 ;
4EN ;***
5 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOCPD" D T1^%ZOSV ;stop rt clock
6 ;S XRTL=$ZU(0),XRTN="IBOCPD-1" D T0^%ZOSV ;start rt clock
7 S DIR(0)="SO^F:FULL CLERK PRODUCTIVITY REPORT;S:SUMMARY OF CLERK PRODUCTIVITY REPORT;"
8 D ^DIR K DIR G:$D(DIRUT) EXIT I Y="F" D FULL G EXIT
9 I Y="S" D ^IBOCPDS
10EXIT K X,Y,DTOUT,DUOUT,DIRUT,DIROUT,DIOEND
11 ;***
12 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOCPD" D T1^%ZOSV ;stop rt clock
13 Q
14 ;
15FULL D ORDER G:IBQUIT ENDF
16 D HOME^%ZIS S IBHDR="CLERK PRODUCTIVITY REPORT"
17 W @IOF,?27,IBHDR,!!,"Report requires 132 columns."
18 S IBFLD="Date "_$S(Y="E":"Entered",Y="A":"Authorized",1:"First Printed")
19 D RANGE I IBQUIT G ENDF
20 ;
21PRINTF ; - Print report.
22 ;***
23 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOCPD" D T1^%ZOSV ;stop rt clock
24 ;S XRTL=$ZU(0),XRTN="IBOCPD-2" D T0^%ZOSV ;start rt clock
25 S DIOEND="D PAUSE^IBOCPDS"
26 S FR=IBBEG_",?,?,",TO=IBEND_",?,?,",L=0,DIC="^DGCR(399,"
27 ;
28 S IBF1=$S(IBORDER="E":"ENTERED/EDITED BY",IBORDER="A":"AUTHORIZER",1:"FIRST PRINTED BY")
29 S IBF2=$S(IBORDER="E":"DATE ENTERED",IBORDER="A":"AUTHORIZATION DATE",1:"DATE FIRST PRINTED")
30 S IBNOW=$P($$FMTE^XLFDT($$NOW^XLFDT),":",1,2)
31 S IBNOW=$P(IBNOW,"@")_" "_$P(IBNOW,"@",2)
32 S IBNOW=$P(IBNOW,", ")_","_$P(IBNOW,", ",2)
33 S IBNOW=$TR(IBNOW,"abceglnoprtuvy","ABCEGLNOPRTUVY")
34 ;
35 S BY="'@"_IBF2_";""Date "_$S(IBORDER="E":"Enter",IBORDER="A":"Authoriz",1:"First Print")_"ed"",+@"_IBF1_";"""_$S(IBORDER="E":"Clerk Enter",IBORDER="A":"Authoriz",1:"First Print")_"ed By"";S1,@RATE TYPE;""Rate Type"",@"_IBF2
36 ;
37 S FLDS="[IB CLK PROD]" D EN1^DIP
38 ;
39ENDF K DIC,L,BY,FR,TO,FLDS,IBHDR,IBBEG,IBEND,IBBEGE,IBENDE,IBFLD,IBORDER
40 K IBQUIT,IBF1,IBF2,IBNOW,X,Y,DIRUT,DIROUT
41 Q
42 ;
43ORDER ; - Selection of order in which to print report.
44 S DIR("A")="REPORT BY WHICH CLERK FUNCTION",DIR(0)="SO^E:WHO ENTERED BILL;A:WHO AUTHORIZED BILL;P:WHO FIRST PRINTED BILL;"
45 S DIR("?")="Choose the clerk's function that will determine who gets 'credit' for a bill on this report"
46 S DIR("B")="A"
47 D ^DIR K DIR I $D(DIRUT)!(X="") S IBQUIT=1 Q
48 S IBORDER=Y,IBQUIT=0
49 Q
50 ;
51RANGE ; - Get date range.
52 S DIR(0)="D^:NOW:EX",DIR("A")="START WITH "_IBFLD
53 D ^DIR K DIR I $D(DIRUT) S IBQUIT=1 Q
54 S IBBEG=Y X ^DD("DD") S IBBEGE=Y
55 S DIR(0)="D^"_IBBEG_":NOW:EX",DIR("A")="GO TO "_IBFLD,DIR("B")="TODAY"
56 D ^DIR K DIR I $D(DIRUT) S IBQUIT=1 Q
57 S IBEND=Y X ^DD("DD") S IBENDE=Y,IBQUIT=0
58 Q
59 ;
60NOTE N IBH1,IBH2
61 S IBH1=$S(IBORDER="E":"ENTERED",IBORDER="A":"AUTHORIZED",1:"PRINTED"),IBH2=$S(IBORDER'="P":IBH1,1:"FIRST PRINTED")
62 W !!,"NOTE: ** TOTAL ",IBH1," COLUMN INCLUDES TOTALS OF ALL BILLS THAT WERE ",IBH2," IN THE SELECTED DATE RANGE REGARDLESS OF THE",!,?13,"BILLS' CURRENT STATUS"
63 W !,?9,IBH1," CANCELLED COLUMN INCLUDES TOTALS OF ONLY THOSE BILLS THAT WERE ",IBH2," IN THE SELECTED DATE RANGE AND HAVE",!,?13,"A CURRENT STATUS OF CANCELLED"
64 W !?9,"MRA REQUESTS COLUMN INCLUDES TOTALS OF ALL BILLS THAT HAD AN MRA REQUEST PERFORMED IN THE SELECTED DATE RANGE"
65 Q
Note: See TracBrowser for help on using the repository browser.