ACRFPAY ;IHS/OIRM/DSD/THL,AEF - CERTIFY AND EXPORT PAYMENT BATCH; [ 02/13/2007 9:19 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**3,16,17,22**;NOV 05, 2001
;
D FMA
I $D(ACRQUIT) D EXIT Q
EN F D EN1 Q:$D(ACRQUIT)!$D(ACROUT)
EXIT K ACR,ACROUT,ACRQUIT,ACRXALL,ACRJ,ACRFYDA,ACRBATDA,ACRBATNO,ACRFY,ACRFYX,ACR0,ACRPAY,ACRPAYEE,ACRACH,ACRBTYP,ACRJJ,ACRMAX,ACRY,ACRDEST,ACRS,ACRSBAT,ACRSFY,ACRSEQDA,ACRSS,ACRXX,ACRSEQNO,ACRCERT,ACRESIG,ACR1,ACR2,ACRBSCH,ACRDOC,ACRREF,ACRTOT
K ACRSNO,ACRBAT,ACRIV,ACRVDAT
K ^TMP("ACRIV",$J),^TMP("ACRRR",$J),^TMP("ACRSYNC",$J),^TMP("ACRNORR",$J),^TMP("ACREXP",$J),^TMP("ACRINVR",$J),^TMP("ACREFTR",$J),^TMP("ACRPAYL",$J),^TMP("ACRBI",$J),^TMP("ACRINV",$J)
Q
EN1 D EXIT
W @IOF
W !!?10,"Select the Payment Function"
S DIR(0)="SO^1:INVOICE Audit;2:AIRLINE Payment;3:EDIT Payment/REVIEW Batch;4:CERTIFY a Batch;5:EXPORT a Batch ;6:ADD a Batch;7:COMBINE Batches;8:REOPEN/RE-EXPORT a Batch;9:REOPEN a Document;10:PRINT Payment Management Reports;11:DELETE A Batch"
S DIR(0)=DIR(0)_";12:Payroll Data;13:Batch STATUS Report;14:Travel Advance Management;15:Payment Management Utilities"
S DIR(0)=DIR(0)_";16:Process Credit Card Payments"
S DIR("A")="Which function"
W !
D DIR^ACRFDIC
I '+Y S ACRQUIT="" Q
;I +Y=1 D ACRIV^ACRFRR K ACRQUIT Q ;ACR*2.1*16.01 IM14473
;I +Y=2 D AIRLINE^ACRFIV12 K ACRQUIT Q ;ACR*2.1*16.01 IM14473
;I +Y=3 D REVIEW K ACRQUIT Q ;ACR*2.1*16.01 IM14473
;I +Y=4 D CERTIFY K ACRQUIT Q ;ACR*2.1*16.01 IM14473
;I +Y=5 D EXPORT^ACRFPAY3 K ACRQUIT Q ;ACR*2.1*16.01 IM14473
;I +Y=6 D ADD^ACRFPAY4 K ACRQUIT Q ;ACR*2.1*16.01 IM14473
;I +Y=7 D COMBINE^ACRFPAY1 K ACRQUIT Q ;ACR*2.1*16.01 IM14473
;I +Y=8 D REOPEN^ACRFPAY4 K ACRQUIT Q ;ACR*2.1*16.01 IM14473
;I +Y=9 S ACRIV="" D REOPEN^ACRFRR K ACRQUIT,ACRIV Q ;ACR*2.1*16.01 IM14473
;I +Y=10 D REPORTS^ACRFPAY6 K ACRQUIT Q ;ACR*2.1*16.01 IM14473
;I +Y=11 D DBATCH^ACRFPAY3 K ACRQUIT Q ;ACR*2.1*16.01 IM14473
;I +Y=12 D ^ACRFPR Q ;ACR*2.1*16.01 IM14473
;I +Y=13 D BSTATUS^ACRFPAY8 K ACRQUIT Q ;ACR*2.1*16.01 IM14473
;I +Y=14 D ^ACRFTA K ACRQUIT Q ;ACR*2.1*16.01 IM14473
;I +Y=15 D ^ACRFPAYU K ACRQUIT Q ;ACR*2.1*16.01 IM14473
I +Y=1 D ACRIV^ACRFRR K ACRQUIT Q
I +Y=2 D AIRLINE^ACRFIV12 K ACRQUIT Q
I +Y=3 D REVIEW K ACRQUIT Q
I +Y=4 D K ACRQUIT Q ;ACR*2.1*16.01 IM14473
.Q:$$CKLK^ACRFPAY("ACRZ NO CERTIFY","CERTIFY a Batch",DUZ) ;ACR*2.1*16.01 IM14473
.D CERTIFY ;ACR*2.1*16.01 IM14473
I +Y=5 D K ACRQUIT Q ;ACR*2.1*16.01 IM14473
.Q:$$CKLK^ACRFPAY("ACRZ NO EXPORT","EXPORT a Batch",DUZ) ;ACR*2.1*16.01 IM14473
.D EXPORT^ACRFPAY3 ;ACR*2.1*16.01 IM14473
I +Y=6 D K ACRQUIT Q ;ACR*2.1*16.01 IM14473
.Q:$$CKLK^ACRFPAY("ACRZ NO ADD","ADD a Batch",DUZ) ;ACR*2.1*16.01 IM14473
.D ADD^ACRFPAY4 ;ACR*2.1*16.01 IM14473
I +Y=7 D COMBINE^ACRFPAY1 K ACRQUIT Q
I +Y=8 D K ACRQUIT Q ;ACR*2.1*16.01 IM14473
.Q:$$CKLK^ACRFPAY("ACRZ NO REOPEN/RE-EXPORT","REOPEN/RE-EXPORT a Batch",DUZ) ;ACR*2.1*16.01 IM14473
.D REOPEN^ACRFPAY4 ;ACR*2.1*16.01 IM14473
I +Y=9 S ACRIV="" D REOPEN^ACRFRR K ACRQUIT,ACRIV Q
I +Y=10 D REPORTS^ACRFPAY6 K ACRQUIT Q
I +Y=11 D K ACRQUIT Q ;ACR*2.1*16.01 IM14473
.Q:$$CKLK^ACRFPAY("ACRZ NO DELETE","DELETE a Batch",DUZ) ;ACR*2.1*16.01 IM14473
.D DBATCH^ACRFPAY3 ;ACR*2.1*16.01 IM14473
I +Y=12 D ^ACRFPR Q
I +Y=13 D BSTATUS^ACRFPAY8 K ACRQUIT Q
I +Y=14 D K ACRQUIT Q ;ACR*2.1*16.01 IM14473
.Q:$$CKLK^ACRFPAY("ACRZ NO TA MGT","TA Management",DUZ) ;ACR*2.1*16.01 IM14473
.D ^ACRFTA ;ACR*2.1*16.01 IM14473
I +Y=15 D ^ACRFPAYU K ACRQUIT Q
Q
REVIEW F D R1 Q:$D(ACRQUIT)!$D(ACROUT)
K ACRQUIT
Q
R1 D BATCHL^ACRFPAY3
D BATCHS
I $D(ACRQUIT)!$D(ACROUT) Q
F D BATCHD^ACRFPAY6 Q:$D(ACRQUIT)!$D(ACROUT)
K ACRQUIT
Q
BATCHS ;EP - SELECT BATCH
I '$G(ACRMAX) D Q
.W !!,"There are no batches on file."
.D PAUSE^ACRFWARN
.S ACRQUIT=""
N X
K ACRXALL
S DIR(0)="FO^1:6"
S DIR("A")="Which BATCH"
S DIR("?",1)="Enter either the 6 digit batch number or"
S DIR("?")="the sequence number (NO.) for the batch."
S:$D(ACREXP)!$D(ACRCERT) DIR("A")=$S($D(ACREXP):"EXPORT",$D(ACRCERT):"CERTIFY",1:"")_" "_DIR("A")
W !
I $D(ACREXP) D
.W !,"Please NOTE: You can export ALL Batches by entering 'ALL' at the"
.W !,"prompt. Otherwise, specify the the batch you want to export."
.W !
D DIR^ACRFDIC
I Y="" S ACRQUIT="" Q
I Y="ALL" S ACRXALL="ALL" Q
I $L(Y)=6,$D(^TMP("ACRBAT",$J,Y)) S Y=^TMP("ACRBAT",$J,Y)
I '$D(^TMP("ACRPAY",$J,+Y)) S ACRQUIT="" Q
S X=^TMP("ACRPAY",$J,+Y)
S ACRBATDA=$P(X,U)
S ACRFYDA=$P(X,U,2)
I '$D(^AFSLAFP(+ACRFYDA,1,+ACRBATDA)) S ACRQUIT="" Q ;ACR*2.1*3.42
S ACRFY=$P($G(^AFSLAFP(+ACRFYDA,0)),U)
S ACRBSCH=$P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,2)),U,6)
K ACRBAT
Q
ADDPAY ;EP;ADD PAYMENT
I $$COUNT^ACRFIV12(ACRFYDA,ACRBATDA)>59 D Q
.W !!,"You cannot add more than 60 payments to a batch."
.W !,"Please add additional payments to another batch"
.W !,"or create a new batch if necessary."
.D PAUSE^ACRFWARN
D NEWSEQ
I $D(ACRQUIT)!$D(ACROUT) K ACRQUIT Q
;I $D(ACRT),ACRT="" D PAYE ; only 1 payment ;Added in ACR*2.1*16.06 IM15505;Commented out in ACR*2.1*17.01 IM17097
D PAYE ;Commented out in ACR*2.1*16.06 IM15505;Restored in ACR*2.1*17.01 IM17097
S ACRNEXT=""
AP ;EP;TO ADD PAYMENT INFO
S DIR(0)="YO"
S DIR("A")="ADD "_$S($D(ACRNEXT):"another",1:"a")_" payment"_$S('$D(ACRNEXT):" now",1:"")
S DIR("B")="NO"
K ACRNEXT
W !
D DIR^ACRFDIC
I +Y'=1 Q
D ADDPAY:$G(ACRREFX)'=326&($G(ACRREFX)'=371)
Q
NEWSEQ ;EP;CREATE NEW SEQUENCE
D NONARMS^ACRFPAY1
Q:$D(ACRQUIT)!$D(ACROUT)
NEWSEQ1 S ACROBJDA=$O(ACRIVPAY(ACRCANDA,0))
Q:'ACROBJDA
;D NEWSEQ^ACRFIV11 ;ACR*2.1*16.06 IM15505
;K ACRIVDC,ACRP ;ACR*2.1*16.06 IM15505
;I $D(ACRIVDIS(ACRCANDA,"P"))#2 D ;ACR*2.1*16.06 IM15505
;.S ACROBJDA=0 ;ACR*2.1*16.06 IM15505
;.F S ACROBJDA=$O(ACRIVDIS(ACRCANDA,ACROBJDA)) Q:'ACROBJDA D ;ACR*2.1*16.06 IM15505
;..S ACRIVTF=0 ;ACR*2.1*16.06 IM15505
;..S ACRTCODE=19917 ;ACR*2.1*16.06 IM15505
;..S ACRP=ACRIVDIS(ACRCANDA,"P") ;ACR*2.1*16.06 IM15505
;..Q:'ACRP ;ACR*2.1*16.06 IM15505
;..D NEWSEQ^ACRFIV11 ;ACR*2.1*16.06 IM15505
;..K ACRIVDC,ACRP ;ACR*2.1*16.06 IM15505
;D ^ACRFIV11 ;Added in ACR*2.1*16.06 IM15505;Commented out in ACR*2.1*17.01 IM17097
D N1166^ACRFIV11 ;ACR*2.1*17.01 IM17097
D EXIT^ACRFIV11
I $G(ACRREFX)=326!($G(ACRREFX)=371) D CONTRACT
K ACRDOCX,ACRVDAX,ACRREFX
Q
SREV ;EP;REVIEW SELECTED PAYMENTS
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 PAYE I $P(ACRXX,",",ACRJ+1) D NEXT
K ACRQUIT
Q
NEXT ;EP
S DIR(0)="YO"
S DIR("A")="Continue Payment Review/Edit"
S DIR("B")="YES"
W !
D DIR^ACRFDIC
S:+Y'=1 ACRQUIT=""
Q
PAYE ;EP;EDIT PAYMENT INFO
S DA(2)=ACRFYDA
S DA(1)=ACRBATDA
S DA=ACRSEQDA
S DIE=9002325
S DDSFILE(1)=9002325.02
S DR="[ACR REVIEW PAYMENT"_$S(ACRBTYP="T":"-T",1:"")_"]"
D DDS^ACRFDIC
D UPODOC(ACRFYDA,ACRBATDA,ACRSEQDA) ; OPEN DOCUMENT INTERFACE
Q:$G(ACRACH)'="A"&($G(ACRACH)'="B")
S X=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0))
S X=$P(X,U,$S(ACRBTYP="V":10,1:24))
Q:'X
S DA=X
BANKINFO ;EP;TO ENTER BANK INFO
Q:$S($D(^XUSEC("ACRFZ EDIT EFT",DUZ)):0,$D(^XUSEC("ACRFZ VIEW EFT",DUZ)):0,1:1)
S DIE=$S(ACRBTYP'="T":9999999.11,1:9002185.3)
S DDSFILE=$S(ACRBTYP'="T":9999999.11,1:9002185.3)
S DR="[ACR BANK INFORMATION]"
D DDS^ACRFDIC
Q
CERTIFY ;EP;TO LIST AND SELECT BATCHES TO BE CERTIFIED
;I '$D(^ACRAPL("AC",DUZ,38)) D Q ;ACR*2.1*16.01 IM14473
I '$D(^ACRAPL("AC",DUZ,38))!($D(^XUSEC("ACRFZ NO CERTIFY",DUZ))) D Q ;ACR*2.1*16.01 IM14473
.W !!,"You do not have the authority to CERTIFY PAYMENTS."
.D PAUSE^ACRFWARN
F D C1 Q:$D(ACRQUIT)!$D(ACROUT)
K ACRQUIT
Q
C1 N J,X,Y
K ACRMAX,ACR,ACRPAY
S ACRCERT=""
S ACRFYDA=0
F S ACRFYDA=$O(^AFSLAFP("CERT","C",ACRFYDA)) Q:'ACRFYDA D
.S ACRFY=$P(^AFSLAFP(ACRFYDA,0),U)
.S ACRBATDA=0
.F S ACRBATDA=$O(^AFSLAFP("CERT","C",ACRFYDA,ACRBATDA)) Q:'ACRBATDA D PAY^ACRFPAY3
D PAY1^ACRFPAY3
I '$G(ACRMAX) D Q
.W !!,"NO Batches pending for CERTIFICATION"
.D PAUSE^ACRFWARN
.S ACRQUIT=""
D BATCHS
I $D(ACRQUIT)!$D(ACROUT) Q
F D BATCHD^ACRFPAY6 Q:$D(ACRQUIT)!$D(ACROUT)
K ACRQUIT
Q
FMA ;CHECK FILE MAN ACCESS CODES
I $G(DUZ(0))'["@",$G(DUZ(0))'["$" D
.W !!,"In order to perfrom functions within Payment Management your"
.W !,"FILE MAN ACCESS CODE must include the '$' (dollar sign)."
.W !!,"Consult with you ARMS manager to get this character assigned"
.W !,"as part of your FILE MAN ACCESS CODE."
.D PAUSE^ACRFWARN
.S ACRQUIT=""
I '$P($G(^ACRAU(DUZ,1)),U,13) D
.W !!,"You are not in the FULL-SCREEN edit mode required in order"
.W !,"to use Payment Management."
.W !!,"Consult with you ARMS manager to get set up for the"
.W !,"FULL-SCREEN edit mode."
.D PAUSE^ACRFWARN
.S ACRQUIT=""
Q
CONTRACT ;ALLOW ADD OF MULTIPLE NEW CONTRACT PAYMENTS
S DIR(0)="YO"
S DIR("A",1)="Add ANOTHER Contract Payment"
S DIR("A",2)="For DOCUMENT NO. "_ACRDOCX
S DIR("A")="For CONTRACTOR.. "_$P($G(^AUTTVNDR(+$G(ACRVDAX),0)),U)
S DIR("B")="NO"
W !
D DIR^ACRFDIC
I Y'=1 S ACRQUIT="" Q
W !!,"DOCUMENT NUMBER.....: ",ACRDOCX
W !,"CONTRACTOR..........: ",$P($G(^AUTTVNDR(+$G(ACRVDAX),0)),U)
S X=ACRDOCX
D DOCX^ACRFPAY1
I $G(ACRDOC)="" S ACRQUIT="" Q
S ACRVDA=ACRVDAX
D 326^ACRFPAY1
Q:$D(ACRQUIT)!$D(ACROUT)
D NEWSEQ1
Q
UPODOC(ACRFYDA,ACRBATDA,ACRSEQDA) ;
;----- UPDATE OPEN DOCUMENT FILE WHEN BATCH PAYMENT IS EDITED
;
; OPEN DOCUMENT INTERFACE
; SETS UP CALL TO EPMT^ACRFODOC TO UPDATE THE PAYMENT ENTRY
; IN THE OPEN DOCUMENT DATABASE WHEN A BATCH PAYMENT IS EDITED
;
N ACRAMT,ACRBATCH,ACRDATE,ACRDOC,ACRFY,ACRPDFOR,ACRSEQ,ACRSCHNO,ACRSSN,D0,D1,D2,DATA
S ACRFY=$P($G(^AFSLAFP(ACRFYDA,0)),U)
Q:'ACRFY
S DATA=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,0))
S ACRBATCH=$P(DATA,U)
Q:ACRBATCH']""
S ACRDATE=$P(DATA,U,2)
S DATA=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0))
S ACRDOC=$S($P(DATA,U,20)]"":$P(DATA,U,20),1:$P(DATA,U,21))
Q:ACRDOC']""
S ACRSEQ=$P(DATA,U)
Q:ACRSEQ']""
S ACRAMT=$P(DATA,U,11)
S ACRAMT=$$DOL^ACRFUTL(ACRAMT)
S ACRSSN=$S($P(DATA,U,10):$P($G(^AUTTVNDR($P(DATA,U,10),11)),U),$P(DATA,U,24):$P($G(^VA(200,$P(DATA,U,24),1)),U,9),1:"")
S ACRSCHNO=$P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,2)),U,6)
S ACRPDFOR=$P(DATA,U,14)
S D0=$O(^AFSLODOC("B",ACRFY,0))
Q:'D0
S D1=$O(^AFSLODOC(D0,1,"B",ACRDOC,0))
Q:'D1
S D2=$O(^AFSLODOC(D0,1,D1,1,"C",ACRBATCH,ACRSEQ,0))
Q:'D2
S DATA=ACRDATE_U_ACRAMT_U_ACRBATCH_U_ACRSSN_U_ACRSCHNO_U_ACRPDFOR_U_ACRDATE_U_U_ACRSEQ
D EPMT^ACRFODOC(D0,D1,D2,DATA)
Q
CKLK(X,Y,DUZ) ;EP; EXTRINSIC FUNCTION TO CHECK FOR BLOCKS ; ACR*2.1*16.01 IM14473
;
; ENTERS WITH - X= NAME OF KEY
; Y= NAME OF OPTION
; DUZ= EIN OF USER
;
; RETURNS 1 = TRUE (BLOCK OUT)
; 0 = FALSE (ALLOW IN)
N Z
S Z=$D(^XUSEC(X,DUZ))
I Z D
.W !!,"You do not have the authority to ",Y
.D PAUSE^ACRFWARN
Q Z
BADRN ;BAD ROUTING NUMBER - MESSAGE USED BY ACR BANK INFORMATION SCREEN
;ACR*2.1*22.11f IM23639
W *7
D HLP^DDSUTL("This Routing Number is incorrect.")
D HLP^DDSUTL("$$EOP")
Q
BADSRN ;BAD SUB-ROUTING NUMBER - MESSAGE USED BY ACR BANK INFORMATION SCREEN
;ACR*2.1*22.11f IM23639
W *7
D HLP^DDSUTL("This Sub-Routing Number is incorrect.")
D HLP^DDSUTL("$$EOP")
Q
ACRFPAY ;IHS/OIRM/DSD/THL,AEF - CERTIFY AND EXPORT PAYMENT BATCH; [ 02/13/2007 9:19 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**3,16,17,22**;NOV 05, 2001
+2 ;
+3 DO FMA
+4 IF $DATA(ACRQUIT)
DO EXIT
QUIT
EN FOR
DO EN1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
EXIT KILL ACR,ACROUT,ACRQUIT,ACRXALL,ACRJ,ACRFYDA,ACRBATDA,ACRBATNO,ACRFY,ACRFYX,ACR0,ACRPAY,ACRPAYEE,ACRACH,ACRBTYP,ACRJJ,ACRMAX,ACRY,ACRDEST,ACRS,ACRSBAT,ACRSFY,ACRSEQDA,ACRSS,ACRXX,ACRSEQNO,ACRCERT,ACRESIG,ACR1,ACR2,ACRBSCH,ACRDOC,ACRREF,ACRTOT
+1 KILL ACRSNO,ACRBAT,ACRIV,ACRVDAT
+2 KILL ^TMP("ACRIV",$JOB),^TMP("ACRRR",$JOB),^TMP("ACRSYNC",$JOB),^TMP("ACRNORR",$JOB),^TMP("ACREXP",$JOB),^TMP("ACRINVR",$JOB),^TMP("ACREFTR",$JOB),^TMP("ACRPAYL",$JOB),^TMP("ACRBI",$JOB),^TMP("ACRINV",$JOB)
+3 QUIT
EN1 DO EXIT
+1 WRITE @IOF
+2 WRITE !!?10,"Select the Payment Function"
+3 SET DIR(0)="SO^1:INVOICE Audit;2:AIRLINE Payment;3:EDIT Payment/REVIEW Batch;4:CERTIFY a Batch;5:EXPORT a Batch ;6:ADD a Batch;7:COMBINE Batches;8:REOPEN/RE-EXPORT a Batch;9:REOPEN a Document;10:PRINT Payment Management Reports;11:DELETE A Batc
h"
+4 SET DIR(0)=DIR(0)_";12:Payroll Data;13:Batch STATUS Report;14:Travel Advance Management;15:Payment Management Utilities"
+5 SET DIR(0)=DIR(0)_";16:Process Credit Card Payments"
+6 SET DIR("A")="Which function"
+7 WRITE !
+8 DO DIR^ACRFDIC
+9 IF '+Y
SET ACRQUIT=""
QUIT
+10 ;I +Y=1 D ACRIV^ACRFRR K ACRQUIT Q ;ACR*2.1*16.01 IM14473
+11 ;I +Y=2 D AIRLINE^ACRFIV12 K ACRQUIT Q ;ACR*2.1*16.01 IM14473
+12 ;I +Y=3 D REVIEW K ACRQUIT Q ;ACR*2.1*16.01 IM14473
+13 ;I +Y=4 D CERTIFY K ACRQUIT Q ;ACR*2.1*16.01 IM14473
+14 ;I +Y=5 D EXPORT^ACRFPAY3 K ACRQUIT Q ;ACR*2.1*16.01 IM14473
+15 ;I +Y=6 D ADD^ACRFPAY4 K ACRQUIT Q ;ACR*2.1*16.01 IM14473
+16 ;I +Y=7 D COMBINE^ACRFPAY1 K ACRQUIT Q ;ACR*2.1*16.01 IM14473
+17 ;I +Y=8 D REOPEN^ACRFPAY4 K ACRQUIT Q ;ACR*2.1*16.01 IM14473
+18 ;I +Y=9 S ACRIV="" D REOPEN^ACRFRR K ACRQUIT,ACRIV Q ;ACR*2.1*16.01 IM14473
+19 ;I +Y=10 D REPORTS^ACRFPAY6 K ACRQUIT Q ;ACR*2.1*16.01 IM14473
+20 ;I +Y=11 D DBATCH^ACRFPAY3 K ACRQUIT Q ;ACR*2.1*16.01 IM14473
+21 ;I +Y=12 D ^ACRFPR Q ;ACR*2.1*16.01 IM14473
+22 ;I +Y=13 D BSTATUS^ACRFPAY8 K ACRQUIT Q ;ACR*2.1*16.01 IM14473
+23 ;I +Y=14 D ^ACRFTA K ACRQUIT Q ;ACR*2.1*16.01 IM14473
+24 ;I +Y=15 D ^ACRFPAYU K ACRQUIT Q ;ACR*2.1*16.01 IM14473
+25 IF +Y=1
DO ACRIV^ACRFRR
KILL ACRQUIT
QUIT
+26 IF +Y=2
DO AIRLINE^ACRFIV12
KILL ACRQUIT
QUIT
+27 IF +Y=3
DO REVIEW
KILL ACRQUIT
QUIT
+28 ;ACR*2.1*16.01 IM14473
IF +Y=4
Begin DoDot:1
+29 ;ACR*2.1*16.01 IM14473
IF $$CKLK^ACRFPAY("ACRZ NO CERTIFY","CERTIFY a Batch",DUZ)
QUIT
+30 ;ACR*2.1*16.01 IM14473
DO CERTIFY
End DoDot:1
KILL ACRQUIT
QUIT
+31 ;ACR*2.1*16.01 IM14473
IF +Y=5
Begin DoDot:1
+32 ;ACR*2.1*16.01 IM14473
IF $$CKLK^ACRFPAY("ACRZ NO EXPORT","EXPORT a Batch",DUZ)
QUIT
+33 ;ACR*2.1*16.01 IM14473
DO EXPORT^ACRFPAY3
End DoDot:1
KILL ACRQUIT
QUIT
+34 ;ACR*2.1*16.01 IM14473
IF +Y=6
Begin DoDot:1
+35 ;ACR*2.1*16.01 IM14473
IF $$CKLK^ACRFPAY("ACRZ NO ADD","ADD a Batch",DUZ)
QUIT
+36 ;ACR*2.1*16.01 IM14473
DO ADD^ACRFPAY4
End DoDot:1
KILL ACRQUIT
QUIT
+37 IF +Y=7
DO COMBINE^ACRFPAY1
KILL ACRQUIT
QUIT
+38 ;ACR*2.1*16.01 IM14473
IF +Y=8
Begin DoDot:1
+39 ;ACR*2.1*16.01 IM14473
IF $$CKLK^ACRFPAY("ACRZ NO REOPEN/RE-EXPORT","REOPEN/RE-EXPORT a Batch",DUZ)
QUIT
+40 ;ACR*2.1*16.01 IM14473
DO REOPEN^ACRFPAY4
End DoDot:1
KILL ACRQUIT
QUIT
+41 IF +Y=9
SET ACRIV=""
DO REOPEN^ACRFRR
KILL ACRQUIT,ACRIV
QUIT
+42 IF +Y=10
DO REPORTS^ACRFPAY6
KILL ACRQUIT
QUIT
+43 ;ACR*2.1*16.01 IM14473
IF +Y=11
Begin DoDot:1
+44 ;ACR*2.1*16.01 IM14473
IF $$CKLK^ACRFPAY("ACRZ NO DELETE","DELETE a Batch",DUZ)
QUIT
+45 ;ACR*2.1*16.01 IM14473
DO DBATCH^ACRFPAY3
End DoDot:1
KILL ACRQUIT
QUIT
+46 IF +Y=12
DO ^ACRFPR
QUIT
+47 IF +Y=13
DO BSTATUS^ACRFPAY8
KILL ACRQUIT
QUIT
+48 ;ACR*2.1*16.01 IM14473
IF +Y=14
Begin DoDot:1
+49 ;ACR*2.1*16.01 IM14473
IF $$CKLK^ACRFPAY("ACRZ NO TA MGT","TA Management",DUZ)
QUIT
+50 ;ACR*2.1*16.01 IM14473
DO ^ACRFTA
End DoDot:1
KILL ACRQUIT
QUIT
+51 IF +Y=15
DO ^ACRFPAYU
KILL ACRQUIT
QUIT
+52 QUIT
REVIEW FOR
DO R1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+1 KILL ACRQUIT
+2 QUIT
R1 DO BATCHL^ACRFPAY3
+1 DO BATCHS
+2 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+3 FOR
DO BATCHD^ACRFPAY6
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+4 KILL ACRQUIT
+5 QUIT
BATCHS ;EP - SELECT BATCH
+1 IF '$GET(ACRMAX)
Begin DoDot:1
+2 WRITE !!,"There are no batches on file."
+3 DO PAUSE^ACRFWARN
+4 SET ACRQUIT=""
End DoDot:1
QUIT
+5 NEW X
+6 KILL ACRXALL
+7 SET DIR(0)="FO^1:6"
+8 SET DIR("A")="Which BATCH"
+9 SET DIR("?",1)="Enter either the 6 digit batch number or"
+10 SET DIR("?")="the sequence number (NO.) for the batch."
+11 IF $DATA(ACREXP)!$DATA(ACRCERT)
SET DIR("A")=$SELECT($DATA(ACREXP):"EXPORT",$DATA(ACRCERT):"CERTIFY",1:"")_" "_DIR("A")
+12 WRITE !
+13 IF $DATA(ACREXP)
Begin DoDot:1
+14 WRITE !,"Please NOTE: You can export ALL Batches by entering 'ALL' at the"
+15 WRITE !,"prompt. Otherwise, specify the the batch you want to export."
+16 WRITE !
End DoDot:1
+17 DO DIR^ACRFDIC
+18 IF Y=""
SET ACRQUIT=""
QUIT
+19 IF Y="ALL"
SET ACRXALL="ALL"
QUIT
+20 IF $LENGTH(Y)=6
IF $DATA(^TMP("ACRBAT",$JOB,Y))
SET Y=^TMP("ACRBAT",$JOB,Y)
+21 IF '$DATA(^TMP("ACRPAY",$JOB,+Y))
SET ACRQUIT=""
QUIT
+22 SET X=^TMP("ACRPAY",$JOB,+Y)
+23 SET ACRBATDA=$PIECE(X,U)
+24 SET ACRFYDA=$PIECE(X,U,2)
+25 ;ACR*2.1*3.42
IF '$DATA(^AFSLAFP(+ACRFYDA,1,+ACRBATDA))
SET ACRQUIT=""
QUIT
+26 SET ACRFY=$PIECE($GET(^AFSLAFP(+ACRFYDA,0)),U)
+27 SET ACRBSCH=$PIECE($GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,2)),U,6)
+28 KILL ACRBAT
+29 QUIT
ADDPAY ;EP;ADD PAYMENT
+1 IF $$COUNT^ACRFIV12(ACRFYDA,ACRBATDA)>59
Begin DoDot:1
+2 WRITE !!,"You cannot add more than 60 payments to a batch."
+3 WRITE !,"Please add additional payments to another batch"
+4 WRITE !,"or create a new batch if necessary."
+5 DO PAUSE^ACRFWARN
End DoDot:1
QUIT
+6 DO NEWSEQ
+7 IF $DATA(ACRQUIT)!$DATA(ACROUT)
KILL ACRQUIT
QUIT
+8 ;I $D(ACRT),ACRT="" D PAYE ; only 1 payment ;Added in ACR*2.1*16.06 IM15505;Commented out in ACR*2.1*17.01 IM17097
+9 ;Commented out in ACR*2.1*16.06 IM15505;Restored in ACR*2.1*17.01 IM17097
DO PAYE
+10 SET ACRNEXT=""
AP ;EP;TO ADD PAYMENT INFO
+1 SET DIR(0)="YO"
+2 SET DIR("A")="ADD "_$SELECT($DATA(ACRNEXT):"another",1:"a")_" payment"_$SELECT('$DATA(ACRNEXT):" now",1:"")
+3 SET DIR("B")="NO"
+4 KILL ACRNEXT
+5 WRITE !
+6 DO DIR^ACRFDIC
+7 IF +Y'=1
QUIT
+8 IF $GET(ACRREFX)'=326&($GET(ACRREFX)'=371)
DO ADDPAY
+9 QUIT
NEWSEQ ;EP;CREATE NEW SEQUENCE
+1 DO NONARMS^ACRFPAY1
+2 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
NEWSEQ1 SET ACROBJDA=$ORDER(ACRIVPAY(ACRCANDA,0))
+1 IF 'ACROBJDA
QUIT
+2 ;D NEWSEQ^ACRFIV11 ;ACR*2.1*16.06 IM15505
+3 ;K ACRIVDC,ACRP ;ACR*2.1*16.06 IM15505
+4 ;I $D(ACRIVDIS(ACRCANDA,"P"))#2 D ;ACR*2.1*16.06 IM15505
+5 ;.S ACROBJDA=0 ;ACR*2.1*16.06 IM15505
+6 ;.F S ACROBJDA=$O(ACRIVDIS(ACRCANDA,ACROBJDA)) Q:'ACROBJDA D ;ACR*2.1*16.06 IM15505
+7 ;..S ACRIVTF=0 ;ACR*2.1*16.06 IM15505
+8 ;..S ACRTCODE=19917 ;ACR*2.1*16.06 IM15505
+9 ;..S ACRP=ACRIVDIS(ACRCANDA,"P") ;ACR*2.1*16.06 IM15505
+10 ;..Q:'ACRP ;ACR*2.1*16.06 IM15505
+11 ;..D NEWSEQ^ACRFIV11 ;ACR*2.1*16.06 IM15505
+12 ;..K ACRIVDC,ACRP ;ACR*2.1*16.06 IM15505
+13 ;D ^ACRFIV11 ;Added in ACR*2.1*16.06 IM15505;Commented out in ACR*2.1*17.01 IM17097
+14 ;ACR*2.1*17.01 IM17097
DO N1166^ACRFIV11
+15 DO EXIT^ACRFIV11
+16 IF $GET(ACRREFX)=326!($GET(ACRREFX)=371)
DO CONTRACT
+17 KILL ACRDOCX,ACRVDAX,ACRREFX
+18 QUIT
SREV ;EP;REVIEW SELECTED PAYMENTS
+1 NEW X
+2 SET ACRXX=ACRY
+3 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 PAYE
IF $PIECE(ACRXX,",",ACRJ+1)
DO NEXT
+4 KILL ACRQUIT
+5 QUIT
NEXT ;EP
+1 SET DIR(0)="YO"
+2 SET DIR("A")="Continue Payment Review/Edit"
+3 SET DIR("B")="YES"
+4 WRITE !
+5 DO DIR^ACRFDIC
+6 IF +Y'=1
SET ACRQUIT=""
+7 QUIT
PAYE ;EP;EDIT PAYMENT INFO
+1 SET DA(2)=ACRFYDA
+2 SET DA(1)=ACRBATDA
+3 SET DA=ACRSEQDA
+4 SET DIE=9002325
+5 SET DDSFILE(1)=9002325.02
+6 SET DR="[ACR REVIEW PAYMENT"_$SELECT(ACRBTYP="T":"-T",1:"")_"]"
+7 DO DDS^ACRFDIC
+8 ; OPEN DOCUMENT INTERFACE
DO UPODOC(ACRFYDA,ACRBATDA,ACRSEQDA)
+9 IF $GET(ACRACH)'="A"&($GET(ACRACH)'="B")
QUIT
+10 SET X=$GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0))
+11 SET X=$PIECE(X,U,$SELECT(ACRBTYP="V":10,1:24))
+12 IF 'X
QUIT
+13 SET DA=X
BANKINFO ;EP;TO ENTER BANK INFO
+1 IF $SELECT($DATA(^XUSEC("ACRFZ EDIT EFT",DUZ))
QUIT
+2 SET DIE=$SELECT(ACRBTYP'="T":9999999.11,1:9002185.3)
+3 SET DDSFILE=$SELECT(ACRBTYP'="T":9999999.11,1:9002185.3)
+4 SET DR="[ACR BANK INFORMATION]"
+5 DO DDS^ACRFDIC
+6 QUIT
CERTIFY ;EP;TO LIST AND SELECT BATCHES TO BE CERTIFIED
+1 ;I '$D(^ACRAPL("AC",DUZ,38)) D Q ;ACR*2.1*16.01 IM14473
+2 ;ACR*2.1*16.01 IM14473
IF '$DATA(^ACRAPL("AC",DUZ,38))!($DATA(^XUSEC("ACRFZ NO CERTIFY",DUZ)))
Begin DoDot:1
+3 WRITE !!,"You do not have the authority to CERTIFY PAYMENTS."
+4 DO PAUSE^ACRFWARN
End DoDot:1
QUIT
+5 FOR
DO C1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+6 KILL ACRQUIT
+7 QUIT
C1 NEW J,X,Y
+1 KILL ACRMAX,ACR,ACRPAY
+2 SET ACRCERT=""
+3 SET ACRFYDA=0
+4 FOR
SET ACRFYDA=$ORDER(^AFSLAFP("CERT","C",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("CERT","C",ACRFYDA,ACRBATDA))
IF 'ACRBATDA
QUIT
DO PAY^ACRFPAY3
End DoDot:1
+8 DO PAY1^ACRFPAY3
+9 IF '$GET(ACRMAX)
Begin DoDot:1
+10 WRITE !!,"NO Batches pending for CERTIFICATION"
+11 DO PAUSE^ACRFWARN
+12 SET ACRQUIT=""
End DoDot:1
QUIT
+13 DO BATCHS
+14 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+15 FOR
DO BATCHD^ACRFPAY6
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+16 KILL ACRQUIT
+17 QUIT
FMA ;CHECK FILE MAN ACCESS CODES
+1 IF $GET(DUZ(0))'["@"
IF $GET(DUZ(0))'["$"
Begin DoDot:1
+2 WRITE !!,"In order to perfrom functions within Payment Management your"
+3 WRITE !,"FILE MAN ACCESS CODE must include the '$' (dollar sign)."
+4 WRITE !!,"Consult with you ARMS manager to get this character assigned"
+5 WRITE !,"as part of your FILE MAN ACCESS CODE."
+6 DO PAUSE^ACRFWARN
+7 SET ACRQUIT=""
End DoDot:1
+8 IF '$PIECE($GET(^ACRAU(DUZ,1)),U,13)
Begin DoDot:1
+9 WRITE !!,"You are not in the FULL-SCREEN edit mode required in order"
+10 WRITE !,"to use Payment Management."
+11 WRITE !!,"Consult with you ARMS manager to get set up for the"
+12 WRITE !,"FULL-SCREEN edit mode."
+13 DO PAUSE^ACRFWARN
+14 SET ACRQUIT=""
End DoDot:1
+15 QUIT
CONTRACT ;ALLOW ADD OF MULTIPLE NEW CONTRACT PAYMENTS
+1 SET DIR(0)="YO"
+2 SET DIR("A",1)="Add ANOTHER Contract Payment"
+3 SET DIR("A",2)="For DOCUMENT NO. "_ACRDOCX
+4 SET DIR("A")="For CONTRACTOR.. "_$PIECE($GET(^AUTTVNDR(+$GET(ACRVDAX),0)),U)
+5 SET DIR("B")="NO"
+6 WRITE !
+7 DO DIR^ACRFDIC
+8 IF Y'=1
SET ACRQUIT=""
QUIT
+9 WRITE !!,"DOCUMENT NUMBER.....: ",ACRDOCX
+10 WRITE !,"CONTRACTOR..........: ",$PIECE($GET(^AUTTVNDR(+$GET(ACRVDAX),0)),U)
+11 SET X=ACRDOCX
+12 DO DOCX^ACRFPAY1
+13 IF $GET(ACRDOC)=""
SET ACRQUIT=""
QUIT
+14 SET ACRVDA=ACRVDAX
+15 DO 326^ACRFPAY1
+16 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+17 DO NEWSEQ1
+18 QUIT
UPODOC(ACRFYDA,ACRBATDA,ACRSEQDA) ;
+1 ;----- UPDATE OPEN DOCUMENT FILE WHEN BATCH PAYMENT IS EDITED
+2 ;
+3 ; OPEN DOCUMENT INTERFACE
+4 ; SETS UP CALL TO EPMT^ACRFODOC TO UPDATE THE PAYMENT ENTRY
+5 ; IN THE OPEN DOCUMENT DATABASE WHEN A BATCH PAYMENT IS EDITED
+6 ;
+7 NEW ACRAMT,ACRBATCH,ACRDATE,ACRDOC,ACRFY,ACRPDFOR,ACRSEQ,ACRSCHNO,ACRSSN,D0,D1,D2,DATA
+8 SET ACRFY=$PIECE($GET(^AFSLAFP(ACRFYDA,0)),U)
+9 IF 'ACRFY
QUIT
+10 SET DATA=$GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,0))
+11 SET ACRBATCH=$PIECE(DATA,U)
+12 IF ACRBATCH']""
QUIT
+13 SET ACRDATE=$PIECE(DATA,U,2)
+14 SET DATA=$GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0))
+15 SET ACRDOC=$SELECT($PIECE(DATA,U,20)]"":$PIECE(DATA,U,20),1:$PIECE(DATA,U,21))
+16 IF ACRDOC']""
QUIT
+17 SET ACRSEQ=$PIECE(DATA,U)
+18 IF ACRSEQ']""
QUIT
+19 SET ACRAMT=$PIECE(DATA,U,11)
+20 SET ACRAMT=$$DOL^ACRFUTL(ACRAMT)
+21 SET ACRSSN=$SELECT($PIECE(DATA,U,10):$PIECE($GET(^AUTTVNDR($PIECE(DATA,U,10),11)),U),$PIECE(DATA,U,24):$PIECE($GET(^VA(200,$PIECE(DATA,U,24),1)),U,9),1:"")
+22 SET ACRSCHNO=$PIECE($GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,2)),U,6)
+23 SET ACRPDFOR=$PIECE(DATA,U,14)
+24 SET D0=$ORDER(^AFSLODOC("B",ACRFY,0))
+25 IF 'D0
QUIT
+26 SET D1=$ORDER(^AFSLODOC(D0,1,"B",ACRDOC,0))
+27 IF 'D1
QUIT
+28 SET D2=$ORDER(^AFSLODOC(D0,1,D1,1,"C",ACRBATCH,ACRSEQ,0))
+29 IF 'D2
QUIT
+30 SET DATA=ACRDATE_U_ACRAMT_U_ACRBATCH_U_ACRSSN_U_ACRSCHNO_U_ACRPDFOR_U_ACRDATE_U_U_ACRSEQ
+31 DO EPMT^ACRFODOC(D0,D1,D2,DATA)
+32 QUIT
CKLK(X,Y,DUZ) ;EP; EXTRINSIC FUNCTION TO CHECK FOR BLOCKS ; ACR*2.1*16.01 IM14473
+1 ;
+2 ; ENTERS WITH - X= NAME OF KEY
+3 ; Y= NAME OF OPTION
+4 ; DUZ= EIN OF USER
+5 ;
+6 ; RETURNS 1 = TRUE (BLOCK OUT)
+7 ; 0 = FALSE (ALLOW IN)
+8 NEW Z
+9 SET Z=$DATA(^XUSEC(X,DUZ))
+10 IF Z
Begin DoDot:1
+11 WRITE !!,"You do not have the authority to ",Y
+12 DO PAUSE^ACRFWARN
End DoDot:1
+13 QUIT Z
BADRN ;BAD ROUTING NUMBER - MESSAGE USED BY ACR BANK INFORMATION SCREEN
+1 ;ACR*2.1*22.11f IM23639
+2 WRITE *7
+3 DO HLP^DDSUTL("This Routing Number is incorrect.")
+4 DO HLP^DDSUTL("$$EOP")
+5 QUIT
BADSRN ;BAD SUB-ROUTING NUMBER - MESSAGE USED BY ACR BANK INFORMATION SCREEN
+1 ;ACR*2.1*22.11f IM23639
+2 WRITE *7
+3 DO HLP^DDSUTL("This Sub-Routing Number is incorrect.")
+4 DO HLP^DDSUTL("$$EOP")
+5 QUIT
