Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACRFPAY

ACRFPAY.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  D FMA
  1.  I $D(ACRQUIT) D EXIT Q
  1. EN F  D EN1 Q:$D(ACRQUIT)!$D(ACROUT)
  1. 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
  1.  K ACRSNO,ACRBAT,ACRIV,ACRVDAT
  1.  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)
  1.  Q
  1. EN1 D EXIT
  1.  W @IOF
  1.  W !!?10,"Select the Payment Function"
  1.  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"
  1.  S DIR(0)=DIR(0)_";12:Payroll Data;13:Batch STATUS Report;14:Travel Advance Management;15:Payment Management Utilities"
  1.  S DIR(0)=DIR(0)_";16:Process Credit Card Payments"
  1.  S DIR("A")="Which function"
  1.  W !
  1.  D DIR^ACRFDIC
  1.  I '+Y S ACRQUIT="" Q
  1.  ;I +Y=1 D ACRIV^ACRFRR K ACRQUIT Q                     ;ACR*2.1*16.01 IM14473
  1.  ;I +Y=2 D AIRLINE^ACRFIV12 K ACRQUIT Q                 ;ACR*2.1*16.01 IM14473
  1.  ;I +Y=3 D REVIEW K ACRQUIT Q                           ;ACR*2.1*16.01 IM14473   
  1.  ;I +Y=4 D CERTIFY K ACRQUIT Q                          ;ACR*2.1*16.01 IM14473
  1.  ;I +Y=5 D EXPORT^ACRFPAY3 K ACRQUIT Q                  ;ACR*2.1*16.01 IM14473
  1.  ;I +Y=6 D ADD^ACRFPAY4 K ACRQUIT Q                     ;ACR*2.1*16.01 IM14473
  1.  ;I +Y=7 D COMBINE^ACRFPAY1 K ACRQUIT Q                 ;ACR*2.1*16.01 IM14473
  1.  ;I +Y=8 D REOPEN^ACRFPAY4 K ACRQUIT Q                  ;ACR*2.1*16.01 IM14473
  1.  ;I +Y=9 S ACRIV="" D REOPEN^ACRFRR K ACRQUIT,ACRIV Q   ;ACR*2.1*16.01 IM14473
  1.  ;I +Y=10 D REPORTS^ACRFPAY6 K ACRQUIT Q                ;ACR*2.1*16.01 IM14473   
  1.  ;I +Y=11 D DBATCH^ACRFPAY3 K ACRQUIT Q                 ;ACR*2.1*16.01 IM14473
  1.  ;I +Y=12 D ^ACRFPR Q                                   ;ACR*2.1*16.01 IM14473
  1.  ;I +Y=13 D BSTATUS^ACRFPAY8 K ACRQUIT Q                ;ACR*2.1*16.01 IM14473
  1.  ;I +Y=14 D ^ACRFTA K ACRQUIT Q                         ;ACR*2.1*16.01 IM14473
  1.  ;I +Y=15 D ^ACRFPAYU K ACRQUIT Q                       ;ACR*2.1*16.01 IM14473
  1.  I +Y=1 D ACRIV^ACRFRR K ACRQUIT Q
  1.  I +Y=2 D AIRLINE^ACRFIV12 K ACRQUIT Q
  1.  I +Y=3 D REVIEW K ACRQUIT Q
  1.  I +Y=4 D  K ACRQUIT Q                                  ;ACR*2.1*16.01 IM14473
  1.  .Q:$$CKLK^ACRFPAY("ACRZ NO CERTIFY","CERTIFY a Batch",DUZ)  ;ACR*2.1*16.01 IM14473
  1.  .D CERTIFY                                             ;ACR*2.1*16.01 IM14473
  1.  I +Y=5 D  K ACRQUIT Q                                  ;ACR*2.1*16.01 IM14473
  1.  .Q:$$CKLK^ACRFPAY("ACRZ NO EXPORT","EXPORT a Batch",DUZ)  ;ACR*2.1*16.01 IM14473
  1.  .D EXPORT^ACRFPAY3                                     ;ACR*2.1*16.01 IM14473
  1.  I +Y=6 D  K ACRQUIT Q                                  ;ACR*2.1*16.01 IM14473
  1.  .Q:$$CKLK^ACRFPAY("ACRZ NO ADD","ADD a Batch",DUZ)     ;ACR*2.1*16.01 IM14473
  1.  .D ADD^ACRFPAY4                                        ;ACR*2.1*16.01 IM14473
  1.  I +Y=7 D COMBINE^ACRFPAY1 K ACRQUIT Q
  1.  I +Y=8 D  K ACRQUIT Q                                  ;ACR*2.1*16.01 IM14473
  1.  .Q:$$CKLK^ACRFPAY("ACRZ NO REOPEN/RE-EXPORT","REOPEN/RE-EXPORT a Batch",DUZ)  ;ACR*2.1*16.01 IM14473
  1.  .D REOPEN^ACRFPAY4                                     ;ACR*2.1*16.01 IM14473
  1.  I +Y=9 S ACRIV="" D REOPEN^ACRFRR K ACRQUIT,ACRIV Q
  1.  I +Y=10 D REPORTS^ACRFPAY6 K ACRQUIT Q
  1.  I +Y=11 D  K ACRQUIT Q                                 ;ACR*2.1*16.01 IM14473
  1.  .Q:$$CKLK^ACRFPAY("ACRZ NO DELETE","DELETE a Batch",DUZ)  ;ACR*2.1*16.01 IM14473
  1.  .D DBATCH^ACRFPAY3                                     ;ACR*2.1*16.01 IM14473
  1.  I +Y=12 D ^ACRFPR Q
  1.  I +Y=13 D BSTATUS^ACRFPAY8 K ACRQUIT Q
  1.  I +Y=14 D  K ACRQUIT Q                                 ;ACR*2.1*16.01 IM14473
  1.  .Q:$$CKLK^ACRFPAY("ACRZ NO TA MGT","TA Management",DUZ)  ;ACR*2.1*16.01 IM14473
  1.  .D ^ACRFTA                                             ;ACR*2.1*16.01 IM14473
  1.  I +Y=15 D ^ACRFPAYU K ACRQUIT Q
  1.  Q
  1. REVIEW F  D R1 Q:$D(ACRQUIT)!$D(ACROUT)
  1.  K ACRQUIT
  1.  Q
  1. R1 D BATCHL^ACRFPAY3
  1.  D BATCHS
  1.  I $D(ACRQUIT)!$D(ACROUT) Q
  1.  F  D BATCHD^ACRFPAY6 Q:$D(ACRQUIT)!$D(ACROUT)
  1.  K ACRQUIT
  1.  Q
  1. BATCHS ;EP - SELECT BATCH
  1.  I '$G(ACRMAX) D  Q
  1.  .W !!,"There are no batches on file."
  1.  .D PAUSE^ACRFWARN
  1.  .S ACRQUIT=""
  1.  N X
  1.  K ACRXALL
  1.  S DIR(0)="FO^1:6"
  1.  S DIR("A")="Which BATCH"
  1.  S DIR("?",1)="Enter either the 6 digit batch number or"
  1.  S DIR("?")="the sequence number (NO.) for the batch."
  1.  S:$D(ACREXP)!$D(ACRCERT) DIR("A")=$S($D(ACREXP):"EXPORT",$D(ACRCERT):"CERTIFY",1:"")_" "_DIR("A")
  1.  W !
  1.  I $D(ACREXP) D
  1.  .W !,"Please NOTE:  You can export ALL Batches by entering 'ALL' at the"
  1.  .W !,"prompt.  Otherwise, specify the the batch you want to export."
  1.  .W !
  1.  D DIR^ACRFDIC
  1.  I Y="" S ACRQUIT="" Q
  1.  I Y="ALL" S ACRXALL="ALL" Q
  1.  I $L(Y)=6,$D(^TMP("ACRBAT",$J,Y)) S Y=^TMP("ACRBAT",$J,Y)
  1.  I '$D(^TMP("ACRPAY",$J,+Y)) S ACRQUIT="" Q
  1.  S X=^TMP("ACRPAY",$J,+Y)
  1.  S ACRBATDA=$P(X,U)
  1.  S ACRFYDA=$P(X,U,2)
  1.  I '$D(^AFSLAFP(+ACRFYDA,1,+ACRBATDA)) S ACRQUIT="" Q   ;ACR*2.1*3.42
  1.  S ACRFY=$P($G(^AFSLAFP(+ACRFYDA,0)),U)
  1.  S ACRBSCH=$P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,2)),U,6)
  1.  K ACRBAT
  1.  Q
  1. ADDPAY ;EP;ADD PAYMENT
  1.  I $$COUNT^ACRFIV12(ACRFYDA,ACRBATDA)>59 D  Q
  1.  .W !!,"You cannot add more than 60 payments to a batch."
  1.  .W !,"Please add additional payments to another batch"
  1.  .W !,"or create a new batch if necessary."
  1.  .D PAUSE^ACRFWARN
  1.  D NEWSEQ
  1.  I $D(ACRQUIT)!$D(ACROUT) K ACRQUIT Q
  1.  ;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
  1.  D PAYE                      ;Commented out in ACR*2.1*16.06 IM15505;Restored in ACR*2.1*17.01 IM17097
  1.  S ACRNEXT=""
  1. AP ;EP;TO ADD PAYMENT INFO
  1.  S DIR(0)="YO"
  1.  S DIR("A")="ADD "_$S($D(ACRNEXT):"another",1:"a")_" payment"_$S('$D(ACRNEXT):" now",1:"")
  1.  S DIR("B")="NO"
  1.  K ACRNEXT
  1.  W !
  1.  D DIR^ACRFDIC
  1.  I +Y'=1 Q
  1.  D ADDPAY:$G(ACRREFX)'=326&($G(ACRREFX)'=371)
  1.  Q
  1. NEWSEQ ;EP;CREATE NEW SEQUENCE
  1.  D NONARMS^ACRFPAY1
  1.  Q:$D(ACRQUIT)!$D(ACROUT)
  1. NEWSEQ1 S ACROBJDA=$O(ACRIVPAY(ACRCANDA,0))
  1.  Q:'ACROBJDA
  1.  ;D NEWSEQ^ACRFIV11                       ;ACR*2.1*16.06 IM15505
  1.  ;K ACRIVDC,ACRP                          ;ACR*2.1*16.06 IM15505
  1.  ;I $D(ACRIVDIS(ACRCANDA,"P"))#2 D        ;ACR*2.1*16.06 IM15505
  1.  ;.S ACROBJDA=0                           ;ACR*2.1*16.06 IM15505
  1.  ;.F  S ACROBJDA=$O(ACRIVDIS(ACRCANDA,ACROBJDA)) Q:'ACROBJDA  D  ;ACR*2.1*16.06 IM15505
  1.  ;..S ACRIVTF=0                           ;ACR*2.1*16.06 IM15505
  1.  ;..S ACRTCODE=19917                      ;ACR*2.1*16.06 IM15505
  1.  ;..S ACRP=ACRIVDIS(ACRCANDA,"P")         ;ACR*2.1*16.06 IM15505
  1.  ;..Q:'ACRP                               ;ACR*2.1*16.06 IM15505
  1.  ;..D NEWSEQ^ACRFIV11                     ;ACR*2.1*16.06 IM15505
  1.  ;..K ACRIVDC,ACRP                        ;ACR*2.1*16.06 IM15505
  1.  ;D ^ACRFIV11                             ;Added in ACR*2.1*16.06 IM15505;Commented out in ACR*2.1*17.01 IM17097
  1.  D N1166^ACRFIV11                         ;ACR*2.1*17.01 IM17097
  1.  D EXIT^ACRFIV11
  1.  I $G(ACRREFX)=326!($G(ACRREFX)=371) D CONTRACT
  1.  K ACRDOCX,ACRVDAX,ACRREFX
  1.  Q
  1. SREV ;EP;REVIEW SELECTED PAYMENTS
  1.  N X
  1.  S ACRXX=ACRY
  1.  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
  1.  K ACRQUIT
  1.  Q
  1. NEXT ;EP
  1.  S DIR(0)="YO"
  1.  S DIR("A")="Continue Payment Review/Edit"
  1.  S DIR("B")="YES"
  1.  W !
  1.  D DIR^ACRFDIC
  1.  S:+Y'=1 ACRQUIT=""
  1.  Q
  1. PAYE ;EP;EDIT PAYMENT INFO
  1.  S DA(2)=ACRFYDA
  1.  S DA(1)=ACRBATDA
  1.  S DA=ACRSEQDA
  1.  S DIE=9002325
  1.  S DDSFILE(1)=9002325.02
  1.  S DR="[ACR REVIEW PAYMENT"_$S(ACRBTYP="T":"-T",1:"")_"]"
  1.  D DDS^ACRFDIC
  1.  D UPODOC(ACRFYDA,ACRBATDA,ACRSEQDA) ; OPEN DOCUMENT INTERFACE
  1.  Q:$G(ACRACH)'="A"&($G(ACRACH)'="B")
  1.  S X=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0))
  1.  S X=$P(X,U,$S(ACRBTYP="V":10,1:24))
  1.  Q:'X
  1.  S DA=X
  1. BANKINFO ;EP;TO ENTER BANK INFO
  1.  Q:$S($D(^XUSEC("ACRFZ EDIT EFT",DUZ)):0,$D(^XUSEC("ACRFZ VIEW EFT",DUZ)):0,1:1)
  1.  S DIE=$S(ACRBTYP'="T":9999999.11,1:9002185.3)
  1.  S DDSFILE=$S(ACRBTYP'="T":9999999.11,1:9002185.3)
  1.  S DR="[ACR BANK INFORMATION]"
  1.  D DDS^ACRFDIC
  1.  Q
  1. 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
  1.  I '$D(^ACRAPL("AC",DUZ,38))!($D(^XUSEC("ACRFZ NO CERTIFY",DUZ))) D  Q  ;ACR*2.1*16.01 IM14473
  1.  .W !!,"You do not have the authority to CERTIFY PAYMENTS."
  1.  .D PAUSE^ACRFWARN
  1.  F  D C1 Q:$D(ACRQUIT)!$D(ACROUT)
  1.  K ACRQUIT
  1.  Q
  1. C1 N J,X,Y
  1.  K ACRMAX,ACR,ACRPAY
  1.  S ACRCERT=""
  1.  S ACRFYDA=0
  1.  F  S ACRFYDA=$O(^AFSLAFP("CERT","C",ACRFYDA)) Q:'ACRFYDA  D
  1.  .S ACRFY=$P(^AFSLAFP(ACRFYDA,0),U)
  1.  .S ACRBATDA=0
  1.  .F  S ACRBATDA=$O(^AFSLAFP("CERT","C",ACRFYDA,ACRBATDA)) Q:'ACRBATDA  D PAY^ACRFPAY3
  1.  D PAY1^ACRFPAY3
  1.  I '$G(ACRMAX) D  Q
  1.  .W !!,"NO Batches pending for CERTIFICATION"
  1.  .D PAUSE^ACRFWARN
  1.  .S ACRQUIT=""
  1.  D BATCHS
  1.  I $D(ACRQUIT)!$D(ACROUT) Q
  1.  F  D BATCHD^ACRFPAY6 Q:$D(ACRQUIT)!$D(ACROUT)
  1.  K ACRQUIT
  1.  Q
  1. FMA ;CHECK FILE MAN ACCESS CODES
  1.  I $G(DUZ(0))'["@",$G(DUZ(0))'["$" D
  1.  .W !!,"In order to perfrom functions within Payment Management your"
  1.  .W !,"FILE MAN ACCESS CODE must include the '$' (dollar sign)."
  1.  .W !!,"Consult with you ARMS manager to get this character assigned"
  1.  .W !,"as part of your FILE MAN ACCESS CODE."
  1.  .D PAUSE^ACRFWARN
  1.  .S ACRQUIT=""
  1.  I '$P($G(^ACRAU(DUZ,1)),U,13) D
  1.  .W !!,"You are not in the FULL-SCREEN edit mode required in order"
  1.  .W !,"to use Payment Management."
  1.  .W !!,"Consult with you ARMS manager to get set up for the"
  1.  .W !,"FULL-SCREEN edit mode."
  1.  .D PAUSE^ACRFWARN
  1.  .S ACRQUIT=""
  1.  Q
  1. CONTRACT ;ALLOW ADD OF MULTIPLE NEW CONTRACT PAYMENTS
  1.  S DIR(0)="YO"
  1.  S DIR("A",1)="Add ANOTHER Contract Payment"
  1.  S DIR("A",2)="For DOCUMENT NO. "_ACRDOCX
  1.  S DIR("A")="For CONTRACTOR.. "_$P($G(^AUTTVNDR(+$G(ACRVDAX),0)),U)
  1.  S DIR("B")="NO"
  1.  W !
  1.  D DIR^ACRFDIC
  1.  I Y'=1 S ACRQUIT="" Q
  1.  W !!,"DOCUMENT NUMBER.....: ",ACRDOCX
  1.  W !,"CONTRACTOR..........: ",$P($G(^AUTTVNDR(+$G(ACRVDAX),0)),U)
  1.  S X=ACRDOCX
  1.  D DOCX^ACRFPAY1
  1.  I $G(ACRDOC)="" S ACRQUIT="" Q
  1.  S ACRVDA=ACRVDAX
  1.  D 326^ACRFPAY1
  1.  Q:$D(ACRQUIT)!$D(ACROUT)
  1.  D NEWSEQ1
  1.  Q
  1. UPODOC(ACRFYDA,ACRBATDA,ACRSEQDA)      ;
  1.  ;----- UPDATE OPEN DOCUMENT FILE WHEN BATCH PAYMENT IS EDITED
  1.  ; 
  1.  ;      OPEN DOCUMENT INTERFACE
  1.  ;      SETS UP CALL TO EPMT^ACRFODOC TO UPDATE THE PAYMENT ENTRY
  1.  ;      IN THE OPEN DOCUMENT DATABASE WHEN A BATCH PAYMENT IS EDITED
  1.  ;
  1.  N ACRAMT,ACRBATCH,ACRDATE,ACRDOC,ACRFY,ACRPDFOR,ACRSEQ,ACRSCHNO,ACRSSN,D0,D1,D2,DATA
  1.  S ACRFY=$P($G(^AFSLAFP(ACRFYDA,0)),U)
  1.  Q:'ACRFY
  1.  S DATA=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,0))
  1.  S ACRBATCH=$P(DATA,U)
  1.  Q:ACRBATCH']""
  1.  S ACRDATE=$P(DATA,U,2)
  1.  S DATA=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0))
  1.  S ACRDOC=$S($P(DATA,U,20)]"":$P(DATA,U,20),1:$P(DATA,U,21))
  1.  Q:ACRDOC']""
  1.  S ACRSEQ=$P(DATA,U)
  1.  Q:ACRSEQ']""
  1.  S ACRAMT=$P(DATA,U,11)
  1.  S ACRAMT=$$DOL^ACRFUTL(ACRAMT)
  1.  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:"")
  1.  S ACRSCHNO=$P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,2)),U,6)
  1.  S ACRPDFOR=$P(DATA,U,14)
  1.  S D0=$O(^AFSLODOC("B",ACRFY,0))
  1.  Q:'D0
  1.  S D1=$O(^AFSLODOC(D0,1,"B",ACRDOC,0))
  1.  Q:'D1
  1.  S D2=$O(^AFSLODOC(D0,1,D1,1,"C",ACRBATCH,ACRSEQ,0))
  1.  Q:'D2
  1.  S DATA=ACRDATE_U_ACRAMT_U_ACRBATCH_U_ACRSSN_U_ACRSCHNO_U_ACRPDFOR_U_ACRDATE_U_U_ACRSEQ
  1.  D EPMT^ACRFODOC(D0,D1,D2,DATA)
  1.  Q
  1. CKLK(X,Y,DUZ) ;EP; EXTRINSIC FUNCTION TO CHECK FOR BLOCKS ; ACR*2.1*16.01 IM14473
  1.  ;
  1.  ; ENTERS WITH  - X= NAME OF KEY
  1.  ;                Y= NAME OF OPTION
  1.  ;              DUZ= EIN OF USER
  1.  ;
  1.  ; RETURNS  1 = TRUE  (BLOCK OUT)
  1.  ;          0 = FALSE (ALLOW IN)
  1.  N Z
  1.  S Z=$D(^XUSEC(X,DUZ))
  1.  I Z D
  1.  .W !!,"You do not have the authority to ",Y
  1.  .D PAUSE^ACRFWARN
  1.  Q Z
  1. BADRN ;BAD ROUTING NUMBER - MESSAGE USED BY ACR BANK INFORMATION SCREEN
  1.  ;ACR*2.1*22.11f IM23639
  1.  W *7
  1.  D HLP^DDSUTL("This Routing Number is incorrect.")
  1.  D HLP^DDSUTL("$$EOP")
  1.  Q
  1. BADSRN ;BAD SUB-ROUTING NUMBER - MESSAGE USED BY ACR BANK INFORMATION SCREEN
  1.  ;ACR*2.1*22.11f IM23639
  1.  W *7
  1.  D HLP^DDSUTL("This Sub-Routing Number is incorrect.")
  1.  D HLP^DDSUTL("$$EOP")
  1.  Q