IBOCPDS.m

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)