IBJDF81 ;ALB/RRG - AR PRODUCTIVITY REPORT (COMPILE) ;29-AUG-00
;;2.0;INTEGRATED BILLING;**123,159,192**;21-MAR-94
;
ST ; - Tasked entry point.
K IB,^TMP("IBJDF8",$J),^TMP("IBJDF8SUM",$J) S IBQ=0
;
; - Initialize the array IB
F I=1:1:13 S IB(I)=0
;
; - Loops through all the AR Transactions by DATE ENTERED X-ref
S IBTRDA="",IBTDATE=IBTDATE+.9
S IBTRTP=0 ; - Don't include INCREASE ADJUSTMENTS transactions
F S IBTRTP=$O(^PRCA(433,"AT",IBTRTP)) Q:'IBTRTP D Q:IBQ
. S IBDTEN=IBFDATE-.1
. F S IBDTEN=$O(^PRCA(433,"AT",IBTRTP,IBDTEN)) Q:'IBDTEN!(IBDTEN>IBTDATE) D Q:IBQ
. . F S IBTRDA=$O(^PRCA(433,"AT",IBTRTP,IBDTEN,IBTRDA)) Q:'IBTRDA D Q:IBQ
. . . S IBTR0=$G(^PRCA(433,IBTRDA,0))
. . . S IBARDA=$P(IBTR0,"^",2) Q:IBARDA=""
. . . S IBTR1=$G(^PRCA(433,IBTRDA,1))
. . . S IBTR5=$G(^PRCA(433,IBTRDA,5))
. . . S IBTR8=$G(^PRCA(433,IBTRDA,8))
. . . I IBARDA#100=0 S IBQ=$$STOP^IBOUTL("AR Productivity Report") Q:IBQ
. . . S IBAR0=$G(^PRCA(430,IBARDA,0))
. . . I 'IBAR0!($P(IBAR0,"^",8)=8) Q ; No AR bill/bill terminated.
. . . S IBAR7=$G(^PRCA(430,IBARDA,7))
. . . S IBAR9=$G(^PRCA(430,IBARDA,9))
. . . D TRDA
;
I IBSEL'="",IBSEL'[",2," G PRT ; AUDIT Transaction type not selected
;
; - Get AUDIT Transactions
S IBARDA="",IBACTDT=IBFDATE-.1
;F S IBACTDT=$O(^PRCA(430,"ACTDT",IBACTDT)) Q:'IBACTDT D Q:IBQ
F S IBACTDT=$O(^PRCA(430,"ACTDT",IBACTDT)) Q:'IBACTDT!(IBACTDT>IBTDATE) D Q:IBQ
. F S IBARDA=$O(^PRCA(430,"ACTDT",IBACTDT,IBARDA)) Q:'IBARDA D Q:IBQ
. . S IBAR0=$G(^PRCA(430,IBARDA,0)) Q:'IBAR0
. . S IBAR7=$G(^PRCA(430,IBARDA,7))
. . S IBAR9=$G(^PRCA(430,IBARDA,9))
. . D AUDIT
;
PRT I 'IBQ D EN^IBJDF82 ; Print the report.
;
ENQ K ^TMP("IBJDF8",$J),^TMP("IBJDF8SUM",$J)
I $D(ZTQUEUED) S ZTREQ="@" G ENQ1
;
D ^%ZISC
ENQ1 K IBARDA,IBTRDA,IBAR0,IBAR7,IBAR9,IBTR0,IBTR1,IBTR5,IBTR8,IBTRTP,IBACTDT
K IBBAL,IBDTEN,IBCLNU,IBCLNM,IBDATA,IBCONT,IBCOM,IBFUDT,IBTRAMT,IBQ
K TRXCAT,TRXCATN,TRXTYPN,IB,I
Q
;
AUDIT ; - Determine if bill has been audited and add to Audit Transaction
; Total, then:
; - Sets temporary detail global (for detail printing)
; - Sets temporary summary global (for summary printing)
;
S IBCLNU=$P(IBAR9,"^",1) I IBCLNU="" Q ; Approved By (Clerk) not found
;
I '$D(^IBE(351.73,IBCLNU,0)) Q ; Clerk not set up
I IBCLERK="S",'$D(IBCLERK(IBCLNU)) Q ; Clerk not selected
S IBCLNM=$P($G(^VA(200,IBCLNU,0)),"^",1)
;
S IBBAL=0 F I=1:1:5 S IBBAL=IBBAL+$P(IBAR7,"^",I) ; Current Bill Balance
;
S IB(2)=($P(IB(2),"^",1)+1)_"^"_($P(IB(2),"^",2)+$P(IBAR0,"^",3))_"^AUDIT"
S TRXCAT=2
;
; - Update TMP global with Summary information by Clerk
S IBDATA=$G(^TMP("IBJDF8SUM",$J,IBCLNM,2))
S $P(IBDATA,"^",1)=$P(IBDATA,"^",1)+1
S $P(IBDATA,"^",2)=$P(IBDATA,"^",2)+$P(IBAR0,"^",3)
S $P(IBDATA,"^",3)="AUDIT"
S ^TMP("IBJDF8SUM",$J,IBCLNM,2)=IBDATA
;
I IBRPT="S" Q ; Don't set ^TMP for detail if only Summary was selected
;
; - Update TMP global with Detailed information
S ^TMP("IBJDF8",$J,IBCLNM,IBARDA,0)=$P(IBAR0,"^")_"^"_IBACTDT_"^"_$$DEBTOR(IBARDA)_"^AUDIT^"_$P(IBAR0,"^",3)_"^"_IBBAL
;
Q
;
TRDA ; - Checks if Transactions is eligible for the Report, then:
; - Sets temporary global (for detail printing)
; - Sets temporary Summary global (for summary printing)
;
S IBCLNU=$P(IBTR0,"^",9) I IBCLNU="" Q ; No CLERK found on the AR Trans.
;
I '$D(^IBE(351.73,IBCLNU,0)) Q ; Clerk not set up
I IBCLERK="S",'$D(IBCLERK(IBCLNU)) Q ; Clerk not selected to print
;
S IBTRAMT=$P(IBTR1,"^",5) ; TRX Amount
;
I IBRPT'="S",IBTT'="ALL" Q:IBTT'[("|"_IBTRTP_"|") ; TRX type not selected
;
I '$$VALID^RCRJRCOT(IBTRDA) Q ; Invalid TRX
;
S IBCONT=$P(IBTR8,"^",8) ; Contractual / Non-Contractual Transaction
;
S IBBAL=0 F I=1:1:5 S IBBAL=IBBAL+$P(IBAR7,"^",I) ; Current Bill Balance
;
; - Set IB array with summary information
I $T(@IBTRTP^IBJDF811)'="" D @(IBTRTP_"^IBJDF811")
;
S IBCLNM=$P($G(^VA(200,$P(IBTR0,"^",9),0)),"^",1) ; Clerk Name
;
; - Set TMP global with Summary information
S IBDATA=$G(^TMP("IBJDF8SUM",$J,IBCLNM,TRXCAT))
S $P(IBDATA,"^",1)=$P(IBDATA,"^",1)+1
S $P(IBDATA,"^",2)=$P(IBDATA,"^",2)+IBTRAMT
S $P(IBDATA,"^",3)=TRXCATN
S ^TMP("IBJDF8SUM",$J,IBCLNM,TRXCAT)=IBDATA
;
I IBRPT="S" Q ; Don't set ^TMP for detail if only Summary was selected
;
S IBCOM=$P(IBTR5,"^",2) ; Brief Comments
S IBFUDT=$P(IBTR5,"^",3) ; Follow-Up Date
;
; - Set TMP global with Detailed information
S ^TMP("IBJDF8",$J,IBCLNM,IBARDA,IBTRDA)=$P(IBAR0,"^")_"^"_IBDTEN_"^"_$$DEBTOR(IBARDA)_"^"_TRXTYPN_"^"_IBTRAMT_"^"_IBBAL_"^"_IBFUDT_"^"_IBCOM
;
Q
;
DEBTOR(ARDA) ; - Retrieve debtor name
N Y,DIC,DA,DR,DIQ,DEB
S DIC="^PRCA(430,",DA=ARDA,DR=9,DIQ="DEB" D EN^DIQ1
S Y=$G(DEB(430,DA,9))
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBJDF81 4901 printed Apr 09, 2024@21:15:56 Page 2
IBJDF81 ;ALB/RRG - AR PRODUCTIVITY REPORT (COMPILE) ;29-AUG-00
+1 ;;2.0;INTEGRATED BILLING;**123,159,192**;21-MAR-94
+2 ;
ST ; - Tasked entry point.
+1 KILL IB,^TMP("IBJDF8",$JOB),^TMP("IBJDF8SUM",$JOB)
SET IBQ=0
+2 ;
+3 ; - Initialize the array IB
+4 FOR I=1:1:13
SET IB(I)=0
+5 ;
+6 ; - Loops through all the AR Transactions by DATE ENTERED X-ref
+7 SET IBTRDA=""
SET IBTDATE=IBTDATE+.9
+8 ; - Don't include INCREASE ADJUSTMENTS transactions
SET IBTRTP=0
+9 FOR
SET IBTRTP=$ORDER(^PRCA(433,"AT",IBTRTP))
if 'IBTRTP
QUIT
Begin DoDot:1
+10 SET IBDTEN=IBFDATE-.1
+11 FOR
SET IBDTEN=$ORDER(^PRCA(433,"AT",IBTRTP,IBDTEN))
if 'IBDTEN!(IBDTEN>IBTDATE)
QUIT
Begin DoDot:2
+12 FOR
SET IBTRDA=$ORDER(^PRCA(433,"AT",IBTRTP,IBDTEN,IBTRDA))
if 'IBTRDA
QUIT
Begin DoDot:3
+13 SET IBTR0=$GET(^PRCA(433,IBTRDA,0))
+14 SET IBARDA=$PIECE(IBTR0,"^",2)
if IBARDA=""
QUIT
+15 SET IBTR1=$GET(^PRCA(433,IBTRDA,1))
+16 SET IBTR5=$GET(^PRCA(433,IBTRDA,5))
+17 SET IBTR8=$GET(^PRCA(433,IBTRDA,8))
+18 IF IBARDA#100=0
SET IBQ=$$STOP^IBOUTL("AR Productivity Report")
if IBQ
QUIT
+19 SET IBAR0=$GET(^PRCA(430,IBARDA,0))
+20 ; No AR bill/bill terminated.
IF 'IBAR0!($PIECE(IBAR0,"^",8)=8)
QUIT
+21 SET IBAR7=$GET(^PRCA(430,IBARDA,7))
+22 SET IBAR9=$GET(^PRCA(430,IBARDA,9))
+23 DO TRDA
End DoDot:3
if IBQ
QUIT
End DoDot:2
if IBQ
QUIT
End DoDot:1
if IBQ
QUIT
+24 ;
+25 ; AUDIT Transaction type not selected
IF IBSEL'=""
IF IBSEL'[",2,"
GOTO PRT
+26 ;
+27 ; - Get AUDIT Transactions
+28 SET IBARDA=""
SET IBACTDT=IBFDATE-.1
+29 ;F S IBACTDT=$O(^PRCA(430,"ACTDT",IBACTDT)) Q:'IBACTDT D Q:IBQ
+30 FOR
SET IBACTDT=$ORDER(^PRCA(430,"ACTDT",IBACTDT))
if 'IBACTDT!(IBACTDT>IBTDATE)
QUIT
Begin DoDot:1
+31 FOR
SET IBARDA=$ORDER(^PRCA(430,"ACTDT",IBACTDT,IBARDA))
if 'IBARDA
QUIT
Begin DoDot:2
+32 SET IBAR0=$GET(^PRCA(430,IBARDA,0))
if 'IBAR0
QUIT
+33 SET IBAR7=$GET(^PRCA(430,IBARDA,7))
+34 SET IBAR9=$GET(^PRCA(430,IBARDA,9))
+35 DO AUDIT
End DoDot:2
if IBQ
QUIT
End DoDot:1
if IBQ
QUIT
+36 ;
PRT ; Print the report.
IF 'IBQ
DO EN^IBJDF82
+1 ;
ENQ KILL ^TMP("IBJDF8",$JOB),^TMP("IBJDF8SUM",$JOB)
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
GOTO ENQ1
+2 ;
+3 DO ^%ZISC
ENQ1 KILL IBARDA,IBTRDA,IBAR0,IBAR7,IBAR9,IBTR0,IBTR1,IBTR5,IBTR8,IBTRTP,IBACTDT
+1 KILL IBBAL,IBDTEN,IBCLNU,IBCLNM,IBDATA,IBCONT,IBCOM,IBFUDT,IBTRAMT,IBQ
+2 KILL TRXCAT,TRXCATN,TRXTYPN,IB,I
+3 QUIT
+4 ;
AUDIT ; - Determine if bill has been audited and add to Audit Transaction
+1 ; Total, then:
+2 ; - Sets temporary detail global (for detail printing)
+3 ; - Sets temporary summary global (for summary printing)
+4 ;
+5 ; Approved By (Clerk) not found
SET IBCLNU=$PIECE(IBAR9,"^",1)
IF IBCLNU=""
QUIT
+6 ;
+7 ; Clerk not set up
IF '$DATA(^IBE(351.73,IBCLNU,0))
QUIT
+8 ; Clerk not selected
IF IBCLERK="S"
IF '$DATA(IBCLERK(IBCLNU))
QUIT
+9 SET IBCLNM=$PIECE($GET(^VA(200,IBCLNU,0)),"^",1)
+10 ;
+11 ; Current Bill Balance
SET IBBAL=0
FOR I=1:1:5
SET IBBAL=IBBAL+$PIECE(IBAR7,"^",I)
+12 ;
+13 SET IB(2)=($PIECE(IB(2),"^",1)+1)_"^"_($PIECE(IB(2),"^",2)+$PIECE(IBAR0,"^",3))_"^AUDIT"
+14 SET TRXCAT=2
+15 ;
+16 ; - Update TMP global with Summary information by Clerk
+17 SET IBDATA=$GET(^TMP("IBJDF8SUM",$JOB,IBCLNM,2))
+18 SET $PIECE(IBDATA,"^",1)=$PIECE(IBDATA,"^",1)+1
+19 SET $PIECE(IBDATA,"^",2)=$PIECE(IBDATA,"^",2)+$PIECE(IBAR0,"^",3)
+20 SET $PIECE(IBDATA,"^",3)="AUDIT"
+21 SET ^TMP("IBJDF8SUM",$JOB,IBCLNM,2)=IBDATA
+22 ;
+23 ; Don't set ^TMP for detail if only Summary was selected
IF IBRPT="S"
QUIT
+24 ;
+25 ; - Update TMP global with Detailed information
+26 SET ^TMP("IBJDF8",$JOB,IBCLNM,IBARDA,0)=$PIECE(IBAR0,"^")_"^"_IBACTDT_"^"_$$DEBTOR(IBARDA)_"^AUDIT^"_$PIECE(IBAR0,"^",3)_"^"_IBBAL
+27 ;
+28 QUIT
+29 ;
TRDA ; - Checks if Transactions is eligible for the Report, then:
+1 ; - Sets temporary global (for detail printing)
+2 ; - Sets temporary Summary global (for summary printing)
+3 ;
+4 ; No CLERK found on the AR Trans.
SET IBCLNU=$PIECE(IBTR0,"^",9)
IF IBCLNU=""
QUIT
+5 ;
+6 ; Clerk not set up
IF '$DATA(^IBE(351.73,IBCLNU,0))
QUIT
+7 ; Clerk not selected to print
IF IBCLERK="S"
IF '$DATA(IBCLERK(IBCLNU))
QUIT
+8 ;
+9 ; TRX Amount
SET IBTRAMT=$PIECE(IBTR1,"^",5)
+10 ;
+11 ; TRX type not selected
IF IBRPT'="S"
IF IBTT'="ALL"
if IBTT'[("|"_IBTRTP_"|")
QUIT
+12 ;
+13 ; Invalid TRX
IF '$$VALID^RCRJRCOT(IBTRDA)
QUIT
+14 ;
+15 ; Contractual / Non-Contractual Transaction
SET IBCONT=$PIECE(IBTR8,"^",8)
+16 ;
+17 ; Current Bill Balance
SET IBBAL=0
FOR I=1:1:5
SET IBBAL=IBBAL+$PIECE(IBAR7,"^",I)
+18 ;
+19 ; - Set IB array with summary information
+20 IF $TEXT(@IBTRTP^IBJDF811)'=""
DO @(IBTRTP_"^IBJDF811")
+21 ;
+22 ; Clerk Name
SET IBCLNM=$PIECE($GET(^VA(200,$PIECE(IBTR0,"^",9),0)),"^",1)
+23 ;
+24 ; - Set TMP global with Summary information
+25 SET IBDATA=$GET(^TMP("IBJDF8SUM",$JOB,IBCLNM,TRXCAT))
+26 SET $PIECE(IBDATA,"^",1)=$PIECE(IBDATA,"^",1)+1
+27 SET $PIECE(IBDATA,"^",2)=$PIECE(IBDATA,"^",2)+IBTRAMT
+28 SET $PIECE(IBDATA,"^",3)=TRXCATN
+29 SET ^TMP("IBJDF8SUM",$JOB,IBCLNM,TRXCAT)=IBDATA
+30 ;
+31 ; Don't set ^TMP for detail if only Summary was selected
IF IBRPT="S"
QUIT
+32 ;
+33 ; Brief Comments
SET IBCOM=$PIECE(IBTR5,"^",2)
+34 ; Follow-Up Date
SET IBFUDT=$PIECE(IBTR5,"^",3)
+35 ;
+36 ; - Set TMP global with Detailed information
+37 SET ^TMP("IBJDF8",$JOB,IBCLNM,IBARDA,IBTRDA)=$PIECE(IBAR0,"^")_"^"_IBDTEN_"^"_$$DEBTOR(IBARDA)_"^"_TRXTYPN_"^"_IBTRAMT_"^"_IBBAL_"^"_IBFUDT_"^"_IBCOM
+38 ;
+39 QUIT
+40 ;
DEBTOR(ARDA) ; - Retrieve debtor name
+1 NEW Y,DIC,DA,DR,DIQ,DEB
+2 SET DIC="^PRCA(430,"
SET DA=ARDA
SET DR=9
SET DIQ="DEB"
DO EN^DIQ1
+3 SET Y=$GET(DEB(430,DA,9))
+4 QUIT Y
