IBOCPDS ;ALB/ARH - CLERK PRODUCTIVITY REPORT (SUMMARY) ;10/8/91
;;2.0;INTEGRATED BILLING;**44,118,155,342**;21-MAR-94;Build 18
;
EN ; - Get parameters then run the report.
D ORDER^IBOCPD I IBQUIT G EXIT
D HOME^%ZIS
S IBHDR="CLERK PRODUCTIVITY SUMMARY REPORT" W @IOF,?22,IBHDR,!!
S IBFLD="Date "_$S(IBORDER="E":"Entered",IBORDER="A":"Authorized",1:"First Printed")
D RANGE^IBOCPD I IBQUIT G EXIT
;
; - Print without clerks' names?
S DIR(0)="Y",DIR("B")="NO",DIR("?")="^D HLP^IBOCPDS" W !
S DIR("A")="Do you want to print the summary without the clerks' names"
D ^DIR K DIR I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) G EXIT
S IBNCLK=+Y K DIR,DIROUT,DTOUT,DUOUT,DIRUT
;
DEV ; - Get the device.
W !!,"Report requires 132 columns."
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
K ^TMP("IB",$J),IBMRAUSR
S IBCDT=IBBEG-.001,IBE=IBEND+.3,U="^",IBQUIT=0
S IBINDX=$S(IBORDER="E":"APD",IBORDER="A":"APD3",1:"AP")
F S IBCDT=$O(^DGCR(399,IBINDX,IBCDT)) Q:IBCDT=""!(IBCDT>IBE)!IBQUIT S IFN=0 D S IBQUIT=$$STOP
.F S IFN=$O(^DGCR(399,IBINDX,IBCDT,IFN)) Q:'IFN D FILE
;
; 5/28/04 - esg - MRA project - patch 155 - get MRA request data
;
S IBCDT=IBBEG-.001,IBE=IBEND+.3
F S IBCDT=$O(^DGCR(399,"APM",IBCDT)) Q:'IBCDT!(IBCDT>IBE)!IBQUIT D
. S IBQUIT=$$STOP Q:IBQUIT
. S IFN=0
. F S IFN=$O(^DGCR(399,"APM",IBCDT,IFN)) Q:'IFN D FILEMRA
. Q
;
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
I $D(ZTQUEUED) Q
K IBE,IBBEG,IBBEGE,IBCANC,IBEND,IBENDE,IBCDT,IFN,IBRT,IBCLK,IBNCLK,IBCT
K IBTD,IBNODE,IBPGN,IBLN,IBHDR,IBINDX,IBFLD,IBQUIT,IBORDER,IBI,X,Y
K DTOUT,DUOUT,DIRUT,DIROUT,IBMRAUSR
D ^%ZISC
Q
;
FILE ; - Save the data in sorted order in a temporary file.
S IBRT=$P($G(^DGCR(399,IFN,0)),U,7) I 'IBRT Q
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
S IBTD=$P($G(^DGCR(399,IFN,"U1")),U,1)-$P($G(^DGCR(399,IFN,"U1")),U,2)
S IBCANC=($P(^DGCR(399,IFN,0),U,13)=7)
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))
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))
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))
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))
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))
;
; 7/26/04 - ESG - MRA Project - Capture division data for MRA authorizer user
I IBCLK["AUTHORIZER,IB MRA"!(IBCLK["POSTMASTER") D
. N DIV
. S DIV=+$P($G(^DGCR(399,IFN,0)),U,22) ; division pointer
. S DIV=$P($G(^DG(40.8,DIV,0)),U,1) ; division name
. I DIV="" S DIV="~UNKNOWN"
. S IBNODE=$G(IBMRAUSR(IBCLK,IBRT,DIV))
. 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))
. Q
Q
;
FILEMRA ; Capture and file MRA data into the scratch global
; 9/9/03 - ESG - MRA Project
NEW IBRT,IBTD,MRAUSR,IBNODE
S IBRT=$P($G(^DGCR(399,IFN,0)),U,7) I 'IBRT G FMX
S IBTD=$P($G(^DGCR(399,IFN,"U1")),U,1)-$P($G(^DGCR(399,IFN,"U1")),U,2)
S MRAUSR=+$P($G(^DGCR(399,IFN,"S")),U,8)
I 'MRAUSR G FMX
S MRAUSR=$P($G(^VA(200,MRAUSR,0)),U,1)
I MRAUSR="" G FMX
S IBNODE=$G(^TMP("IB",$J)),$P(^($J),U,5,6)=($P(IBNODE,U,5)+1)_U_($P(IBNODE,U,6)+IBTD)
S IBNODE=$G(^TMP("IB",$J,MRAUSR)),$P(^(MRAUSR),U,5,6)=($P(IBNODE,U,5)+1)_U_($P(IBNODE,U,6)+IBTD)
S IBNODE=$G(^TMP("IB",$J,MRAUSR,IBRT)),$P(^(IBRT),U,5,6)=($P(IBNODE,U,5)+1)_U_($P(IBNODE,U,6)+IBTD)
S IBNODE=$G(^TMP("IB",$J,"~~")),$P(^("~~"),U,5,6)=($P(IBNODE,U,5)+1)_U_($P(IBNODE,U,6)+IBTD)
S IBNODE=$G(^TMP("IB",$J,"~~",IBRT)),$P(^(IBRT),U,5,6)=($P(IBNODE,U,5)+1)_U_($P(IBNODE,U,6)+IBTD)
;
FMX ;
Q
;
;
PRINT ; - Print the report from the temp sort file to the appropriate device.
N IBT,IBH1,L1,L2,T1,T2,T3,T4,T5,T6
S IBCLK="",IBPGN=0
S L1=7 ; length of count fields
S L2=13 ; length of dollar amount fields
S T1=50 ; tab stop 1 - total count
S T2=59 ; tab stop 2 - total dollar amount
S T3=78 ; tab stop 3 - cancelled count
S T4=87 ; tab stop 4 - cancelled dollar amount
S T5=106 ; tab stop 5 - MRA request count
S T6=115 ; tab stop 6 - MRA request dollar amount
D HDR F S IBCLK=$O(^TMP("IB",$J,IBCLK)) Q:IBCLK=""!(IBQUIT) D LINE
S IBT=$G(^TMP("IB",$J)) I IBQUIT Q
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),!
D NOTE^IBOCPD,PAUSE
Q
;
LINE ; - Print all data for a particular clerk.
N IBT,DIV
S IBLN=IBLN+1 I IBNCLK S IBCT=$G(IBCT)+1
I IBCLK'="~~" W !,$S(IBNCLK:"CLERK #"_IBCT,1:$E(IBCLK,1,25))
E W !,"RATE TYPE TOTALS"
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
. S IBT=$G(^TMP("IB",$J,IBCLK,IBRT))
. 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)
. W ?T5,$J(+$P(IBT,U,5),L1),?T6,$J($P(IBT,U,6),L2,2),!
. ; divisional display
. I '$D(IBMRAUSR(IBCLK,IBRT)) Q
. W ?T1," -----",?T2," -----------",?T3," -----",?T4," -----------",?T5," -----",?T6," -----------"
. S DIV=""
. F S DIV=$O(IBMRAUSR(IBCLK,IBRT,DIV)) Q:DIV=""!IBQUIT D
.. S IBLN=IBLN+1 I IBLN>(IOSL-7) D PAUSE,HDR:'IBQUIT
.. I IBQUIT Q
.. S IBT=$G(IBMRAUSR(IBCLK,IBRT,DIV))
.. 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)
.. Q
. I IBQUIT Q
. W !
. Q
;
I IBQUIT Q
W ?T1," -----",?T2," -----------",?T3," -----",?T4," -----------"
W ?T5," -----",?T6," -----------"
S IBT=$G(^TMP("IB",$J,IBCLK))
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)
W ?T5,$J(+$P(IBT,U,5),L1),?T6,$J($P(IBT,U,6),L2,2),!
S IBLN=IBLN+2
Q
;
HDR ; - Print the report header.
N IBH1,IBH2
S IBQUIT=$$STOP Q:IBQUIT S IBPGN=IBPGN+1,IBLN=7
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
S IBH1=$S(IBORDER="E":"ENTERED",IBORDER="A":"AUTHORIZED",1:"FIRST PRINTED")
W "CLERK PRODUCTIVITY SUMMARY FOR BILLS ",IBH1," ",IBBEGE," - ",IBENDE I IOM<85 W !
S IBH2=$S(IBORDER'="P":IBH1,1:"PRINTED") S:IBORDER="E" IBH1="ENTERED/EDITED"
W ?(IOM-30),IBCDT,?(IOM-8),"PAGE ",IBPGN,!
W !,?T1,"---",$S(IBORDER'="A":"-",1:""),"TOTAL ",IBH2,"---",$S(IBORDER'="A":"--",1:""),?T3,"-",$S(IBORDER'="A":"-",1:""),IBH2," CANCELLED-",$S(IBORDER'="A":"--",1:"")
W ?T5,"-----MRA REQUESTS-----"
W !,IBH1," BY",?30,"RATE TYPE",?T1,$J("COUNT",L1),?T2,$J("AMOUNT",L2),?T3,$J("COUNT",L1),?T4,$J("AMOUNT",L2)
W ?T5,$J("COUNT",L1),?T6,$J("AMOUNT",L2),!
S IBI="",$P(IBI,"-",IOM+1)="" W IBI,!
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)
;
HLP ; - "Do you want to print..." prompt.
W !!,"Select: '<CR>' to print the summary with the clerks' actual names"
W !?11,"'Y' to print the summary with an identifier ('CLERK #xxx')"
W !?15,"in place of the clerks' names",!?11,"'^' to quit"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBOCPDS 8601 printed Oct 16, 2024@18:26:02 Page 2
IBOCPDS ;ALB/ARH - CLERK PRODUCTIVITY REPORT (SUMMARY) ;10/8/91
+1 ;;2.0;INTEGRATED BILLING;**44,118,155,342**;21-MAR-94;Build 18
+2 ;
EN ; - Get parameters then run the report.
+1 DO ORDER^IBOCPD
IF IBQUIT
GOTO EXIT
+2 DO HOME^%ZIS
+3 SET IBHDR="CLERK PRODUCTIVITY SUMMARY REPORT"
WRITE @IOF,?22,IBHDR,!!
+4 SET IBFLD="Date "_$SELECT(IBORDER="E":"Entered",IBORDER="A":"Authorized",1:"First Printed")
+5 DO RANGE^IBOCPD
IF IBQUIT
GOTO EXIT
+6 ;
+7 ; - Print without clerks' names?
+8 SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("?")="^D HLP^IBOCPDS"
WRITE !
+9 SET DIR("A")="Do you want to print the summary without the clerks' names"
+10 DO ^DIR
KILL DIR
IF $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
GOTO EXIT
+11 SET IBNCLK=+Y
KILL DIR,DIROUT,DTOUT,DUOUT,DIRUT
+12 ;
DEV ; - Get the device.
+1 WRITE !!,"Report requires 132 columns."
+2 SET %ZIS="QM"
SET %ZIS("A")="OUTPUT DEVICE: "
DO ^%ZIS
if POP
GOTO EXIT
+3 IF $DATA(IO("Q"))
SET ZTRTN="ENT^IBOCPDS"
SET ZTDESC="Clerk Productivity Summary Report"
SET ZTSAVE("IB*")=""
DO ^%ZTLOAD
KILL IO("Q")
GOTO EXIT
+4 USE IO
+5 ;***
+6 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOCPDS" D T1^%ZOSV ;stop rt clock
+7 ;
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 KILL ^TMP("IB",$JOB),IBMRAUSR
+5 SET IBCDT=IBBEG-.001
SET IBE=IBEND+.3
SET U="^"
SET IBQUIT=0
+6 SET IBINDX=$SELECT(IBORDER="E":"APD",IBORDER="A":"APD3",1:"AP")
+7 FOR
SET IBCDT=$ORDER(^DGCR(399,IBINDX,IBCDT))
if IBCDT=""!(IBCDT>IBE)!IBQUIT
QUIT
SET IFN=0
Begin DoDot:1
+8 FOR
SET IFN=$ORDER(^DGCR(399,IBINDX,IBCDT,IFN))
if 'IFN
QUIT
DO FILE
End DoDot:1
SET IBQUIT=$$STOP
+9 ;
+10 ; 5/28/04 - esg - MRA project - patch 155 - get MRA request data
+11 ;
+12 SET IBCDT=IBBEG-.001
SET IBE=IBEND+.3
+13 FOR
SET IBCDT=$ORDER(^DGCR(399,"APM",IBCDT))
if 'IBCDT!(IBCDT>IBE)!IBQUIT
QUIT
Begin DoDot:1
+14 SET IBQUIT=$$STOP
if IBQUIT
QUIT
+15 SET IFN=0
+16 FOR
SET IFN=$ORDER(^DGCR(399,"APM",IBCDT,IFN))
if 'IFN
QUIT
DO FILEMRA
+17 QUIT
End DoDot:1
+18 ;
+19 IF $DATA(^TMP("IB",$JOB))
IF 'IBQUIT
DO PRINT
+20 ;
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,IBCANC,IBEND,IBENDE,IBCDT,IFN,IBRT,IBCLK,IBNCLK,IBCT
+6 KILL IBTD,IBNODE,IBPGN,IBLN,IBHDR,IBINDX,IBFLD,IBQUIT,IBORDER,IBI,X,Y
+7 KILL DTOUT,DUOUT,DIRUT,DIROUT,IBMRAUSR
+8 DO ^%ZISC
+9 QUIT
+10 ;
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,$SELECT(IBORDER="E":2,IBORDER="A":11,IBORDER="P":13,1:0)),0)),U)
IF IBCLK=""
QUIT
+3 SET IBTD=$PIECE($GET(^DGCR(399,IFN,"U1")),U,1)-$PIECE($GET(^DGCR(399,IFN,"U1")),U,2)
+4 SET IBCANC=($PIECE(^DGCR(399,IFN,0),U,13)=7)
+5 SET IBNODE=$GET(^TMP("IB",$JOB))
SET $PIECE(^($JOB),U,1,4)=($PIECE(IBNODE,U,1)+1)_U_($PIECE(IBNODE,U,2)+IBTD)_U_($PIECE(IBNODE,U,3)+$SELECT('IBCANC:0,1:1))_U_($PIECE(IBNODE,U,4)+$SELECT('IBCANC:0,1:IBTD))
+6 SET IBNODE=$GET(^TMP("IB",$JOB,IBCLK))
SET $PIECE(^(IBCLK),U,1,4)=($PIECE(IBNODE,U,1)+1)_U_($PIECE(IBNODE,U,2)+IBTD)_U_($PIECE(IBNODE,U,3)+$SELECT('IBCANC:0,1:1))_U_($PIECE(IBNODE,U,4)+$SELECT('IBCANC:0,1:IBTD))
+7 SET IBNODE=$GET(^TMP("IB",$JOB,IBCLK,IBRT))
SET $PIECE(^(IBRT),U,1,4)=($PIECE(IBNODE,U,1)+1)_U_($PIECE(IBNODE,U,2)+IBTD)_U_($PIECE(IBNODE,U,3)+$SELECT('IBCANC:0,1:1))_U_($PIECE(IBNODE,U,4)+$SELECT('IBCANC:0,1:IBTD))
+8 SET IBNODE=$GET(^TMP("IB",$JOB,"~~"))
SET $PIECE(^("~~"),U,1,4)=($PIECE(IBNODE,U,1)+1)_U_($PIECE(IBNODE,U,2)+IBTD)_U_($PIECE(IBNODE,U,3)+$SELECT('IBCANC:0,1:1))_U_($PIECE(IBNODE,U,4)+$SELECT('IBCANC:0,1:IBTD))
+9 SET IBNODE=$GET(^TMP("IB",$JOB,"~~",IBRT))
SET $PIECE(^(IBRT),U,1,4)=($PIECE(IBNODE,U,1)+1)_U_($PIECE(IBNODE,U,2)+IBTD)_U_($PIECE(IBNODE,U,3)+$SELECT('IBCANC:0,1:1))_U_($PIECE(IBNODE,U,4)+$SELECT('IBCANC:0,1:IBTD))
+10 ;
+11 ; 7/26/04 - ESG - MRA Project - Capture division data for MRA authorizer user
+12 IF IBCLK["AUTHORIZER,IB MRA"!(IBCLK["POSTMASTER")
Begin DoDot:1
+13 NEW DIV
+14 ; division pointer
SET DIV=+$PIECE($GET(^DGCR(399,IFN,0)),U,22)
+15 ; division name
SET DIV=$PIECE($GET(^DG(40.8,DIV,0)),U,1)
+16 IF DIV=""
SET DIV="~UNKNOWN"
+17 SET IBNODE=$GET(IBMRAUSR(IBCLK,IBRT,DIV))
+18 SET $PIECE(IBMRAUSR(IBCLK,IBRT,DIV),U,1,4)=($PIECE(IBNODE,U,1)+1)_U_($PIECE(IBNODE,U,2)+IBTD)_U_($PIECE(IBNODE,U,3)+$SELECT('IBCANC:0,1:1))_U_($PIECE(IBNODE,U,4)+$SELECT('IBCANC:0,1:IBTD))
+19 QUIT
End DoDot:1
+20 QUIT
+21 ;
FILEMRA ; Capture and file MRA data into the scratch global
+1 ; 9/9/03 - ESG - MRA Project
+2 NEW IBRT,IBTD,MRAUSR,IBNODE
+3 SET IBRT=$PIECE($GET(^DGCR(399,IFN,0)),U,7)
IF 'IBRT
GOTO FMX
+4 SET IBTD=$PIECE($GET(^DGCR(399,IFN,"U1")),U,1)-$PIECE($GET(^DGCR(399,IFN,"U1")),U,2)
+5 SET MRAUSR=+$PIECE($GET(^DGCR(399,IFN,"S")),U,8)
+6 IF 'MRAUSR
GOTO FMX
+7 SET MRAUSR=$PIECE($GET(^VA(200,MRAUSR,0)),U,1)
+8 IF MRAUSR=""
GOTO FMX
+9 SET IBNODE=$GET(^TMP("IB",$JOB))
SET $PIECE(^($JOB),U,5,6)=($PIECE(IBNODE,U,5)+1)_U_($PIECE(IBNODE,U,6)+IBTD)
+10 SET IBNODE=$GET(^TMP("IB",$JOB,MRAUSR))
SET $PIECE(^(MRAUSR),U,5,6)=($PIECE(IBNODE,U,5)+1)_U_($PIECE(IBNODE,U,6)+IBTD)
+11 SET IBNODE=$GET(^TMP("IB",$JOB,MRAUSR,IBRT))
SET $PIECE(^(IBRT),U,5,6)=($PIECE(IBNODE,U,5)+1)_U_($PIECE(IBNODE,U,6)+IBTD)
+12 SET IBNODE=$GET(^TMP("IB",$JOB,"~~"))
SET $PIECE(^("~~"),U,5,6)=($PIECE(IBNODE,U,5)+1)_U_($PIECE(IBNODE,U,6)+IBTD)
+13 SET IBNODE=$GET(^TMP("IB",$JOB,"~~",IBRT))
SET $PIECE(^(IBRT),U,5,6)=($PIECE(IBNODE,U,5)+1)_U_($PIECE(IBNODE,U,6)+IBTD)
+14 ;
FMX ;
+1 QUIT
+2 ;
+3 ;
PRINT ; - Print the report from the temp sort file to the appropriate device.
+1 NEW IBT,IBH1,L1,L2,T1,T2,T3,T4,T5,T6
+2 SET IBCLK=""
SET IBPGN=0
+3 ; length of count fields
SET L1=7
+4 ; length of dollar amount fields
SET L2=13
+5 ; tab stop 1 - total count
SET T1=50
+6 ; tab stop 2 - total dollar amount
SET T2=59
+7 ; tab stop 3 - cancelled count
SET T3=78
+8 ; tab stop 4 - cancelled dollar amount
SET T4=87
+9 ; tab stop 5 - MRA request count
SET T5=106
+10 ; tab stop 6 - MRA request dollar amount
SET T6=115
+11 DO HDR
FOR
SET IBCLK=$ORDER(^TMP("IB",$JOB,IBCLK))
if IBCLK=""!(IBQUIT)
QUIT
DO LINE
+12 SET IBT=$GET(^TMP("IB",$JOB))
IF IBQUIT
QUIT
+13 WRITE !!,"TOTAL:",?T1,$JUSTIFY(+$PIECE(IBT,U,1),L1),?T2,$JUSTIFY($PIECE(IBT,U,2),L2,2),?T3,$JUSTIFY(+$PIECE(IBT,U,3),L1),?T4,$JUSTIFY($PIECE(IBT,U,4),L2,2),?T5,$JUSTIFY(+$PIECE(IBT,U,5),L1),?T6,$JUSTIFY($PIECE(IBT,U,6),L2,2),!
+14 DO NOTE^IBOCPD
DO PAUSE
+15 QUIT
+16 ;
LINE ; - Print all data for a particular clerk.
+1 NEW IBT,DIV
+2 SET IBLN=IBLN+1
IF IBNCLK
SET IBCT=$GET(IBCT)+1
+3 IF IBCLK'="~~"
WRITE !,$SELECT(IBNCLK:"CLERK #"_IBCT,1:$EXTRACT(IBCLK,1,25))
+4 IF '$TEST
WRITE !,"RATE TYPE TOTALS"
+5 SET IBRT=""
FOR
SET IBRT=$ORDER(^TMP("IB",$JOB,IBCLK,IBRT))
if IBRT=""!(IBQUIT)
QUIT
Begin DoDot:1
+6 SET IBT=$GET(^TMP("IB",$JOB,IBCLK,IBRT))
+7 WRITE ?30,$EXTRACT($PIECE(^DGCR(399.3,IBRT,0),U,1),1,20),?T1,$JUSTIFY(+$PIECE(IBT,U,1),L1),?T2,$JUSTIFY($PIECE(IBT,U,2),L2,2),?T3,$JUSTIFY(+$PIECE(IBT,U,3),L1),?T4,$JUSTIFY($PIECE(IBT,U,4),L2,2)
+8 WRITE ?T5,$JUSTIFY(+$PIECE(IBT,U,5),L1),?T6,$JUSTIFY($PIECE(IBT,U,6),L2,2),!
+9 ; divisional display
+10 IF '$DATA(IBMRAUSR(IBCLK,IBRT))
QUIT
+11 WRITE ?T1," -----",?T2," -----------",?T3," -----",?T4," -----------",?T5," -----",?T6," -----------"
+12 SET DIV=""
+13 FOR
SET DIV=$ORDER(IBMRAUSR(IBCLK,IBRT,DIV))
if DIV=""!IBQUIT
QUIT
Begin DoDot:2
+14 SET IBLN=IBLN+1
IF IBLN>(IOSL-7)
DO PAUSE
if 'IBQUIT
DO HDR
+15 IF IBQUIT
QUIT
+16 SET IBT=$GET(IBMRAUSR(IBCLK,IBRT,DIV))
+17 WRITE !?7,DIV,?T1,$JUSTIFY(+$PIECE(IBT,U,1),L1),?T2,$JUSTIFY($PIECE(IBT,U,2),L2,2),?T3,$JUSTIFY(+$PIECE(IBT,U,3),L1),?T4,$JUSTIFY($PIECE(IBT,U,4),L2,2),?T5,$JUSTIFY(+$PIECE(IBT,U,5),L1),?T6,$JUSTIFY($PIECE(IBT,U,6),L2,2)
+18 QUIT
End DoDot:2
+19 IF IBQUIT
QUIT
+20 WRITE !
+21 QUIT
End DoDot:1
if IBQUIT
QUIT
SET IBLN=IBLN+1
IF IBLN>(IOSL-7)
DO PAUSE
if 'IBQUIT
DO HDR
+22 ;
+23 IF IBQUIT
QUIT
+24 WRITE ?T1," -----",?T2," -----------",?T3," -----",?T4," -----------"
+25 WRITE ?T5," -----",?T6," -----------"
+26 SET IBT=$GET(^TMP("IB",$JOB,IBCLK))
+27 WRITE !,?30,"SUBTOTAL:",?T1,$JUSTIFY(+$PIECE(IBT,U,1),L1),?T2,$JUSTIFY($PIECE(IBT,U,2),L2,2),?T3,$JUSTIFY(+$PIECE(IBT,U,3),L1),?T4,$JUSTIFY($PIECE(IBT,U,4),L2,2)
+28 WRITE ?T5,$JUSTIFY(+$PIECE(IBT,U,5),L1),?T6,$JUSTIFY($PIECE(IBT,U,6),L2,2),!
+29 SET IBLN=IBLN+2
+30 QUIT
+31 ;
HDR ; - Print the report header.
+1 NEW IBH1,IBH2
+2 SET IBQUIT=$$STOP
if IBQUIT
QUIT
SET IBPGN=IBPGN+1
SET IBLN=7
+3 DO NOW^%DTC
SET Y=$EXTRACT(%,1,12)
DO DD^%DT
SET IBCDT=$PIECE(Y,"@",1)_" "_$PIECE(Y,"@",2)
+4 IF IBPGN>1!($EXTRACT(IOST,1,2)["C-")
WRITE @IOF
+5 SET IBH1=$SELECT(IBORDER="E":"ENTERED",IBORDER="A":"AUTHORIZED",1:"FIRST PRINTED")
+6 WRITE "CLERK PRODUCTIVITY SUMMARY FOR BILLS ",IBH1," ",IBBEGE," - ",IBENDE
IF IOM<85
WRITE !
+7 SET IBH2=$SELECT(IBORDER'="P":IBH1,1:"PRINTED")
if IBORDER="E"
SET IBH1="ENTERED/EDITED"
+8 WRITE ?(IOM-30),IBCDT,?(IOM-8),"PAGE ",IBPGN,!
+9 WRITE !,?T1,"---",$SELECT(IBORDER'="A":"-",1:""),"TOTAL ",IBH2,"---",$SELECT(IBORDER'="A":"--",1:""),?T3,"-",$SELECT(IBORDER'="A":"-",1:""),IBH2," CANCELLED-",$SELECT(IBORDER'="A":"--",1:"")
+10 WRITE ?T5,"-----MRA REQUESTS-----"
+11 WRITE !,IBH1," BY",?30,"RATE TYPE",?T1,$JUSTIFY("COUNT",L1),?T2,$JUSTIFY("AMOUNT",L2),?T3,$JUSTIFY("COUNT",L1),?T4,$JUSTIFY("AMOUNT",L2)
+12 WRITE ?T5,$JUSTIFY("COUNT",L1),?T6,$JUSTIFY("AMOUNT",L2),!
+13 SET IBI=""
SET $PIECE(IBI,"-",IOM+1)=""
WRITE IBI,!
+14 QUIT
+15 ;
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)
+3 ;
HLP ; - "Do you want to print..." prompt.
+1 WRITE !!,"Select: '<CR>' to print the summary with the clerks' actual names"
+2 WRITE !?11,"'Y' to print the summary with an identifier ('CLERK #xxx')"
+3 WRITE !?15,"in place of the clerks' names",!?11,"'^' to quit"
+4 QUIT
