ACRFPAY7 ;IHS/OIRM/DSD/THL,AEF - CERTIFY AND EXPORT PAYMENT BATCH; [ 09/23/2005 9:50 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**3,5,17,19**;NOV 05, 2001
;;
CASHREC ;EP;CASH RECONCILIAITON REPORT
D CREXIT
W !
D ^ACRFDATE
Q:$D(ACRQUIT)!$D(ACROUT)
Q:'$G(ACRBEGIN)!'$G(ACREND)
S (ACRRTN,ZTRTN)="CR^ACRFPAY7"
S ZTDESC="CASH RECONCILATION REPORT"
D ^ACRFZIS
CREXIT K ACR,ACRQUIT,ACROUT,ACRBEGIN,ACREND,ACRJ,ACRTOT,ACRSCHD,ACRFYDA,ACRBATDA,ACRSEQDA,ACR
K ^TMP("ACRCR",$J)
Q
CR ;EP;TO PRINT CASH RECONCILIATION REPORT
D CR1
D CREXIT
Q
CR1 D CRHEAD
S ACR=ACRBEGIN-.1
F S ACR=$O(^AFSLAFP("EXP",ACR)) Q:'ACR!(ACR>ACREND) D
.N X,Y,Z
.S X=0
.F S X=$O(^AFSLAFP("EXP",ACR,X)) Q:'X D
..S Y=0
..F S Y=$O(^AFSLAFP("EXP",ACR,X,Y)) Q:'Y D
...S Z=$$BATCH^ACRFPAYE(X,Y) ;ACR*2.1*5.02
...Q:Z="G" ;ACR*2.1*5.02
...S Z=$G(^AFSLAFP(X,1,Y,2))
...Q:$P(Z,U,6)=""
...S ^TMP("ACRCR",$J,$P(Z,U,6),X,Y)=""
S (ACRTOT,ACRJ)=0
S ACRSCHD=""
F S ACRSCHD=$O(^TMP("ACRCR",$J,ACRSCHD)) Q:ACRSCHD=""!$D(ACRQUIT) D
.S ACRFYDA=0
.F S ACRFYDA=$O(^TMP("ACRCR",$J,ACRSCHD,ACRFYDA)) Q:'ACRFYDA!$D(ACRQUIT) D
..S ACRBATDA=0
..F S ACRBATDA=$O(^TMP("ACRCR",$J,ACRSCHD,ACRFYDA,ACRBATDA)) Q:'ACRBATDA!$D(ACRQUIT) D
...W !,ACRSCHD
...W ?14,$P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,0)),U)
...S Y=$P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,2)),U)
...X ^DD("DD")
...W ?24,Y
...S ACRJ=ACRJ+1
...S (ACRSEQDA,X)=0
...F S ACRSEQDA=$O(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA)) Q:'ACRSEQDA D
....S Y=$$NET^ACRFSSU(ACRFYDA,ACRBATDA,ACRSEQDA) ;ACR*2.1*5.02
....S X=X+Y
....S ACRTOT=ACRTOT+Y
...W ?64,$J($FN(X,"P,",2),15)
...I $Y+4>IOSL D PAUSE^ACRFWARN Q:$D(ACRQUIT) D CRHEAD
W $$DASH^ACRFMENU
W !,"TOTAL",?24,"COUNT: ",ACRJ,?64,$J($FN(ACRTOT,"P,",2),15)
D PAUSE^ACRFWARN
Q
CRHEAD ;CASH RECONCILIATION HEADER
W @IOF
W $$DASH^ACRFMENU
W !?20,"Export listing for comparison with the"
W !?20,"Treasury Confirmation Report"
S Y=DT
X ^DD("DD")
W !?20,"Report Date.....: ",Y
S Y=ACRBEGIN
X ^DD("DD")
W !?20,"Report Period FR: ",Y
S Y=ACREND
X ^DD("DD")
W !?20,"Report Period TO: ",Y
W $$DASH^ACRFMENU
W !,"SCHEDULE",?14,"BATCH",?24,"EXPORT",?72,"NET"
W !,"NUMBER",?14,"NUMBER",?24,"DATE",?72,"AMOUNT"
W $$DASH^ACRFMENU
Q
APPROP ;EP;FOR APPROPRIATION REPORTS
D APPEXIT
F D APP1 Q:$D(ACRQUIT)!$D(ACROUT)
APPEXIT K ACROUT,ACRQUIT,ACR1,ACR1A,ACR2,ACR2A,ACRX,ACRXREF,ACRAPP,ACRFY,ACR,ACRDC,ACRFYDA,ACRBATDA,ACRSEQDA
K ^TMP("ACRAPPRP",$J)
Q
APP1 W @IOF
W !!?10,"Appropriation Report"
S DIR(0)="SO^1:Sort by Batch within Appropriation;2:Sort by Schedule within Appropriation;3:Sort by Appropriation within Schedule"
S DIR("A")="Which one"
W !
D DIR^ACRFDIC
I $D(ACRQUIT)!$D(ACROUT)!'Y S ACRQUIT="" Q
I X=1 S ACR1="APPROPRIATION",ACR2="BATCH",ACRXREF="PROBAT"
I X=2 S ACR1="APPROPRIATION",ACR2="SCHEDULE",ACRXREF="PROSCH"
I X=3 S ACR1="SCHEDULE",ACR2="APPROPRIATION",ACRXREF="SCHPRO"
K ACRFYDA,ACRBATDA,ACRSEQDA
D FYBAT^ACRFPAY2
Q:$D(ACROUT)
I '$G(ACRBATDA) S (ACRBATNO,ACRBATDA)=""
N ACRBATDX
S ACRBATDX=ACRBATDA
S ACRBATDA=ACRBATDA-1
D APP
Q:$D(ACRQUIT) ;ACR*2.1*3.17
S (ZTRTN,ACRRTN)="PAPP^ACRFPAY7"
S ZTDESC="PAYMENT APPROPRIATION REPORT"
D ^ACRFZIS
Q
APP ;SELECT APPROPRIATION SORT RANGE
S DIC="^AUTTPRO("
S DIC(0)="AEMQZ"
S DIC("A")="Report for which APPROPRIATION: "
W !!,"Select an APPROPRIATION NO. to report for ONE Appropriation"
W !,"Press <ENTER> to report for all APPROPRIATIONs."
W !
D DIC^ACRFDIC
I X["^" S ACRQUIT="" Q
S ACRAPP=$P(Y,U,2)
I ACR1="APPROPRIATION" S ACR1A=ACRAPP
E S ACR1A=""
S:ACRAPP]"" ACRAPP=$O(^AUTTPRO("B",ACRAPP),-1)
Q
PAPP ;EP;TO PRINT APPROPRIATION REPORTS
K ^TMP("ACRAPPRP",$J)
D PAPPHEAD
S ACRBATDA=0
F S ACRBATDA=$O(^AFSLAFP(ACRFYDA,1,ACRBATDA)) Q:'ACRBATDA!(ACRBATDX&(ACRBATDA'=ACRBATDX)) D
.N ACRBAT ;ACR*2.1*5.02
.S ACRBAT=$$BATCH^ACRFPAYE(ACRFYDA,ACRBATDA) ;ACR*2.1*5.02
.Q:ACRBAT="G" ;ACR*2.1*5.02
.Q:ACRBAT="" ;ACR*2.1*5.02
.S ACRSEQDA=0
.F S ACRSEQDA=$O(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA)) Q:'ACRSEQDA D
..N X,Y,Z
..S X=$P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,0)),U)
..S Y=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,1))
..S Z=$P(Y,U,21)
..Q:X=""!(Y="")!(Z="") ;ACR*2.1*5.02
..S Y=$$NET^ACRFSSU(ACRFYDA,ACRBATDA,ACRSEQDA) ;ACR*2.1*5.02
..I ACR1="APPROPRIATION",ACR2="BATCH" S ACR1X=Z,ACR2X=X
..I ACR1="APPROPRIATION",ACR2="SCHEDULE" S ACR1X=Z,ACR2X=Y
..I ACR1="SCHEDULE",ACR2="APPROPRIATION" S ACR1X=Y,ACR2X=Z
..S ^TMP("ACRAPPRP",$J,ACR1X,ACR2X,ACRFYDA,ACRBATDA,ACRSEQDA)=""
S ACR1X=""
F S ACR1X=$O(^TMP("ACRAPPRP",$J,ACR1X)) Q:ACR1X=""!$D(ACRQUIT) D:ACR1X[ACR1A
.W !!,"FISCAL YEAR",?15,": ",ACRFY
.W !,ACR1,?15,": ",ACR1X
.N ACR1TOT
.S ACR1TOT=0
.S ACR2X=""
.F S ACR2X=$O(^TMP("ACRAPPRP",$J,ACR1X,ACR2X)) Q:ACR2X=""!$D(ACRQUIT) D
..W !,ACR2,?15,": ",ACR2X,!
..S ACRBATDA=0
..F S ACRBATDA=$O(^TMP("ACRAPPRP",$J,ACR1X,ACR2X,ACRFYDA,ACRBATDA)) Q:'ACRBATDA!$D(ACRQUIT) D
...S ACRBATNO=$P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,0)),U)
...S ACRSEQDA=0
...F S ACRSEQDA=$O(^TMP("ACRAPPRP",$J,ACR1X,ACR2X,ACRFYDA,ACRBATDA,ACRSEQDA)) Q:'ACRSEQDA!$D(ACRQUIT) D
....D PDISP
....I $Y+5>IOSL D PAUSE^ACRFWARN Q:$D(ACRQUIT) D PAPPHEAD:$O(^TMP("ACRAPPRP",$J,ACR1X,ACR2X,ACRFYDA,ACRBATDA,ACRSEQDA))
....I '$O(^TMP("ACRAPPRP",$J,ACR1X,ACR2X,ACRFYDA,ACRBATDA,ACRSEQDA)) D PAUSE^ACRFWARN
...D APPSUM^ACRFPAY8
..W $$DASH^ACRFMENU
D PAUSE^ACRFWARN
W @IOF
K ^TMP("ACRAPPRP",$J)
Q
PAPPHEAD ;HEADER FOR APPROPRIATION REPORT
W @IOF
S ACRDC=$G(ACRDC)+1
W !?10,"Appropriation Report",?60,"PAGE ",ACRDC
W !?10,"Report Date: "
S Y=DT
X ^DD("DD")
W Y
W !?10,"Sort by....: ",ACR1
W !?10,"Then by....: ",ACR2
W $$DASH^ACRFMENU
Q
PDISP ;APPROPRIATION DISPLAY
N X,Y,Z,XT
S X=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0))
S Y=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,1))
S Z=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,2))
S XT=$$NET^ACRFSSU(ACRFYDA,ACRBATDA,ACRSEQDA) ;ACR*2.1*5.02
S ACR1TOT=ACR1TOT+XT ;ACR*2.1*5.02
W !,$P(X,U),?5,$P(X,U,20),?16,$P(X,U,5),?20,$P(X,U,21),?31,$P(X,U,6) ;ACR*2.1*5.02
W ?35,ACRBATNO,?42,$P(Y,U,11) ;ACR*2.1*5.02
W ?50,$J($FN(XT,"P,",2),15) ;ACR*2.1*5.02
W !?5,$P($G(^AUTTCAN(+$P(X,U,7),0)),U),?13,$P($G(^AUTTOBJC(+$P(X,U,8),0)),U),?18,$P(X,U,15),?20,$P(Y,U,19),?22,$P(X,U,17),?27,$P(X,U,18)
I $P(X,U,10) W ?50,$P($G(^AUTTVNDR(+$P(X,U,10),0)),U)
;E I $P(X,U,24) W ?50,$P($G(^VA(200,+$P(X,U,24),0)),U) ;ACR*2.1*19.02 IM16848
E I $P(X,U,24) W ?50,$$NAME2^ACRFUTL1(+$P(X,U,24)) ;ACR*2.1*19.02 IM16848
W !?5,$P(Z,U,14)
Q
PBDISP ;EP;BATCH DISPLAY
K ACRAPPN
D PBHEAD
S ACRSEQDA=0
F S ACRSEQDA=$O(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA)) Q:'ACRSEQDA!$D(ACRQUIT) D
.N X
.S X=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0))
.Q:'$P(X,U,10)&'$P(X,U,24)
.I $P(X,U,10) S X=$P($G(^AUTTVNDR($P(X,U,10),0)),U)
.;E S:$P(X,U,24) X=$P($G(^VA(200,$P(X,U,24),0)),U) ;ACR*2.1*19.02 IM16848
.E S:$P(X,U,24) X=$$NAME2^ACRFUTL1($P(X,U,24)) ;ACR*2.1*19.02 IM16848
.Q:X=""
.S ^TMP("ACRPBAT",$J,ACRFYDA,ACRBATDA,X,ACRSEQDA)=""
N ACRX
S ACRX=""
F S ACRX=$O(^TMP("ACRPBAT",$J,ACRFYDA,ACRBATDA,ACRX)) Q:ACRX=""!$D(ACRQUIT) D
.S ACRSEQDA=0
.F S ACRSEQDA=$O(^TMP("ACRPBAT",$J,ACRFYDA,ACRBATDA,ACRX,ACRSEQDA)) Q:'ACRSEQDA!$D(ACRQUIT) D PBD1
D APPSUM^ACRFPAY8
Q
PBD1 ;EP; TO DISPLAY BATCH PAYMENT SUMMARY
N ACRACH,X,Y,Z
S X=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0))
S Y=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,1))
S Z=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,2))
W !,"DOCUMENT #: ",$P(X,U,5)," ",$P(X,U,20)
W ?30,"CAN....: ",$P($G(^AUTTCAN(+$P(X,U,7),0)),U)
W ?60,"OBJECT CODE: ",$P($G(^AUTTOBJC(+$P(X,U,8),0)),U)
W !,"OTHER DOC.: ",$P(X,U,6)," ",$P(X,U,21)
W ?30,"FORM #.: "
W ?60,"FED/NONFED.: ",$P(X,U,15)
I $P(X,U,10) D I 1
.W !,"PAYEE.....: "
.W ?12,$P($G(^AUTTVNDR(+$P(X,U,10),0)),U)
.W ?60,"EIN: ",$P($G(^AUTTVNDR(+$P(X,U,10),11)),U,13)
.W !,"REMIT ADDR: "
.W ?12,$P(X,U,28)
.W !,"(PAYMENT",?12,$P(Y,U)," ",$P(Y,U,2)," ",$P(Y,U,3)
.W !,"RECORD)",?12,"ATTN: ",$P(X,U,25)
.N ACRX,ACRY,ACRZ
.S ACRX=$G(^AUTTVNDR(+$P(X,U,10),13))
.S ACRY=$G(^AUTTVNDR(+$P(X,U,10),14))
.S ACRZ=$G(^AUTTVNDR(+$P(X,U,10),19))
.I $P(ACRZ,U)]"",$S($D(^XUSEC("ACRFZ EDIT EFT",DUZ)):1,$D(^XUSEC("ACRFZ VIEW EFT",DUZ)):1,1:0) W !?12,$P(ACRZ,U),"/",$P(ACRZ,U,2),"/",$P(ACRZ,U,3)
.W !,"REMIT ADDR: "
.W ?12,$P(ACRY,U)
.W:$P(ACRY,U,2)]"" !?12,$P(ACRY,U,2)
.W !,"(VENDOR",?12,$P(ACRY,U,3)," ",$P($G(^DIC(5,+$P(ACRY,U,4),0)),U,2)," ",$P(ACRY,U,5)
.W !,"FILE)",?12,"ATTN: ",$P(ACRY,U,6)
.W !,"MAIL ADDR.: "
.W ?12,$P(ACRX,U)
.W:$P(ACRX,U,10)]"" !?12,$P(ACRX,U,10)
.W !?12,$P(ACRX,U,2)," ",$P($G(^DIC(5,+$P(ACRX,U,3),0)),U,2)," ",$P(ACRX,U,4)
.W !?12,"ATTN: ",$P(ACRX,U,5)
E I $P(X,U,24) D
.W !,"PAYEE.....: "
.;W ?12,$P($G(^VA(200,+$P(X,U,24),0)),U) ;ACR*2.1*19.02 IM16848
.W ?12,$$NAME2^ACRFUTL1(+$P(X,U,24)) ;ACR*2.1*19.02 IM16848
.S ACRZ=$G(^ACRAU(+$P(X,U,24),19))
.I $P(ACRZ,U)]"",$S($D(^XUSEC("ACRFZ EDIT EFT",DUZ)):1,$D(^XUSEC("ACRFZ VIEW EFT",DUZ)):1,1:0) W !?12,$P(ACRZ,U),"/",$P(ACRZ,U,2),"/",$P(ACRZ,U,3)
;W !,"ACCT TECH.: ",$P($G(^VA(200,+$P(X,U,3),0)),U) ;ACR*2.1*19.02 IM16848
W !,"ACCT TECH.: ",$$NAME2^ACRFUTL1(+$P(X,U,3)) ;ACR*2.1*19.02 IM16848
S ACRACH=$P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,2)),U,8)
;W !,$S(ACRACH="C"!(ACRACH="N"):"PAID FOR..: ",1:"ACH ADDEN.: ") ;ACR*2.1*17.05 IM17132
;W:$P(Z,U,14)]"" $P(Z,U,14)," " ;ACR*2.1*17.05 IM17132
;W:$L($P(Z,U,2))>1 $P(Z,U,2) ;ACR*2.1*17.05 IM17132
I "NCG"[ACRACH W !,"PAID FOR..: ",$P(Z,U,14) ;ACR*2.1*17.05 IM17132
I "AB"[ACRACH W !,"ACH ADDEN.: ",$P(Z,U,2) ;ACR*2.1*17.05 IM17132
S ACRBTYP=$P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,0)),U,4)
N XT ;ACR*2.1*5.02
S XT=$$NET^ACRFSSU(ACRFYDA,ACRBATDA,ACRSEQDA) ;ACR*2.1*5.02
W !,"PAY AMOUNT: ",$J($FN(XT,"P,",2),15) ;ACR*2.1*5.02
W ?30,"FULL/PART: "
;W ?60,"INT SEQ.: ",$P(Y,U,5) ;ACR*2.1*17.11 IM17514
W ?59,"INT SEQ.: ",$P(Y,U,5) ;ACR*2.1*17.11 IM17514
W !,"TRANS CODE: ",$P(X,U,18)
W ?30,"OTH TR CD: ",$P(X,U,19)
;W ?60,"INT $AMT: ",$P(Y,U,6) ;ACR*2.1*17.11 IM17514
W ?59,"INT $AMT: ",$P(Y,U,6) ;ACR*2.1*17.11 IM17514
W !,"SCHED NO..: ",$P(Y,U,11)
W ?30,"PP-DUE...: "
;W ?60,"INT DOC.: ",$P(Y,U,8) ;ACR*2.1*17.11 IM17514
W ?59,"INT DOC.: ",$P(Y,U,8) ;ACR*2.1*17.11 IM17514
W !,"APPROPRTN.: ",$P(Y,U,21)
W $$DASH^ACRFMENU
I $Y+10>IOSL D PAUSE^ACRFWARN Q:$D(ACRQUIT) D PBHEAD:$O(^TMP("ACRPBAT",$J,ACRFYDA,ACRBATDA,ACRX,ACRSEQDA))!($O(^TMP("ACRPBAT",$J,ACRFYDA,ACRBATDA,ACRX))]"")
Q
PBAT ;EP;TO PRINT BATCH PAYMENT LISTING
D PBEXIT
F D PB1 Q:$D(ACRQUIT)!$D(ACROUT)
PBEXIT K ACROUT,ACRQUIT,ACR1,ACR1A,ACR2,ACR2A,ACRX,ACRXREF,ACRAPP,ACRFY,ACR,ACRDC,ACRFYDA,ACRBATDA,ACRSEQDA
Q
PB1 W @IOF
W !!?10,"Batch Payment Listing"
K ACRFYDA,ACRBATDA,ACRSEQDA
D FYBAT^ACRFPAY2
I '$G(ACRFYDA)!'$G(ACRBATDA) S ACRQUIT="" Q
Q:'$G(ACRBATDA)
S (ZTRTN,ACRRTN)="PBDISP^ACRFPAY7"
S ZTDESC="BATCH PAYMENT LISTING"
D ^ACRFZIS
Q
PBHEAD ;EP;HEADER
W @IOF
S ACRDC=$G(ACRDC)+1
W !?10,"Batch Payment Listing",?60,"PAGE: ",ACRDC
W !?10,"Report Date: "
S Y=DT
X ^DD("DD")
W Y
W !?10,"Fiscal Year: ",$P(^AFSLAFP(ACRFYDA,0),U)
W !?10,"Batch......: ",ACRBATNO
W $$DASH^ACRFMENU
Q
ACRFPAY7 ;IHS/OIRM/DSD/THL,AEF - CERTIFY AND EXPORT PAYMENT BATCH; [ 09/23/2005 9:50 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**3,5,17,19**;NOV 05, 2001
+2 ;;
CASHREC ;EP;CASH RECONCILIAITON REPORT
+1 DO CREXIT
+2 WRITE !
+3 DO ^ACRFDATE
+4 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+5 IF '$GET(ACRBEGIN)!'$GET(ACREND)
QUIT
+6 SET (ACRRTN,ZTRTN)="CR^ACRFPAY7"
+7 SET ZTDESC="CASH RECONCILATION REPORT"
+8 DO ^ACRFZIS
CREXIT KILL ACR,ACRQUIT,ACROUT,ACRBEGIN,ACREND,ACRJ,ACRTOT,ACRSCHD,ACRFYDA,ACRBATDA,ACRSEQDA,ACR
+1 KILL ^TMP("ACRCR",$JOB)
+2 QUIT
CR ;EP;TO PRINT CASH RECONCILIATION REPORT
+1 DO CR1
+2 DO CREXIT
+3 QUIT
CR1 DO CRHEAD
+1 SET ACR=ACRBEGIN-.1
+2 FOR
SET ACR=$ORDER(^AFSLAFP("EXP",ACR))
IF 'ACR!(ACR>ACREND)
QUIT
Begin DoDot:1
+3 NEW X,Y,Z
+4 SET X=0
+5 FOR
SET X=$ORDER(^AFSLAFP("EXP",ACR,X))
IF 'X
QUIT
Begin DoDot:2
+6 SET Y=0
+7 FOR
SET Y=$ORDER(^AFSLAFP("EXP",ACR,X,Y))
IF 'Y
QUIT
Begin DoDot:3
+8 ;ACR*2.1*5.02
SET Z=$$BATCH^ACRFPAYE(X,Y)
+9 ;ACR*2.1*5.02
IF Z="G"
QUIT
+10 SET Z=$GET(^AFSLAFP(X,1,Y,2))
+11 IF $PIECE(Z,U,6)=""
QUIT
+12 SET ^TMP("ACRCR",$JOB,$PIECE(Z,U,6),X,Y)=""
End DoDot:3
End DoDot:2
End DoDot:1
+13 SET (ACRTOT,ACRJ)=0
+14 SET ACRSCHD=""
+15 FOR
SET ACRSCHD=$ORDER(^TMP("ACRCR",$JOB,ACRSCHD))
IF ACRSCHD=""!$DATA(ACRQUIT)
QUIT
Begin DoDot:1
+16 SET ACRFYDA=0
+17 FOR
SET ACRFYDA=$ORDER(^TMP("ACRCR",$JOB,ACRSCHD,ACRFYDA))
IF 'ACRFYDA!$DATA(ACRQUIT)
QUIT
Begin DoDot:2
+18 SET ACRBATDA=0
+19 FOR
SET ACRBATDA=$ORDER(^TMP("ACRCR",$JOB,ACRSCHD,ACRFYDA,ACRBATDA))
IF 'ACRBATDA!$DATA(ACRQUIT)
QUIT
Begin DoDot:3
+20 WRITE !,ACRSCHD
+21 WRITE ?14,$PIECE($GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,0)),U)
+22 SET Y=$PIECE($GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,2)),U)
+23 XECUTE ^DD("DD")
+24 WRITE ?24,Y
+25 SET ACRJ=ACRJ+1
+26 SET (ACRSEQDA,X)=0
+27 FOR
SET ACRSEQDA=$ORDER(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA))
IF 'ACRSEQDA
QUIT
Begin DoDot:4
+28 ;ACR*2.1*5.02
SET Y=$$NET^ACRFSSU(ACRFYDA,ACRBATDA,ACRSEQDA)
+29 SET X=X+Y
+30 SET ACRTOT=ACRTOT+Y
End DoDot:4
+31 WRITE ?64,$JUSTIFY($FNUMBER(X,"P,",2),15)
+32 IF $Y+4>IOSL
DO PAUSE^ACRFWARN
IF $DATA(ACRQUIT)
QUIT
DO CRHEAD
End DoDot:3
End DoDot:2
End DoDot:1
+33 WRITE $$DASH^ACRFMENU
+34 WRITE !,"TOTAL",?24,"COUNT: ",ACRJ,?64,$JUSTIFY($FNUMBER(ACRTOT,"P,",2),15)
+35 DO PAUSE^ACRFWARN
+36 QUIT
CRHEAD ;CASH RECONCILIATION HEADER
+1 WRITE @IOF
+2 WRITE $$DASH^ACRFMENU
+3 WRITE !?20,"Export listing for comparison with the"
+4 WRITE !?20,"Treasury Confirmation Report"
+5 SET Y=DT
+6 XECUTE ^DD("DD")
+7 WRITE !?20,"Report Date.....: ",Y
+8 SET Y=ACRBEGIN
+9 XECUTE ^DD("DD")
+10 WRITE !?20,"Report Period FR: ",Y
+11 SET Y=ACREND
+12 XECUTE ^DD("DD")
+13 WRITE !?20,"Report Period TO: ",Y
+14 WRITE $$DASH^ACRFMENU
+15 WRITE !,"SCHEDULE",?14,"BATCH",?24,"EXPORT",?72,"NET"
+16 WRITE !,"NUMBER",?14,"NUMBER",?24,"DATE",?72,"AMOUNT"
+17 WRITE $$DASH^ACRFMENU
+18 QUIT
APPROP ;EP;FOR APPROPRIATION REPORTS
+1 DO APPEXIT
+2 FOR
DO APP1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
APPEXIT KILL ACROUT,ACRQUIT,ACR1,ACR1A,ACR2,ACR2A,ACRX,ACRXREF,ACRAPP,ACRFY,ACR,ACRDC,ACRFYDA,ACRBATDA,ACRSEQDA
+1 KILL ^TMP("ACRAPPRP",$JOB)
+2 QUIT
APP1 WRITE @IOF
+1 WRITE !!?10,"Appropriation Report"
+2 SET DIR(0)="SO^1:Sort by Batch within Appropriation;2:Sort by Schedule within Appropriation;3:Sort by Appropriation within Schedule"
+3 SET DIR("A")="Which one"
+4 WRITE !
+5 DO DIR^ACRFDIC
+6 IF $DATA(ACRQUIT)!$DATA(ACROUT)!'Y
SET ACRQUIT=""
QUIT
+7 IF X=1
SET ACR1="APPROPRIATION"
SET ACR2="BATCH"
SET ACRXREF="PROBAT"
+8 IF X=2
SET ACR1="APPROPRIATION"
SET ACR2="SCHEDULE"
SET ACRXREF="PROSCH"
+9 IF X=3
SET ACR1="SCHEDULE"
SET ACR2="APPROPRIATION"
SET ACRXREF="SCHPRO"
+10 KILL ACRFYDA,ACRBATDA,ACRSEQDA
+11 DO FYBAT^ACRFPAY2
+12 IF $DATA(ACROUT)
QUIT
+13 IF '$GET(ACRBATDA)
SET (ACRBATNO,ACRBATDA)=""
+14 NEW ACRBATDX
+15 SET ACRBATDX=ACRBATDA
+16 SET ACRBATDA=ACRBATDA-1
+17 DO APP
+18 ;ACR*2.1*3.17
IF $DATA(ACRQUIT)
QUIT
+19 SET (ZTRTN,ACRRTN)="PAPP^ACRFPAY7"
+20 SET ZTDESC="PAYMENT APPROPRIATION REPORT"
+21 DO ^ACRFZIS
+22 QUIT
APP ;SELECT APPROPRIATION SORT RANGE
+1 SET DIC="^AUTTPRO("
+2 SET DIC(0)="AEMQZ"
+3 SET DIC("A")="Report for which APPROPRIATION: "
+4 WRITE !!,"Select an APPROPRIATION NO. to report for ONE Appropriation"
+5 WRITE !,"Press <ENTER> to report for all APPROPRIATIONs."
+6 WRITE !
+7 DO DIC^ACRFDIC
+8 IF X["^"
SET ACRQUIT=""
QUIT
+9 SET ACRAPP=$PIECE(Y,U,2)
+10 IF ACR1="APPROPRIATION"
SET ACR1A=ACRAPP
+11 IF '$TEST
SET ACR1A=""
+12 IF ACRAPP]""
SET ACRAPP=$ORDER(^AUTTPRO("B",ACRAPP),-1)
+13 QUIT
PAPP ;EP;TO PRINT APPROPRIATION REPORTS
+1 KILL ^TMP("ACRAPPRP",$JOB)
+2 DO PAPPHEAD
+3 SET ACRBATDA=0
+4 FOR
SET ACRBATDA=$ORDER(^AFSLAFP(ACRFYDA,1,ACRBATDA))
IF 'ACRBATDA!(ACRBATDX&(ACRBATDA'=ACRBATDX))
QUIT
Begin DoDot:1
+5 ;ACR*2.1*5.02
NEW ACRBAT
+6 ;ACR*2.1*5.02
SET ACRBAT=$$BATCH^ACRFPAYE(ACRFYDA,ACRBATDA)
+7 ;ACR*2.1*5.02
IF ACRBAT="G"
QUIT
+8 ;ACR*2.1*5.02
IF ACRBAT=""
QUIT
+9 SET ACRSEQDA=0
+10 FOR
SET ACRSEQDA=$ORDER(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA))
IF 'ACRSEQDA
QUIT
Begin DoDot:2
+11 NEW X,Y,Z
+12 SET X=$PIECE($GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,0)),U)
+13 SET Y=$GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,1))
+14 SET Z=$PIECE(Y,U,21)
+15 ;ACR*2.1*5.02
IF X=""!(Y="")!(Z="")
QUIT
+16 ;ACR*2.1*5.02
SET Y=$$NET^ACRFSSU(ACRFYDA,ACRBATDA,ACRSEQDA)
+17 IF ACR1="APPROPRIATION"
IF ACR2="BATCH"
SET ACR1X=Z
SET ACR2X=X
+18 IF ACR1="APPROPRIATION"
IF ACR2="SCHEDULE"
SET ACR1X=Z
SET ACR2X=Y
+19 IF ACR1="SCHEDULE"
IF ACR2="APPROPRIATION"
SET ACR1X=Y
SET ACR2X=Z
+20 SET ^TMP("ACRAPPRP",$JOB,ACR1X,ACR2X,ACRFYDA,ACRBATDA,ACRSEQDA)=""
End DoDot:2
End DoDot:1
+21 SET ACR1X=""
+22 FOR
SET ACR1X=$ORDER(^TMP("ACRAPPRP",$JOB,ACR1X))
IF ACR1X=""!$DATA(ACRQUIT)
QUIT
IF ACR1X[ACR1A
Begin DoDot:1
+23 WRITE !!,"FISCAL YEAR",?15,": ",ACRFY
+24 WRITE !,ACR1,?15,": ",ACR1X
+25 NEW ACR1TOT
+26 SET ACR1TOT=0
+27 SET ACR2X=""
+28 FOR
SET ACR2X=$ORDER(^TMP("ACRAPPRP",$JOB,ACR1X,ACR2X))
IF ACR2X=""!$DATA(ACRQUIT)
QUIT
Begin DoDot:2
+29 WRITE !,ACR2,?15,": ",ACR2X,!
+30 SET ACRBATDA=0
+31 FOR
SET ACRBATDA=$ORDER(^TMP("ACRAPPRP",$JOB,ACR1X,ACR2X,ACRFYDA,ACRBATDA))
IF 'ACRBATDA!$DATA(ACRQUIT)
QUIT
Begin DoDot:3
+32 SET ACRBATNO=$PIECE($GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,0)),U)
+33 SET ACRSEQDA=0
+34 FOR
SET ACRSEQDA=$ORDER(^TMP("ACRAPPRP",$JOB,ACR1X,ACR2X,ACRFYDA,ACRBATDA,ACRSEQDA))
IF 'ACRSEQDA!$DATA(ACRQUIT)
QUIT
Begin DoDot:4
+35 DO PDISP
+36 IF $Y+5>IOSL
DO PAUSE^ACRFWARN
IF $DATA(ACRQUIT)
QUIT
IF $ORDER(^TMP("ACRAPPRP",$JOB,ACR1X,ACR2X,ACRFYDA,ACRBATDA,ACRSEQDA))
DO PAPPHEAD
+37 IF '$ORDER(^TMP("ACRAPPRP",$JOB,ACR1X,ACR2X,ACRFYDA,ACRBATDA,ACRSEQDA))
DO PAUSE^ACRFWARN
End DoDot:4
+38 DO APPSUM^ACRFPAY8
End DoDot:3
+39 WRITE $$DASH^ACRFMENU
End DoDot:2
End DoDot:1
+40 DO PAUSE^ACRFWARN
+41 WRITE @IOF
+42 KILL ^TMP("ACRAPPRP",$JOB)
+43 QUIT
PAPPHEAD ;HEADER FOR APPROPRIATION REPORT
+1 WRITE @IOF
+2 SET ACRDC=$GET(ACRDC)+1
+3 WRITE !?10,"Appropriation Report",?60,"PAGE ",ACRDC
+4 WRITE !?10,"Report Date: "
+5 SET Y=DT
+6 XECUTE ^DD("DD")
+7 WRITE Y
+8 WRITE !?10,"Sort by....: ",ACR1
+9 WRITE !?10,"Then by....: ",ACR2
+10 WRITE $$DASH^ACRFMENU
+11 QUIT
PDISP ;APPROPRIATION DISPLAY
+1 NEW X,Y,Z,XT
+2 SET X=$GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0))
+3 SET Y=$GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,1))
+4 SET Z=$GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,2))
+5 ;ACR*2.1*5.02
SET XT=$$NET^ACRFSSU(ACRFYDA,ACRBATDA,ACRSEQDA)
+6 ;ACR*2.1*5.02
SET ACR1TOT=ACR1TOT+XT
+7 ;ACR*2.1*5.02
WRITE !,$PIECE(X,U),?5,$PIECE(X,U,20),?16,$PIECE(X,U,5),?20,$PIECE(X,U,21),?31,$PIECE(X,U,6)
+8 ;ACR*2.1*5.02
WRITE ?35,ACRBATNO,?42,$PIECE(Y,U,11)
+9 ;ACR*2.1*5.02
WRITE ?50,$JUSTIFY($FNUMBER(XT,"P,",2),15)
+10 WRITE !?5,$PIECE($GET(^AUTTCAN(+$PIECE(X,U,7),0)),U),?13,$PIECE($GET(^AUTTOBJC(+$PIECE(X,U,8),0)),U),?18,$PIECE(X,U,15),?20,$PIECE(Y,U,19),?22,$PIECE(X,U,17),?27,$PIECE(X,U,18)
+11 IF $PIECE(X,U,10)
WRITE ?50,$PIECE($GET(^AUTTVNDR(+$PIECE(X,U,10),0)),U)
+12 ;E I $P(X,U,24) W ?50,$P($G(^VA(200,+$P(X,U,24),0)),U) ;ACR*2.1*19.02 IM16848
+13 ;ACR*2.1*19.02 IM16848
IF '$TEST
IF $PIECE(X,U,24)
WRITE ?50,$$NAME2^ACRFUTL1(+$PIECE(X,U,24))
+14 WRITE !?5,$PIECE(Z,U,14)
+15 QUIT
PBDISP ;EP;BATCH DISPLAY
+1 KILL ACRAPPN
+2 DO PBHEAD
+3 SET ACRSEQDA=0
+4 FOR
SET ACRSEQDA=$ORDER(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA))
IF 'ACRSEQDA!$DATA(ACRQUIT)
QUIT
Begin DoDot:1
+5 NEW X
+6 SET X=$GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0))
+7 IF '$PIECE(X,U,10)&'$PIECE(X,U,24)
QUIT
+8 IF $PIECE(X,U,10)
SET X=$PIECE($GET(^AUTTVNDR($PIECE(X,U,10),0)),U)
+9 ;E S:$P(X,U,24) X=$P($G(^VA(200,$P(X,U,24),0)),U) ;ACR*2.1*19.02 IM16848
+10 ;ACR*2.1*19.02 IM16848
IF '$TEST
IF $PIECE(X,U,24)
SET X=$$NAME2^ACRFUTL1($PIECE(X,U,24))
+11 IF X=""
QUIT
+12 SET ^TMP("ACRPBAT",$JOB,ACRFYDA,ACRBATDA,X,ACRSEQDA)=""
End DoDot:1
+13 NEW ACRX
+14 SET ACRX=""
+15 FOR
SET ACRX=$ORDER(^TMP("ACRPBAT",$JOB,ACRFYDA,ACRBATDA,ACRX))
IF ACRX=""!$DATA(ACRQUIT)
QUIT
Begin DoDot:1
+16 SET ACRSEQDA=0
+17 FOR
SET ACRSEQDA=$ORDER(^TMP("ACRPBAT",$JOB,ACRFYDA,ACRBATDA,ACRX,ACRSEQDA))
IF 'ACRSEQDA!$DATA(ACRQUIT)
QUIT
DO PBD1
End DoDot:1
+18 DO APPSUM^ACRFPAY8
+19 QUIT
PBD1 ;EP; TO DISPLAY BATCH PAYMENT SUMMARY
+1 NEW ACRACH,X,Y,Z
+2 SET X=$GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0))
+3 SET Y=$GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,1))
+4 SET Z=$GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,2))
+5 WRITE !,"DOCUMENT #: ",$PIECE(X,U,5)," ",$PIECE(X,U,20)
+6 WRITE ?30,"CAN....: ",$PIECE($GET(^AUTTCAN(+$PIECE(X,U,7),0)),U)
+7 WRITE ?60,"OBJECT CODE: ",$PIECE($GET(^AUTTOBJC(+$PIECE(X,U,8),0)),U)
+8 WRITE !,"OTHER DOC.: ",$PIECE(X,U,6)," ",$PIECE(X,U,21)
+9 WRITE ?30,"FORM #.: "
+10 WRITE ?60,"FED/NONFED.: ",$PIECE(X,U,15)
+11 IF $PIECE(X,U,10)
Begin DoDot:1
+12 WRITE !,"PAYEE.....: "
+13 WRITE ?12,$PIECE($GET(^AUTTVNDR(+$PIECE(X,U,10),0)),U)
+14 WRITE ?60,"EIN: ",$PIECE($GET(^AUTTVNDR(+$PIECE(X,U,10),11)),U,13)
+15 WRITE !,"REMIT ADDR: "
+16 WRITE ?12,$PIECE(X,U,28)
+17 WRITE !,"(PAYMENT",?12,$PIECE(Y,U)," ",$PIECE(Y,U,2)," ",$PIECE(Y,U,3)
+18 WRITE !,"RECORD)",?12,"ATTN: ",$PIECE(X,U,25)
+19 NEW ACRX,ACRY,ACRZ
+20 SET ACRX=$GET(^AUTTVNDR(+$PIECE(X,U,10),13))
+21 SET ACRY=$GET(^AUTTVNDR(+$PIECE(X,U,10),14))
+22 SET ACRZ=$GET(^AUTTVNDR(+$PIECE(X,U,10),19))
+23 IF $PIECE(ACRZ,U)]""
IF $SELECT($DATA(^XUSEC("ACRFZ EDIT EFT",DUZ)):1,$DATA(^XUSEC("ACRFZ VIEW EFT",DUZ)):1,1:0)
WRITE !?12,$PIECE(ACRZ,U),"/",$PIECE(ACRZ,U,2),"/",$PIECE(ACRZ,U,3)
+24 WRITE !,"REMIT ADDR: "
+25 WRITE ?12,$PIECE(ACRY,U)
+26 IF $PIECE(ACRY,U,2)]""
WRITE !?12,$PIECE(ACRY,U,2)
+27 WRITE !,"(VENDOR",?12,$PIECE(ACRY,U,3)," ",$PIECE($GET(^DIC(5,+$PIECE(ACRY,U,4),0)),U,2)," ",$PIECE(ACRY,U,5)
+28 WRITE !,"FILE)",?12,"ATTN: ",$PIECE(ACRY,U,6)
+29 WRITE !,"MAIL ADDR.: "
+30 WRITE ?12,$PIECE(ACRX,U)
+31 IF $PIECE(ACRX,U,10)]""
WRITE !?12,$PIECE(ACRX,U,10)
+32 WRITE !?12,$PIECE(ACRX,U,2)," ",$PIECE($GET(^DIC(5,+$PIECE(ACRX,U,3),0)),U,2)," ",$PIECE(ACRX,U,4)
+33 WRITE !?12,"ATTN: ",$PIECE(ACRX,U,5)
End DoDot:1
IF 1
+34 IF '$TEST
IF $PIECE(X,U,24)
Begin DoDot:1
+35 WRITE !,"PAYEE.....: "
+36 ;W ?12,$P($G(^VA(200,+$P(X,U,24),0)),U) ;ACR*2.1*19.02 IM16848
+37 ;ACR*2.1*19.02 IM16848
WRITE ?12,$$NAME2^ACRFUTL1(+$PIECE(X,U,24))
+38 SET ACRZ=$GET(^ACRAU(+$PIECE(X,U,24),19))
+39 IF $PIECE(ACRZ,U)]""
IF $SELECT($DATA(^XUSEC("ACRFZ EDIT EFT",DUZ)):1,$DATA(^XUSEC("ACRFZ VIEW EFT",DUZ)):1,1:0)
WRITE !?12,$PIECE(ACRZ,U),"/",$PIECE(ACRZ,U,2),"/",$PIECE(ACRZ,U,3)
End DoDot:1
+40 ;W !,"ACCT TECH.: ",$P($G(^VA(200,+$P(X,U,3),0)),U) ;ACR*2.1*19.02 IM16848
+41 ;ACR*2.1*19.02 IM16848
WRITE !,"ACCT TECH.: ",$$NAME2^ACRFUTL1(+$PIECE(X,U,3))
+42 SET ACRACH=$PIECE($GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,2)),U,8)
+43 ;W !,$S(ACRACH="C"!(ACRACH="N"):"PAID FOR..: ",1:"ACH ADDEN.: ") ;ACR*2.1*17.05 IM17132
+44 ;W:$P(Z,U,14)]"" $P(Z,U,14)," " ;ACR*2.1*17.05 IM17132
+45 ;W:$L($P(Z,U,2))>1 $P(Z,U,2) ;ACR*2.1*17.05 IM17132
+46 ;ACR*2.1*17.05 IM17132
IF "NCG"[ACRACH
WRITE !,"PAID FOR..: ",$PIECE(Z,U,14)
+47 ;ACR*2.1*17.05 IM17132
IF "AB"[ACRACH
WRITE !,"ACH ADDEN.: ",$PIECE(Z,U,2)
+48 SET ACRBTYP=$PIECE($GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,0)),U,4)
+49 ;ACR*2.1*5.02
NEW XT
+50 ;ACR*2.1*5.02
SET XT=$$NET^ACRFSSU(ACRFYDA,ACRBATDA,ACRSEQDA)
+51 ;ACR*2.1*5.02
WRITE !,"PAY AMOUNT: ",$JUSTIFY($FNUMBER(XT,"P,",2),15)
+52 WRITE ?30,"FULL/PART: "
+53 ;W ?60,"INT SEQ.: ",$P(Y,U,5) ;ACR*2.1*17.11 IM17514
+54 ;ACR*2.1*17.11 IM17514
WRITE ?59,"INT SEQ.: ",$PIECE(Y,U,5)
+55 WRITE !,"TRANS CODE: ",$PIECE(X,U,18)
+56 WRITE ?30,"OTH TR CD: ",$PIECE(X,U,19)
+57 ;W ?60,"INT $AMT: ",$P(Y,U,6) ;ACR*2.1*17.11 IM17514
+58 ;ACR*2.1*17.11 IM17514
WRITE ?59,"INT $AMT: ",$PIECE(Y,U,6)
+59 WRITE !,"SCHED NO..: ",$PIECE(Y,U,11)
+60 WRITE ?30,"PP-DUE...: "
+61 ;W ?60,"INT DOC.: ",$P(Y,U,8) ;ACR*2.1*17.11 IM17514
+62 ;ACR*2.1*17.11 IM17514
WRITE ?59,"INT DOC.: ",$PIECE(Y,U,8)
+63 WRITE !,"APPROPRTN.: ",$PIECE(Y,U,21)
+64 WRITE $$DASH^ACRFMENU
+65 IF $Y+10>IOSL
DO PAUSE^ACRFWARN
IF $DATA(ACRQUIT)
QUIT
IF $ORDER(^TMP("ACRPBAT",$JOB,ACRFYDA,ACRBATDA,ACRX,ACRSEQDA))!($ORDER(^TMP("ACRPBAT",$JOB,ACRFYDA,ACRBATDA,ACRX))]"")
DO PBHEAD
+66 QUIT
PBAT ;EP;TO PRINT BATCH PAYMENT LISTING
+1 DO PBEXIT
+2 FOR
DO PB1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
PBEXIT KILL ACROUT,ACRQUIT,ACR1,ACR1A,ACR2,ACR2A,ACRX,ACRXREF,ACRAPP,ACRFY,ACR,ACRDC,ACRFYDA,ACRBATDA,ACRSEQDA
+1 QUIT
PB1 WRITE @IOF
+1 WRITE !!?10,"Batch Payment Listing"
+2 KILL ACRFYDA,ACRBATDA,ACRSEQDA
+3 DO FYBAT^ACRFPAY2
+4 IF '$GET(ACRFYDA)!'$GET(ACRBATDA)
SET ACRQUIT=""
QUIT
+5 IF '$GET(ACRBATDA)
QUIT
+6 SET (ZTRTN,ACRRTN)="PBDISP^ACRFPAY7"
+7 SET ZTDESC="BATCH PAYMENT LISTING"
+8 DO ^ACRFZIS
+9 QUIT
PBHEAD ;EP;HEADER
+1 WRITE @IOF
+2 SET ACRDC=$GET(ACRDC)+1
+3 WRITE !?10,"Batch Payment Listing",?60,"PAGE: ",ACRDC
+4 WRITE !?10,"Report Date: "
+5 SET Y=DT
+6 XECUTE ^DD("DD")
+7 WRITE Y
+8 WRITE !?10,"Fiscal Year: ",$PIECE(^AFSLAFP(ACRFYDA,0),U)
+9 WRITE !?10,"Batch......: ",ACRBATNO
+10 WRITE $$DASH^ACRFMENU
+11 QUIT
