ACRFPAY4 ;IHS/OIRM/DSD/THL,AEF - CERTIFY AND EXPORT PAYMENT BATCH; [ 07/22/2005 8:27 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**2,5,17**;NOV 05, 2001
;;
Q
VS1 ;EP;TO SYNCRONIZE BETWEEN ARMS PAYEE AND 1166 AFP APPROVALS FOR
;PAYMENT ENTRY
N ACRP0,ACRP11,ACRP14,ACRV0,ACRV11,ACRV14
Q:'$G(ACRFYDA)!'$G(ACRBATDA)!'$G(ACRSEQDA)
S ACRDOCDA=+$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,"ARMS"))
S ACRSEQ0=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0))
N ACRPVDA,ACRVDA
S ACRPVDA=$P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0)),U,10)
I $G(ACRDOCDA) D
.D VENDOR^ACRFRR
.S ACRVDA=$P($G(^ACRDOC(ACRDOCDA,5)),U,5)
I '$G(ACRDOCDA) D VENDOR
D VDATA
D VS2
Q
VDATA ;DISPLAY ARMS AND 1166 PAYEE DATA
S ACRP0=$G(^AUTTVNDR(+ACRPVDA,0))
S ACRP11=$G(^AUTTVNDR(+ACRPVDA,11))
S ACRP14=$G(^AUTTVNDR(+ACRPVDA,14))
S ACRV0=$G(^AUTTVNDR(+ACRVDA,0))
S ACRV11=$G(^AUTTVNDR(+ACRVDA,11))
S ACRV14=$G(^AUTTVNDR(+ACRVDA,14))
W @IOF
W !!,"ARMS PAYEE: ",$P(ACRV0,U),?50,"EIN: ",$P(ACRV11,U,13)
W !?12,$P(ACRV14,U)
W !?12,$P(ACRV14,U,2)
W !?12,$P(ACRV14,U,3),", ",$P($G(^DIC(5,+$P(ACRV14,U,3),0)),U,2)," ",$P(ACRV14,U,5)
W !!,"1166 PAYEE: ",$P(ACRP0,U),?50,"EIN: ",$P(ACRP11,U,13)
W !?12,$P(ACRP14,U)
W !?12,$P(ACRP14,U,2)
W !?12,$P(ACRP14,U,3),", ",$P($G(^DIC(5,+$P(ACRP14,U,3),0)),U,2)," ",$P(ACRP14,U,5)
W !!,"Payment Sequence NO. ",$P(ACRSEQ0,U)
W !,"will now be updated with the new Payee information."
W !
D PAUSE^ACRFWARN
Q
VS2 ;SYCHRONIZE BETWEEN ARMS AND 1166
S DA=ACRSEQDA
S DA(1)=ACRBATDA
S DA(2)=ACRFYDA
S DIE="^AFSLAFP("_DA(2)_",1,"_DA(1)_",1,"
S X=ACRV11
S DR="16////"_ACRVDA_";65////"_ACRVDA_";28////"_$P(ACRV14,U,6)_";29////"_$P(ACRV14,U)_";30////"_$P(ACRV14,U,3)_";31////"_$P($G(^DIC(5,+$P(ACRV14,U,4),0)),U,2)_";32////"_$P(ACRV14,U,5)_";33////"_$P(ACRV0,U)_";56////"_$P(X,U,2)_";58////"_$P(X,U)
D DIE^ACRFDIC
Q
VSYNC ;EP - REVIEW SELECTED PAYMENTS
I ACRBTYP="T" D Q
.W !!,"This function is not applicable to Travel Batches."
.D PAUSE^ACRFWARN
N X
S ACRXX=ACRY
F ACRJ=1:1 S X=$P(ACRXX,",",ACRJ) Q:'X!'+$G(^TMP("ACRPAY",$J,+X))!$D(ACRQUIT) S ACRSEQDA=+^TMP("ACRPAY",$J,X) D VS1 I $P(ACRXX,",",ACRJ+1) D NEXT^ACRFPAY
K ACRQUIT
Q
VENDOR ;SELECT VENDOR FOR PAYMENT
S DIC="^AUTTVNDR("
S DIC(0)="AEMQZ"
S DIC("A")="Select VENDOR for this payment: "
S:ACRPVDA DIC("B")=$P(^AUTTVNDR(ACRPVDA,0),U)
D DIC^ACRFDIC
I +Y<1 W !!,"You must select a vendor for this payment." G VENDOR
S ACRVDA=+Y
Q
REOPEN ;EP;TO REOPEN CLOSED BATCH
F D R1 Q:$D(ACRQUIT)!$D(ACROUT)
K ACRQUIT
Q
R1 S DIC="^AFSLAFP("
S DIC(0)="AEMQZ"
S DIC("A")="Which FISCAL YEAR: "
S DIC("B")=$S($E(DT,4,5)<10:$E(DT,1,3)+1700,1:($E(DT,1,3)+1)+1700)
S DIC("S")="I $P(^(0),U)=X"
W !
D DIC^ACRFDIC
I +Y<1 S ACRQUIT="" Q
N ACRFYNO,ACRFYDA
S ACRFYDA=+Y
S ACRFYNO=$P(Y(0),U)
F D R11 Q:$D(ACRQUIT)!$D(ACROUT)
Q
R11 S DA(1)=ACRFYDA
S DIC="^AFSLAFP("_ACRFYDA_",1,"
S DIC(0)="AEMQZ"
S DIC("A")="REOPEN Which Batch: "
S DIC("S")="I $P($G(^AFSLAFP(ACRFYDA,1,+Y,2)),U,3)=""C"""
W !
D DIC^ACRFDIC
I +Y<1 S ACRQUIT="" Q
S ACRBATDA=+Y
S ACRBATNO=$P(Y(0),U)
S DA(1)=ACRFYDA
S DA=ACRBATDA
S DIR(0)="YO"
S DIR("A",1)="Are you certain you want to RE"_$S(+$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,2)):"-EXPORT",1:"OPEN")
S DIR("A")="Batch NO: "_ACRBATNO_" from Fiscal Year "_ACRFYNO
S DIR("B")="NO"
W !
D DIR^ACRFDIC
Q:Y'=1
D DHR
W !!,"Batch NO: "_ACRBATNO_" from Fiscal Year "_ACRFYNO
W !,$S(+$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,2)):"Can now be RE-EXPORT'ed.",1:"Is now OPEN for further processing.")
S DA(1)=ACRFYDA
S DA=ACRBATDA
S DIE="^AFSLAFP("_ACRFYDA_",1,"
I +$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,2)),$P($G(^(0)),U,5) S DR="5///@;7///@;4////"_$P($G(^(0)),U,5)
E S DR="4///@;5///@;6////O;7///@"
D DIE^ACRFDIC
Q
DHR ;ALLOW RE-CREATION OF DHR'S
S DIR(0)="YO"
S DIR("A")="Do you need to RE-CREATE the DHR's"
S DIR("B")="NO"
W !
D DIR^ACRFDIC
Q:Y'=1
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=".03///@"
.D DIE^ACRFDIC
Q
CLOSEB ;EP;CLOSE A BATCH
D VALCHK^ACRFPAY5
Q:$D(ACRQUIT)
S DIR(0)="YO"
S DIR("A")="Are you certain you want to "_$S('$D(ACRCERT)#2:"CLOSE",1:"CERTIFY")_" this batch"
S DIR("B")="NO"
W !
D DIR^ACRFDIC
Q:+Y'=1
I $D(ACRCERT)#2 D ^ACRFESIG Q:$D(ACRQUIT)
S DA=ACRBATDA
S DA(1)=ACRFYDA
S DIE="^AFSLAFP("_ACRFYDA_",1,"
S DR=$S('$D(ACRCERT)#2:"",1:"4////"_DT_";2////"_DUZ_";")_"6////C"
D DIE^ACRFDIC
I $D(ACRCERT)#2,'$P(^AFSLAFP(ACRFYDA,1,ACRBATDA,0),U,5) D Q
.W !!,"The CERTIFICATION was not applied to BATCH ",ACRBATNO
.D PAUSE^ACRFWARN
.S ACRQUIT=""
I '$D(ACRCERT)#2,$P(^AFSLAFP(ACRFYDA,1,ACRBATDA,2),U,3)'="C" D Q
.W !!,"BATCH NO. ",ACRBATNO," could not be closed."
.W !,"Someone else may be editing it at this time."
.D PAUSE^ACRFWARN
.S ACRQUIT=""
Q:$D(ACRQUIT)
W !!,ACRBATNO," has now been ",$S('$D(ACRCERT)#2:"CLOSED",1:"CERTIFIED"),"."
D PAIDUP^ACRFPAID
D PAUSE^ACRFWARN
S ACRQUIT=""
Q
DELETE ;EP;DELETE A PAYMENT
I '$G(ACRMAX) D Q
.W !!,"There are no payments to delete."
.D PAUSE^ACRFWARN
S DIR(0)="LO^1:"_ACRMAX
S DIR("A")="DELETE Which PAYMENT(s)"
W !
D DIR^ACRFDIC
I '+Y S ACRQUIT="" Q
S ACRXX=ACRY
S DIR("A",1)="Are you ABSOLUTELY CERTAIN you want to DELETE"
S DIR("A")="payment(s) "_$E(ACRY,1,$L(ACRY)-1)_" from this batch"
S DIR(0)="YO"
S DIR("B")="NO"
W !
D DIR^ACRFDIC
I +Y'=1 S ACRQUIT="" Q
F ACRJ=1:1 S X=$P(ACRXX,",",ACRJ) Q:'X!'+$G(^TMP("ACRPAY",$J,+X))!$D(ACRQUIT) S ACRSEQDA=+^TMP("ACRPAY",$J,X) D
.S DA=ACRSEQDA
.S DA(1)=ACRBATDA
.S DA(2)=ACRFYDA
.S DIK="^AFSLAFP("_DA(2)_",1,"_DA(1)_",1,"
.D DIK^ACRFDIC
.I '$D(ACRFY) D ;ACR*2.1*5.12
..S ACRFY=+^AFSLAFP(ACRFYDA,0) ;ACR*2.1*5.12
. D KP^ACRFODOC(ACRFY,ACRDOC,ACRBATNO,$P(ACR0,U)) ;OPEN DOCUMENT INTERFACE
K ACRQUIT
Q
ADD ;EP;ADD A NEW BATCH
N ACRFYDA,ACRFY
D FY
Q:$D(ACRQUIT)
S ACRFYDA=$O(^AFSLAFP("B",ACRFY,0))
I 'ACRFYDA D Q:'ACRFYDA
.S X=ACRFY
.S DIC="^AFSLAFP("
.S DIC(0)="L"
.D FILE^ACRFDIC
.S ACRFYDA=+Y
S DIR(0)="FO^6:6^I X?6N"
S DIR("A")="Batch Number..."
D DIR^ACRFDIC
I X'?6UN S ACRQUIT="" Q
S ACRBATNO=X
D BNCHK
Q:$D(ACRQUIT)
I '$D(ACRBATNO) G ADD
S DIR(0)="SOA^1:VENDOR Payment;2:TRAVEL Payment"
S DIR("A")="Batch Type.....: "
D DIR^ACRFDIC
I '+Y S ACRQUIT="" Q
S ACRBTYP=$S(+Y=1:"V",1:"T")
;S DIR(0)="SOA^1:ACH-Grouped;2:ACH NON-Grouped;3:Check-Grouped;4:NO-Check (DHR-ONLY);5:Check-Not Grouped" ;ACR*2.1*2.1;ACR*2.1*17.13 IM17827
S DIR(0)="SOA^2:ACH NON-Grouped;3:Check-Grouped;4:NO-Check (DHR-ONLY);5:Check-Not Grouped" ;ACR*2.1*2.1;ACR*2.1*17.13 IM17827
S DIR("A")="Type of Payment: "
D DIR^ACRFDIC
I '+Y S ACRQUIT="" Q
;S ACRACH=$S(+Y=1:"A",+Y=2:"B",+Y=3:"C",+Y=5:"N",1:"G") ;ACR*2.1*17.13 IM17827
S ACRACH=$S(+Y=1:"B",+Y=2:"B",+Y=3:"C",+Y=5:"N",1:"G") ;ACR*2.1*17.13 IM17827
W !!?10,"FISCAL YEAR.: ",ACRFY
W !?10,"BATCH NUMBER: ",ACRBATNO
W !?10,"BATCH TYPE..: ",$S(ACRBTYP="V":"Vendor Payment",1:"Travel Payment")
;W !?10,"PAYMENT TYPE: ",$S("AD"[ACRACH:"ACH Grouped","BE"[ACRACH:"ACH NON-Grouped","CF"[ACRACH:"Check-Grouped","NO"[ACRACH:"Check-Not Grouped",ACRACH="G":"NO-Check (DHR-ONLY)",1:"") ;ACR*2.1*2.1;ACR*2.1*17.13 IM17827
W !?10,"PAYMENT TYPE: ",$S("BE"[ACRACH:"ACH NON-Grouped","CF"[ACRACH:"Check-Grouped","NO"[ACRACH:"Check-Not Grouped",ACRACH="G":"NO-Check (DHR-ONLY)",1:"") ;ACR*2.1*2.1;ACR*2.1*17.13 IM17827
S DIR(0)="YO"
S DIR("A")="Create NEW BATCH"
S DIR("B")="NO"
W !
D DIR^ACRFDIC
I +Y'=1 S ACRQUIT="" Q
S X=ACRBATNO
S DA(1)=ACRFYDA
S DIC="^AFSLAFP("_ACRFYDA_",1,"
S:'$D(^AFSLAFP(ACRFYDA,1,0)) ^(0)="^9002325.01"
S DIC(0)="L"
S DIC("DR")=".04////"_$G(ACRBTYP)_";1////"_DT_";6////O;8////"_DUZ_";22////"_ACRACH
D FILE^ACRFDIC
I +Y<1 S ACRQUIT="" Q
S (ACRBATDA,DA)=+Y
S DA(1)=ACRFYDA
S DIE=9002325
S DDSFILE(1)=9002325.01
S DR="[ACR BATCH]"
D DDS^ACRFDIC
D AP^ACRFPAY
Q
BNCHK ;BATCH NUMBER CHECK TO ENSURE NO DUPLICATE NUMBERS
I $D(^AFSLAFP("L",ACRBATNO,ACRFYDA)) D
.W !!,"Batch NO. ",@ACRON,ACRBATNO,@ACROF," has already been used."
.W !,"Please select another batch number."
.D PAUSE^ACRFWARN
.K ACRBATNO
Q
FY ;EP;
S DIR(0)="NO^1000:9999"
S DIR("B")=$S($E(DT,4,5)>9:($E(DT,1,3)+1)+1700,1:$E(DT,1,3)+1700)
S DIR("A")="Fiscal Year...."
W !
D DIR^ACRFDIC
I $D(DTOUT)!($D(DUOUT))!($D(DIRUT)) S ACRQUIT=""
Q:$D(ACRQUIT)
S ACRFY=X
Q
ACRFPAY4 ;IHS/OIRM/DSD/THL,AEF - CERTIFY AND EXPORT PAYMENT BATCH; [ 07/22/2005 8:27 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**2,5,17**;NOV 05, 2001
+2 ;;
+3 QUIT
VS1 ;EP;TO SYNCRONIZE BETWEEN ARMS PAYEE AND 1166 AFP APPROVALS FOR
+1 ;PAYMENT ENTRY
+2 NEW ACRP0,ACRP11,ACRP14,ACRV0,ACRV11,ACRV14
+3 IF '$GET(ACRFYDA)!'$GET(ACRBATDA)!'$GET(ACRSEQDA)
QUIT
+4 SET ACRDOCDA=+$GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,"ARMS"))
+5 SET ACRSEQ0=$GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0))
+6 NEW ACRPVDA,ACRVDA
+7 SET ACRPVDA=$PIECE($GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0)),U,10)
+8 IF $GET(ACRDOCDA)
Begin DoDot:1
+9 DO VENDOR^ACRFRR
+10 SET ACRVDA=$PIECE($GET(^ACRDOC(ACRDOCDA,5)),U,5)
End DoDot:1
+11 IF '$GET(ACRDOCDA)
DO VENDOR
+12 DO VDATA
+13 DO VS2
+14 QUIT
VDATA ;DISPLAY ARMS AND 1166 PAYEE DATA
+1 SET ACRP0=$GET(^AUTTVNDR(+ACRPVDA,0))
+2 SET ACRP11=$GET(^AUTTVNDR(+ACRPVDA,11))
+3 SET ACRP14=$GET(^AUTTVNDR(+ACRPVDA,14))
+4 SET ACRV0=$GET(^AUTTVNDR(+ACRVDA,0))
+5 SET ACRV11=$GET(^AUTTVNDR(+ACRVDA,11))
+6 SET ACRV14=$GET(^AUTTVNDR(+ACRVDA,14))
+7 WRITE @IOF
+8 WRITE !!,"ARMS PAYEE: ",$PIECE(ACRV0,U),?50,"EIN: ",$PIECE(ACRV11,U,13)
+9 WRITE !?12,$PIECE(ACRV14,U)
+10 WRITE !?12,$PIECE(ACRV14,U,2)
+11 WRITE !?12,$PIECE(ACRV14,U,3),", ",$PIECE($GET(^DIC(5,+$PIECE(ACRV14,U,3),0)),U,2)," ",$PIECE(ACRV14,U,5)
+12 WRITE !!,"1166 PAYEE: ",$PIECE(ACRP0,U),?50,"EIN: ",$PIECE(ACRP11,U,13)
+13 WRITE !?12,$PIECE(ACRP14,U)
+14 WRITE !?12,$PIECE(ACRP14,U,2)
+15 WRITE !?12,$PIECE(ACRP14,U,3),", ",$PIECE($GET(^DIC(5,+$PIECE(ACRP14,U,3),0)),U,2)," ",$PIECE(ACRP14,U,5)
+16 WRITE !!,"Payment Sequence NO. ",$PIECE(ACRSEQ0,U)
+17 WRITE !,"will now be updated with the new Payee information."
+18 WRITE !
+19 DO PAUSE^ACRFWARN
+20 QUIT
VS2 ;SYCHRONIZE BETWEEN ARMS AND 1166
+1 SET DA=ACRSEQDA
+2 SET DA(1)=ACRBATDA
+3 SET DA(2)=ACRFYDA
+4 SET DIE="^AFSLAFP("_DA(2)_",1,"_DA(1)_",1,"
+5 SET X=ACRV11
+6 SET DR="16////"_ACRVDA_";65////"_ACRVDA_";28////"_$PIECE(ACRV14,U,6)_";29////"_$PIECE(ACRV14,U)_";30////"_...
... $PIECE(ACRV14,U,3)_";31////"_$PIECE($GET(^DIC(5,+$PIECE(ACRV14,U,4),0)),U,2)_";32////"_$PIECE(ACRV14,U,5)_";33////"_$PIECE(ACRV0,U)_";56////"_$PIECE(X,U,2)_";58////"_$PIECE(X,U)
+7 DO DIE^ACRFDIC
+8 QUIT
VSYNC ;EP - REVIEW SELECTED PAYMENTS
+1 IF ACRBTYP="T"
Begin DoDot:1
+2 WRITE !!,"This function is not applicable to Travel Batches."
+3 DO PAUSE^ACRFWARN
End DoDot:1
QUIT
+4 NEW X
+5 SET ACRXX=ACRY
+6 FOR ACRJ=1:1
SET X=$PIECE(ACRXX,",",ACRJ)
IF 'X!'+$GET(^TMP("ACRPAY",$JOB,+X))!$DATA(ACRQUIT)
QUIT
SET ACRSEQDA=+^TMP("ACRPAY",$JOB,X)
DO VS1
IF $PIECE(ACRXX,",",ACRJ+1)
DO NEXT^ACRFPAY
+7 KILL ACRQUIT
+8 QUIT
VENDOR ;SELECT VENDOR FOR PAYMENT
+1 SET DIC="^AUTTVNDR("
+2 SET DIC(0)="AEMQZ"
+3 SET DIC("A")="Select VENDOR for this payment: "
+4 IF ACRPVDA
SET DIC("B")=$PIECE(^AUTTVNDR(ACRPVDA,0),U)
+5 DO DIC^ACRFDIC
+6 IF +Y<1
WRITE !!,"You must select a vendor for this payment."
GOTO VENDOR
+7 SET ACRVDA=+Y
+8 QUIT
REOPEN ;EP;TO REOPEN CLOSED BATCH
+1 FOR
DO R1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+2 KILL ACRQUIT
+3 QUIT
R1 SET DIC="^AFSLAFP("
+1 SET DIC(0)="AEMQZ"
+2 SET DIC("A")="Which FISCAL YEAR: "
+3 SET DIC("B")=$SELECT($EXTRACT(DT,4,5)<10:$EXTRACT(DT,1,3)+1700,1:($EXTRACT(DT,1,3)+1)+1700)
+4 SET DIC("S")="I $P(^(0),U)=X"
+5 WRITE !
+6 DO DIC^ACRFDIC
+7 IF +Y<1
SET ACRQUIT=""
QUIT
+8 NEW ACRFYNO,ACRFYDA
+9 SET ACRFYDA=+Y
+10 SET ACRFYNO=$PIECE(Y(0),U)
+11 FOR
DO R11
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+12 QUIT
R11 SET DA(1)=ACRFYDA
+1 SET DIC="^AFSLAFP("_ACRFYDA_",1,"
+2 SET DIC(0)="AEMQZ"
+3 SET DIC("A")="REOPEN Which Batch: "
+4 SET DIC("S")="I $P($G(^AFSLAFP(ACRFYDA,1,+Y,2)),U,3)=""C"""
+5 WRITE !
+6 DO DIC^ACRFDIC
+7 IF +Y<1
SET ACRQUIT=""
QUIT
+8 SET ACRBATDA=+Y
+9 SET ACRBATNO=$PIECE(Y(0),U)
+10 SET DA(1)=ACRFYDA
+11 SET DA=ACRBATDA
+12 SET DIR(0)="YO"
+13 SET DIR("A",1)="Are you certain you want to RE"_$SELECT(+$GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,2)):"-EXPORT",1:"OPEN")
+14 SET DIR("A")="Batch NO: "_ACRBATNO_" from Fiscal Year "_ACRFYNO
+15 SET DIR("B")="NO"
+16 WRITE !
+17 DO DIR^ACRFDIC
+18 IF Y'=1
QUIT
+19 DO DHR
+20 WRITE !!,"Batch NO: "_ACRBATNO_" from Fiscal Year "_ACRFYNO
+21 WRITE !,$SELECT(+$GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,2)):"Can now be RE-EXPORT'ed.",1:"Is now OPEN for further processing.")
+22 SET DA(1)=ACRFYDA
+23 SET DA=ACRBATDA
+24 SET DIE="^AFSLAFP("_ACRFYDA_",1,"
+25 IF +$GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,2))
IF $PIECE($GET(^(0)),U,5)
SET DR="5///@;7///@;4////"_$PIECE($GET(^(0)),U,5)
+26 IF '$TEST
SET DR="4///@;5///@;6////O;7///@"
+27 DO DIE^ACRFDIC
+28 QUIT
DHR ;ALLOW RE-CREATION OF DHR'S
+1 SET DIR(0)="YO"
+2 SET DIR("A")="Do you need to RE-CREATE the DHR's"
+3 SET DIR("B")="NO"
+4 WRITE !
+5 DO DIR^ACRFDIC
+6 IF Y'=1
QUIT
+7 SET ACRSEQDA=0
+8 FOR
SET ACRSEQDA=$ORDER(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA))
IF 'ACRSEQDA
QUIT
Begin DoDot:1
+9 SET DA=ACRSEQDA
+10 SET DA(1)=ACRBATDA
+11 SET DA(2)=ACRFYDA
+12 SET DIE="^AFSLAFP("_DA(2)_",1,"_DA(1)_",1,"
+13 SET DR=".03///@"
+14 DO DIE^ACRFDIC
End DoDot:1
+15 QUIT
CLOSEB ;EP;CLOSE A BATCH
+1 DO VALCHK^ACRFPAY5
+2 IF $DATA(ACRQUIT)
QUIT
+3 SET DIR(0)="YO"
+4 SET DIR("A")="Are you certain you want to "_$SELECT('$DATA(ACRCERT)#2:"CLOSE",1:"CERTIFY")_" this batch"
+5 SET DIR("B")="NO"
+6 WRITE !
+7 DO DIR^ACRFDIC
+8 IF +Y'=1
QUIT
+9 IF $DATA(ACRCERT)#2
DO ^ACRFESIG
IF $DATA(ACRQUIT)
QUIT
+10 SET DA=ACRBATDA
+11 SET DA(1)=ACRFYDA
+12 SET DIE="^AFSLAFP("_ACRFYDA_",1,"
+13 SET DR=$SELECT('$DATA(ACRCERT)#2:"",1:"4////"_DT_";2////"_DUZ_";")_"6////C"
+14 DO DIE^ACRFDIC
+15 IF $DATA(ACRCERT)#2
IF '$PIECE(^AFSLAFP(ACRFYDA,1,ACRBATDA,0),U,5)
Begin DoDot:1
+16 WRITE !!,"The CERTIFICATION was not applied to BATCH ",ACRBATNO
+17 DO PAUSE^ACRFWARN
+18 SET ACRQUIT=""
End DoDot:1
QUIT
+19 IF '$DATA(ACRCERT)#2
IF $PIECE(^AFSLAFP(ACRFYDA,1,ACRBATDA,2),U,3)'="C"
Begin DoDot:1
+20 WRITE !!,"BATCH NO. ",ACRBATNO," could not be closed."
+21 WRITE !,"Someone else may be editing it at this time."
+22 DO PAUSE^ACRFWARN
+23 SET ACRQUIT=""
End DoDot:1
QUIT
+24 IF $DATA(ACRQUIT)
QUIT
+25 WRITE !!,ACRBATNO," has now been ",$SELECT('$DATA(ACRCERT)#2:"CLOSED",1:"CERTIFIED"),"."
+26 DO PAIDUP^ACRFPAID
+27 DO PAUSE^ACRFWARN
+28 SET ACRQUIT=""
+29 QUIT
DELETE ;EP;DELETE A PAYMENT
+1 IF '$GET(ACRMAX)
Begin DoDot:1
+2 WRITE !!,"There are no payments to delete."
+3 DO PAUSE^ACRFWARN
End DoDot:1
QUIT
+4 SET DIR(0)="LO^1:"_ACRMAX
+5 SET DIR("A")="DELETE Which PAYMENT(s)"
+6 WRITE !
+7 DO DIR^ACRFDIC
+8 IF '+Y
SET ACRQUIT=""
QUIT
+9 SET ACRXX=ACRY
+10 SET DIR("A",1)="Are you ABSOLUTELY CERTAIN you want to DELETE"
+11 SET DIR("A")="payment(s) "_$EXTRACT(ACRY,1,$LENGTH(ACRY)-1)_" from this batch"
+12 SET DIR(0)="YO"
+13 SET DIR("B")="NO"
+14 WRITE !
+15 DO DIR^ACRFDIC
+16 IF +Y'=1
SET ACRQUIT=""
QUIT
+17 FOR ACRJ=1:1
SET X=$PIECE(ACRXX,",",ACRJ)
IF 'X!'+$GET(^TMP("ACRPAY",$JOB,+X))!$DATA(ACRQUIT)
QUIT
SET ACRSEQDA=+^TMP("ACRPAY",$JOB,X)
Begin DoDot:1
+18 SET DA=ACRSEQDA
+19 SET DA(1)=ACRBATDA
+20 SET DA(2)=ACRFYDA
+21 SET DIK="^AFSLAFP("_DA(2)_",1,"_DA(1)_",1,"
+22 DO DIK^ACRFDIC
+23 ;ACR*2.1*5.12
IF '$DATA(ACRFY)
Begin DoDot:2
+24 ;ACR*2.1*5.12
SET ACRFY=+^AFSLAFP(ACRFYDA,0)
End DoDot:2
+25 ;OPEN DOCUMENT INTERFACE
DO KP^ACRFODOC(ACRFY,ACRDOC,ACRBATNO,$PIECE(ACR0,U))
End DoDot:1
+26 KILL ACRQUIT
+27 QUIT
ADD ;EP;ADD A NEW BATCH
+1 NEW ACRFYDA,ACRFY
+2 DO FY
+3 IF $DATA(ACRQUIT)
QUIT
+4 SET ACRFYDA=$ORDER(^AFSLAFP("B",ACRFY,0))
+5 IF 'ACRFYDA
Begin DoDot:1
+6 SET X=ACRFY
+7 SET DIC="^AFSLAFP("
+8 SET DIC(0)="L"
+9 DO FILE^ACRFDIC
+10 SET ACRFYDA=+Y
End DoDot:1
IF 'ACRFYDA
QUIT
+11 SET DIR(0)="FO^6:6^I X?6N"
+12 SET DIR("A")="Batch Number..."
+13 DO DIR^ACRFDIC
+14 IF X'?6UN
SET ACRQUIT=""
QUIT
+15 SET ACRBATNO=X
+16 DO BNCHK
+17 IF $DATA(ACRQUIT)
QUIT
+18 IF '$DATA(ACRBATNO)
GOTO ADD
+19 SET DIR(0)="SOA^1:VENDOR Payment;2:TRAVEL Payment"
+20 SET DIR("A")="Batch Type.....: "
+21 DO DIR^ACRFDIC
+22 IF '+Y
SET ACRQUIT=""
QUIT
+23 SET ACRBTYP=$SELECT(+Y=1:"V",1:"T")
+24 ;S DIR(0)="SOA^1:ACH-Grouped;2:ACH NON-Grouped;3:Check-Grouped;4:NO-Check (DHR-ONLY);5:Check-Not Grouped" ;ACR*2.1*2.1;ACR*2.1*17.13 IM17827
+25 ;ACR*2.1*2.1;ACR*2.1*17.13 IM17827
SET DIR(0)="SOA^2:ACH NON-Grouped;3:Check-Grouped;4:NO-Check (DHR-ONLY);5:Check-Not Grouped"
+26 SET DIR("A")="Type of Payment: "
+27 DO DIR^ACRFDIC
+28 IF '+Y
SET ACRQUIT=""
QUIT
+29 ;S ACRACH=$S(+Y=1:"A",+Y=2:"B",+Y=3:"C",+Y=5:"N",1:"G") ;ACR*2.1*17.13 IM17827
+30 ;ACR*2.1*17.13 IM17827
SET ACRACH=$SELECT(+Y=1:"B",+Y=2:"B",+Y=3:"C",+Y=5:"N",1:"G")
+31 WRITE !!?10,"FISCAL YEAR.: ",ACRFY
+32 WRITE !?10,"BATCH NUMBER: ",ACRBATNO
+33 WRITE !?10,"BATCH TYPE..: ",$SELECT(ACRBTYP="V":"Vendor Payment",1:"Travel Payment")
+34 ;W !?10,"PAYMENT TYPE: ",$S("AD"[ACRACH:"ACH Grouped","BE"[ACRACH:"ACH NON-Grouped","CF"[ACRACH:"Check-Grouped","NO"[ACRACH:"Check-Not Grouped",ACRACH="G":"NO-Check (DHR-ONLY)",1:"") ;ACR*2.1*2.1;ACR*2.1*17.13 IM17827
+35 ;ACR*2.1*2.1;ACR*2.1*17.13 IM17827
WRITE !?10,"PAYMENT TYPE: ",$SELECT("BE"[ACRACH:"ACH NON-Grouped","CF"[ACRACH:"Check-Grouped","NO"[ACRACH:"Check-Not Grouped",ACRACH="G":"NO-Check (DHR-ONLY)",1:"")
+36 SET DIR(0)="YO"
+37 SET DIR("A")="Create NEW BATCH"
+38 SET DIR("B")="NO"
+39 WRITE !
+40 DO DIR^ACRFDIC
+41 IF +Y'=1
SET ACRQUIT=""
QUIT
+42 SET X=ACRBATNO
+43 SET DA(1)=ACRFYDA
+44 SET DIC="^AFSLAFP("_ACRFYDA_",1,"
+45 IF '$DATA(^AFSLAFP(ACRFYDA,1,0))
SET ^(0)="^9002325.01"
+46 SET DIC(0)="L"
+47 SET DIC("DR")=".04////"_$GET(ACRBTYP)_";1////"_DT_";6////O;8////"_DUZ_";22////"_ACRACH
+48 DO FILE^ACRFDIC
+49 IF +Y<1
SET ACRQUIT=""
QUIT
+50 SET (ACRBATDA,DA)=+Y
+51 SET DA(1)=ACRFYDA
+52 SET DIE=9002325
+53 SET DDSFILE(1)=9002325.01
+54 SET DR="[ACR BATCH]"
+55 DO DDS^ACRFDIC
+56 DO AP^ACRFPAY
+57 QUIT
BNCHK ;BATCH NUMBER CHECK TO ENSURE NO DUPLICATE NUMBERS
+1 IF $DATA(^AFSLAFP("L",ACRBATNO,ACRFYDA))
Begin DoDot:1
+2 WRITE !!,"Batch NO. ",@ACRON,ACRBATNO,@ACROF," has already been used."
+3 WRITE !,"Please select another batch number."
+4 DO PAUSE^ACRFWARN
+5 KILL ACRBATNO
End DoDot:1
+6 QUIT
FY ;EP;
+1 SET DIR(0)="NO^1000:9999"
+2 SET DIR("B")=$SELECT($EXTRACT(DT,4,5)>9:($EXTRACT(DT,1,3)+1)+1700,1:$EXTRACT(DT,1,3)+1700)
+3 SET DIR("A")="Fiscal Year...."
+4 WRITE !
+5 DO DIR^ACRFDIC
+6 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))
SET ACRQUIT=""
+7 IF $DATA(ACRQUIT)
QUIT
+8 SET ACRFY=X
+9 QUIT
