IBOCPDS ;ALB/ARH - CLERK PRODUCTIVITY REPORT, SUMMARY ; 10/8/91
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;
EN ;get parameters then run the report
D HOME^%ZIS
S IBHDR="CLERK PRODUCTIVITY SUMMARY REPORT"
W @IOF,?22,IBHDR,!!
S IBFLD="Date Entered"
D RANGE^IBOCPD G:IBQUIT EXIT
W !!
DEV ;get the device
S %ZIS="QM",%ZIS("A")="OUTPUT DEVICE: " D ^%ZIS G:POP EXIT
I $D(IO("Q")) S ZTRTN="ENT^IBOCPDS",ZTDESC="Clerk Productivity Summary Report",ZTSAVE("IB*")="" D ^%ZTLOAD K IO("Q") G EXIT
U IO
;***
;I $D(XRT0) S:'$D(XRTN) XRTN="IBOCPDS" D T1^%ZOSV ;stop rt clock
ENT ;find, save, and print the data that satisfies the search parameters
;entry for tasked jobs
;***
;S XRTL=$ZU(0),XRTN="IBOCPDS-2" D T0^%ZOSV ;start rt clock
S IBCDT=IBBEG-.001,IBE=IBEND+.3,U="^",IBQUIT=0
F S IBCDT=$O(^DGCR(399,"APD",IBCDT)) Q:IBCDT=""!(IBCDT>IBE)!IBQUIT S IFN="" D S IBQUIT=$$STOP
. F S IFN=$O(^DGCR(399,"APD",IBCDT,IFN)) Q:IFN="" D FILE
I $D(^TMP("IB",$J)),'IBQUIT D PRINT
;
EXIT ;clean up and quit
K ^TMP("IB",$J)
;***
;I $D(XRT0) S:'$D(XRTN) XRTN="IBOCPDS" D T1^%ZOSV ;stop rt clock
Q:$D(ZTQUEUED)
K IBE,IBBEG,IBBEGE,IBEND,IBENDE,IBCDT,IFN,IBRT,IBCLK,IBTD,IBNODE,IBPGN,IBLN,IBHDR,IBFLD,IBQUIT,IBI,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
D ^%ZISC
Q
;
FILE ;save the data in sorted order in a temporary file
S IBRT=$P($G(^DGCR(399,IFN,0)),U,7) Q:'IBRT
S IBCLK=$P($G(^VA(200,+$P($G(^DGCR(399,IFN,"S")),U,2),0)),U,1) Q:IBCLK=""
S IBTD=$P($G(^DGCR(399,IFN,"U1")),U,1)
S IBNODE=$G(^TMP("IB",$J)),^($J)=($P(IBNODE,U,1)+1)_U_($P(IBNODE,U,2)+IBTD)
S IBNODE=$G(^TMP("IB",$J,IBCLK)),^(IBCLK)=($P(IBNODE,U,1)+1)_U_($P(IBNODE,U,2)+IBTD)
S IBNODE=$G(^TMP("IB",$J,IBCLK,IBRT)),^(IBRT)=($P(IBNODE,U,1)+1)_U_($P(IBNODE,U,2)+IBTD)
S IBNODE=$G(^TMP("IB",$J,"~~")),^("~~")=($P(IBNODE,U,1)+1)_U_($P(IBNODE,U,2)+IBTD)
S IBNODE=$G(^TMP("IB",$J,"~~",IBRT)),^(IBRT)=($P(IBNODE,U,1)+1)_U_($P(IBNODE,U,2)+IBTD)
Q
;
PRINT ;print the report from the temp sort file to the appropriate device
S IBCLK="",IBPGN=0
D HDR F S IBCLK=$O(^TMP("IB",$J,IBCLK)) Q:IBCLK=""!(IBQUIT) D LINE
W !!,"TOTAL:",?50,$J($P(^TMP("IB",$J),U,1),8),?60,$J($P(^($J),U,2),15,2),!
D:'IBQUIT PAUSE
Q
;
LINE ;print all data for a particular clerk
W !,$S(IBCLK'="~~":$E(IBCLK,1,25),1:"RATE TYPE TOTALS") S IBLN=IBLN+1
S IBRT="" F S IBRT=$O(^TMP("IB",$J,IBCLK,IBRT)) Q:IBRT=""!(IBQUIT) D S IBLN=IBLN+1 I IBLN>(IOSL-7) D PAUSE,HDR
. W ?30,$E($P(^DGCR(399.3,IBRT,0),U,1),1,20),?50,$J($P(^TMP("IB",$J,IBCLK,IBRT),U,1),8),?60,$J($P(^(IBRT),U,2),15,2),!
W ?50," ------",?60," ------------"
W !,?30,"SUBTOTAL:",?50,$J($P(^TMP("IB",$J,IBCLK),U,1),8),?60,$J($P(^(IBCLK),U,2),15,2),! S IBLN=IBLN+2
Q
;
HDR ;print the report header
S IBQUIT=$$STOP Q:IBQUIT S IBPGN=IBPGN+1,IBLN=5
D NOW^%DTC S Y=$E(%,1,12) D DD^%DT S IBCDT=$P(Y,"@",1)_" "_$P(Y,"@",2)
I IBPGN>1!($E(IOST,1,2)["C-") W @IOF
W "CLERK PRODUCTIVITY SUMMARY FOR ",IBBEGE," - ",IBENDE I IOM<85 W !
W ?(IOM-30),IBCDT,?(IOM-8),"PAGE ",IBPGN,!
W !,"ENTERED BY",?30,"RATE TYPE",?53,"COUNT",?69,"AMOUNT",!
F IBI=1:1:IOM W "-"
W !
Q
;
PAUSE ;pause at end of screen if beeing displayed on a terminal
Q:$E(IOST,1,2)'["C-"
S DIR(0)="E" D ^DIR K DIR
I $D(DUOUT)!($D(DIRUT)) S IBQUIT=1
Q
;
STOP() ;determine if user has requested the queued report to stop
I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ I +$G(IBPGN) W !,"***TASK STOPPED BY USER***"
Q +$G(ZTSTOP)
IBOCPDS ;ALB/ARH - CLERK PRODUCTIVITY REPORT, SUMMARY ; 10/8/91
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;
EN ;get parameters then run the report
+1 DO HOME^%ZIS
+2 SET IBHDR="CLERK PRODUCTIVITY SUMMARY REPORT"
+3 WRITE @IOF,?22,IBHDR,!!
+4 SET IBFLD="Date Entered"
+5 DO RANGE^IBOCPD
IF IBQUIT
GOTO EXIT
+6 WRITE !!
DEV ;get the device
+1 SET %ZIS="QM"
SET %ZIS("A")="OUTPUT DEVICE: "
DO ^%ZIS
IF POP
GOTO EXIT
+2 IF $DATA(IO("Q"))
SET ZTRTN="ENT^IBOCPDS"
SET ZTDESC="Clerk Productivity Summary Report"
SET ZTSAVE("IB*")=""
DO ^%ZTLOAD
KILL IO("Q")
GOTO EXIT
+3 USE IO
+4 ;***
+5 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOCPDS" D T1^%ZOSV ;stop rt clock
ENT ;find, save, and print the data that satisfies the search parameters
+1 ;entry for tasked jobs
+2 ;***
+3 ;S XRTL=$ZU(0),XRTN="IBOCPDS-2" D T0^%ZOSV ;start rt clock
+4 SET IBCDT=IBBEG-.001
SET IBE=IBEND+.3
SET U="^"
SET IBQUIT=0
+5 FOR
SET IBCDT=$ORDER(^DGCR(399,"APD",IBCDT))
IF IBCDT=""!(IBCDT>IBE)!IBQUIT
QUIT
SET IFN=""
Begin DoDot:1
+6 FOR
SET IFN=$ORDER(^DGCR(399,"APD",IBCDT,IFN))
IF IFN=""
QUIT
DO FILE
End DoDot:1
SET IBQUIT=$$STOP
+7 IF $DATA(^TMP("IB",$JOB))
IF 'IBQUIT
DO PRINT
+8 ;
EXIT ;clean up and quit
+1 KILL ^TMP("IB",$JOB)
+2 ;***
+3 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOCPDS" D T1^%ZOSV ;stop rt clock
+4 IF $DATA(ZTQUEUED)
QUIT
+5 KILL IBE,IBBEG,IBBEGE,IBEND,IBENDE,IBCDT,IFN,IBRT,IBCLK,IBTD,IBNODE,IBPGN,IBLN,IBHDR,IBFLD,IBQUIT,IBI,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
+6 DO ^%ZISC
+7 QUIT
+8 ;
FILE ;save the data in sorted order in a temporary file
+1 SET IBRT=$PIECE($GET(^DGCR(399,IFN,0)),U,7)
IF 'IBRT
QUIT
+2 SET IBCLK=$PIECE($GET(^VA(200,+$PIECE($GET(^DGCR(399,IFN,"S")),U,2),0)),U,1)
IF IBCLK=""
QUIT
+3 SET IBTD=$PIECE($GET(^DGCR(399,IFN,"U1")),U,1)
+4 SET IBNODE=$GET(^TMP("IB",$JOB))
SET ^($JOB)=($PIECE(IBNODE,U,1)+1)_U_($PIECE(IBNODE,U,2)+IBTD)
+5 SET IBNODE=$GET(^TMP("IB",$JOB,IBCLK))
SET ^(IBCLK)=($PIECE(IBNODE,U,1)+1)_U_($PIECE(IBNODE,U,2)+IBTD)
+6 SET IBNODE=$GET(^TMP("IB",$JOB,IBCLK,IBRT))
SET ^(IBRT)=($PIECE(IBNODE,U,1)+1)_U_($PIECE(IBNODE,U,2)+IBTD)
+7 SET IBNODE=$GET(^TMP("IB",$JOB,"~~"))
SET ^("~~")=($PIECE(IBNODE,U,1)+1)_U_($PIECE(IBNODE,U,2)+IBTD)
+8 SET IBNODE=$GET(^TMP("IB",$JOB,"~~",IBRT))
SET ^(IBRT)=($PIECE(IBNODE,U,1)+1)_U_($PIECE(IBNODE,U,2)+IBTD)
+9 QUIT
+10 ;
PRINT ;print the report from the temp sort file to the appropriate device
+1 SET IBCLK=""
SET IBPGN=0
+2 DO HDR
FOR
SET IBCLK=$ORDER(^TMP("IB",$JOB,IBCLK))
IF IBCLK=""!(IBQUIT)
QUIT
DO LINE
+3 WRITE !!,"TOTAL:",?50,$JUSTIFY($PIECE(^TMP("IB",$JOB),U,1),8),?60,$JUSTIFY($PIECE(^($JOB),U,2),15,2),!
+4 IF 'IBQUIT
DO PAUSE
+5 QUIT
+6 ;
LINE ;print all data for a particular clerk
+1 WRITE !,$SELECT(IBCLK'="~~":$EXTRACT(IBCLK,1,25),1:"RATE TYPE TOTALS")
SET IBLN=IBLN+1
+2 SET IBRT=""
FOR
SET IBRT=$ORDER(^TMP("IB",$JOB,IBCLK,IBRT))
IF IBRT=""!(IBQUIT)
QUIT
Begin DoDot:1
+3 WRITE ?30,$EXTRACT($PIECE(^DGCR(399.3,IBRT,0),U,1),1,20),?50,$JUSTIFY($PIECE(^TMP("IB",$JOB,IBCLK,IBRT),U,1),8),?60,$JUSTIFY($PIECE(^(IBRT),U,2),15,2),!
End DoDot:1
SET IBLN=IBLN+1
IF IBLN>(IOSL-7)
DO PAUSE
DO HDR
+4 WRITE ?50," ------",?60," ------------"
+5 WRITE !,?30,"SUBTOTAL:",?50,$JUSTIFY($PIECE(^TMP("IB",$JOB,IBCLK),U,1),8),?60,$JUSTIFY($PIECE(^(IBCLK),U,2),15,2),!
SET IBLN=IBLN+2
+6 QUIT
+7 ;
HDR ;print the report header
+1 SET IBQUIT=$$STOP
IF IBQUIT
QUIT
SET IBPGN=IBPGN+1
SET IBLN=5
+2 DO NOW^%DTC
SET Y=$EXTRACT(%,1,12)
DO DD^%DT
SET IBCDT=$PIECE(Y,"@",1)_" "_$PIECE(Y,"@",2)
+3 IF IBPGN>1!($EXTRACT(IOST,1,2)["C-")
WRITE @IOF
+4 WRITE "CLERK PRODUCTIVITY SUMMARY FOR ",IBBEGE," - ",IBENDE
IF IOM<85
WRITE !
+5 WRITE ?(IOM-30),IBCDT,?(IOM-8),"PAGE ",IBPGN,!
+6 WRITE !,"ENTERED BY",?30,"RATE TYPE",?53,"COUNT",?69,"AMOUNT",!
+7 FOR IBI=1:1:IOM
WRITE "-"
+8 WRITE !
+9 QUIT
+10 ;
PAUSE ;pause at end of screen if beeing displayed on a terminal
+1 IF $EXTRACT(IOST,1,2)'["C-"
QUIT
+2 SET DIR(0)="E"
DO ^DIR
KILL DIR
+3 IF $DATA(DUOUT)!($DATA(DIRUT))
SET IBQUIT=1
+4 QUIT
+5 ;
STOP() ;determine if user has requested the queued report to stop
+1 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET ZTSTOP=1
KILL ZTREQ
IF +$GET(IBPGN)
WRITE !,"***TASK STOPPED BY USER***"
+2 QUIT +$GET(ZTSTOP)
