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

ACRFPAYL.m

Go to the documentation of this file. 
  1. ACRFPAYL ;IHS/DSD/THL,AEF - PAY LETTER [ 10/27/2004   4:15 PM ]
  1.  ;;2.1;ADMIN RESOURCE MGT SYSTEM;**14**;NOV 05, 2001
  1. EN ;EP;TO PRINT VENDOR PAYMENT LETTERS
  1.  K ^TMP("ACRPAYL",$J)
  1.  D EN1
  1. EXIT K ACR,ACRTOT,ACRDUE,ACRDC,ACRACT,ACRJ,ACRY,ACRQUIT,ACROUT,ACRVDAX,ACRFYDA,ACRBATDA
  1.  K ^TMP("ACRPAYL",$J)
  1.  Q
  1. EN1 ;
  1.  Q:'$G(ACRFYDA)!'$G(ACRBATDA)
  1.  N ACRPTYPE
  1.  S ACRPTYPE=$P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,2)),U,8)
  1.  S ACRDUE=$P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,2)),U,2)
  1.  D GATHER
  1.  Q:'$D(^TMP("ACRPAYL",$J))
  1.  N ACRVDA
  1.  S ACRVDA=0
  1.  F  S ACRVDA=$O(^TMP("ACRPAYL",$J,ACRVDA)) Q:'ACRVDA!$D(ACRQUIT)  D PRINT
  1.  Q
  1. GATHER ;CREATE TEMP ARRAY OF VENDORS TO BE PAID FROM PAYMENT BATCH/SCHEDULE
  1.  N ACRSEQDA
  1.  S ACRSEQDA=0
  1.  F  S ACRSEQDA=$O(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA)) Q:'ACRSEQDA  D
  1.  .S X=$P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0)),U,10)
  1.  .Q:'X
  1.  .I $G(ACRVDAX),ACRVDAX'=X Q
  1.  .S ^TMP("ACRPAYL",$J,X,ACRSEQDA)=""
  1.  Q
  1. PRINT ;EP;PRINT CONTENT OF EACH LETTER
  1.  D PHEADER
  1.  D LETTER
  1.  D PAYMENTS:'$D(ACRQUIT)
  1.  Q
  1. PHEADER ;PAYMENT LETTER HEADER
  1.  D FINANCE
  1.  D VENDOR
  1.  Q
  1. LETTER ;BODY OF LETTER
  1.  W !!!!?5,"The purpose of this letter is to inform you that"
  1.  W !?5,"the payment(s) listed below were sent to Treasury"
  1.  W !?5,"for direct deposit into your ",$G(ACRACT)," account."
  1.  W !!?5,"The payment(s) is scheduled for direct deposit to your"
  1.  S X1=ACRDUE
  1.  S X2=1
  1.  D C^%DTC
  1.  S Y=X
  1.  X ^DD("DD")
  1.  W !?5,ACRACT," account on ",Y," or the next business day"
  1.  W !?5,"if this is a weekend or holiday."
  1.  W !!?5,"If you have any questions concerning this payment,"
  1.  W !?5,"please call the Accounts Payable Section, Division of"
  1.  W !?5,"Financial Management at the number listed above."
  1.  S X=$O(^TMP("ACRPAYL",$J,ACRVDA,0))
  1.  I $O(^TMP("ACRPAYL",$J,ACRVDA,X)) D
  1.  .W !!?5,"Please note, this payment was made as a ",$S(ACRPTYPE="A":"GROUPED",1:"NON-GROUPED")," payment."
  1.  .W !?5
  1.  .I ACRPTYPE="A" W "Therefore, the TOTAL AMOUNT will be made as ONE deposit."
  1.  .E  W "Therefore, each amount will be made as a separate deposit."
  1.  W !
  1.  D PAUSE^ACRFWARN
  1.  Q
  1. PAYMENTS ;LIST ALL PAYMENTS
  1.  N X,Y,Z,ACRJ
  1.  S (ACRSEQDA,ACRJ,ACRTOT)=0
  1.  F  S ACRSEQDA=$O(^TMP("ACRPAYL",$J,ACRVDA,ACRSEQDA)) Q:'ACRSEQDA!$D(ACRQUIT)  D
  1.  .S X=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0))
  1.  .S Y=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,1))
  1.  .S Z=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,2))
  1.  .S ACRJ=ACRJ+1
  1.  .W !?2,ACRJ,?5,"ORDER NO...: ",$$DOC(ACRFYDA,ACRBATDA,ACRSEQDA),?40,"AMOUNT: ",$J($FN($P(X,U,11),"P,",2),12) ;ACR*2.1*14.01 IM12272
  1.  .S Z=$P(Z,U,2)
  1.  .S Z=$P(Z,"*",3,99)
  1.  .S Z=$TR(Z,"\","")
  1.  .W !?5,"INVOICE NO.: ",Z
  1.  .S ACRTOT=$G(ACRTOT)+$P(X,U,11)
  1.  .I IOSL-4<$Y D PAUSE^ACRFWARN K ACRQUIT D PAGE2
  1.  I ACRJ>1 D
  1.  .W !?40,"--------  ----------"
  1.  .W !?40,"TOTAL.: ",$J($FN($G(ACRTOT),"P,",2),12)
  1.  .D PAUSE^ACRFWARN
  1.  W @IOF
  1.  Q
  1. VENDOR ;PRINT VENDOR'S ADDRESS
  1.  N X,Y,Z,S
  1.  S X=$P($G(^AUTTVNDR(+$G(ACRVDA),0)),U)
  1.  S Y=$G(^AUTTVNDR(+$G(ACRVDA),13))
  1.  S Z=$G(^AUTTVNDR(+$G(ACRVDA),14))
  1.  S ACRACT=$P($G(^AUTTVNDR(+$G(ACRVDA),19)),U)
  1.  S ACRACT=$S(ACRACT="C":"CHECKING",1:"SAVINGS")
  1.  W !!!?5,X
  1.  W !?5,"ATTN: Accounts Receivable"
  1.  W !?5,$S($P(Z,U)]"":$P(Z,U),1:$P(Y,U))
  1.  I $P(Z,U,2)]""!($P(Y,U,10)]"") W !?5,$S($P(Z,U,2)]"":$P(Z,U,2),1:$P(Y,U,10))
  1.  W !?5,$S($P(Z,U,3)]"":$P(Z,U,3),1:$P(Y,U,2))
  1.  S S=$S($P(Z,U,4):$P(Z,U,4),1:$P(Y,U,3))
  1.  W ", ",$P($G(^DIC(5,+S,0)),U,2),"  "
  1.  W $S($P(Z,U,5)]"":$P(Z,U,5),1:$P(Y,U,4))
  1.  Q
  1. FINANCE ;PRINT FINANCE ADDRESS
  1.  N X,Y
  1.  S X=$P(^ACRPO(1,0),U,8)
  1.  S Y=$G(^AUTTPRG(+X,"DT"))
  1.  S X=$G(^AUTTPRG(+X,0))
  1.  W !!!!?35,"DEPARTMENT OF HEALTH AND HUMAN SERVICES"
  1.  W !?35,"INDIAN HEALTH SERVICE"
  1.  W !?35,$P(X,U)
  1.  W !?35,$P(Y,U)
  1.  W:$P(Y,U,2)]"" !?35,$P(Y,U,2)
  1.  W !?35,$P(Y,U,3),", ",$P($G(^DIC(5,+$P(Y,U,4),0)),U,2),"  ",$P(Y,U,5)
  1.  W !?35,$P(Y,U,6)
  1.  Q
  1. PAGE2 ;HEADER FOR PAGES 2 - X
  1.  S:'$G(ACRDC) ACRDC=1
  1.  W @IOF
  1.  W !?55,"Page: ",$G(ACRDC)+1
  1.  Q
  1. FY ;EP;SELECT FY & BATCH
  1.  D FYBAT^ACRFPAY2
  1.  Q:'$G(ACRFYDA)!'$G(ACRBATDA)
  1.  I '+$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,2)) W !!,"Batch not yet exported." S ACRQUIT="" Q
  1.  D ZIS
  1.  Q
  1. ZIS ;EP;SELECT DEVICE      
  1.  D EXIT
  1.  D FYBAT^ACRFPAY2
  1.  Q:$D(ACRQUIT)
  1.  Q:'$G(ACRFYDA)!'$G(ACRBATDA)
  1.  D ONEV
  1.  Q:$D(ACRQUIT)
  1.  W !!,"Select the printer for the VENDOR PAYMENT NOTIFICATION LETTERS"
  1.  S (ZTRTN,ACRRTN)="EN^ACRFPAYL"
  1.  S ZTDESC="PRINT VENDOR PAYMENT LETTERS"
  1.  D ^ACRFZIS
  1.  Q
  1. ONEV ;TO SELECT PRINT FOR ONE VENDOR ONLY
  1.  S DIR(0)="YO"
  1.  S DIR("A",1)="Print NOTIFICAITON LETTERS"
  1.  S DIR("A")="for ALL Vendors"
  1.  S DIR("B")="YES"
  1.  W !
  1.  D DIR^ACRFDIC
  1.  Q:Y=1!$D(ACRQUIT)
  1.  S DIC="^AUTTVNDR("
  1.  S DIC(0)="AEMQZ"
  1.  S DIC("A")="Which VENDOR: "
  1.  S DIC("S")="I $D(^AFSLAFP(""E"",+Y,+$G(ACRFYDA),+$G(ACRBATDA)))"
  1.  W !
  1.  D DIC^ACRFDIC
  1.  Q:+Y<1
  1.  S ACRVDAX=+Y
  1.  Q
  1. DOC(D0,D1,D2)      ;EP  ;ACR*2.1*14.01 IM12272
  1.  ;----- EXTRINSIC FUNCTION TO PRINT EXPANDED DOCUMENT NUMBER
  1.  ;
  1.  ;      INPUT:
  1.  ;      D0  =  FISCAL YEAR IEN (ACRFDA)
  1.  ;      D1  =  BATCH IEN (ACRBATDA)
  1.  ;      D2  =  SEQUENCE NO. IEN (ACRSEQDA)
  1.  ;
  1.  ;      OUTPUT:
  1.  ;      Y  =  EXPANDED DOCUMENT NUMBER IF ARMS DOCUMENT,
  1.  ;            FREE TEXT DOCUMENT NUMBER IF NOT ARMS DOCUMENT
  1.  ;
  1.  N X,Y
  1.  S Y=$P($G(^AFSLAFP(D0,1,D1,1,D2,0)),U,20)
  1.  S X=$P($G(^AFSLAFP(D0,1,D1,1,D2,"ARMS")),U)
  1.  I X S X=$$EXPDN^ACRFUTL(X)
  1.  I X]"" S Y=X
  1.  Q Y