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

ACRFPAY3.m

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