IBJDF82 ;ALB/RRG - AR PRODUCTIVITY REPORT (PRINT) ;29-AUG-00
;;2.0;INTEGRATED BILLING;**123,159**;21-MAR-94
;
EN ; - Print the AR Productivity Report
;
S IBQ=0 D NOW^%DTC S IBRUN=$$DAT2^IBOUTL(%)
;
I '$D(^TMP("IBJDF8SUM",$J)) D G ENQ
. D @($S(IBRPT="D":"HDRD",1:"HDRS"))
. W !!,"There is no AR Productivity information for the parameters selected."
. D PAUSE
;
; - Summary report was selected
I IBRPT="S" G SUM
;
S IBPAG=0 D HDRD G:IBQ ENQ
;
S (IBCLNAM,IBBLNUM,IBTRXNUM)="",CLIDENT=0
F S IBCLNAM=$O(^TMP("IBJDF8",$J,IBCLNAM)) Q:IBCLNAM="" D Q:IBQ
. I IBPNI="I" S CLIDENT=CLIDENT+1
. I $Y>(IOSL-6) D PAUSE Q:IBQ D HDRD Q:IBQ
. D WCLK
. F S IBBLNUM=$O(^TMP("IBJDF8",$J,IBCLNAM,IBBLNUM)) Q:IBBLNUM="" D Q:IBQ
. . F S IBTRXNUM=$O(^TMP("IBJDF8",$J,IBCLNAM,IBBLNUM,IBTRXNUM)) Q:IBTRXNUM="" D Q:IBQ
. . . S IBTRXDAT=$G(^TMP("IBJDF8",$J,IBCLNAM,IBBLNUM,IBTRXNUM)),IBFLG=1
. . . ;
. . . ; - Page Break
. . . I $Y>(IOSL-6) D PAUSE Q:IBQ D HDRD,WCLK Q:IBQ
. . . ;
. . . ; - Bill, Trx Date, Debtor, Trx Type, Trx Amount
. . . W !,$P(IBTRXDAT,"^",1),?13,$$DAT1^IBOUTL($P(IBTRXDAT,"^",2))
. . . W ?23,$E($P(IBTRXDAT,"^",3),1,28)
. . . W ?53,$E($P(IBTRXDAT,"^",4),1,20)
. . . W ?75,$J($FN($P(IBTRXDAT,"^",5),",",2),11)
. . . ;
. . . ; - Current Balance, Follow-up date, Trx Number
. . . W ?90,$J($FN($P(IBTRXDAT,"^",6),",",2),11)
. . . W ?104,$$DAT1^IBOUTL($P(IBTRXDAT,"^",7))
. . . W ?115,$S(IBTRXNUM:IBTRXNUM,1:"N/A")
. . . ;
. . . ; - Most recent brief comment
. . . I $P(IBTRXDAT,"^",8)'="" D
. . . . W !,?13,"COMMENT: ",?22,$E($P(IBTRXDAT,"^",8),1,90)
. W !
;
G ENQ:IBQ D PAUSE G ENQ:IBQ
;
SUM ; - Print Summary Report
;
D HDRS G ENQ:IBQ
;
S (IBCNT1,IBTOT1,CLIDENT)=0
I IBSPT=1 D
. S CLNAM="" F S CLNAM=$O(^TMP("IBJDF8SUM",$J,CLNAM)) Q:CLNAM="" D Q:IBQ
. . I IBPNI="I" S CLIDENT=CLIDENT+1
. . I $Y>(IOSL-7) D PAUSE Q:IBQ D HDRS Q:IBQ
. . W !,$S(IBPNI="I":"CLERK # "_CLIDENT,1:CLNAM)
. . S (IBCNT,IBTOT)=0,TRXCAT=""
. . F S TRXCAT=$O(^TMP("IBJDF8SUM",$J,CLNAM,TRXCAT)) Q:TRXCAT="" D Q:IBQ
. . . I $Y>(IOSL-6) D PAUSE Q:IBQ D HDRS Q:IBQ W !,$S(IBPNI="I":"CLERK # "_CLIDENT,1:CLNAM)
. . . S SUMDAT=^TMP("IBJDF8SUM",$J,CLNAM,TRXCAT)
. . . W ?25,$P(SUMDAT,"^",3),?50,$J($P(SUMDAT,"^",1),12)
. . . W ?65,$J($FN($P(SUMDAT,"^",2),",",2),15),!
. . . S IBQ=$$STOP^IBOUTL("AR Productivity Report")
. . . S IBCNT=IBCNT+SUMDAT,IBTOT=IBTOT+$P(SUMDAT,"^",2)
. . ;
. . D WTOT
. I IBCNT1>1 D WTOT1
;
G ENQ:IBQ
;
I IBSPT=0 D
. S (IBCNT,IBTOT)=0,TRXCAT=""
. F S TRXCAT=$O(IB(TRXCAT)) Q:TRXCAT="" D
. . S SUMDAT=IB(TRXCAT) I $P(SUMDAT,"^",1)=0 Q
. . W !,?25,$P(SUMDAT,"^",3),?50,$J($P(SUMDAT,"^",1),12)
. . W ?65,$J($FN($P(SUMDAT,"^",2),",",2),15)
. . S IBCNT=IBCNT+SUMDAT,IBTOT=IBTOT+$P(SUMDAT,"^",2)
. W ! D WTOT
;
D PAUSE
;
ENQ K IBCNT,IBCNT1,IBFLG,IBDFN,IBILL,IBKEY,IBPAT,IBPAG,IBQ,IBRUN,IBRP
K IBTOT,IBTOT1,%,SUMDAT,CLIDENT,TRXCAT,IBCLNAM,IBTRXNUM,IBTRXDAT
K CLNAM,IBBLNUM
Q
;
WCLK ; - Print Clerk Name or Identifier
W !,$S(IBPNI="I":"CLERK # "_CLIDENT,1:IBCLNAM)
Q
;
WTOT ; Write the Totals by Clerk
;
S IBCNT1=IBCNT1+IBCNT,IBTOT1=IBTOT1+IBTOT
I IBCNT'>1 S (IBCNT,IBTOT)=0 Q
W ?53,"---------",?67,"-------------"
W !?50,$J(IBCNT,12),?65,$J($FN(IBTOT,",",2),15),!
S (IBCNT,IBTOT)=0
Q
;
WTOT1 ; Write the Grand Totals
;
W !?53,"---------",?67,"-------------"
W !?25,"GRAND TOTALS",?50,$J(IBCNT1,12),?65,$J($FN(IBTOT1,",",2),15),!
Q
;
HDRD ; - Prints the Detailed Report Header
;
W @IOF,*13 S IBPAG=$G(IBPAG)+1
W !,"AR Productivity Report",?60,"Run Date: ",IBRUN
W ?123,"Page: ",$J(IBPAG,3)
W !,"From: ",?7,IBF,?20,"to",?23,IBT
W ?60,"Detail By ",?70,$S(IBPNI="N":"Clerk Name",1:"Clerk Identifier")
;
W !!,?13,"Trx.",?53,"Transaction",?75,"Transaction",?90,"Current"
W ?104,"Follow-Up",?115,"Transaction"
W !,"Bill Number",?13,"Date",?23,"Debtor",?53,"Type",?75,"Amount"
W ?90,"Balance",?104,"Date",?115,"Number"
W !,$$DASH(132,0) S IBQ=$$STOP^IBOUTL("AR Productivity Report")
Q
;
HDRS ; - Prints the Summary Report Header
;
N X
W @IOF,$C(13) W !?26,"SUMMARY AR PRODUCTIVITY REPORT"
S X=" From "_IBF_" to "_IBT
W !?(80-$L(X)/2+1),X,!!?(80-$L(IBRUN)/2+1),IBRUN
S X="",$P(X,"=",$L(IBRUN))="" W !?(80-$L(IBRUN)/2+1),X
W !!,$S(IBSPT=1:"Clerk",1:""),?25,"Transaction Category"
W ?50,"Total Number",?64,"Total Dollar Amt"
W !,$$DASH(80,0) S IBQ=$$STOP^IBOUTL("AR Productivity Report")
Q
;
DASH(X,Y) ; - Return a dashed line.
; Input: X=Number of Columns (80 or 132), Y=Char to be printed
;
Q $TR($J("",X)," ",$S(Y:"-",1:"="))
;
PAUSE ; - Page break.
;
I $E(IOST,1,2)'="C-" Q
N IBX,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
F IBX=$Y:1:(IOSL-3) W !
S DIR(0)="E" D ^DIR S:$D(DIRUT)!($D(DUOUT)) IBQ=1
Q
;
DT(X) ; - Return date.
; Input: X=Date in Fileman format
; Output: Z=Date in MMDDYY format
;
Q $E(X,4,7)_$E(X,2,3)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBJDF82 5000 printed Nov 22, 2024@17:33:12 Page 2
IBJDF82 ;ALB/RRG - AR PRODUCTIVITY REPORT (PRINT) ;29-AUG-00
+1 ;;2.0;INTEGRATED BILLING;**123,159**;21-MAR-94
+2 ;
EN ; - Print the AR Productivity Report
+1 ;
+2 SET IBQ=0
DO NOW^%DTC
SET IBRUN=$$DAT2^IBOUTL(%)
+3 ;
+4 IF '$DATA(^TMP("IBJDF8SUM",$JOB))
Begin DoDot:1
+5 DO @($SELECT(IBRPT="D":"HDRD",1:"HDRS"))
+6 WRITE !!,"There is no AR Productivity information for the parameters selected."
+7 DO PAUSE
End DoDot:1
GOTO ENQ
+8 ;
+9 ; - Summary report was selected
+10 IF IBRPT="S"
GOTO SUM
+11 ;
+12 SET IBPAG=0
DO HDRD
if IBQ
GOTO ENQ
+13 ;
+14 SET (IBCLNAM,IBBLNUM,IBTRXNUM)=""
SET CLIDENT=0
+15 FOR
SET IBCLNAM=$ORDER(^TMP("IBJDF8",$JOB,IBCLNAM))
if IBCLNAM=""
QUIT
Begin DoDot:1
+16 IF IBPNI="I"
SET CLIDENT=CLIDENT+1
+17 IF $Y>(IOSL-6)
DO PAUSE
if IBQ
QUIT
DO HDRD
if IBQ
QUIT
+18 DO WCLK
+19 FOR
SET IBBLNUM=$ORDER(^TMP("IBJDF8",$JOB,IBCLNAM,IBBLNUM))
if IBBLNUM=""
QUIT
Begin DoDot:2
+20 FOR
SET IBTRXNUM=$ORDER(^TMP("IBJDF8",$JOB,IBCLNAM,IBBLNUM,IBTRXNUM))
if IBTRXNUM=""
QUIT
Begin DoDot:3
+21 SET IBTRXDAT=$GET(^TMP("IBJDF8",$JOB,IBCLNAM,IBBLNUM,IBTRXNUM))
SET IBFLG=1
+22 ;
+23 ; - Page Break
+24 IF $Y>(IOSL-6)
DO PAUSE
if IBQ
QUIT
DO HDRD
DO WCLK
if IBQ
QUIT
+25 ;
+26 ; - Bill, Trx Date, Debtor, Trx Type, Trx Amount
+27 WRITE !,$PIECE(IBTRXDAT,"^",1),?13,$$DAT1^IBOUTL($PIECE(IBTRXDAT,"^",2))
+28 WRITE ?23,$EXTRACT($PIECE(IBTRXDAT,"^",3),1,28)
+29 WRITE ?53,$EXTRACT($PIECE(IBTRXDAT,"^",4),1,20)
+30 WRITE ?75,$JUSTIFY($FNUMBER($PIECE(IBTRXDAT,"^",5),",",2),11)
+31 ;
+32 ; - Current Balance, Follow-up date, Trx Number
+33 WRITE ?90,$JUSTIFY($FNUMBER($PIECE(IBTRXDAT,"^",6),",",2),11)
+34 WRITE ?104,$$DAT1^IBOUTL($PIECE(IBTRXDAT,"^",7))
+35 WRITE ?115,$SELECT(IBTRXNUM:IBTRXNUM,1:"N/A")
+36 ;
+37 ; - Most recent brief comment
+38 IF $PIECE(IBTRXDAT,"^",8)'=""
Begin DoDot:4
+39 WRITE !,?13,"COMMENT: ",?22,$EXTRACT($PIECE(IBTRXDAT,"^",8),1,90)
End DoDot:4
End DoDot:3
if IBQ
QUIT
End DoDot:2
if IBQ
QUIT
+40 WRITE !
End DoDot:1
if IBQ
QUIT
+41 ;
+42 if IBQ
GOTO ENQ
DO PAUSE
if IBQ
GOTO ENQ
+43 ;
SUM ; - Print Summary Report
+1 ;
+2 DO HDRS
if IBQ
GOTO ENQ
+3 ;
+4 SET (IBCNT1,IBTOT1,CLIDENT)=0
+5 IF IBSPT=1
Begin DoDot:1
+6 SET CLNAM=""
FOR
SET CLNAM=$ORDER(^TMP("IBJDF8SUM",$JOB,CLNAM))
if CLNAM=""
QUIT
Begin DoDot:2
+7 IF IBPNI="I"
SET CLIDENT=CLIDENT+1
+8 IF $Y>(IOSL-7)
DO PAUSE
if IBQ
QUIT
DO HDRS
if IBQ
QUIT
+9 WRITE !,$SELECT(IBPNI="I":"CLERK # "_CLIDENT,1:CLNAM)
+10 SET (IBCNT,IBTOT)=0
SET TRXCAT=""
+11 FOR
SET TRXCAT=$ORDER(^TMP("IBJDF8SUM",$JOB,CLNAM,TRXCAT))
if TRXCAT=""
QUIT
Begin DoDot:3
+12 IF $Y>(IOSL-6)
DO PAUSE
if IBQ
QUIT
DO HDRS
if IBQ
QUIT
WRITE !,$SELECT(IBPNI="I":"CLERK # "_CLIDENT,1:CLNAM)
+13 SET SUMDAT=^TMP("IBJDF8SUM",$JOB,CLNAM,TRXCAT)
+14 WRITE ?25,$PIECE(SUMDAT,"^",3),?50,$JUSTIFY($PIECE(SUMDAT,"^",1),12)
+15 WRITE ?65,$JUSTIFY($FNUMBER($PIECE(SUMDAT,"^",2),",",2),15),!
+16 SET IBQ=$$STOP^IBOUTL("AR Productivity Report")
+17 SET IBCNT=IBCNT+SUMDAT
SET IBTOT=IBTOT+$PIECE(SUMDAT,"^",2)
End DoDot:3
if IBQ
QUIT
+18 ;
+19 DO WTOT
End DoDot:2
if IBQ
QUIT
+20 IF IBCNT1>1
DO WTOT1
End DoDot:1
+21 ;
+22 if IBQ
GOTO ENQ
+23 ;
+24 IF IBSPT=0
Begin DoDot:1
+25 SET (IBCNT,IBTOT)=0
SET TRXCAT=""
+26 FOR
SET TRXCAT=$ORDER(IB(TRXCAT))
if TRXCAT=""
QUIT
Begin DoDot:2
+27 SET SUMDAT=IB(TRXCAT)
IF $PIECE(SUMDAT,"^",1)=0
QUIT
+28 WRITE !,?25,$PIECE(SUMDAT,"^",3),?50,$JUSTIFY($PIECE(SUMDAT,"^",1),12)
+29 WRITE ?65,$JUSTIFY($FNUMBER($PIECE(SUMDAT,"^",2),",",2),15)
+30 SET IBCNT=IBCNT+SUMDAT
SET IBTOT=IBTOT+$PIECE(SUMDAT,"^",2)
End DoDot:2
+31 WRITE !
DO WTOT
End DoDot:1
+32 ;
+33 DO PAUSE
+34 ;
ENQ KILL IBCNT,IBCNT1,IBFLG,IBDFN,IBILL,IBKEY,IBPAT,IBPAG,IBQ,IBRUN,IBRP
+1 KILL IBTOT,IBTOT1,%,SUMDAT,CLIDENT,TRXCAT,IBCLNAM,IBTRXNUM,IBTRXDAT
+2 KILL CLNAM,IBBLNUM
+3 QUIT
+4 ;
WCLK ; - Print Clerk Name or Identifier
+1 WRITE !,$SELECT(IBPNI="I":"CLERK # "_CLIDENT,1:IBCLNAM)
+2 QUIT
+3 ;
WTOT ; Write the Totals by Clerk
+1 ;
+2 SET IBCNT1=IBCNT1+IBCNT
SET IBTOT1=IBTOT1+IBTOT
+3 IF IBCNT'>1
SET (IBCNT,IBTOT)=0
QUIT
+4 WRITE ?53,"---------",?67,"-------------"
+5 WRITE !?50,$JUSTIFY(IBCNT,12),?65,$JUSTIFY($FNUMBER(IBTOT,",",2),15),!
+6 SET (IBCNT,IBTOT)=0
+7 QUIT
+8 ;
WTOT1 ; Write the Grand Totals
+1 ;
+2 WRITE !?53,"---------",?67,"-------------"
+3 WRITE !?25,"GRAND TOTALS",?50,$JUSTIFY(IBCNT1,12),?65,$JUSTIFY($FNUMBER(IBTOT1,",",2),15),!
+4 QUIT
+5 ;
HDRD ; - Prints the Detailed Report Header
+1 ;
+2 WRITE @IOF,*13
SET IBPAG=$GET(IBPAG)+1
+3 WRITE !,"AR Productivity Report",?60,"Run Date: ",IBRUN
+4 WRITE ?123,"Page: ",$JUSTIFY(IBPAG,3)
+5 WRITE !,"From: ",?7,IBF,?20,"to",?23,IBT
+6 WRITE ?60,"Detail By ",?70,$SELECT(IBPNI="N":"Clerk Name",1:"Clerk Identifier")
+7 ;
+8 WRITE !!,?13,"Trx.",?53,"Transaction",?75,"Transaction",?90,"Current"
+9 WRITE ?104,"Follow-Up",?115,"Transaction"
+10 WRITE !,"Bill Number",?13,"Date",?23,"Debtor",?53,"Type",?75,"Amount"
+11 WRITE ?90,"Balance",?104,"Date",?115,"Number"
+12 WRITE !,$$DASH(132,0)
SET IBQ=$$STOP^IBOUTL("AR Productivity Report")
+13 QUIT
+14 ;
HDRS ; - Prints the Summary Report Header
+1 ;
+2 NEW X
+3 WRITE @IOF,$CHAR(13)
WRITE !?26,"SUMMARY AR PRODUCTIVITY REPORT"
+4 SET X=" From "_IBF_" to "_IBT
+5 WRITE !?(80-$LENGTH(X)/2+1),X,!!?(80-$LENGTH(IBRUN)/2+1),IBRUN
+6 SET X=""
SET $PIECE(X,"=",$LENGTH(IBRUN))=""
WRITE !?(80-$LENGTH(IBRUN)/2+1),X
+7 WRITE !!,$SELECT(IBSPT=1:"Clerk",1:""),?25,"Transaction Category"
+8 WRITE ?50,"Total Number",?64,"Total Dollar Amt"
+9 WRITE !,$$DASH(80,0)
SET IBQ=$$STOP^IBOUTL("AR Productivity Report")
+10 QUIT
+11 ;
DASH(X,Y) ; - Return a dashed line.
+1 ; Input: X=Number of Columns (80 or 132), Y=Char to be printed
+2 ;
+3 QUIT $TRANSLATE($JUSTIFY("",X)," ",$SELECT(Y:"-",1:"="))
+4 ;
PAUSE ; - Page break.
+1 ;
+2 IF $EXTRACT(IOST,1,2)'="C-"
QUIT
+3 NEW IBX,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
+4 FOR IBX=$Y:1:(IOSL-3)
WRITE !
+5 SET DIR(0)="E"
DO ^DIR
if $DATA(DIRUT)!($DATA(DUOUT))
SET IBQ=1
+6 QUIT
+7 ;
DT(X) ; - Return date.
+1 ; Input: X=Date in Fileman format
+2 ; Output: Z=Date in MMDDYY format
+3 ;
+4 QUIT $EXTRACT(X,4,7)_$EXTRACT(X,2,3)
