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

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

initial load of FOIAVistA 6/30/08 version
File size: 8.2 KB
Line 
1IBOCPDS ;ALB/ARH - CLERK PRODUCTIVITY REPORT (SUMMARY) ;10/8/91
2 ;;2.0;INTEGRATED BILLING;**44,118,155,342**;21-MAR-94;Build 18
3 ;
4EN ; - Get parameters then run the report.
5 D ORDER^IBOCPD I IBQUIT G EXIT
6 D HOME^%ZIS
7 S IBHDR="CLERK PRODUCTIVITY SUMMARY REPORT" W @IOF,?22,IBHDR,!!
8 S IBFLD="Date "_$S(IBORDER="E":"Entered",IBORDER="A":"Authorized",1:"First Printed")
9 D RANGE^IBOCPD I IBQUIT G EXIT
10 ;
11 ; - Print without clerks' names?
12 S DIR(0)="Y",DIR("B")="NO",DIR("?")="^D HLP^IBOCPDS" W !
13 S DIR("A")="Do you want to print the summary without the clerks' names"
14 D ^DIR K DIR I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) G EXIT
15 S IBNCLK=+Y K DIR,DIROUT,DTOUT,DUOUT,DIRUT
16 ;
17DEV ; - Get the device.
18 W !!,"Report requires 132 columns."
19 S %ZIS="QM",%ZIS("A")="OUTPUT DEVICE: " D ^%ZIS G:POP EXIT
20 I $D(IO("Q")) S ZTRTN="ENT^IBOCPDS",ZTDESC="Clerk Productivity Summary Report",ZTSAVE("IB*")="" D ^%ZTLOAD K IO("Q") G EXIT
21 U IO
22 ;***
23 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOCPDS" D T1^%ZOSV ;stop rt clock
24 ;
25ENT ; - Find, save, and print the data that satisfies the search parameters
26 ; entry for tasked jobs.
27 ;***
28 ;S XRTL=$ZU(0),XRTN="IBOCPDS-2" D T0^%ZOSV ;start rt clock
29 K ^TMP("IB",$J),IBMRAUSR
30 S IBCDT=IBBEG-.001,IBE=IBEND+.3,U="^",IBQUIT=0
31 S IBINDX=$S(IBORDER="E":"APD",IBORDER="A":"APD3",1:"AP")
32 F S IBCDT=$O(^DGCR(399,IBINDX,IBCDT)) Q:IBCDT=""!(IBCDT>IBE)!IBQUIT S IFN=0 D S IBQUIT=$$STOP
33 .F S IFN=$O(^DGCR(399,IBINDX,IBCDT,IFN)) Q:'IFN D FILE
34 ;
35 ; 5/28/04 - esg - MRA project - patch 155 - get MRA request data
36 ;
37 S IBCDT=IBBEG-.001,IBE=IBEND+.3
38 F S IBCDT=$O(^DGCR(399,"APM",IBCDT)) Q:'IBCDT!(IBCDT>IBE)!IBQUIT D
39 . S IBQUIT=$$STOP Q:IBQUIT
40 . S IFN=0
41 . F S IFN=$O(^DGCR(399,"APM",IBCDT,IFN)) Q:'IFN D FILEMRA
42 . Q
43 ;
44 I $D(^TMP("IB",$J)),'IBQUIT D PRINT
45 ;
46EXIT ; - Clean up and quit.
47 K ^TMP("IB",$J)
48 ;***
49 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOCPDS" D T1^%ZOSV ;stop rt clock
50 I $D(ZTQUEUED) Q
51 K IBE,IBBEG,IBBEGE,IBCANC,IBEND,IBENDE,IBCDT,IFN,IBRT,IBCLK,IBNCLK,IBCT
52 K IBTD,IBNODE,IBPGN,IBLN,IBHDR,IBINDX,IBFLD,IBQUIT,IBORDER,IBI,X,Y
53 K DTOUT,DUOUT,DIRUT,DIROUT,IBMRAUSR
54 D ^%ZISC
55 Q
56 ;
57FILE ; - Save the data in sorted order in a temporary file.
58 S IBRT=$P($G(^DGCR(399,IFN,0)),U,7) I 'IBRT Q
59 S IBCLK=$P($G(^VA(200,+$P($G(^DGCR(399,IFN,"S")),U,$S(IBORDER="E":2,IBORDER="A":11,IBORDER="P":13,1:0)),0)),U) I IBCLK="" Q
60 S IBTD=$P($G(^DGCR(399,IFN,"U1")),U,1)-$P($G(^DGCR(399,IFN,"U1")),U,2)
61 S IBCANC=($P(^DGCR(399,IFN,0),U,13)=7)
62 S IBNODE=$G(^TMP("IB",$J)),$P(^($J),U,1,4)=($P(IBNODE,U,1)+1)_U_($P(IBNODE,U,2)+IBTD)_U_($P(IBNODE,U,3)+$S('IBCANC:0,1:1))_U_($P(IBNODE,U,4)+$S('IBCANC:0,1:IBTD))
63 S IBNODE=$G(^TMP("IB",$J,IBCLK)),$P(^(IBCLK),U,1,4)=($P(IBNODE,U,1)+1)_U_($P(IBNODE,U,2)+IBTD)_U_($P(IBNODE,U,3)+$S('IBCANC:0,1:1))_U_($P(IBNODE,U,4)+$S('IBCANC:0,1:IBTD))
64 S IBNODE=$G(^TMP("IB",$J,IBCLK,IBRT)),$P(^(IBRT),U,1,4)=($P(IBNODE,U,1)+1)_U_($P(IBNODE,U,2)+IBTD)_U_($P(IBNODE,U,3)+$S('IBCANC:0,1:1))_U_($P(IBNODE,U,4)+$S('IBCANC:0,1:IBTD))
65 S IBNODE=$G(^TMP("IB",$J,"~~")),$P(^("~~"),U,1,4)=($P(IBNODE,U,1)+1)_U_($P(IBNODE,U,2)+IBTD)_U_($P(IBNODE,U,3)+$S('IBCANC:0,1:1))_U_($P(IBNODE,U,4)+$S('IBCANC:0,1:IBTD))
66 S IBNODE=$G(^TMP("IB",$J,"~~",IBRT)),$P(^(IBRT),U,1,4)=($P(IBNODE,U,1)+1)_U_($P(IBNODE,U,2)+IBTD)_U_($P(IBNODE,U,3)+$S('IBCANC:0,1:1))_U_($P(IBNODE,U,4)+$S('IBCANC:0,1:IBTD))
67 ;
68 ; 7/26/04 - ESG - MRA Project - Capture division data for MRA authorizer user
69 I IBCLK["AUTHORIZER,IB MRA"!(IBCLK["POSTMASTER") D
70 . N DIV
71 . S DIV=+$P($G(^DGCR(399,IFN,0)),U,22) ; division pointer
72 . S DIV=$P($G(^DG(40.8,DIV,0)),U,1) ; division name
73 . I DIV="" S DIV="~UNKNOWN"
74 . S IBNODE=$G(IBMRAUSR(IBCLK,IBRT,DIV))
75 . S $P(IBMRAUSR(IBCLK,IBRT,DIV),U,1,4)=($P(IBNODE,U,1)+1)_U_($P(IBNODE,U,2)+IBTD)_U_($P(IBNODE,U,3)+$S('IBCANC:0,1:1))_U_($P(IBNODE,U,4)+$S('IBCANC:0,1:IBTD))
76 . Q
77 Q
78 ;
79FILEMRA ; Capture and file MRA data into the scratch global
80 ; 9/9/03 - ESG - MRA Project
81 NEW IBRT,IBTD,MRAUSR,IBNODE
82 S IBRT=$P($G(^DGCR(399,IFN,0)),U,7) I 'IBRT G FMX
83 S IBTD=$P($G(^DGCR(399,IFN,"U1")),U,1)-$P($G(^DGCR(399,IFN,"U1")),U,2)
84 S MRAUSR=+$P($G(^DGCR(399,IFN,"S")),U,8)
85 I 'MRAUSR G FMX
86 S MRAUSR=$P($G(^VA(200,MRAUSR,0)),U,1)
87 I MRAUSR="" G FMX
88 S IBNODE=$G(^TMP("IB",$J)),$P(^($J),U,5,6)=($P(IBNODE,U,5)+1)_U_($P(IBNODE,U,6)+IBTD)
89 S IBNODE=$G(^TMP("IB",$J,MRAUSR)),$P(^(MRAUSR),U,5,6)=($P(IBNODE,U,5)+1)_U_($P(IBNODE,U,6)+IBTD)
90 S IBNODE=$G(^TMP("IB",$J,MRAUSR,IBRT)),$P(^(IBRT),U,5,6)=($P(IBNODE,U,5)+1)_U_($P(IBNODE,U,6)+IBTD)
91 S IBNODE=$G(^TMP("IB",$J,"~~")),$P(^("~~"),U,5,6)=($P(IBNODE,U,5)+1)_U_($P(IBNODE,U,6)+IBTD)
92 S IBNODE=$G(^TMP("IB",$J,"~~",IBRT)),$P(^(IBRT),U,5,6)=($P(IBNODE,U,5)+1)_U_($P(IBNODE,U,6)+IBTD)
93 ;
94FMX ;
95 Q
96 ;
97 ;
98PRINT ; - Print the report from the temp sort file to the appropriate device.
99 N IBT,IBH1,L1,L2,T1,T2,T3,T4,T5,T6
100 S IBCLK="",IBPGN=0
101 S L1=7 ; length of count fields
102 S L2=13 ; length of dollar amount fields
103 S T1=50 ; tab stop 1 - total count
104 S T2=59 ; tab stop 2 - total dollar amount
105 S T3=78 ; tab stop 3 - cancelled count
106 S T4=87 ; tab stop 4 - cancelled dollar amount
107 S T5=106 ; tab stop 5 - MRA request count
108 S T6=115 ; tab stop 6 - MRA request dollar amount
109 D HDR F S IBCLK=$O(^TMP("IB",$J,IBCLK)) Q:IBCLK=""!(IBQUIT) D LINE
110 S IBT=$G(^TMP("IB",$J)) I IBQUIT Q
111 W !!,"TOTAL:",?T1,$J(+$P(IBT,U,1),L1),?T2,$J($P(IBT,U,2),L2,2),?T3,$J(+$P(IBT,U,3),L1),?T4,$J($P(IBT,U,4),L2,2),?T5,$J(+$P(IBT,U,5),L1),?T6,$J($P(IBT,U,6),L2,2),!
112 D NOTE^IBOCPD,PAUSE
113 Q
114 ;
115LINE ; - Print all data for a particular clerk.
116 N IBT,DIV
117 S IBLN=IBLN+1 I IBNCLK S IBCT=$G(IBCT)+1
118 I IBCLK'="~~" W !,$S(IBNCLK:"CLERK #"_IBCT,1:$E(IBCLK,1,25))
119 E W !,"RATE TYPE TOTALS"
120 S IBRT="" F S IBRT=$O(^TMP("IB",$J,IBCLK,IBRT)) Q:IBRT=""!(IBQUIT) D Q:IBQUIT S IBLN=IBLN+1 I IBLN>(IOSL-7) D PAUSE,HDR:'IBQUIT
121 . S IBT=$G(^TMP("IB",$J,IBCLK,IBRT))
122 . W ?30,$E($P(^DGCR(399.3,IBRT,0),U,1),1,20),?T1,$J(+$P(IBT,U,1),L1),?T2,$J($P(IBT,U,2),L2,2),?T3,$J(+$P(IBT,U,3),L1),?T4,$J($P(IBT,U,4),L2,2)
123 . W ?T5,$J(+$P(IBT,U,5),L1),?T6,$J($P(IBT,U,6),L2,2),!
124 . ; divisional display
125 . I '$D(IBMRAUSR(IBCLK,IBRT)) Q
126 . W ?T1," -----",?T2," -----------",?T3," -----",?T4," -----------",?T5," -----",?T6," -----------"
127 . S DIV=""
128 . F S DIV=$O(IBMRAUSR(IBCLK,IBRT,DIV)) Q:DIV=""!IBQUIT D
129 .. S IBLN=IBLN+1 I IBLN>(IOSL-7) D PAUSE,HDR:'IBQUIT
130 .. I IBQUIT Q
131 .. S IBT=$G(IBMRAUSR(IBCLK,IBRT,DIV))
132 .. W !?7,DIV,?T1,$J(+$P(IBT,U,1),L1),?T2,$J($P(IBT,U,2),L2,2),?T3,$J(+$P(IBT,U,3),L1),?T4,$J($P(IBT,U,4),L2,2),?T5,$J(+$P(IBT,U,5),L1),?T6,$J($P(IBT,U,6),L2,2)
133 .. Q
134 . I IBQUIT Q
135 . W !
136 . Q
137 ;
138 I IBQUIT Q
139 W ?T1," -----",?T2," -----------",?T3," -----",?T4," -----------"
140 W ?T5," -----",?T6," -----------"
141 S IBT=$G(^TMP("IB",$J,IBCLK))
142 W !,?30,"SUBTOTAL:",?T1,$J(+$P(IBT,U,1),L1),?T2,$J($P(IBT,U,2),L2,2),?T3,$J(+$P(IBT,U,3),L1),?T4,$J($P(IBT,U,4),L2,2)
143 W ?T5,$J(+$P(IBT,U,5),L1),?T6,$J($P(IBT,U,6),L2,2),!
144 S IBLN=IBLN+2
145 Q
146 ;
147HDR ; - Print the report header.
148 N IBH1,IBH2
149 S IBQUIT=$$STOP Q:IBQUIT S IBPGN=IBPGN+1,IBLN=7
150 D NOW^%DTC S Y=$E(%,1,12) D DD^%DT S IBCDT=$P(Y,"@",1)_" "_$P(Y,"@",2)
151 I IBPGN>1!($E(IOST,1,2)["C-") W @IOF
152 S IBH1=$S(IBORDER="E":"ENTERED",IBORDER="A":"AUTHORIZED",1:"FIRST PRINTED")
153 W "CLERK PRODUCTIVITY SUMMARY FOR BILLS ",IBH1," ",IBBEGE," - ",IBENDE I IOM<85 W !
154 S IBH2=$S(IBORDER'="P":IBH1,1:"PRINTED") S:IBORDER="E" IBH1="ENTERED/EDITED"
155 W ?(IOM-30),IBCDT,?(IOM-8),"PAGE ",IBPGN,!
156 W !,?T1,"---",$S(IBORDER'="A":"-",1:""),"TOTAL ",IBH2,"---",$S(IBORDER'="A":"--",1:""),?T3,"-",$S(IBORDER'="A":"-",1:""),IBH2," CANCELLED-",$S(IBORDER'="A":"--",1:"")
157 W ?T5,"-----MRA REQUESTS-----"
158 W !,IBH1," BY",?30,"RATE TYPE",?T1,$J("COUNT",L1),?T2,$J("AMOUNT",L2),?T3,$J("COUNT",L1),?T4,$J("AMOUNT",L2)
159 W ?T5,$J("COUNT",L1),?T6,$J("AMOUNT",L2),!
160 S IBI="",$P(IBI,"-",IOM+1)="" W IBI,!
161 Q
162 ;
163PAUSE ; - Pause at end of screen if beeing displayed on a terminal.
164 Q:$E(IOST,1,2)'["C-"
165 S DIR(0)="E" D ^DIR K DIR
166 I $D(DUOUT)!($D(DIRUT)) S IBQUIT=1
167 Q
168 ;
169STOP() ; - Determine if user has requested the queued report to stop.
170 I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ I +$G(IBPGN) W !,"***TASK STOPPED BY USER***"
171 Q +$G(ZTSTOP)
172 ;
173HLP ; - "Do you want to print..." prompt.
174 W !!,"Select: '<CR>' to print the summary with the clerks' actual names"
175 W !?11,"'Y' to print the summary with an identifier ('CLERK #xxx')"
176 W !?15,"in place of the clerks' names",!?11,"'^' to quit"
177 Q
Note: See TracBrowser for help on using the repository browser.