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

ACRFPAY6.m

Go to the documentation of this file. 
  1. ACRFPAY6 ;IHS/OIRM/DSD/THL,AEF - CERTIFY AND EXPORT PAYMENT BATCH;  [ 07/20/2006  12:17 PM ]
  1.  ;;2.1;ADMIN RESOURCE MGT SYSTEM;**5,16,19,20**;NOV 05, 2001
  1.  ;;
  1. BATCHD ;EP - DISPLAY BATCH SUMMARY
  1.  K ^TMP("ACRPAY",$J)
  1.  K ^TMP("ACRBAT",$J)
  1.  K ^TMP("ACR",$J)
  1.  K ^TMP("ACRACR",$J)
  1.  S ACRBATNO=$P(^AFSLAFP(ACRFYDA,1,ACRBATDA,0),U)
  1.  S ACRBTYP=$P(^AFSLAFP(ACRFYDA,1,ACRBATDA,0),U,4)
  1.  S ACRACH=$P(^AFSLAFP(ACRFYDA,1,ACRBATDA,2),U,8)
  1.  S X=$O(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,0))
  1.  S ACRREF=$P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,+X,0)),U,5)
  1.  I ACRREF="" S ACRREF=$P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,+X,0)),U,6)
  1.  S ACRBTYP=$S(ACRBTYP]"":ACRBTYP,ACRREF=""&("ABC"[$E(ACRBATNO)):"V",ACRREF=""&("DEF"[$E(ACRBATNO)):"T","^130^600^602^   ^"[(U_ACRREF_U):"T",1:"V")
  1.  D BATHEAD
  1.  K ACR,ACRBAT,ACRPAY,ACRTOT
  1.  S (ACR,ACRJ)=0
  1.  F  S ACR=$O(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACR)) Q:'ACR!$D(ACRQUIT)  D
  1.  .Q:'$D(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACR,0))  S ACR0=$G(^(0)),ACR1=$G(^(1)),ACR2=$G(^(2))
  1.  .S ACRJ=ACRJ+1
  1.  .S X=$P(ACR0,U,$S(ACRBTYP="V":10,1:24))
  1.  .;S X=$E($S(ACRBTYP="V":$P($G(^AUTTVNDR(+X,0)),U),1:$P($G(^VA(200,+X,0)),U)),1,12)  ;ACR*2.1*19.02 IM16848
  1.  .S X=$E($S(ACRBTYP="V":$P($G(^AUTTVNDR(+X,0)),U),1:$$NAME2^ACRFUTL1(+X)),1,12)  ;ACR*2.1*19.02 IM16848
  1.  .S:X="" X="NOT STATED"
  1.  .S ^TMP("ACR",$J,X,ACRJ)=ACR_U_ACRFYDA_U_ACRBATDA
  1.  S ACRK=0
  1.  S ACR=""
  1.  F  S ACR=$O(^TMP("ACR",$J,ACR)) Q:ACR=""  S ACRJ=0 F  S ACRJ=$O(^TMP("ACR",$J,ACR,ACRJ)) Q:'ACRJ  S ACRK=ACRK+1,^TMP("ACRACR",$J,ACRK)=^TMP("ACR",$J,ACR,ACRJ)
  1.  S (ACRJ,ACRMAX)=0
  1.  F  S ACRJ=$O(^TMP("ACRACR",$J,ACRJ)) Q:'ACRJ  D
  1.  .S ACRMAX=ACRJ
  1.  .S X=^TMP("ACRACR",$J,ACRJ)
  1.  .S ACRFYDA=$P(X,U,2)
  1.  .S ACRBATDA=$P(X,U,3)
  1.  .S ACR=+X
  1.  .Q:'ACRFYDA!'ACRBATDA!'ACR
  1.  .Q:'$D(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACR,0))
  1.  .S ACR0=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACR,0))
  1.  .S ACR1=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACR,1))
  1.  .S ACR2=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACR,2))
  1.  .S ACR2=$P(ACR2,U,2)
  1.  .I $E(ACR2,$L(ACR2))'="\" D
  1.  ..S DA(2)=ACRFYDA
  1.  ..S DA(1)=ACRBATDA
  1.  ..S DIE="^AFSLAFP("_ACRFYDA_",1,"_ACRBATDA_",1,"
  1.  ..S DA=ACR
  1.  ..S DR="63////"_(ACR2)_"\"
  1.  ..S:DR[";" DR=$TR(DR,";",",")
  1.  ..D DIE^ACRFDIC
  1.  .S ACRDOC=$E($P(ACR0,U,20),1,10)
  1.  .S:ACRDOC=""!(ACRDOC="          ") ACRDOC=$E($P(ACR0,U,21),1,10)
  1.  .D ODOC:ACRDOC]""
  1.  .;S ^TMP("ACRPAY",$J,ACRJ)=ACR_U_$P(ACR0,U,$S(ACRBTYP="V":10,1:24))_U_ACRDOC_U_$S(ACRBTYP="V":+$P(ACR0,U,11)-$P(ACR0,U,12),ACRBTYP="T":$$NET^ACRFSSU(ACRFYDA,ACRBATDA,ACR),1:0) ;ACR*2.1*16.06 IM15505
  1.  .N ACRTMP                                       ;ACR*2.1*16.06 IM15505
  1.  .S ACRTMP=ACR_U_$P(ACR0,U,$S(ACRBTYP="V":10,1:24))_U_ACRDOC_U  ;ACR*2.1*16.06 IM15505
  1.  .S ACRTMP=ACRTMP_$S(ACRBTYP="V":+$P(ACR0,U,11),ACRBTYP="T":$$NET^ACRFSSU(ACRFYDA,ACRBATDA,ACR),1:0)  ;ACR*2.1*16.06 IM15505
  1.  .S ^TMP("ACRPAY",$J,ACRJ)=ACRTMP        ;ACR*2.1*16.06 IM15505
  1.  .S ^TMP("ACRBAT",$J,$S($P(ACR0,U)]"":$P(ACR0,U),1:"NOTSTATED"))=ACRJ
  1.  .S ACRTOT=$G(ACRTOT)+$P(^TMP("ACRPAY",$J,ACRJ),U,4)
  1.  K ACRACR,ACRK,ACR
  1.  K ^TMP("ACR",$J)
  1.  K ^TMP("ACRACR",$J)
  1.  S ACRJJ=0
  1.  F  S ACRJJ=$O(^TMP("ACRPAY",$J,ACRJJ)) Q:'ACRJJ!$D(ACRQUIT)  D
  1.  .S X=^TMP("ACRPAY",$J,ACRJJ)
  1.  .;S ACRPAYEE=$E($S(ACRBTYP="V":$P($G(^AUTTVNDR(+$P(X,U,2),0)),U),1:$P($G(^VA(200,+$P(X,U,2),0)),U)),1,12)  ;ACR*2.1*19.02 IM16848
  1.  .S ACRPAYEE=$E($S(ACRBTYP="V":$P($G(^AUTTVNDR(+$P(X,U,2),0)),U),1:$$NAME2^ACRFUTL1(+$P(X,U,2))),1,12)  ;ACR*2.1*19.02 IM16848
  1.  .W !,ACRJJ,?4,ACRPAYEE,?17,$P(X,U,3),?28,$J($FN($P(X,U,4),"P",2),11)
  1.  .I '$D(^TMP("ACRPAY",$J,ACRJJ+10)) D  Q
  1.  ..I ACRJJ#10=0 D PAUSE^ACRFWARN S ACRJJ=ACRJJ+10
  1.  .S X=^TMP("ACRPAY",$J,ACRJJ+10)
  1.  .;S ACRPAYEE=$E($S(ACRBTYP="V":$P($G(^AUTTVNDR(+$P(X,U,2),0)),U),1:$P($G(^VA(200,+$P(X,U,2),0)),U)),1,12)  ;ACR*2.1*19.02 IM16848
  1.  .;S ACRPAYEE=$E($S(ACRBTYP="V":$P($G(^AUTTVNDR(+$P(X,U,2),0)),U),1:$$NAME2^ACRFUTL1($P(+X,U,2))),1,12)  ;ACR*2.1*19.02 IM16848   ; ACR*2.1*20.04  IM16848
  1.  .S ACRPAYEE=$E($S(ACRBTYP="V":$P($G(^AUTTVNDR(+$P(X,U,2),0)),U),1:$$NAME2^ACRFUTL1(+$P(X,U,2))),1,12)  ;ACR*2.1*19.02 IM16848    ; ACR*2.1*20.04  IM16848
  1.  .W ?39,"|",ACRJJ+10,?44,ACRPAYEE,?57,$P(X,U,3),?68,$J($FN($P(X,U,4),"P",2),11)
  1.  .I ACRJJ#10=0 D PAUSE^ACRFWARN Q:$D(ACRQUIT)  S:ACRJJ#10=0 ACRJJ=ACRJJ+10
  1.  W !?16,"----------- -----------"
  1.  W !?15,"BATCH TOTAL: ",$J($FN($G(ACRTOT),"P",2),11)
  1.  K ACRQUIT,ACROUT
  1.  S DIR(0)="SO^1:Review ALL Payments;2:Review SELECTED Payments;3:ADD a Payment;4:"_$S('$D(ACRCERT)#2:"CLOSE",1:"CERTIFY")_" the Batch;5:DELETE a Payment;6:TRANSFER a Payment;7:CHANGE Payee Info;8:PRINT Related Document;N:EXIT Payment Review"
  1.  S DIR("A")="Which one"
  1.  S DIR("B")="EXIT Payment Review"
  1.  D DIR^ACRFDIC
  1.  I '+Y S ACRQUIT="" Q
  1.  I +Y=1 D ALL Q
  1.  I +Y=7 S ACRVSYNC=""
  1.  I +Y=2!(+Y=7) D  Q
  1.  .D WHICHP
  1.  .I $D(ACRQUIT) K ACRQUIT Q
  1.  .D SREV^ACRFPAY:'$D(ACRVSYNC)
  1.  .D VSYNC^ACRFPAY4:$D(ACRVSYNC)
  1.  .K ACRVSYNC
  1.  I +Y=3 D ADDPAY^ACRFPAY Q
  1.  I +Y=4 D CLOSEB^ACRFPAY4 Q
  1.  I +Y=5 D DELETE^ACRFPAY4 K ACRQUIT Q
  1.  I +Y=6 D TRANS^ACRFPAY2 K ACRQUIT Q
  1.  I +Y=8 D PORR^ACRFPAYR K ACRQUIT Q
  1.  Q
  1. ODOC ;UPDATE OPEN DOCUMENT FILE POINTERS
  1.  Q:'$D(^AFSLODOC("DOCNO",ACRDOC))
  1.  S ACRDFYDA=$O(^AFSLODOC("DOCNO",ACRDOC,0))
  1.  Q:'ACRDFYDA
  1.  N ACRDDCDA
  1.  S ACRDDCDA=$O(^AFSLODOC("DOCNO",ACRDOC,ACRDFYDA,0))
  1.  Q:$P(ACR1,U,15)=ACRDFYDA&($P(ACR1,U,16)=ACRDDCDA)
  1.  S DA(2)=ACRFYDA
  1.  S DA(1)=ACRBATDA
  1.  S DA=ACR
  1.  S DIE="^AFSLAFP("_DA(2)_",1,"_DA(1)_",1,"
  1.  S DR="43////"_ACRDFYDA_";44////"_ACRDDCDA
  1.  D DIE^ACRFDIC
  1.  Q
  1. REPORTS ;EP;SELECT PAYMENT MANAGEMENT REPORTS
  1.  F  D R1 Q:$D(ACRQUIT)!$D(ACROUT)
  1.  K ACRQUIT,ACROUT
  1.  Q
  1. R1 W @IOF
  1.  W !?10,"Select PAYMENT MANAGEMENT Report"
  1.  S DIR(0)="SO^1:Document Payment History;2:Print Payment DHR's;3:Invoices without Receiving Reports;4:Interest Penalty Report;5:Prompt Payment Report;6:List Batches exported on specified date;7:Invoice Workload Report"
  1.  S DIR(0)=DIR(0)_";8:Electronic funds Transfer Profile;9:Vendor Payment Notification Letters;10:Treasury Schedule Comparison;11:Appropriation List;12:Batch Payment Listing;13:Review Payments for One Tech only"
  1.  S DIR(0)=DIR(0)_";14:Create ECS Schedule Flat File"
  1.  S DIR("A")="Which report"
  1.  W !
  1.  D DIR^ACRFDIC
  1.  I 'Y S ACRQUIT="" Q
  1.  I Y=1 D LOCATOR^ACRFPAY2 K ACRQUIT Q
  1.  I Y=2 D DHRPRINT^ACRFPAY2 K ACRQUIT Q
  1.  I Y=3 D NORR K ACRQUIT Q
  1.  I Y=4 D IPPR^ACRFPAYR Q
  1.  I Y=5 D PPR^ACRFPPR Q
  1.  I Y=6 D EXPLIST^ACRFPAY8 Q
  1.  I Y=7 D INVRPT^ACRFPAY5 Q
  1.  I Y=8 D EFTRPT^ACRFPAYE Q                  ;ACR*2.1*5.05
  1.  I Y=9 D ZIS^ACRFPAYL Q
  1.  I Y=10 D CASHREC^ACRFPAY7 Q
  1.  I Y=11 D APPROP^ACRFPAY7 Q
  1.  I Y=12 D PBAT^ACRFPAY7 Q
  1.  I Y=13 D TECHPAY^ACRFPAY9 Q
  1.  I Y=14 D EN^ACRFFF1 Q
  1.  Q
  1. SCHCHK ;EP;CHECK FOR CURRENT SCHEDULE NUMBER
  1.  Q:$P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,2)),U,6)=""  S (ACRBSCH,ACRSNO(1))=$P(^(2),U,6)
  1.  S DIR(0)="YO"
  1.  S DIR("A",1)="Treasury Schedule Number: "_ACRSNO(1)
  1.  S DIR("A",2)="has been assigned to this batch."
  1.  S DIR("A",3)="  "
  1.  S DIR("A")="Retain SCHEDULE NO. "_ACRSNO(1)
  1.  S DIR("B")="YES"
  1.  D DIR^ACRFDIC
  1.  I Y'=1 K ACRSNO
  1.  Q
  1. NORR ;EP;PRINT INVOICES WITHOUT RECEIVING REPORTS
  1.  S ZTDESC="INVOICE'S WITHOUT RECEIVING  RECEIVING REPORTS"
  1.  S (ZTRTN,ACRRTN)="NO1^ACRFPAY6"
  1. ZIS D ^ACRFZIS
  1.  K ACRQUIT,ACROUT
  1.  Q
  1. NO1 ;EP;
  1.  N ACRRO,ACRX,ACRDOCDA,ACRIVNO,ACRIVD
  1.  D NOHEAD
  1.  K ^TMP("ACRNORR",$J)
  1.  S ACRX=""
  1.  F  S ACRX=$O(^ACRDOC("L",ACRX)) Q:ACRX=""  D
  1.  .S ACRDOCDA=0
  1.  .F  S ACRDOCDA=$O(^ACRDOC("L",ACRX,ACRDOCDA)) Q:'ACRDOCDA  D
  1.  ..I $P($G(^ACROBL(ACRDOCDA,"APV")),U,8)="A",$P($G(^ACRDOC(ACRDOCDA,5)),U,5),'$D(^ACRRR("AC",ACRDOCDA)) S ^TMP("ACRNORR",$J,$S($P(^ACRDOC(ACRDOCDA,0),U,2)]"":$P(^(0),U,2),1:$P(^(0),U)),ACRDOCDA)=""
  1.  S ACRX=""
  1.  F  S ACRX=$O(^TMP("ACRNORR",$J,ACRX)) Q:ACRX=""!$D(ACRQUIT)  D
  1.  .S ACRDOCDA=$O(^TMP("ACRNORR",$J,ACRX,0))
  1.  .S ACRRO=$P($G(^ACRDOC(ACRDOCDA,"REQ1")),U,6)
  1.  .S ACRIVNO=$P($G(^ACRDOC(ACRDOCDA,"PO")),U,16)
  1.  .S ACRIVD=$P($G(^ACRDOC(ACRDOCDA,"PO")),U,21)
  1.  .S ACRLBDA=$P($G(^ACRDOC(ACRDOCDA,0)),U,6)
  1.  .S ACRDEPT=$P($G(^ACRLOCB(+ACRLBDA,0)),U,5)
  1.  .S ACRPHONE=$P($G(^AUTTPRG(+ACRDEPT,"DT")),U,6)
  1.  .;S ACRRO=$P($G(^VA(200,+ACRRO,0)),U)  ;ACR*2.1*19.02 IM16848
  1.  .S ACRRO=$$NAME2^ACRFUTL1(+ACRRO)  ;ACR*2.1*19.02 IM16848
  1.  .W !,ACRX,?14,ACRIVNO,?30
  1.  .S Y=ACRIVD
  1.  .I Y X ^DD("DD") W Y
  1.  .W ?45,$E(ACRRO,1,20),?66,$E(ACRPHONE,1,14)
  1.  .I IOSL-4<$Y D PAUSE^ACRFWARN Q:$D(ACRQUIT)  D NOHEAD
  1.  K ^TMP("ACRNORR",$J)
  1.  D PAUSE^ACRFWARN
  1.  Q
  1. NOHEAD ;
  1.  W @IOF
  1.  W !?10,"Documents with Invoice recorded"
  1.  W !?10,"but no Receiving Report on file."
  1.  S Y=DT
  1.  X ^DD("DD")
  1.  W !!,"REPORT DATE: ",Y
  1.  W !!,"DOCUMENT NO.",?14,"INVOICE NO.",?30,"RECEIVED",?45,"RECEIVING AGENT"
  1.  W !,"------------",?14,"--------------",?30,"-------------",?45,"------------------------------"
  1.  Q
  1. BATHEAD ;EP;
  1.  W @IOF
  1.  W !!,"BATCH NO.: ",ACRBATNO,?20,"TREASURY SCHEDULE NO.: ",ACRBSCH
  1.  W !!,"NO.",?4,"PAYEE",?17,"DOCUMENT",?28,"AMOUNT",?39,"|","NO.",?44,"PAYEE",?57,"DOCUMENT",?68,"AMOUNT"
  1.  W !,"---",?4,"------------",?17,"----------",?28,"-----------",?39,"|","---",?44,"------------",?57,"----------",?68,"-----------"
  1.  Q
  1. WHICHP ;EP - SPECIFY PAYMENT(S) TO SELECT
  1.  S DIR(0)="LO^1:"_ACRMAX
  1.  S DIR("A")="Which PAYMENT(s)"
  1.  W !
  1.  D DIR^ACRFDIC
  1.  I '+Y S ACRQUIT="" Q
  1.  Q
  1. ALL ;REVIEW ALL PAYMENTS
  1.  K ACRSEQDA,ACRBAT,ACRQUIT
  1.  S ACRSEQ=0
  1.  F  S ACRSEQ=$O(^TMP("ACRPAY",$J,ACRSEQ)) Q:'ACRSEQ!$D(ACRQUIT)  S ACRSEQDA=+$G(^TMP("ACRPAY",$J,ACRSEQ)) I ACRSEQDA D PAYE^ACRFPAY I $O(^TMP("ACRPAY",$J,ACRSEQ)) D NEXT
  1.  K ACRQUIT,ACRSEQDA,ACRBAT,ACRPAY,ACRQUIT
  1.  Q
  1. NEXT ;
  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