ACRFPAY8 ;IHS/OIRM/DSD/THL,AEF - CERTIFY AND EXPORT PAYMENT BATCH; [ 11/01/2001 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
;;
VENDOR ;EP;SELECT VENDOR
S DIC="^AUTTVNDR("
S DIC(0)="AEMQZ"
S DIC("A")="VENDOR NAME OR EIN..: "
S DIC("S")="I $P($G(^(11)),U)]"""",$P($G(^(13)),U)]""""&($P($G(^(13)),U,4)]"""")!($P($G(^(14)),U)]""""&($P($G(^(14)),U,4)]""""))"
I $G(ACRACH)]"","AB"[ACRACH S DIC("S")=DIC("S")_",$P($G(^(19)),U)]"""""
S:$P($G(^AUTTVNDR(+$G(ACRVDA),0)),U) DIC("B")=$P(^(0),U)
I $G(ACRREF)=618,$G(ACRVDAT),$P($G(^AUTTVNDR(ACRVDAT,0)),U)]"" S DIC("B")=$P(^(0),U)
K ACRVDAT
D DIC^ACRFDIC
I X["^" S ACROUT="" Q
I $D(DTOUT)!($D(DUOUT)) S ACROUT="" Q
I +Y<1 W !!,"VENDOR'S NAME REQUIRED",! G VENDOR
S (ACRVDA,ACRVDAX)=+Y
S:$G(ACRREF)=618 ACRVDAT=+Y
Q
LCOD ;EP;SELECT LOCATION CODE
S DIC="^AUTTLCOD("
S DIC(0)="AEMQZ"
S DIC("A")="LOCATION CODE.......: "
D DIC^ACRFDIC
I X["^" S ACROUT="" Q
I $D(DTOUT)!($D(DUOUT)) S ACROUT="" Q
I +Y<1 W !!,"LOCATION CODE REQUIRED",! G LCOD
S $P(ACRLBDT,U,11)=+Y
Q
TRAVELER ;EP;SELECT TRAVERER
S DIC="^ACRAU("
S DIC(0)="AEMQZ"
S DIC("A")="TRAVELER............: "
D DIC^ACRFDIC
I X["^" S ACROUT="" Q
I $D(DTOUT)!($D(DUOUT)) S ACROUT="" Q
I +Y<1 W !!,"TRAVELER'S NAME REQUIRED",! G TRAVELER
S ACRDUZ=+Y
Q
CCOMPLET ;EP;COMPLETE THE COMBINATION/TRANSFER OF BATCHES
S DIR(0)="YO"
S DIR("A",1)="Are you ABSOLUTELY CERTAIN you want to combine"
S DIR("A")="the(se) SOURCE batches into the DESTINATION Batch."
S DIR("B")="NO"
W !
D DIR^ACRFDIC
Q:+Y'=1
S ACRS=0
F S ACRS=$O(ACR("SOURCE",ACRS)) Q:'ACRS D
.S X=ACR("SOURCE",ACRS)
.S ACRSBAT=+X
.S ACRSFY=$P(X,U,2)
.Q:'ACRSBAT
.S ACRSS=0
.F S ACRSS=$O(^AFSLAFP(ACRSFY,1,ACRSBAT,1,ACRSS)) Q:'ACRSS D TRANSFER^ACRFPAY2
Q
CSELECT K ACRDEST,ACRACH,ACRX
Q
BSTATUS ;EP;TO PRINT BATCH STATUS
Q:$G(ACRXALL)="ALL"
F D BS Q:$D(ACRQUIT)!$D(ACROUT)
K ACRQUIT
Q
BS K ACRFYDA,ACRBATDA
W @IOF
W !!,"Select Fiscal Year and Batch number for the"
W !,"Batch STATUS Report"
D FYBAT^ACRFPAY2
I '$G(ACRFYDA)!'$G(ACRBATDA) S ACRQUIT="" Q
N ACR0,ACR1,ACR2
D BS1
Q
BS1 ;EP;
Q:$G(ACRXALL)="ALL"
Q:'$G(ACRFYDA)!'$D(ACRBATDA)
S ACR0=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,0))
S ACR1=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1))
S ACR2=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,2))
W @IOF
W !?20,"Batch STATUS Report"
W !?20,"Report Date: "
S Y=DT
X ^DD("DD")
W Y
W !!,"Fiscal Year.......: ",ACRFY
W !,"Batch Number......: ",ACRBATNO
W !,"Treasury Schedule.: ",$P(ACR2,U,6)
W:$P(ACR2,U,8)]"" !,"Schedule Format...: ",$P($P($P($G(^DD(9002325.01,22,0)),U,3),$P(ACR2,U,8)_":",2),";")
I '$O(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,0)) W " (This batch has no payments)"
W !,"Payment Due.......: "
I $P(ACR2,U,2) D I 1
.S Y=$P(ACR2,U,2)
.X ^DD("DD")
.W Y
W !,"Payment Open/Clsd.: "
W $S($P(ACR2,U,3)="O":"OPEN",$P(ACR2,U,3)="C":"CLOSED",1:"NOT SPECIFIED")
W !,"Payment Certified.: "
I $P(ACR0,U,5) D I 1
.S Y=$P(ACR0,U,5)
.X ^DD("DD")
.W Y
E W "Not yet certified"
W !,"Payment Exported..: "
I $P(ACR2,U) D I 1
.S Y=$P(ACR2,U)
.X ^DD("DD")
.W Y
E W "Not yet exported"
I $P(ACR2,U,11)]"" W !,"ECS FileName......: ",$P(ACR2,U,11)
K ACRAPPN
N ACRSEQDA,ACRTOT,ACRTOTC,J,K
S (ACRSEQDA,J,K,ACRTOT,ACRTOTC)=0
F S ACRSEQDA=$O(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA)) Q:'ACRSEQDA D
.S ACRTCODE=$P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0)),U,18)
.S ACRAMT=+$P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0)),U,11)
. S ACRBTYP=$P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,0)),U,4)
. S ACRAMT=$S(ACRBTYP="T":$$NET^ACRFSSU(ACRFYDA,ACRBATDA,ACRSEQDA),1:ACRAMT)
.I ACRTCODE'=23717 D
..S J=J+1
..S ACRTOT=ACRTOT+ACRAMT
.I ACRTCODE=23717 D
..S K=K+1
..S ACRTOTC=ACRTOTC+ACRAMT
W !,"Number of Paymts..: ",J
W !,"Tot amt of Paymts.: ",$J($FN(ACRTOT,"P,",2),12)
I K D
.W !,"Number of Credits.: ",K
.W !,"Tot amt of Credits: ",$J($FN(ACRTOTC,"P,",2),12)
.W !?21,"------------"
.W !,"Actual Payment....: ",$J($FN(ACRTOT-ACRTOTC,"P,",2),12)
W !
D PAUSE^ACRFWARN:$G(ACRXALL)'="ALL"
D APPSUM
Q
BANK ;UPDATE BANK ROUTINE INFORMATION
N X,Y,ACRCHK,ACRRTN,ACRDAN
S X=$P(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0),U,10)
I X D Q:$P(Y,U)=""
.S Y=$G(^AUTTVNDR(X,19))
I 'X S X=$P(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0),U,24) D:X Q:$P(Y,U)=""
.S Y=$G(^ACRAU(X,19))
Q:$P(Y,U)=""
S ACRCHK=$P(Y,U)
S ACRRTN=$P(Y,U,2)
S ACRDAN=$P(Y,U,3)
S DA(2)=ACRFYDA
S DA(1)=ACRBATDA
S DA=ACRSEQDA
S DIE="^AFSLAFP("_DA(2)_",1,"_DA(1)_",1,"
S DR="1901////"_ACRCHK_";1902////"_ACRRTN_";1903////"_ACRDAN
D DIE^ACRFDIC
Q
SSCHUP ;EP;
Q:$E($P(^AFSLAFP(ACRFYDA,1,ACRBATDA,0),U))="G"
N ACRSEQDA,ACRJ,ACR1
S (ACRSEQDA,ACRJ)=0
F S ACRSEQDA=$O(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA)) Q:'ACRSEQDA!$D(ACRQUIT) D
.Q:'$D(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0)) S ACR1=$G(^(1))
.S ACRJ=ACRJ+1
.I $G(ACRBSCH)]"",$P(ACR1,U,11)'=ACRBSCH D SSCH
.D BANK:"AB"[$P(^AFSLAFP(ACRFYDA,1,ACRBATDA,2),U,8)
Q
SSCH ;UPDATE SEQUENCE ENTRY SCHEDULE NUMBER
S DA(2)=ACRFYDA
S DA(1)=ACRBATDA
S DA=ACRSEQDA
S DIE="^AFSLAFP("_DA(2)_",1,"_DA(1)_",1,"
S DR="40////"_ACRBSCH
D DIE^ACRFDIC
I $P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,1)),U,11)="" S $P(^(1),U,11)=ACRBSCH
Q
APPSUM ;EP;APPROPRIATION SUMMARY
Q:$G(ACRXALL)="ALL"
K ACRQUIT
D APPSUMH
N ACRSEQDA,Y,Z
S ACRSEQDA=0
F S ACRSEQDA=$O(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA)) Q:'ACRSEQDA D
.S X=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0))
.S Y=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,1))
.S:$P(Y,U,21)="" $P(Y,U,21)="NOT STATED"
.S Z=$P(X,U,18)
.S:'$D(ACRAPPN($P(Y,U,21))) ACRAPPN($P(Y,U,21))=""
. S ACRBTYP=$P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,0)),U,4)
. I Z'=23717 S ACRAPPN($P(Y,U,21))=ACRAPPN($P(Y,U,21))+$S(ACRBTYP="V":+$P(X,U,11),ACRBTYP="T":$$NET^ACRFSSU(ACRFYDA,ACRBATDA,ACRSEQDA),1:0)
.E S ACRAPPN($P(Y,U,21))=ACRAPPN($P(Y,U,21))-$P(X,U,11)
S Z=0
S X=""
F S X=$O(ACRAPPN(X)) Q:X=""!$D(ACRQUIT) S Z=Z+ACRAPPN(X)
S X=""
F S X=$O(ACRAPPN(X)) Q:X=""!$D(ACRQUIT) D
.W !?10,X,?25,$J($FN(+ACRAPPN(X),"P,",2),15)
.I IOSL-4<$Y D Q:$D(ACRQUIT)
..N X,Y,Z
..D PAUSE^ACRFWARN
..Q:$D(ACRQUIT)
..D APPSUMH
D AH1
W !?25,$J($FN(Z,"P,",2),15)
K ACRAPPN
D PAUSE^ACRFWARN
Q
APPSUMH ;APPROPRIATION SUMMARY HEADER
W @IOF
W !!,"Appropriation Summary "
W:$G(ACRBATNO)]"" "Batch NO. ",ACRBATNO
W:$G(ACRSCHNO)]"" " Schedule NO. ",ACRSCHNO
W !!?10,"APPROPRIATION",?25,"AMOUNT"
AH1 W !?10,"-------------",?25,"---------------"
Q
EXPLIST ;EP;TO PRINT LIST OF EXPORT FILES FOR SPECIFIED DATE
D EXPEXIT
F D EXP1 Q:$D(ACRQUIT)!$D(ACROUT)
EXPEXIT K ACRQUIT,ACRDC
K ^TMP("ACREXP",$J)
Q
EXP1 ;
D EXPEXIT
W @IOF
W !?17,"Enter the EXPORT DATE(S)",!
D DATES^ACRFDATE
I '$G(ACRBEGIN) S ACRQUIT="" Q
S (ACRRTN,ZTRTN)="EXP2^ACRFPAY8"
S ZTDESC="LIST OF BATCHES EXPORTED ON SPECIFIC DATE"
D ^ACRFZIS
Q
EXP2 ;EP;TO PRINT LIST OF BATCHES EXPORTED ON SPECIFIC DATE
K ACRQUIT
N ACRX,ACRY,ACRZ,ACRDC,ACRXX,ACRXY,Z
S ACRDATE=ACRBEGIN-.0001
F S ACRDATE=$O(^AFSLAFP("EXP",ACRDATE)) Q:'ACRDATE!(ACRDATE>(ACREND+.9999)) D
.S ACRFYDA=0
.F S ACRFYDA=$O(^AFSLAFP("EXP",ACRDATE,ACRFYDA)) Q:'ACRFYDA D
..S ACRBATDA=0
..F S ACRBATDA=$O(^AFSLAFP("EXP",ACRDATE,ACRFYDA,ACRBATDA)) Q:'ACRBATDA D
...N X,Y,Z,T1,T2,N1,N2
...S (ACRSEQDA,N1,T1,N2,T2)=0
...F S ACRSEQDA=$O(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA)) Q:'ACRSEQDA D
....S X=^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0)
....S Y=$P(X,U,18)
....I Y'=23717 S N1=N1+1,T1=T1+$P(X,U,11)
....I Y=23717 S N2=N2+1,T2=T2+$P(X,U,11)
...S ACRY=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,0))
...S ACRZ=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,2))
...S ^TMP("ACREXP",$J,ACRDATE,$S($P(ACRZ,U,11)]"":$P(ACRZ,U,11),1:"NOT STATED"),ACRBATDA)=$P(ACRY,U)_U_$P(ACRZ,U,6)_U_$P(ACRZ,U,11)_U_$P(ACRZ,U,8)_U_N1_U_T1_U_N2_U_T2
I '$D(^TMP("ACREXP",$J)) D
.W !,"No EXPORTS recorded on "
.S Y=ACRBEGIN
.X ^DD("DD")
.W Y
S ACRDATE=""
F S ACRDATE=$O(^TMP("ACREXP",$J,ACRDATE)) Q:ACRDATE=""!$D(ACROUT) D
.D EXPH
.S ACRXX=""
.F S ACRXX=$O(^TMP("ACREXP",$J,ACRDATE,ACRXX)) Q:ACRXX=""!$D(ACROUT) D
..S ACRXY=0
..F S ACRXY=$O(^TMP("ACREXP",$J,ACRDATE,ACRXX,ACRXY)) Q:'ACRXY!$D(^ACROUT) D
...S Z=^TMP("ACREXP",$J,ACRDATE,ACRXX,ACRXY)
...W !,$P(Z,U),?8,$P(Z,U,2),?20,$P(Z,U,3),?30
...W $S($E($P(Z,U,4))="C":"CHECKS",$E($P(Z,U,4))="A":"GROUPD",$E($P(Z,U,4))="B":"NOTGPD",$E($P(Z,U,4))="G":"DHRONL",1:"")
...W ?38,$J($P(Z,U,5),3),?42,$J($FN($P(Z,U,6),"P,",2),15)
...W ?59,$J($P(Z,U,7),3),?63,$J($FN($P(Z,U,8),"P,",2),15)
...I IOSL-4<$Y D PAUSE^ACRFWARN Q:$D(ACROUT) D EXPH
...K ACRQUIT
.D PAUSE^ACRFWARN
Q
EXPH ;EXPORT LIST HEADER
W @IOF
W !?10,"List of files exported on "
S Y=ACRDATE
X ^DD("DD")
W Y
W !?10,"Report Date: "
S Y=DT
X ^DD("DD")
W Y
S ACRDC=$G(ACRDC)+1
W ?55,"PAGE: ",ACRDC
W !?40,"PAYMENTS",?62,"CREDITS"
W !,"BATCH",?8,"SCHD",?20,"ECS FILE",?30,"FORMAT",?38,"NO.",?44,"AMOUNT",?59,"NO.",?66,"AMOUNT"
W !,"------",?8,"------",?20,"--------",?30,"------",?38,"---",?42,"---------------",?59,"---",?63,"---------------"
Q
ACRFPAY8 ;IHS/OIRM/DSD/THL,AEF - CERTIFY AND EXPORT PAYMENT BATCH; [ 11/01/2001 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
+2 ;;
VENDOR ;EP;SELECT VENDOR
+1 SET DIC="^AUTTVNDR("
+2 SET DIC(0)="AEMQZ"
+3 SET DIC("A")="VENDOR NAME OR EIN..: "
+4 SET DIC("S")="I $P($G(^(11)),U)]"""",$P($G(^(13)),U)]""""&($P($G(^(13)),U,4)]"""")!($P($G(^(14)),U)]""""&($P($G(^(14)),U,4)]""""))"
+5 IF $GET(ACRACH)]""
IF "AB"[ACRACH
SET DIC("S")=DIC("S")_",$P($G(^(19)),U)]"""""
+6 IF $PIECE($GET(^AUTTVNDR(+$GET(ACRVDA),0)),U)
SET DIC("B")=$PIECE(^(0),U)
+7 IF $GET(ACRREF)=618
IF $GET(ACRVDAT)
IF $PIECE($GET(^AUTTVNDR(ACRVDAT,0)),U)]""
SET DIC("B")=$PIECE(^(0),U)
+8 KILL ACRVDAT
+9 DO DIC^ACRFDIC
+10 IF X["^"
SET ACROUT=""
QUIT
+11 IF $DATA(DTOUT)!($DATA(DUOUT))
SET ACROUT=""
QUIT
+12 IF +Y<1
WRITE !!,"VENDOR'S NAME REQUIRED",!
GOTO VENDOR
+13 SET (ACRVDA,ACRVDAX)=+Y
+14 IF $GET(ACRREF)=618
SET ACRVDAT=+Y
+15 QUIT
LCOD ;EP;SELECT LOCATION CODE
+1 SET DIC="^AUTTLCOD("
+2 SET DIC(0)="AEMQZ"
+3 SET DIC("A")="LOCATION CODE.......: "
+4 DO DIC^ACRFDIC
+5 IF X["^"
SET ACROUT=""
QUIT
+6 IF $DATA(DTOUT)!($DATA(DUOUT))
SET ACROUT=""
QUIT
+7 IF +Y<1
WRITE !!,"LOCATION CODE REQUIRED",!
GOTO LCOD
+8 SET $PIECE(ACRLBDT,U,11)=+Y
+9 QUIT
TRAVELER ;EP;SELECT TRAVERER
+1 SET DIC="^ACRAU("
+2 SET DIC(0)="AEMQZ"
+3 SET DIC("A")="TRAVELER............: "
+4 DO DIC^ACRFDIC
+5 IF X["^"
SET ACROUT=""
QUIT
+6 IF $DATA(DTOUT)!($DATA(DUOUT))
SET ACROUT=""
QUIT
+7 IF +Y<1
WRITE !!,"TRAVELER'S NAME REQUIRED",!
GOTO TRAVELER
+8 SET ACRDUZ=+Y
+9 QUIT
CCOMPLET ;EP;COMPLETE THE COMBINATION/TRANSFER OF BATCHES
+1 SET DIR(0)="YO"
+2 SET DIR("A",1)="Are you ABSOLUTELY CERTAIN you want to combine"
+3 SET DIR("A")="the(se) SOURCE batches into the DESTINATION Batch."
+4 SET DIR("B")="NO"
+5 WRITE !
+6 DO DIR^ACRFDIC
+7 IF +Y'=1
QUIT
+8 SET ACRS=0
+9 FOR
SET ACRS=$ORDER(ACR("SOURCE",ACRS))
IF 'ACRS
QUIT
Begin DoDot:1
+10 SET X=ACR("SOURCE",ACRS)
+11 SET ACRSBAT=+X
+12 SET ACRSFY=$PIECE(X,U,2)
+13 IF 'ACRSBAT
QUIT
+14 SET ACRSS=0
+15 FOR
SET ACRSS=$ORDER(^AFSLAFP(ACRSFY,1,ACRSBAT,1,ACRSS))
IF 'ACRSS
QUIT
DO TRANSFER^ACRFPAY2
End DoDot:1
+16 QUIT
CSELECT KILL ACRDEST,ACRACH,ACRX
+1 QUIT
BSTATUS ;EP;TO PRINT BATCH STATUS
+1 IF $GET(ACRXALL)="ALL"
QUIT
+2 FOR
DO BS
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+3 KILL ACRQUIT
+4 QUIT
BS KILL ACRFYDA,ACRBATDA
+1 WRITE @IOF
+2 WRITE !!,"Select Fiscal Year and Batch number for the"
+3 WRITE !,"Batch STATUS Report"
+4 DO FYBAT^ACRFPAY2
+5 IF '$GET(ACRFYDA)!'$GET(ACRBATDA)
SET ACRQUIT=""
QUIT
+6 NEW ACR0,ACR1,ACR2
+7 DO BS1
+8 QUIT
BS1 ;EP;
+1 IF $GET(ACRXALL)="ALL"
QUIT
+2 IF '$GET(ACRFYDA)!'$DATA(ACRBATDA)
QUIT
+3 SET ACR0=$GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,0))
+4 SET ACR1=$GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,1))
+5 SET ACR2=$GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,2))
+6 WRITE @IOF
+7 WRITE !?20,"Batch STATUS Report"
+8 WRITE !?20,"Report Date: "
+9 SET Y=DT
+10 XECUTE ^DD("DD")
+11 WRITE Y
+12 WRITE !!,"Fiscal Year.......: ",ACRFY
+13 WRITE !,"Batch Number......: ",ACRBATNO
+14 WRITE !,"Treasury Schedule.: ",$PIECE(ACR2,U,6)
+15 IF $PIECE(ACR2,U,8)]""
WRITE !,"Schedule Format...: ",$PIECE($PIECE($PIECE($GET(^DD(9002325.01,22,0)),U,3),$PIECE(ACR2,U,8)_":",2),";")
+16 IF '$ORDER(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,0))
WRITE " (This batch has no payments)"
+17 WRITE !,"Payment Due.......: "
+18 IF $PIECE(ACR2,U,2)
Begin DoDot:1
+19 SET Y=$PIECE(ACR2,U,2)
+20 XECUTE ^DD("DD")
+21 WRITE Y
End DoDot:1
IF 1
+22 WRITE !,"Payment Open/Clsd.: "
+23 WRITE $SELECT($PIECE(ACR2,U,3)="O":"OPEN",$PIECE(ACR2,U,3)="C":"CLOSED",1:"NOT SPECIFIED")
+24 WRITE !,"Payment Certified.: "
+25 IF $PIECE(ACR0,U,5)
Begin DoDot:1
+26 SET Y=$PIECE(ACR0,U,5)
+27 XECUTE ^DD("DD")
+28 WRITE Y
End DoDot:1
IF 1
+29 IF '$TEST
WRITE "Not yet certified"
+30 WRITE !,"Payment Exported..: "
+31 IF $PIECE(ACR2,U)
Begin DoDot:1
+32 SET Y=$PIECE(ACR2,U)
+33 XECUTE ^DD("DD")
+34 WRITE Y
End DoDot:1
IF 1
+35 IF '$TEST
WRITE "Not yet exported"
+36 IF $PIECE(ACR2,U,11)]""
WRITE !,"ECS FileName......: ",$PIECE(ACR2,U,11)
+37 KILL ACRAPPN
+38 NEW ACRSEQDA,ACRTOT,ACRTOTC,J,K
+39 SET (ACRSEQDA,J,K,ACRTOT,ACRTOTC)=0
+40 FOR
SET ACRSEQDA=$ORDER(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA))
IF 'ACRSEQDA
QUIT
Begin DoDot:1
+41 SET ACRTCODE=$PIECE($GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0)),U,18)
+42 SET ACRAMT=+$PIECE($GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0)),U,11)
+43 SET ACRBTYP=$PIECE($GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,0)),U,4)
+44 SET ACRAMT=$SELECT(ACRBTYP="T":$$NET^ACRFSSU(ACRFYDA,ACRBATDA,ACRSEQDA),1:ACRAMT)
+45 IF ACRTCODE'=23717
Begin DoDot:2
+46 SET J=J+1
+47 SET ACRTOT=ACRTOT+ACRAMT
End DoDot:2
+48 IF ACRTCODE=23717
Begin DoDot:2
+49 SET K=K+1
+50 SET ACRTOTC=ACRTOTC+ACRAMT
End DoDot:2
End DoDot:1
+51 WRITE !,"Number of Paymts..: ",J
+52 WRITE !,"Tot amt of Paymts.: ",$JUSTIFY($FNUMBER(ACRTOT,"P,",2),12)
+53 IF K
Begin DoDot:1
+54 WRITE !,"Number of Credits.: ",K
+55 WRITE !,"Tot amt of Credits: ",$JUSTIFY($FNUMBER(ACRTOTC,"P,",2),12)
+56 WRITE !?21,"------------"
+57 WRITE !,"Actual Payment....: ",$JUSTIFY($FNUMBER(ACRTOT-ACRTOTC,"P,",2),12)
End DoDot:1
+58 WRITE !
+59 IF $GET(ACRXALL)'="ALL"
DO PAUSE^ACRFWARN
+60 DO APPSUM
+61 QUIT
BANK ;UPDATE BANK ROUTINE INFORMATION
+1 NEW X,Y,ACRCHK,ACRRTN,ACRDAN
+2 SET X=$PIECE(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0),U,10)
+3 IF X
Begin DoDot:1
+4 SET Y=$GET(^AUTTVNDR(X,19))
End DoDot:1
IF $PIECE(Y,U)=""
QUIT
+5 IF 'X
SET X=$PIECE(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0),U,24)
IF X
Begin DoDot:1
+6 SET Y=$GET(^ACRAU(X,19))
End DoDot:1
IF $PIECE(Y,U)=""
QUIT
+7 IF $PIECE(Y,U)=""
QUIT
+8 SET ACRCHK=$PIECE(Y,U)
+9 SET ACRRTN=$PIECE(Y,U,2)
+10 SET ACRDAN=$PIECE(Y,U,3)
+11 SET DA(2)=ACRFYDA
+12 SET DA(1)=ACRBATDA
+13 SET DA=ACRSEQDA
+14 SET DIE="^AFSLAFP("_DA(2)_",1,"_DA(1)_",1,"
+15 SET DR="1901////"_ACRCHK_";1902////"_ACRRTN_";1903////"_ACRDAN
+16 DO DIE^ACRFDIC
+17 QUIT
SSCHUP ;EP;
+1 IF $EXTRACT($PIECE(^AFSLAFP(ACRFYDA,1,ACRBATDA,0),U))="G"
QUIT
+2 NEW ACRSEQDA,ACRJ,ACR1
+3 SET (ACRSEQDA,ACRJ)=0
+4 FOR
SET ACRSEQDA=$ORDER(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA))
IF 'ACRSEQDA!$DATA(ACRQUIT)
QUIT
Begin DoDot:1
+5 IF '$DATA(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0))
QUIT
SET ACR1=$GET(^(1))
+6 SET ACRJ=ACRJ+1
+7 IF $GET(ACRBSCH)]""
IF $PIECE(ACR1,U,11)'=ACRBSCH
DO SSCH
+8 IF "AB"[$PIECE(^AFSLAFP(ACRFYDA,1,ACRBATDA,2),U,8)
DO BANK
End DoDot:1
+9 QUIT
SSCH ;UPDATE SEQUENCE ENTRY SCHEDULE NUMBER
+1 SET DA(2)=ACRFYDA
+2 SET DA(1)=ACRBATDA
+3 SET DA=ACRSEQDA
+4 SET DIE="^AFSLAFP("_DA(2)_",1,"_DA(1)_",1,"
+5 SET DR="40////"_ACRBSCH
+6 DO DIE^ACRFDIC
+7 IF $PIECE($GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,1)),U,11)=""
SET $PIECE(^(1),U,11)=ACRBSCH
+8 QUIT
APPSUM ;EP;APPROPRIATION SUMMARY
+1 IF $GET(ACRXALL)="ALL"
QUIT
+2 KILL ACRQUIT
+3 DO APPSUMH
+4 NEW ACRSEQDA,Y,Z
+5 SET ACRSEQDA=0
+6 FOR
SET ACRSEQDA=$ORDER(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA))
IF 'ACRSEQDA
QUIT
Begin DoDot:1
+7 SET X=$GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0))
+8 SET Y=$GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,1))
+9 IF $PIECE(Y,U,21)=""
SET $PIECE(Y,U,21)="NOT STATED"
+10 SET Z=$PIECE(X,U,18)
+11 IF '$DATA(ACRAPPN($PIECE(Y,U,21)))
SET ACRAPPN($PIECE(Y,U,21))=""
+12 SET ACRBTYP=$PIECE($GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,0)),U,4)
+13 IF Z'=23717
SET ACRAPPN($PIECE(Y,U,21))=ACRAPPN($PIECE(Y,U,21))+$SELECT(ACRBTYP="V":+$PIECE(X,U,11),ACRBTYP="T":$$NET^ACRFSSU(ACRFYDA,ACRBATDA,ACRSEQDA),1:0)
+14 IF '$TEST
SET ACRAPPN($PIECE(Y,U,21))=ACRAPPN($PIECE(Y,U,21))-$PIECE(X,U,11)
End DoDot:1
+15 SET Z=0
+16 SET X=""
+17 FOR
SET X=$ORDER(ACRAPPN(X))
IF X=""!$DATA(ACRQUIT)
QUIT
SET Z=Z+ACRAPPN(X)
+18 SET X=""
+19 FOR
SET X=$ORDER(ACRAPPN(X))
IF X=""!$DATA(ACRQUIT)
QUIT
Begin DoDot:1
+20 WRITE !?10,X,?25,$JUSTIFY($FNUMBER(+ACRAPPN(X),"P,",2),15)
+21 IF IOSL-4<$Y
Begin DoDot:2
+22 NEW X,Y,Z
+23 DO PAUSE^ACRFWARN
+24 IF $DATA(ACRQUIT)
QUIT
+25 DO APPSUMH
End DoDot:2
IF $DATA(ACRQUIT)
QUIT
End DoDot:1
+26 DO AH1
+27 WRITE !?25,$JUSTIFY($FNUMBER(Z,"P,",2),15)
+28 KILL ACRAPPN
+29 DO PAUSE^ACRFWARN
+30 QUIT
APPSUMH ;APPROPRIATION SUMMARY HEADER
+1 WRITE @IOF
+2 WRITE !!,"Appropriation Summary "
+3 IF $GET(ACRBATNO)]""
WRITE "Batch NO. ",ACRBATNO
+4 IF $GET(ACRSCHNO)]""
WRITE " Schedule NO. ",ACRSCHNO
+5 WRITE !!?10,"APPROPRIATION",?25,"AMOUNT"
AH1 WRITE !?10,"-------------",?25,"---------------"
+1 QUIT
EXPLIST ;EP;TO PRINT LIST OF EXPORT FILES FOR SPECIFIED DATE
+1 DO EXPEXIT
+2 FOR
DO EXP1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
EXPEXIT KILL ACRQUIT,ACRDC
+1 KILL ^TMP("ACREXP",$JOB)
+2 QUIT
EXP1 ;
+1 DO EXPEXIT
+2 WRITE @IOF
+3 WRITE !?17,"Enter the EXPORT DATE(S)",!
+4 DO DATES^ACRFDATE
+5 IF '$GET(ACRBEGIN)
SET ACRQUIT=""
QUIT
+6 SET (ACRRTN,ZTRTN)="EXP2^ACRFPAY8"
+7 SET ZTDESC="LIST OF BATCHES EXPORTED ON SPECIFIC DATE"
+8 DO ^ACRFZIS
+9 QUIT
EXP2 ;EP;TO PRINT LIST OF BATCHES EXPORTED ON SPECIFIC DATE
+1 KILL ACRQUIT
+2 NEW ACRX,ACRY,ACRZ,ACRDC,ACRXX,ACRXY,Z
+3 SET ACRDATE=ACRBEGIN-.0001
+4 FOR
SET ACRDATE=$ORDER(^AFSLAFP("EXP",ACRDATE))
IF 'ACRDATE!(ACRDATE>(ACREND+.9999))
QUIT
Begin DoDot:1
+5 SET ACRFYDA=0
+6 FOR
SET ACRFYDA=$ORDER(^AFSLAFP("EXP",ACRDATE,ACRFYDA))
IF 'ACRFYDA
QUIT
Begin DoDot:2
+7 SET ACRBATDA=0
+8 FOR
SET ACRBATDA=$ORDER(^AFSLAFP("EXP",ACRDATE,ACRFYDA,ACRBATDA))
IF 'ACRBATDA
QUIT
Begin DoDot:3
+9 NEW X,Y,Z,T1,T2,N1,N2
+10 SET (ACRSEQDA,N1,T1,N2,T2)=0
+11 FOR
SET ACRSEQDA=$ORDER(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA))
IF 'ACRSEQDA
QUIT
Begin DoDot:4
+12 SET X=^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0)
+13 SET Y=$PIECE(X,U,18)
+14 IF Y'=23717
SET N1=N1+1
SET T1=T1+$PIECE(X,U,11)
+15 IF Y=23717
SET N2=N2+1
SET T2=T2+$PIECE(X,U,11)
End DoDot:4
+16 SET ACRY=$GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,0))
+17 SET ACRZ=$GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,2))
+18 SET ^TMP("ACREXP",$JOB,ACRDATE,$SELECT($PIECE(ACRZ,U,11)]"":$PIECE(ACRZ,U,11),1:"NOT STATED"),ACRBATDA)=$PIECE(ACRY,U)_U_$PIECE(ACRZ,U,6)_U_$PIECE(ACRZ,U,11)_U_$PIECE(ACRZ,U,8)_U_N1_U_T1_U_N2_U_T2
End DoDot:3
End DoDot:2
End DoDot:1
+19 IF '$DATA(^TMP("ACREXP",$JOB))
Begin DoDot:1
+20 WRITE !,"No EXPORTS recorded on "
+21 SET Y=ACRBEGIN
+22 XECUTE ^DD("DD")
+23 WRITE Y
End DoDot:1
+24 SET ACRDATE=""
+25 FOR
SET ACRDATE=$ORDER(^TMP("ACREXP",$JOB,ACRDATE))
IF ACRDATE=""!$DATA(ACROUT)
QUIT
Begin DoDot:1
+26 DO EXPH
+27 SET ACRXX=""
+28 FOR
SET ACRXX=$ORDER(^TMP("ACREXP",$JOB,ACRDATE,ACRXX))
IF ACRXX=""!$DATA(ACROUT)
QUIT
Begin DoDot:2
+29 SET ACRXY=0
+30 FOR
SET ACRXY=$ORDER(^TMP("ACREXP",$JOB,ACRDATE,ACRXX,ACRXY))
IF 'ACRXY!$DATA(^ACROUT)
QUIT
Begin DoDot:3
+31 SET Z=^TMP("ACREXP",$JOB,ACRDATE,ACRXX,ACRXY)
+32 WRITE !,$PIECE(Z,U),?8,$PIECE(Z,U,2),?20,$PIECE(Z,U,3),?30
+33 WRITE $SELECT($EXTRACT($PIECE(Z,U,4))="C":"CHECKS",$EXTRACT($PIECE(Z,U,4))="A":"GROUPD",$EXTRACT($PIECE(Z,U,4))="B":"NOTGPD",$EXTRACT($PIECE(Z,U,4))="G":"DHRONL",1:"")
+34 WRITE ?38,$JUSTIFY($PIECE(Z,U,5),3),?42,$JUSTIFY($FNUMBER($PIECE(Z,U,6),"P,",2),15)
+35 WRITE ?59,$JUSTIFY($PIECE(Z,U,7),3),?63,$JUSTIFY($FNUMBER($PIECE(Z,U,8),"P,",2),15)
+36 IF IOSL-4<$Y
DO PAUSE^ACRFWARN
IF $DATA(ACROUT)
QUIT
DO EXPH
+37 KILL ACRQUIT
End DoDot:3
End DoDot:2
+38 DO PAUSE^ACRFWARN
End DoDot:1
+39 QUIT
EXPH ;EXPORT LIST HEADER
+1 WRITE @IOF
+2 WRITE !?10,"List of files exported on "
+3 SET Y=ACRDATE
+4 XECUTE ^DD("DD")
+5 WRITE Y
+6 WRITE !?10,"Report Date: "
+7 SET Y=DT
+8 XECUTE ^DD("DD")
+9 WRITE Y
+10 SET ACRDC=$GET(ACRDC)+1
+11 WRITE ?55,"PAGE: ",ACRDC
+12 WRITE !?40,"PAYMENTS",?62,"CREDITS"
+13 WRITE !,"BATCH",?8,"SCHD",?20,"ECS FILE",?30,"FORMAT",?38,"NO.",?44,"AMOUNT",?59,"NO.",?66,"AMOUNT"
+14 WRITE !,"------",?8,"------",?20,"--------",?30,"------",?38,"---",?42,"---------------",?59,"---",?63,"---------------"
+15 QUIT
