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