ACRFPAY3 ;IHS/OIRM/DSD/THL,AEF - CERTIFY AND EXPORT PAYMENT BATCH; [ 07/20/2006 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**20**;NOV 05, 2001
;;
DBATCH ;EP;TO SELECT BATCH TO DELETE
I '$D(^ACRAPL("AC",DUZ,38))&'$D(^ACRAPL("AC",DUZ,39)) D Q
.W !!,"You do not have the authority to DELETE PAYMENTS."
.D PAUSE^ACRFWARN
S DIC="^AFSLAFP("
S DIC(0)="AEMQZ"
S DIC("A")="Fiscal Year.............: "
S DIC("B")=$S($E(DT,4,5)>9:($E(DT,1,3)+1)+1700,1:$E(DT,1,3)+1700)
S DIC("S")="I $P(^(0),U)=X"
W !
D DIC^ACRFDIC
Q:+Y<1
S ACRFYDA=+Y
F D DB1 Q:$D(ACRQUIT)!$D(ACROUT)
K ACRQUIT
Q
DB1 S DIC="^AFSLAFP("_ACRFYDA_",1,"
S DIC(0)="AEMQZ"
S DIC("A")="Batch/Schedule to DELETE: "
S DIC("S")="I '$O(^AFSLAFP(ACRFYDA,1,+Y,1,0))"
W !
D DIC^ACRFDIC
I +Y<1 S ACRQUIT="" Q
S ACRBATDA=+Y
S DIR(0)="YO"
S DIR("A",1)="Are you ABSOLUTELY CERTAIN"
S DIR("A")="you want to DELETE Batch NO. "_$P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,0)),U)
S DIR("B")="NO"
W !
D DIR^ACRFDIC
I Y'=1 K ACRQUIT Q
S DA(1)=ACRFYDA
S DA=ACRBATDA
S DIK="^AFSLAFP("_DA(1)_",1,"
D DIK^ACRFDIC
K ACRQUIT
Q
BATCHL ;EP;LIST OPEN BATCHS DUE TODAY OR EARLIER
N J,X,Y
K ACR,ACRPAY
S (ACRFYDA,ACRMAX)=0
F S ACRFYDA=$O(^AFSLAFP("K","O",ACRFYDA)) Q:'ACRFYDA D
.S ACRFY=$P(^AFSLAFP(ACRFYDA,0),U)
.S ACRBATDA=0
.F S ACRBATDA=$O(^AFSLAFP("K","O",ACRFYDA,ACRBATDA)) Q:'ACRBATDA D PAY
D PAY1
Q
LIST ;PRINT BATCH LIST
W @IOF
D PARRAY
N ACRJJ,ACRJX
S (ACRJX,ACRJJ)=0
S (ACRFY,ACRFYX)=""
F S ACRFY=$O(ACR(ACRFY)) Q:ACRFY=""!$D(ACRQUIT) D
.D FYHEAD:ACRFY'=ACRFYX
.S ACRJJ=0 ;ACR*2.1*20.12 IM20953
.D L1
K ACRQUIT,ACROUT
Q
PARRAY ;SET ACRPAY ARRAY
N ACRFY
S ACRFY=""
F S ACRFY=$O(ACR(ACRFY)) Q:ACRFY="" D
.S ACRJ=0
.F S ACRJ=$O(ACR(ACRFY,ACRJ)) Q:'ACRJ D
..S X=ACR(ACRFY,ACRJ)
..S ^TMP("ACRPAY",$J,ACRJ)=$P(X,"&&",2)_U_$P(X,"&&",3)_U_$P(X,U)_U_$P(X,"&&",6)
Q
L1 ;LIST BATCHES
S ACRFYX=ACRFY
S ACRJ=0
F S ACRJ=$O(ACR(ACRFY,ACRJ)) Q:'ACRJ!$D(ACRQUIT) D
.D L2
.I ACRJJ#10=0 D
..D PAUSE^ACRFWARN
..Q:$D(ACRQUIT)
..S ACRJ=ACRJX
..W !
Q
L2 S ACRJJ=ACRJJ+1
S X=ACR(ACRFY,ACRJ)
W !,ACRJ,?4,$P(X,U),?12
S Y=$P(X,"&&",6)
X ^DD("DD")
W Y,?25
S Y=$P(X,"&&",4)
I Y?7N X ^DD("DD") W Y
W:$P(X,"&&",5)=1 " *"
S:ACRJ>ACRJX ACRJX=ACRJ
Q:'$D(ACR(ACRFY,ACRJ+10))
S X=ACR(ACRFY,ACRJ+10)
Q:$D(ACRQUIT)
W ?39,"|",ACRJ+10,?44,$P(X,U),?52
S Y=$P(X,"&&",6)
X ^DD("DD")
W Y,?65
S Y=$P(X,"&&",4)
I Y?7N X ^DD("DD") W Y
W:$P(X,"&&",5)=1 " *"
S:ACRJ+10>ACRJX ACRJX=ACRJ+10
Q
PAY ;EP;SET LOCAL ACRPAY ARRAY
S X=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,0))
Q:$P(X,U)=""!'$P(X,U,2)!($P($P(X,U,2),".")>DT)!('$D(ACREXP)&$P(X,U,5))!+$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,2))
Q:$D(ACRCERT)&'$O(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,0))
D CONFLICT:$D(ACRCERT)
I $D(ACRQUIT) K ACRQUIT Q
S J=$G(J)+1
S ACR(ACRFY,$P(X,U))=X_"&&"_ACRBATDA_"&&"_ACRFYDA_"&&"_$P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,2)),U,2)_"&&"_'$O(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,0))_"&&"_$P($P(X,U,2),".")
Q
PAY1 ;EP
N ACRFY
S J=0
S ACRFY=""
F S ACRFY=$O(ACR(ACRFY)) Q:ACRFY="" D
.S ACRBATNO=""
.F S ACRBATNO=$O(ACR(ACRFY,ACRBATNO)) Q:ACRBATNO="" D
..S J=$G(J)+1
..S ACR(ACRFY,J)=ACR(ACRFY,ACRBATNO)
..S ^TMP("ACRBAT",$J,ACRBATNO)=J
..K ACR(ACRFY,ACRBATNO)
S ACRMAX=J
D LIST:J
Q
FYHEAD ;EP;
W !!,"FISCAL YEAR: ",ACRFY
W !!,"NO.",?4,"BATCH",?12,"CREATED",?25,"DUE",?39,"|","NO.",?44,"BATCH",?52,"CREATED",?65,"DUE"
W !,"---",?4,"------",?12,"-----------",?25,"-----------",?39,"|","---",?44,"------",?52,"-----------",?65,"-----------"
Q
GBATCH ;ENTER SCHEDULE NUMBER FOR EACH PAYMENT ON G BATCHES
W !
S ACRSEQDA=0
F S ACRSEQDA=$O(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA)) Q:'ACRSEQDA D
.S DA=ACRSEQDA
.S DA(1)=ACRBATDA
.S DA(2)=ACRFYDA
.S DIE="^AFSLAFP("_DA(2)_",1,"_DA(1)_",1,"
.S DR="40T"
.N X
.S X=^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0)
.W !,"Schedule Number for Sequence # ",$P(X,U)," ORDER # ",$P(X,U,20)
.D DIE^ACRFDIC
.S (ACRSNO(1),ACRBSCH)=$P(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,1),U,11)
Q
EXPORT ;EP;TO EXPORT BATCH
F D EX1 Q:$D(ACRQUIT)!$D(ACROUT)
Q
EX1 N J,X,Y,ACREXP
K ACRMAX,ACR,ACRPAY,ACRQUIT
S ACREXP=""
S ACRFYDA=0
F S ACRFYDA=$O(^AFSLAFP("EXPORT",ACRFYDA)) Q:'ACRFYDA D
.S ACRFY=$P(^AFSLAFP(ACRFYDA,0),U)
.S ACRBATDA=0
.F S ACRBATDA=$O(^AFSLAFP("EXPORT",ACRFYDA,ACRBATDA)) Q:'ACRBATDA D PAY
D PAY1
I '$G(ACRMAX) D Q
.W !!,"NO Batches pending for EXPORT"
.D PAUSE^ACRFWARN
.S ACRQUIT=""
D BATCHS^ACRFPAY
I $D(ACRQUIT)!$D(ACROUT) Q
I $G(ACRXALL)="ALL" D EXALL Q
S ACRFY=$P(^AFSLAFP(ACRFYDA,0),U)
S ACRBATNO=$P(^AFSLAFP(ACRFYDA,1,ACRBATDA,0),U)
K ACRQUIT
D TSCH
I $G(ACRBSCH)="" D Q
.W !!,"The Treasury Schedule must be completed before export."
.D PAUSE^ACRFWARN
ALL K ACRQUIT
D VALCHK^ACRFPAY5
I $D(ACRQUIT) K ACRQUIT Q
S ACRSEQDA=0
F S ACRSEQDA=$O(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA)) Q:'ACRSEQDA D DHR^ACRFPAY2(ACRFYDA,ACRBATDA,ACRSEQDA)
K ACROUT
I '$P(^AFSLAFP(ACRFYDA,1,ACRBATDA,0),U,5)!($P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,2)),U,3)'="C") D Q
.W !!,"Batch NO ",$P(^AFSLAFP(ACRFYDA,1,ACRBATDA,0),U)," is not properly marked as CLOSED and/or CERTIFIED."
.W !,"Please CLOSE and CERTIFY this batch then attempt to export it again."
.S DA(1)=ACRFYDA
.S DA=ACRBATDA
.S DIE="^AFSLAFP("_DA(1)_",1,"
.S DR="4///@;5///@;6///O"
.D DIE^ACRFDIC
.K ^AFSLAFP("EXPORT",ACRFYDA,ACRBATDA)
.I $G(ACRXALL)'="ALL" D PAUSE^ACRFWARN
D DHRPYN^ACRFPAY2:$G(ACRXALL)'="ALL"
Q:$D(ACROUT)
W !!,"Export of "
W "Batch NO ",$P(^AFSLAFP(ACRFYDA,1,ACRBATDA,0),U)
W " in progress. Please stand by...."
D EN^ACRFEXP2(ACRFYDA,ACRBATDA)
;THE SECTION BELOW WILL PRINT OUT PAYMENT NOTIFICATION LETTERS TO
;VENDORS FOR ACH BATCHES
I $P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,2)),U,8)="A"!($P($G(^(2)),U,8)="B") D
.;Begin new code ACR*2.1*20.06 IM17145
.N ACRAO
.S ACRAO=$P(^AUTTSITE(1,0),U,14)
.I ACRAO="albaao" Q
.I ACRAO["bij" S X=138 ;LOCAL MOD BEMIDJI:MRS:6/05/2003
.;End new code ACR*2.1*20.06 IM17145
.N X
.S X=$P(^ACRPO(1,0),U,8)
.Q:'X
.S X=$P($G(^AUTTPRG(X,"DT")),U,10)
.Q:'X
.S X=$P($G(^%ZIS(1,X,0)),U)
.Q:X=""
.S ION=X
.S (ACRRTN,ZTRTN)="EN^ACRFPAYL"
.S ZTDESC="PRINT VENDOR PAYMENT LETTERS"
.S ZTDTH=$H
.D ZTLOAD^ACRFZIS
Q
EXALL ;EXPORT ALL BATCHES
I '$O(^AFSLAFP("EXPORT",0)) D Q
.W !!,"No batches found to export"
S ACRFYDA=0
F S ACRFYDA=$O(^AFSLAFP("EXPORT",ACRFYDA)) Q:'ACRFYDA D
.S ACRBATDA=0
.F S ACRBATDA=$O(^AFSLAFP("EXPORT",ACRFYDA,ACRBATDA)) Q:'ACRBATDA!$D(ACRQUIT) D
..I '$D(^AFSLAFP(ACRFYDA,1,ACRBATDA,0)) K ^AFSLAFP("EXPORT",ACRFYDA,ACRBATDA) Q
..D TSCH
Q:$D(ACRQUIT)
W !!,"All batches for which a TREASURY SCHEDULE number was entered"
W !,"will now be exported. You can find the DHR, TREASURY and ECS"
W !,"names by referring to function 14 Review Batch STatus."
W !!,"To continue with the export press <ENTER>."
W !,"To abort the export enter '^' then press <ENTER>."
D PAUSE^ACRFWARN
I $D(ACROUT) W !!,"Export aborted..." H 3 Q
N ACRFYDAX,ACRBATDX
S ACRFYDAX=0
F S ACRFYDAX=$O(^AFSLAFP("EXPORT",ACRFYDAX)) Q:'ACRFYDAX D
.S ACRBATDX=0
.F S ACRBATDX=$O(^AFSLAFP("EXPORT",ACRFYDAX,ACRBATDX)) Q:'ACRBATDX I $P($G(^AFSLAFP(ACRFYDAX,1,ACRBATDX,2)),U,6)]"" D
..S ACRFY=$P(^AFSLAFP(ACRFYDAX,0),U)
..S ACRBATNO=$P(^AFSLAFP(ACRFYDAX,1,ACRBATDX,0),U)
..I '$P(^AFSLAFP(ACRFYDAX,1,ACRBATDX,0),U,5)!($P(^AFSLAFP(ACRFYDAX,1,ACRBATDX,2),U,3)'="C") D Q
...K ^AFSLAFP("EXPORT",ACRFYDAX,ACRBATDX)
...W !!,"Batch Number ",ACRBATNO," seems to have either"
...W !,"missing Certification Date or is not marked as CLOSED."
...H 5
..S ACRFYDA=ACRFYDAX
..S ACRBATDA=ACRBATDX
..D ALL
Q
TSCH ;TREASURY SCHEDULE NUMBER
K ACREXP,ACRBSCH
I '$G(ACRFYDA)!'$G(ACRBATDA) K ACRBSCH Q
S ACRFY=$P(^AFSLAFP(ACRFYDA,0),U)
I $E($P(^AFSLAFP(ACRFYDA,1,ACRBATDA,0),U))="G" D GBATCH Q
W !!,"BATCH NO................: ",$P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,0)),U)
D SCHNO^ACRFPAYS(ACRFYDA,ACRBATDA,.ACRSNO,.ACRQUIT)
I $G(ACRSNO(1))'?10UN K ACRBSCH Q
Q:$D(ACROUT)
S DA(1)=ACRFYDA
S DA=ACRBATDA
S DIE="^AFSLAFP("_ACRFYDA_",1,"
S DR="10////"_ACRSNO(1)
D DIE^ACRFDIC
S ACRBSCH=$P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,2)),U,6)
I ACRBSCH="" D
.S $P(^AFSLAFP(ACRFYDA,1,ACRBATDA,2),U,6)=ACRSNO(1)
.S ^AFSLAFP("M",ACRSNO(1),ACRFYDA,ACRBATDA)=""
.S ^AFSLAFP(ACRFYDA,1,"F",ACRSNO(1),ACRBATDA)=""
.S ACRBSCH=ACRSNO(1)
D SSCHUP^ACRFPAY8
Q
CONFLICT ;CHECK TO ENSURE THAT THERE ARE NO PAYMENTS IN THE BATCH WHICH THE
;CERTIFYING OFFICER HAS ENTERED INTO THE BATCH
N ACRSEQDA,X
K ACRQUIT
S ACRSEQDA=0
F S ACRSEQDA=$O(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA)) Q:'ACRSEQDA D
.I $P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0)),U,3)=DUZ S X=^(0) D
..I '$D(ACRQUIT) D
...W !!,"Batch NO. ",$P(^AFSLAFP(ACRFYDA,1,ACRBATDA,0),U)," contains the following payment(s) which you entered:",!
..S ACRQUIT=""
..W !,"Payment ",$P(X,U)," to "
..W:$P(X,U,10) $P($G(^AUTTVNDR($P(X,U,10),0)),U)
..;W:$P(X,U,24) $P($G(^VA(200,$P(X,U,24),0)),U) ;ACR*2.1*19.02 IM16848
..W:$P(X,U,24) $$NAME2^ACRFUTL1($P(X,U,24)) ;ACR*2.1*19.02 IM16848
Q:'$D(ACRQUIT)
W !!,"You cannot certify a batch containing payment(s) you entered."
W !,"Either have someone else certify the batch or"
W !,"transfer your payments to another batch."
D PAUSE^ACRFWARN
S ACRQUIT=""
Q
ACRFPAY3 ;IHS/OIRM/DSD/THL,AEF - CERTIFY AND EXPORT PAYMENT BATCH; [ 07/20/2006 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**20**;NOV 05, 2001
+2 ;;
DBATCH ;EP;TO SELECT BATCH TO DELETE
+1 IF '$DATA(^ACRAPL("AC",DUZ,38))&'$DATA(^ACRAPL("AC",DUZ,39))
Begin DoDot:1
+2 WRITE !!,"You do not have the authority to DELETE PAYMENTS."
+3 DO PAUSE^ACRFWARN
End DoDot:1
QUIT
+4 SET DIC="^AFSLAFP("
+5 SET DIC(0)="AEMQZ"
+6 SET DIC("A")="Fiscal Year.............: "
+7 SET DIC("B")=$SELECT($EXTRACT(DT,4,5)>9:($EXTRACT(DT,1,3)+1)+1700,1:$EXTRACT(DT,1,3)+1700)
+8 SET DIC("S")="I $P(^(0),U)=X"
+9 WRITE !
+10 DO DIC^ACRFDIC
+11 IF +Y<1
QUIT
+12 SET ACRFYDA=+Y
+13 FOR
DO DB1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+14 KILL ACRQUIT
+15 QUIT
DB1 SET DIC="^AFSLAFP("_ACRFYDA_",1,"
+1 SET DIC(0)="AEMQZ"
+2 SET DIC("A")="Batch/Schedule to DELETE: "
+3 SET DIC("S")="I '$O(^AFSLAFP(ACRFYDA,1,+Y,1,0))"
+4 WRITE !
+5 DO DIC^ACRFDIC
+6 IF +Y<1
SET ACRQUIT=""
QUIT
+7 SET ACRBATDA=+Y
+8 SET DIR(0)="YO"
+9 SET DIR("A",1)="Are you ABSOLUTELY CERTAIN"
+10 SET DIR("A")="you want to DELETE Batch NO. "_$PIECE($GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,0)),U)
+11 SET DIR("B")="NO"
+12 WRITE !
+13 DO DIR^ACRFDIC
+14 IF Y'=1
KILL ACRQUIT
QUIT
+15 SET DA(1)=ACRFYDA
+16 SET DA=ACRBATDA
+17 SET DIK="^AFSLAFP("_DA(1)_",1,"
+18 DO DIK^ACRFDIC
+19 KILL ACRQUIT
+20 QUIT
BATCHL ;EP;LIST OPEN BATCHS DUE TODAY OR EARLIER
+1 NEW J,X,Y
+2 KILL ACR,ACRPAY
+3 SET (ACRFYDA,ACRMAX)=0
+4 FOR
SET ACRFYDA=$ORDER(^AFSLAFP("K","O",ACRFYDA))
IF 'ACRFYDA
QUIT
Begin DoDot:1
+5 SET ACRFY=$PIECE(^AFSLAFP(ACRFYDA,0),U)
+6 SET ACRBATDA=0
+7 FOR
SET ACRBATDA=$ORDER(^AFSLAFP("K","O",ACRFYDA,ACRBATDA))
IF 'ACRBATDA
QUIT
DO PAY
End DoDot:1
+8 DO PAY1
+9 QUIT
LIST ;PRINT BATCH LIST
+1 WRITE @IOF
+2 DO PARRAY
+3 NEW ACRJJ,ACRJX
+4 SET (ACRJX,ACRJJ)=0
+5 SET (ACRFY,ACRFYX)=""
+6 FOR
SET ACRFY=$ORDER(ACR(ACRFY))
IF ACRFY=""!$DATA(ACRQUIT)
QUIT
Begin DoDot:1
+7 IF ACRFY'=ACRFYX
DO FYHEAD
+8 ;ACR*2.1*20.12 IM20953
SET ACRJJ=0
+9 DO L1
End DoDot:1
+10 KILL ACRQUIT,ACROUT
+11 QUIT
PARRAY ;SET ACRPAY ARRAY
+1 NEW ACRFY
+2 SET ACRFY=""
+3 FOR
SET ACRFY=$ORDER(ACR(ACRFY))
IF ACRFY=""
QUIT
Begin DoDot:1
+4 SET ACRJ=0
+5 FOR
SET ACRJ=$ORDER(ACR(ACRFY,ACRJ))
IF 'ACRJ
QUIT
Begin DoDot:2
+6 SET X=ACR(ACRFY,ACRJ)
+7 SET ^TMP("ACRPAY",$JOB,ACRJ)=$PIECE(X,"&&",2)_U_$PIECE(X,"&&",3)_U_$PIECE(X,U)_U_$PIECE(X,"&&",6)
End DoDot:2
End DoDot:1
+8 QUIT
L1 ;LIST BATCHES
+1 SET ACRFYX=ACRFY
+2 SET ACRJ=0
+3 FOR
SET ACRJ=$ORDER(ACR(ACRFY,ACRJ))
IF 'ACRJ!$DATA(ACRQUIT)
QUIT
Begin DoDot:1
+4 DO L2
+5 IF ACRJJ#10=0
Begin DoDot:2
+6 DO PAUSE^ACRFWARN
+7 IF $DATA(ACRQUIT)
QUIT
+8 SET ACRJ=ACRJX
+9 WRITE !
End DoDot:2
End DoDot:1
+10 QUIT
L2 SET ACRJJ=ACRJJ+1
+1 SET X=ACR(ACRFY,ACRJ)
+2 WRITE !,ACRJ,?4,$PIECE(X,U),?12
+3 SET Y=$PIECE(X,"&&",6)
+4 XECUTE ^DD("DD")
+5 WRITE Y,?25
+6 SET Y=$PIECE(X,"&&",4)
+7 IF Y?7N
XECUTE ^DD("DD")
WRITE Y
+8 IF $PIECE(X,"&&",5)=1
WRITE " *"
+9 IF ACRJ>ACRJX
SET ACRJX=ACRJ
+10 IF '$DATA(ACR(ACRFY,ACRJ+10))
QUIT
+11 SET X=ACR(ACRFY,ACRJ+10)
+12 IF $DATA(ACRQUIT)
QUIT
+13 WRITE ?39,"|",ACRJ+10,?44,$PIECE(X,U),?52
+14 SET Y=$PIECE(X,"&&",6)
+15 XECUTE ^DD("DD")
+16 WRITE Y,?65
+17 SET Y=$PIECE(X,"&&",4)
+18 IF Y?7N
XECUTE ^DD("DD")
WRITE Y
+19 IF $PIECE(X,"&&",5)=1
WRITE " *"
+20 IF ACRJ+10>ACRJX
SET ACRJX=ACRJ+10
+21 QUIT
PAY ;EP;SET LOCAL ACRPAY ARRAY
+1 SET X=$GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,0))
+2 IF $PIECE(X,U)=""!'$PIECE(X,U,2)!($PIECE($PIECE(X,U,2),".")>DT)!('$DATA(ACREXP)&$PIECE(X,U,5))!+$GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,2))
QUIT
+3 IF $DATA(ACRCERT)&'$ORDER(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,0))
QUIT
+4 IF $DATA(ACRCERT)
DO CONFLICT
+5 IF $DATA(ACRQUIT)
KILL ACRQUIT
QUIT
+6 SET J=$GET(J)+1
+7 SET ACR(ACRFY,$PIECE(X,U))=X_"&&"_ACRBATDA_"&&"_ACRFYDA_"&&"_$PIECE($GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,2)),U,2)_"&&"_'$ORDER(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,0))_"&&"_$PIECE($PIECE(X,U,2),".")
+8 QUIT
PAY1 ;EP
+1 NEW ACRFY
+2 SET J=0
+3 SET ACRFY=""
+4 FOR
SET ACRFY=$ORDER(ACR(ACRFY))
IF ACRFY=""
QUIT
Begin DoDot:1
+5 SET ACRBATNO=""
+6 FOR
SET ACRBATNO=$ORDER(ACR(ACRFY,ACRBATNO))
IF ACRBATNO=""
QUIT
Begin DoDot:2
+7 SET J=$GET(J)+1
+8 SET ACR(ACRFY,J)=ACR(ACRFY,ACRBATNO)
+9 SET ^TMP("ACRBAT",$JOB,ACRBATNO)=J
+10 KILL ACR(ACRFY,ACRBATNO)
End DoDot:2
End DoDot:1
+11 SET ACRMAX=J
+12 IF J
DO LIST
+13 QUIT
FYHEAD ;EP;
+1 WRITE !!,"FISCAL YEAR: ",ACRFY
+2 WRITE !!,"NO.",?4,"BATCH",?12,"CREATED",?25,"DUE",?39,"|","NO.",?44,"BATCH",?52,"CREATED",?65,"DUE"
+3 WRITE !,"---",?4,"------",?12,"-----------",?25,"-----------",?39,"|","---",?44,"------",?52,"-----------",?65,"-----------"
+4 QUIT
GBATCH ;ENTER SCHEDULE NUMBER FOR EACH PAYMENT ON G BATCHES
+1 WRITE !
+2 SET ACRSEQDA=0
+3 FOR
SET ACRSEQDA=$ORDER(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA))
IF 'ACRSEQDA
QUIT
Begin DoDot:1
+4 SET DA=ACRSEQDA
+5 SET DA(1)=ACRBATDA
+6 SET DA(2)=ACRFYDA
+7 SET DIE="^AFSLAFP("_DA(2)_",1,"_DA(1)_",1,"
+8 SET DR="40T"
+9 NEW X
+10 SET X=^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0)
+11 WRITE !,"Schedule Number for Sequence # ",$PIECE(X,U)," ORDER # ",$PIECE(X,U,20)
+12 DO DIE^ACRFDIC
+13 SET (ACRSNO(1),ACRBSCH)=$PIECE(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,1),U,11)
End DoDot:1
+14 QUIT
EXPORT ;EP;TO EXPORT BATCH
+1 FOR
DO EX1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+2 QUIT
EX1 NEW J,X,Y,ACREXP
+1 KILL ACRMAX,ACR,ACRPAY,ACRQUIT
+2 SET ACREXP=""
+3 SET ACRFYDA=0
+4 FOR
SET ACRFYDA=$ORDER(^AFSLAFP("EXPORT",ACRFYDA))
IF 'ACRFYDA
QUIT
Begin DoDot:1
+5 SET ACRFY=$PIECE(^AFSLAFP(ACRFYDA,0),U)
+6 SET ACRBATDA=0
+7 FOR
SET ACRBATDA=$ORDER(^AFSLAFP("EXPORT",ACRFYDA,ACRBATDA))
IF 'ACRBATDA
QUIT
DO PAY
End DoDot:1
+8 DO PAY1
+9 IF '$GET(ACRMAX)
Begin DoDot:1
+10 WRITE !!,"NO Batches pending for EXPORT"
+11 DO PAUSE^ACRFWARN
+12 SET ACRQUIT=""
End DoDot:1
QUIT
+13 DO BATCHS^ACRFPAY
+14 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+15 IF $GET(ACRXALL)="ALL"
DO EXALL
QUIT
+16 SET ACRFY=$PIECE(^AFSLAFP(ACRFYDA,0),U)
+17 SET ACRBATNO=$PIECE(^AFSLAFP(ACRFYDA,1,ACRBATDA,0),U)
+18 KILL ACRQUIT
+19 DO TSCH
+20 IF $GET(ACRBSCH)=""
Begin DoDot:1
+21 WRITE !!,"The Treasury Schedule must be completed before export."
+22 DO PAUSE^ACRFWARN
End DoDot:1
QUIT
ALL KILL ACRQUIT
+1 DO VALCHK^ACRFPAY5
+2 IF $DATA(ACRQUIT)
KILL ACRQUIT
QUIT
+3 SET ACRSEQDA=0
+4 FOR
SET ACRSEQDA=$ORDER(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA))
IF 'ACRSEQDA
QUIT
DO DHR^ACRFPAY2(ACRFYDA,ACRBATDA,ACRSEQDA)
+5 KILL ACROUT
+6 IF '$PIECE(^AFSLAFP(ACRFYDA,1,ACRBATDA,0),U,5)!($PIECE($GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,2)),U,3)'="C")
Begin DoDot:1
+7 WRITE !!,"Batch NO ",$PIECE(^AFSLAFP(ACRFYDA,1,ACRBATDA,0),U)," is not properly marked as CLOSED and/or CERTIFIED."
+8 WRITE !,"Please CLOSE and CERTIFY this batch then attempt to export it again."
+9 SET DA(1)=ACRFYDA
+10 SET DA=ACRBATDA
+11 SET DIE="^AFSLAFP("_DA(1)_",1,"
+12 SET DR="4///@;5///@;6///O"
+13 DO DIE^ACRFDIC
+14 KILL ^AFSLAFP("EXPORT",ACRFYDA,ACRBATDA)
+15 IF $GET(ACRXALL)'="ALL"
DO PAUSE^ACRFWARN
End DoDot:1
QUIT
+16 IF $GET(ACRXALL)'="ALL"
DO DHRPYN^ACRFPAY2
+17 IF $DATA(ACROUT)
QUIT
+18 WRITE !!,"Export of "
+19 WRITE "Batch NO ",$PIECE(^AFSLAFP(ACRFYDA,1,ACRBATDA,0),U)
+20 WRITE " in progress. Please stand by...."
+21 DO EN^ACRFEXP2(ACRFYDA,ACRBATDA)
+22 ;THE SECTION BELOW WILL PRINT OUT PAYMENT NOTIFICATION LETTERS TO
+23 ;VENDORS FOR ACH BATCHES
+24 IF $PIECE($GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,2)),U,8)="A"!($PIECE($GET(^(2)),U,8)="B")
Begin DoDot:1
+25 ;Begin new code ACR*2.1*20.06 IM17145
+26 NEW ACRAO
+27 SET ACRAO=$PIECE(^AUTTSITE(1,0),U,14)
+28 IF ACRAO="albaao"
QUIT
+29 ;LOCAL MOD BEMIDJI:MRS:6/05/2003
IF ACRAO["bij"
SET X=138
+30 ;End new code ACR*2.1*20.06 IM17145
+31 NEW X
+32 SET X=$PIECE(^ACRPO(1,0),U,8)
+33 IF 'X
QUIT
+34 SET X=$PIECE($GET(^AUTTPRG(X,"DT")),U,10)
+35 IF 'X
QUIT
+36 SET X=$PIECE($GET(^%ZIS(1,X,0)),U)
+37 IF X=""
QUIT
+38 SET ION=X
+39 SET (ACRRTN,ZTRTN)="EN^ACRFPAYL"
+40 SET ZTDESC="PRINT VENDOR PAYMENT LETTERS"
+41 SET ZTDTH=$HOROLOG
+42 DO ZTLOAD^ACRFZIS
End DoDot:1
+43 QUIT
EXALL ;EXPORT ALL BATCHES
+1 IF '$ORDER(^AFSLAFP("EXPORT",0))
Begin DoDot:1
+2 WRITE !!,"No batches found to export"
End DoDot:1
QUIT
+3 SET ACRFYDA=0
+4 FOR
SET ACRFYDA=$ORDER(^AFSLAFP("EXPORT",ACRFYDA))
IF 'ACRFYDA
QUIT
Begin DoDot:1
+5 SET ACRBATDA=0
+6 FOR
SET ACRBATDA=$ORDER(^AFSLAFP("EXPORT",ACRFYDA,ACRBATDA))
IF 'ACRBATDA!$DATA(ACRQUIT)
QUIT
Begin DoDot:2
+7 IF '$DATA(^AFSLAFP(ACRFYDA,1,ACRBATDA,0))
KILL ^AFSLAFP("EXPORT",ACRFYDA,ACRBATDA)
QUIT
+8 DO TSCH
End DoDot:2
End DoDot:1
+9 IF $DATA(ACRQUIT)
QUIT
+10 WRITE !!,"All batches for which a TREASURY SCHEDULE number was entered"
+11 WRITE !,"will now be exported. You can find the DHR, TREASURY and ECS"
+12 WRITE !,"names by referring to function 14 Review Batch STatus."
+13 WRITE !!,"To continue with the export press <ENTER>."
+14 WRITE !,"To abort the export enter '^' then press <ENTER>."
+15 DO PAUSE^ACRFWARN
+16 IF $DATA(ACROUT)
WRITE !!,"Export aborted..."
HANG 3
QUIT
+17 NEW ACRFYDAX,ACRBATDX
+18 SET ACRFYDAX=0
+19 FOR
SET ACRFYDAX=$ORDER(^AFSLAFP("EXPORT",ACRFYDAX))
IF 'ACRFYDAX
QUIT
Begin DoDot:1
+20 SET ACRBATDX=0
+21 FOR
SET ACRBATDX=$ORDER(^AFSLAFP("EXPORT",ACRFYDAX,ACRBATDX))
IF 'ACRBATDX
QUIT
IF $PIECE($GET(^AFSLAFP(ACRFYDAX,1,ACRBATDX,2)),U,6)]""
Begin DoDot:2
+22 SET ACRFY=$PIECE(^AFSLAFP(ACRFYDAX,0),U)
+23 SET ACRBATNO=$PIECE(^AFSLAFP(ACRFYDAX,1,ACRBATDX,0),U)
+24 IF '$PIECE(^AFSLAFP(ACRFYDAX,1,ACRBATDX,0),U,5)!($PIECE(^AFSLAFP(ACRFYDAX,1,ACRBATDX,2),U,3)'="C")
Begin DoDot:3
+25 KILL ^AFSLAFP("EXPORT",ACRFYDAX,ACRBATDX)
+26 WRITE !!,"Batch Number ",ACRBATNO," seems to have either"
+27 WRITE !,"missing Certification Date or is not marked as CLOSED."
+28 HANG 5
End DoDot:3
QUIT
+29 SET ACRFYDA=ACRFYDAX
+30 SET ACRBATDA=ACRBATDX
+31 DO ALL
End DoDot:2
End DoDot:1
+32 QUIT
TSCH ;TREASURY SCHEDULE NUMBER
+1 KILL ACREXP,ACRBSCH
+2 IF '$GET(ACRFYDA)!'$GET(ACRBATDA)
KILL ACRBSCH
QUIT
+3 SET ACRFY=$PIECE(^AFSLAFP(ACRFYDA,0),U)
+4 IF $EXTRACT($PIECE(^AFSLAFP(ACRFYDA,1,ACRBATDA,0),U))="G"
DO GBATCH
QUIT
+5 WRITE !!,"BATCH NO................: ",$PIECE($GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,0)),U)
+6 DO SCHNO^ACRFPAYS(ACRFYDA,ACRBATDA,.ACRSNO,.ACRQUIT)
+7 IF $GET(ACRSNO(1))'?10UN
KILL ACRBSCH
QUIT
+8 IF $DATA(ACROUT)
QUIT
+9 SET DA(1)=ACRFYDA
+10 SET DA=ACRBATDA
+11 SET DIE="^AFSLAFP("_ACRFYDA_",1,"
+12 SET DR="10////"_ACRSNO(1)
+13 DO DIE^ACRFDIC
+14 SET ACRBSCH=$PIECE($GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,2)),U,6)
+15 IF ACRBSCH=""
Begin DoDot:1
+16 SET $PIECE(^AFSLAFP(ACRFYDA,1,ACRBATDA,2),U,6)=ACRSNO(1)
+17 SET ^AFSLAFP("M",ACRSNO(1),ACRFYDA,ACRBATDA)=""
+18 SET ^AFSLAFP(ACRFYDA,1,"F",ACRSNO(1),ACRBATDA)=""
+19 SET ACRBSCH=ACRSNO(1)
End DoDot:1
+20 DO SSCHUP^ACRFPAY8
+21 QUIT
CONFLICT ;CHECK TO ENSURE THAT THERE ARE NO PAYMENTS IN THE BATCH WHICH THE
+1 ;CERTIFYING OFFICER HAS ENTERED INTO THE BATCH
+2 NEW ACRSEQDA,X
+3 KILL ACRQUIT
+4 SET ACRSEQDA=0
+5 FOR
SET ACRSEQDA=$ORDER(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA))
IF 'ACRSEQDA
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0)),U,3)=DUZ
SET X=^(0)
Begin DoDot:2
+7 IF '$DATA(ACRQUIT)
Begin DoDot:3
+8 WRITE !!,"Batch NO. ",$PIECE(^AFSLAFP(ACRFYDA,1,ACRBATDA,0),U)," contains the following payment(s) which you entered:",!
End DoDot:3
+9 SET ACRQUIT=""
+10 WRITE !,"Payment ",$PIECE(X,U)," to "
+11 IF $PIECE(X,U,10)
WRITE $PIECE($GET(^AUTTVNDR($PIECE(X,U,10),0)),U)
+12 ;W:$P(X,U,24) $P($G(^VA(200,$P(X,U,24),0)),U) ;ACR*2.1*19.02 IM16848
+13 ;ACR*2.1*19.02 IM16848
IF $PIECE(X,U,24)
WRITE $$NAME2^ACRFUTL1($PIECE(X,U,24))
End DoDot:2
End DoDot:1
+14 IF '$DATA(ACRQUIT)
QUIT
+15 WRITE !!,"You cannot certify a batch containing payment(s) you entered."
+16 WRITE !,"Either have someone else certify the batch or"
+17 WRITE !,"transfer your payments to another batch."
+18 DO PAUSE^ACRFWARN
+19 SET ACRQUIT=""
+20 QUIT
