ACRFIV ;IHS/OIRM/DSD/THL,AEF - INVOICE AUDIT; [ 11/01/2001 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
;;ROUTINE CALLED DURING PROCESSING OF INVOICES
EN K ACRSST,ACRIVT,ACRSSTX,ACRIVTX,ACRIVPAY,^TMP("ACRRR",$J)
Q:'+$G(ACRRRNOX)
Q:'ACRVDA
D GATHER
D DISPLAY
D SELECT:'$D(ACRQUIT)
EXIT K ACRSSDT,ACRSSNMS,ACRSSDSC,ACRNOTES,ACRSSUP,ACRSSACP,ACRSSACT,ACRIVACP,ACRSSIT,ACRIVIT,ACRSST,ACRIVT,ACRIVPAY,ACRSSTX,ACRIVTX,^TMP("ACRRR",$J)
Q
SELECT ;
K ACRFINAL
B11 S DIR(0)="LO^1:"_ACRSSNO
S DIR("A")="Edit which item(s)"
W !
D DIR^ACRFDIC
I $D(ACROUT) K ACRFINAL Q
I 'Y D Q
.S ACRFINAL=0
.S ACRXX=0
.F S ACRXX=$O(^TMP("ACRRR",$J,ACRXX)) Q:'ACRXX I $D(^TMP("ACRRR",$J,ACRXX)) S Y=ACRXX D BYRR1
.S ACRQUIT=""
N ACRXX
S ACRXX=Y
F ACRI=1:1 S Y=$P(ACRXX,",",ACRI) Q:'Y D:$D(^TMP("ACRRR",$J,Y)) BYRR1 Q:$D(ACROUT)
K ACRQUIT,ACRFINAL
Q
BYRR1 S (ACRRRDA,DA)=+^TMP("ACRRR",$J,Y)
S DIE="^ACRRR("
S DR="[ACR INVOICE AUDIT]"
I '$D(ACRFINAL) D
.W !!?22,"Item number ",Y
.D DIE^ACRFDIC
S ACRSSDA=+^ACRRR(ACRRRDA,0)
D SYNC^ACRFRR32
Q
RR ;EP;SELECT RECEIVING REPORTS FOR AUDITING
K ACRRRNO,ACRRRNOX
D RRNO^ACRFRR31
Q
GATHER ;EP;GATHER INFO ON RECEIVING ACTIONS
K ACRSST,ACRSSTX,ACRIVTX,ACRRR,ACRIVT
N I,J,K,X,Y,Z
I $G(ACRRRNOX),$G(ACRDOCDA) F J=1:1 S X=$P(ACRRRNOX,",",J) Q:X="" D
.K ACRIVPAY
.S Y=0
.F S Y=$O(^ACRRR("AC",ACRDOCDA,X,Y)) Q:'Y D
..S Z=0
..F S Z=$O(^ACRRR("AC",ACRDOCDA,X,Y,Z)) Q:'Z D G1
S ACRSSTX=$G(ACRSST)
S ACRIVTX=$G(ACRIVT)
K ACRQUIT
Q
G1 S ACR0=$G(^ACRRR(Z,0))
S ACRDT=$G(^ACRRR(Z,"DT"))
S:'$P(ACRDT,U,5) $P(ACRDT,U,5)=$P(ACRDT,U),$P(^ACRRR(Z,"DT"),U,5)=$P(ACRDT,U)
Q:'$P(ACRDT,U,3)
S I=$G(I)+1
S $P(^TMP("ACRRR",$J,I),U)=Z
S $P(^TMP("ACRRR",$J,I),U,2)=+ACRDT
S $P(^TMP("ACRRR",$J,I),U,3)=$P(^TMP("ACRRR",$J,I),U,3)+$P(ACRDT,U,3)
S $P(^TMP("ACRRR",$J,I),U,4)=$P(ACR0,U,2)
S $P(^TMP("ACRRR",$J,I),U,5)=$P(ACRDT,U,5)
S $P(^TMP("ACRRR",$J,I),U,6)=$P(ACRDT,U,6)
S ACRXX=I
D D1
Q
DISPLAY ;DISPLAY ITEMS FOR AUDIT
K ACRSST,ACRIVT,ACRIVPAY,ACRXX
D HEAD
K ACRJ
S (ACRXX,ACRJ)=0
F S ACRXX=$O(^TMP("ACRRR",$J,ACRXX)) Q:'ACRXX!$D(ACRQUIT) S ACRJ=ACRJ+1
S ACRMAX=ACRJ
S (ACRXX,ACRJ)=0
F S ACRXX=$O(^TMP("ACRRR",$J,ACRXX)) Q:'ACRXX!$D(ACRQUIT) D DISP
K ACRQUIT
I '$G(ACRMAX) W !,"NO ITEMS ON FILE FOR THIS RECEIVING REPORT." D PAUSE^ACRFWARN S ACRQUIT="" Q
W !?22,"Totals:"
W ?41,"-------------"
W ?55,"-------------"
W !?41,$J($FN(ACRSSTX,"P",2),13)
W ?55,$J($FN(ACRIVTX,"P",2),13)
W:ACRIVTX>0 ?69,$J($P(ACRIVTX-ACRSSTX,"."),4)
W:ACRSSTX>0 !?69,$J($P((ACRIVTX/ACRSSTX)*100-100,"."),4)
S (ACRSSMAX,ACRSSNO)=ACRMAX
Q
DISP S ACRJ=ACRJ+1
D D1
W !,$J(ACRJ,3)
I $P(ACRSSNMS,U)]"" D
.W ?4,"VON: ",$P(ACRSSNMS,U)
.W !?3
I $P(ACRSSNMS,U,3)]"" D
.W ?4,"NDC: ",$P(ACRSSNMS,U,3)
.W !?3
I $P(ACRSSNMS,U,2)]"" D
.W ?4,"NSN: ",$P(ACRSSNMS,U,2)
.W !?3
W ?4,$P(ACRSSDSC,U)
N ACRJ,ACRI,ACRX
F ACRJ=2:1:5 I $P(ACRSSDSC,U,ACRJ)]"" S ACRX=$P(ACRSSDSC,U,ACRJ) D
.F ACRI=1:1 S ACRY=$P(ACRX," ",ACRI) Q:ACRY="" D
.W:$X+$L(ACRY)>79 !?3
.W ?$X+1,ACRY
W:ACRNOTES]"" !
F ACRJ=1:1:5 I $P(ACRNOTES,U,ACRJ)]"" S ACRX=$P(ACRNOTES,U,ACRJ) D
.F ACRI=1:1 S ACRY=$P(ACRX," ",ACRI) Q:ACRY="" D
.W:$X+$L(ACRY)>79 !?3
.W ?$X+1,ACRY
K ACRSSDSC,ACRNOTES
W !?22,$J(ACRSSACP,6)
W ?29,$J($FN(ACRSSUP,"P",2),12)
W ?41,$J($FN(ACRSSIT,"P",2),13)
W:ACRIVIT>0 ?69,$J($P(ACRIVIT-ACRSSIT,"."),4)
I ACRIVACP]"" D
.W !?13,"INVOICED:"
.W ?22,$J(ACRIVACP,6)
.W ?29,$J($FN(ACRIVUP,"P",2),12)
.W ?55,$J($FN(ACRIVIT,"P",2),13)
.I $P(^TMP("ACRRR",$J,ACRXX),U,10)="PAID" W !?13,"(PAYMENT MADE FOR THIS ITEM.)"
I ACRIVIT,ACRSSIT>0 W ?69,$J($P((ACRIVIT/ACRSSIT)*100-100,"."),4)
I IOSL-4<$Y D
.S DIR(0)="YO"
.S DIR("A")="Display Remaining Items"
.S DIR("B")="YES"
.W !
.D DIR^ACRFDIC
.I Y'=1 S ACRQUIT="" Q
.D HEAD
Q
HEAD W @IOF
W !?10,@ACRON,"SERVICES/SUPPLIES",@ACROF," RECEIVED FOR"
W !?10,"PURCHASE ORDER NO..: ",@ACRON,$P(ACRDOC0,U,2),@ACROF
W !?10,"RECEIVING REPORT(S): ",@ACRON,$E(ACRRRNOX,1,$L(ACRRRNOX)-1),@ACROF
W !?69,"VARI"
W !?22,"ACC-"
W ?41,"OBLIGATED"
W ?55,"RECOMMENDED"
W ?69,"ANCE"
W !,"ITM"
W ?4,"ORDER #/DESCRIPT"
W ?22,"EPTED"
W ?29,"UNIT PRICE"
W ?41,"AMOUNT"
W ?55,"PAYMENT"
W ?69,"$$/%"
W !,"---"
W ?4,"-----------------"
W ?22,"------"
W ?29,"-----------"
W ?41,"-------------"
W ?55,"-------------"
W ?69,"----"
Q
D1 K ACRSSDT,ACRSSNMS,ACRSSDSC,ACRNOTES,ACRSSUP,ACRSSACP,ACRSSACT,ACRIVACP,ACRSSIT,ACRIVIT
S ACRRRDA=+^TMP("ACRRR",$J,ACRXX)
I 'ACRRRDA S ACRJ=ACRJ-1 Q
S ACRSSDA=+^ACRRR(ACRRRDA,0)
I '$D(^ACRSS(+ACRSSDA,0)) S ACRJ=ACRJ-1 Q
S ACRSS0=^ACRSS(ACRSSDA,0)
S ACRSSDT=^ACRSS(ACRSSDA,"DT")
I $P(^ACRRR(ACRRRDA,"DT"),U)=""!($P(^("DT"),U,5)="") D
.N X,Y,Z
.S DA=ACRRRDA
.S DIE="^ACRRR("
.S DR="1////"_$P(ACRSSDT,U,3)
.D DIE^ACRFDIC
S ACROBJDA=$P(ACRSS0,U,4)
S ACRCANDA=$P(ACRSS0,U,5)
S ACRSSNMS=$G(^ACRSS(ACRSSDA,"NMS"))
S ACRSSDSC=$G(^ACRSS(ACRSSDA,"DESC"))
S ACRNOTES=$G(^ACRSS(ACRSSDA,"NOTES"))
S ACRSSUP=$P(ACRSSDT,U,3)
S ACRSSACP=$P(^TMP("ACRRR",$J,ACRXX),U,3)
S ACRSSACT=$G(ACRSSACT)+ACRSSACP
S ACRIVACP=$P(^TMP("ACRRR",$J,ACRXX),U,6)
S ACRIVACT=$G(ACRIVACT)+ACRIVACP
S ACRIVUP=$P(^TMP("ACRRR",$J,ACRXX),U,5)
S:ACRIVUP="" ACRIVUP=ACRSSUP
S ACRSSIT=ACRSSACP*ACRSSUP
S:ACRIVACP]""&(ACRIVUP]"") ACRIVIT=ACRIVACP*ACRIVUP
S:$G(ACRIVIT)="" ACRIVIT=ACRSSIT
I $P(ACR0,U,11)>0,ACRSSACP=ACRIVACP D
.S $P(^TMP("ACRRR",$J,ACRXX),U,10)="PAID"
.S ACRIVIT=0
S ACRIVPAY(ACRCANDA,ACROBJDA)=$G(ACRIVPAY(ACRCANDA,ACROBJDA))+ACRIVIT
S ACRSST=$G(ACRSST)+ACRSSIT
S ACRIVT=$G(ACRIVT)+ACRIVIT
Q
ACRFIV ;IHS/OIRM/DSD/THL,AEF - INVOICE AUDIT; [ 11/01/2001 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
+2 ;;ROUTINE CALLED DURING PROCESSING OF INVOICES
EN KILL ACRSST,ACRIVT,ACRSSTX,ACRIVTX,ACRIVPAY,^TMP("ACRRR",$JOB)
+1 IF '+$GET(ACRRRNOX)
QUIT
+2 IF 'ACRVDA
QUIT
+3 DO GATHER
+4 DO DISPLAY
+5 IF '$DATA(ACRQUIT)
DO SELECT
EXIT KILL ACRSSDT,ACRSSNMS,ACRSSDSC,ACRNOTES,ACRSSUP,ACRSSACP,ACRSSACT,ACRIVACP,ACRSSIT,ACRIVIT,ACRSST,ACRIVT,ACRIVPAY,ACRSSTX,ACRIVTX,^TMP("ACRRR",$JOB)
+1 QUIT
SELECT ;
+1 KILL ACRFINAL
B11 SET DIR(0)="LO^1:"_ACRSSNO
+1 SET DIR("A")="Edit which item(s)"
+2 WRITE !
+3 DO DIR^ACRFDIC
+4 IF $DATA(ACROUT)
KILL ACRFINAL
QUIT
+5 IF 'Y
Begin DoDot:1
+6 SET ACRFINAL=0
+7 SET ACRXX=0
+8 FOR
SET ACRXX=$ORDER(^TMP("ACRRR",$JOB,ACRXX))
IF 'ACRXX
QUIT
IF $DATA(^TMP("ACRRR",$JOB,ACRXX))
SET Y=ACRXX
DO BYRR1
+9 SET ACRQUIT=""
End DoDot:1
QUIT
+10 NEW ACRXX
+11 SET ACRXX=Y
+12 FOR ACRI=1:1
SET Y=$PIECE(ACRXX,",",ACRI)
IF 'Y
QUIT
IF $DATA(^TMP("ACRRR",$JOB,Y))
DO BYRR1
IF $DATA(ACROUT)
QUIT
+13 KILL ACRQUIT,ACRFINAL
+14 QUIT
BYRR1 SET (ACRRRDA,DA)=+^TMP("ACRRR",$JOB,Y)
+1 SET DIE="^ACRRR("
+2 SET DR="[ACR INVOICE AUDIT]"
+3 IF '$DATA(ACRFINAL)
Begin DoDot:1
+4 WRITE !!?22,"Item number ",Y
+5 DO DIE^ACRFDIC
End DoDot:1
+6 SET ACRSSDA=+^ACRRR(ACRRRDA,0)
+7 DO SYNC^ACRFRR32
+8 QUIT
RR ;EP;SELECT RECEIVING REPORTS FOR AUDITING
+1 KILL ACRRRNO,ACRRRNOX
+2 DO RRNO^ACRFRR31
+3 QUIT
GATHER ;EP;GATHER INFO ON RECEIVING ACTIONS
+1 KILL ACRSST,ACRSSTX,ACRIVTX,ACRRR,ACRIVT
+2 NEW I,J,K,X,Y,Z
+3 IF $GET(ACRRRNOX)
IF $GET(ACRDOCDA)
FOR J=1:1
SET X=$PIECE(ACRRRNOX,",",J)
IF X=""
QUIT
Begin DoDot:1
+4 KILL ACRIVPAY
+5 SET Y=0
+6 FOR
SET Y=$ORDER(^ACRRR("AC",ACRDOCDA,X,Y))
IF 'Y
QUIT
Begin DoDot:2
+7 SET Z=0
+8 FOR
SET Z=$ORDER(^ACRRR("AC",ACRDOCDA,X,Y,Z))
IF 'Z
QUIT
DO G1
End DoDot:2
End DoDot:1
+9 SET ACRSSTX=$GET(ACRSST)
+10 SET ACRIVTX=$GET(ACRIVT)
+11 KILL ACRQUIT
+12 QUIT
G1 SET ACR0=$GET(^ACRRR(Z,0))
+1 SET ACRDT=$GET(^ACRRR(Z,"DT"))
+2 IF '$PIECE(ACRDT,U,5)
SET $PIECE(ACRDT,U,5)=$PIECE(ACRDT,U)
SET $PIECE(^ACRRR(Z,"DT"),U,5)=$PIECE(ACRDT,U)
+3 IF '$PIECE(ACRDT,U,3)
QUIT
+4 SET I=$GET(I)+1
+5 SET $PIECE(^TMP("ACRRR",$JOB,I),U)=Z
+6 SET $PIECE(^TMP("ACRRR",$JOB,I),U,2)=+ACRDT
+7 SET $PIECE(^TMP("ACRRR",$JOB,I),U,3)=$PIECE(^TMP("ACRRR",$JOB,I),U,3)+$PIECE(ACRDT,U,3)
+8 SET $PIECE(^TMP("ACRRR",$JOB,I),U,4)=$PIECE(ACR0,U,2)
+9 SET $PIECE(^TMP("ACRRR",$JOB,I),U,5)=$PIECE(ACRDT,U,5)
+10 SET $PIECE(^TMP("ACRRR",$JOB,I),U,6)=$PIECE(ACRDT,U,6)
+11 SET ACRXX=I
+12 DO D1
+13 QUIT
DISPLAY ;DISPLAY ITEMS FOR AUDIT
+1 KILL ACRSST,ACRIVT,ACRIVPAY,ACRXX
+2 DO HEAD
+3 KILL ACRJ
+4 SET (ACRXX,ACRJ)=0
+5 FOR
SET ACRXX=$ORDER(^TMP("ACRRR",$JOB,ACRXX))
IF 'ACRXX!$DATA(ACRQUIT)
QUIT
SET ACRJ=ACRJ+1
+6 SET ACRMAX=ACRJ
+7 SET (ACRXX,ACRJ)=0
+8 FOR
SET ACRXX=$ORDER(^TMP("ACRRR",$JOB,ACRXX))
IF 'ACRXX!$DATA(ACRQUIT)
QUIT
DO DISP
+9 KILL ACRQUIT
+10 IF '$GET(ACRMAX)
WRITE !,"NO ITEMS ON FILE FOR THIS RECEIVING REPORT."
DO PAUSE^ACRFWARN
SET ACRQUIT=""
QUIT
+11 WRITE !?22,"Totals:"
+12 WRITE ?41,"-------------"
+13 WRITE ?55,"-------------"
+14 WRITE !?41,$JUSTIFY($FNUMBER(ACRSSTX,"P",2),13)
+15 WRITE ?55,$JUSTIFY($FNUMBER(ACRIVTX,"P",2),13)
+16 IF ACRIVTX>0
WRITE ?69,$JUSTIFY($PIECE(ACRIVTX-ACRSSTX,"."),4)
+17 IF ACRSSTX>0
WRITE !?69,$JUSTIFY($PIECE((ACRIVTX/ACRSSTX)*100-100,"."),4)
+18 SET (ACRSSMAX,ACRSSNO)=ACRMAX
+19 QUIT
DISP SET ACRJ=ACRJ+1
+1 DO D1
+2 WRITE !,$JUSTIFY(ACRJ,3)
+3 IF $PIECE(ACRSSNMS,U)]""
Begin DoDot:1
+4 WRITE ?4,"VON: ",$PIECE(ACRSSNMS,U)
+5 WRITE !?3
End DoDot:1
+6 IF $PIECE(ACRSSNMS,U,3)]""
Begin DoDot:1
+7 WRITE ?4,"NDC: ",$PIECE(ACRSSNMS,U,3)
+8 WRITE !?3
End DoDot:1
+9 IF $PIECE(ACRSSNMS,U,2)]""
Begin DoDot:1
+10 WRITE ?4,"NSN: ",$PIECE(ACRSSNMS,U,2)
+11 WRITE !?3
End DoDot:1
+12 WRITE ?4,$PIECE(ACRSSDSC,U)
+13 NEW ACRJ,ACRI,ACRX
+14 FOR ACRJ=2:1:5
IF $PIECE(ACRSSDSC,U,ACRJ)]""
SET ACRX=$PIECE(ACRSSDSC,U,ACRJ)
Begin DoDot:1
+15 FOR ACRI=1:1
SET ACRY=$PIECE(ACRX," ",ACRI)
IF ACRY=""
QUIT
Begin DoDot:2
End DoDot:2
+16 IF $X+$LENGTH(ACRY)>79
WRITE !?3
+17 WRITE ?$X+1,ACRY
End DoDot:1
+18 IF ACRNOTES]""
WRITE !
+19 FOR ACRJ=1:1:5
IF $PIECE(ACRNOTES,U,ACRJ)]""
SET ACRX=$PIECE(ACRNOTES,U,ACRJ)
Begin DoDot:1
+20 FOR ACRI=1:1
SET ACRY=$PIECE(ACRX," ",ACRI)
IF ACRY=""
QUIT
Begin DoDot:2
End DoDot:2
+21 IF $X+$LENGTH(ACRY)>79
WRITE !?3
+22 WRITE ?$X+1,ACRY
End DoDot:1
+23 KILL ACRSSDSC,ACRNOTES
+24 WRITE !?22,$JUSTIFY(ACRSSACP,6)
+25 WRITE ?29,$JUSTIFY($FNUMBER(ACRSSUP,"P",2),12)
+26 WRITE ?41,$JUSTIFY($FNUMBER(ACRSSIT,"P",2),13)
+27 IF ACRIVIT>0
WRITE ?69,$JUSTIFY($PIECE(ACRIVIT-ACRSSIT,"."),4)
+28 IF ACRIVACP]""
Begin DoDot:1
+29 WRITE !?13,"INVOICED:"
+30 WRITE ?22,$JUSTIFY(ACRIVACP,6)
+31 WRITE ?29,$JUSTIFY($FNUMBER(ACRIVUP,"P",2),12)
+32 WRITE ?55,$JUSTIFY($FNUMBER(ACRIVIT,"P",2),13)
+33 IF $PIECE(^TMP("ACRRR",$JOB,ACRXX),U,10)="PAID"
WRITE !?13,"(PAYMENT MADE FOR THIS ITEM.)"
End DoDot:1
+34 IF ACRIVIT
IF ACRSSIT>0
WRITE ?69,$JUSTIFY($PIECE((ACRIVIT/ACRSSIT)*100-100,"."),4)
+35 IF IOSL-4<$Y
Begin DoDot:1
+36 SET DIR(0)="YO"
+37 SET DIR("A")="Display Remaining Items"
+38 SET DIR("B")="YES"
+39 WRITE !
+40 DO DIR^ACRFDIC
+41 IF Y'=1
SET ACRQUIT=""
QUIT
+42 DO HEAD
End DoDot:1
+43 QUIT
HEAD WRITE @IOF
+1 WRITE !?10,@ACRON,"SERVICES/SUPPLIES",@ACROF," RECEIVED FOR"
+2 WRITE !?10,"PURCHASE ORDER NO..: ",@ACRON,$PIECE(ACRDOC0,U,2),@ACROF
+3 WRITE !?10,"RECEIVING REPORT(S): ",@ACRON,$EXTRACT(ACRRRNOX,1,$LENGTH(ACRRRNOX)-1),@ACROF
+4 WRITE !?69,"VARI"
+5 WRITE !?22,"ACC-"
+6 WRITE ?41,"OBLIGATED"
+7 WRITE ?55,"RECOMMENDED"
+8 WRITE ?69,"ANCE"
+9 WRITE !,"ITM"
+10 WRITE ?4,"ORDER #/DESCRIPT"
+11 WRITE ?22,"EPTED"
+12 WRITE ?29,"UNIT PRICE"
+13 WRITE ?41,"AMOUNT"
+14 WRITE ?55,"PAYMENT"
+15 WRITE ?69,"$$/%"
+16 WRITE !,"---"
+17 WRITE ?4,"-----------------"
+18 WRITE ?22,"------"
+19 WRITE ?29,"-----------"
+20 WRITE ?41,"-------------"
+21 WRITE ?55,"-------------"
+22 WRITE ?69,"----"
+23 QUIT
D1 KILL ACRSSDT,ACRSSNMS,ACRSSDSC,ACRNOTES,ACRSSUP,ACRSSACP,ACRSSACT,ACRIVACP,ACRSSIT,ACRIVIT
+1 SET ACRRRDA=+^TMP("ACRRR",$JOB,ACRXX)
+2 IF 'ACRRRDA
SET ACRJ=ACRJ-1
QUIT
+3 SET ACRSSDA=+^ACRRR(ACRRRDA,0)
+4 IF '$DATA(^ACRSS(+ACRSSDA,0))
SET ACRJ=ACRJ-1
QUIT
+5 SET ACRSS0=^ACRSS(ACRSSDA,0)
+6 SET ACRSSDT=^ACRSS(ACRSSDA,"DT")
+7 IF $PIECE(^ACRRR(ACRRRDA,"DT"),U)=""!($PIECE(^("DT"),U,5)="")
Begin DoDot:1
+8 NEW X,Y,Z
+9 SET DA=ACRRRDA
+10 SET DIE="^ACRRR("
+11 SET DR="1////"_$PIECE(ACRSSDT,U,3)
+12 DO DIE^ACRFDIC
End DoDot:1
+13 SET ACROBJDA=$PIECE(ACRSS0,U,4)
+14 SET ACRCANDA=$PIECE(ACRSS0,U,5)
+15 SET ACRSSNMS=$GET(^ACRSS(ACRSSDA,"NMS"))
+16 SET ACRSSDSC=$GET(^ACRSS(ACRSSDA,"DESC"))
+17 SET ACRNOTES=$GET(^ACRSS(ACRSSDA,"NOTES"))
+18 SET ACRSSUP=$PIECE(ACRSSDT,U,3)
+19 SET ACRSSACP=$PIECE(^TMP("ACRRR",$JOB,ACRXX),U,3)
+20 SET ACRSSACT=$GET(ACRSSACT)+ACRSSACP
+21 SET ACRIVACP=$PIECE(^TMP("ACRRR",$JOB,ACRXX),U,6)
+22 SET ACRIVACT=$GET(ACRIVACT)+ACRIVACP
+23 SET ACRIVUP=$PIECE(^TMP("ACRRR",$JOB,ACRXX),U,5)
+24 IF ACRIVUP=""
SET ACRIVUP=ACRSSUP
+25 SET ACRSSIT=ACRSSACP*ACRSSUP
+26 IF ACRIVACP]""&(ACRIVUP]"")
SET ACRIVIT=ACRIVACP*ACRIVUP
+27 IF $GET(ACRIVIT)=""
SET ACRIVIT=ACRSSIT
+28 IF $PIECE(ACR0,U,11)>0
IF ACRSSACP=ACRIVACP
Begin DoDot:1
+29 SET $PIECE(^TMP("ACRRR",$JOB,ACRXX),U,10)="PAID"
+30 SET ACRIVIT=0
End DoDot:1
+31 SET ACRIVPAY(ACRCANDA,ACROBJDA)=$GET(ACRIVPAY(ACRCANDA,ACROBJDA))+ACRIVIT
+32 SET ACRSST=$GET(ACRSST)+ACRSSIT
+33 SET ACRIVT=$GET(ACRIVT)+ACRIVIT
+34 QUIT
