ACRFPAY2 ;IHS/OIRM/DSD/THL,AEF - CERTIFY AND EXPORT PAYMENT BATCH; [ 09/23/2005 9:22 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**3,16,19**;NOV 05, 2001
;;
TRANSFER ;EP;TO CREATE NEW SEQUENCE NUMBER AND TRANSFER PAYMENT TO ANOTHER BATCH
N ACRBATDA,ACRFYDA
S ACRBATDA=+ACRDEST
S ACRFYDA=$P(ACRDEST,U,2)
D NEWSEQ
Q:'$D(ACRSEQDA)
S ACRSEQNO=$P(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0),U)
S %X="^AFSLAFP("_ACRSFY_",1,"_ACRSBAT_",1,"_ACRSS_","
S %Y="^AFSLAFP("_ACRFYDA_",1,"_ACRBATDA_",1,"_ACRSEQDA_","
D %XY^%RCR
S $P(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0),U)=ACRSEQNO
S DA=ACRSEQDA
S DA(2)=ACRFYDA
S DA(1)=ACRBATDA
S DIK="^AFSLAFP("_ACRFYDA_",1,"_ACRBATDA_",1,"
D IX1^ACRFDIC
S DA=ACRSS
S DA(2)=ACRSFY
S DA(1)=ACRSBAT
S DIK="^AFSLAFP("_ACRSFY_",1,"_ACRSBAT_",1,"
D DIK^ACRFDIC
Q
NEWSEQ ;CREATE NEW SEQUENCE ENTRY
;D SEQNO^ACRFIV12 ;ACR*2.1*16.06 IM15505
D SEQNO^ACRFIV12(ACRFYDA,ACRBATDA,.ACRSEQNO) ;ACR*2.1*16.06 IM15505
Q:'$G(ACRSEQNO)
S DA(2)=ACRFYDA
S DA(1)=ACRBATDA
S X=ACRSEQNO
S DIC="^AFSLAFP("_DA(2)_",1,"_DA(1)_",1,"
S DIC(0)="L"
S DIC("DR")="2////"_DUZ
S:'$D(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,0)) ^(0)="^9002325.02"
D FILE^ACRFDIC
S ACRSEQDA=+Y
Q
TRANS ;EP;TRANSFER A PAYMENT
S DIC="^AFSLAFP("
S DIC(0)="AEMQZ"
S DIC("A")="Fiscal Year of DESTINATION Batch.: "
S DIC("B")=$P(^AFSLAFP(ACRFYDA,0),U)
W !
D DIC^ACRFDIC
I +Y<1 S ACRQUIT="" Q
S $P(ACRDEST,U,2)=+Y
BAT S DIC="^AFSLAFP("_+Y_",1,"
S DIC(0)="AEMQZ"
S DIC("A")="Batch Number of DESTINATION Batch: "
S DIC("S")="I $P($G(^(2)),U,3)=""O"""
D DIC^ACRFDIC
I +Y<1 S ACRQUIT="" Q
S $P(ACRDEST,U)=+Y
S DIR(0)="LO^1:"_ACRMAX
S DIR("A")="TRANSFER Which PAYMENT(s)"
W !
D DIR^ACRFDIC
I '+Y S ACRQUIT="" Q
S ACRXX=ACRY
S DIR("A",1)="Are you CERTAIN you want to TRANSFER"
S DIR("A")="payment(s) "_$E(ACRY,1,$L(ACRY)-1)_" from this batch"
S DIR(0)="YO"
S DIR("B")="NO"
W !
D DIR^ACRFDIC
I +Y'=1 S ACRQUIT="" Q
S ACRSFY=ACRFYDA
S ACRSBAT=ACRBATDA
F ACRJ=1:1 S X=$P(ACRXX,",",ACRJ) Q:'X!'+$G(^TMP("ACRPAY",$J,+X))!$D(ACRQUIT) S ACRSS=+^TMP("ACRPAY",$J,X) D TRANSFER
K ACRQUIT
Q
LOCATOR ;EP;TO LOCATE A DOCUMENT
F D L1 Q:$D(ACRQUIT)!$D(ACROUT)
Q
L1 W @IOF
N ACRXREF,ACRX
W !?17,"Document LOCATOR",!
S DIR(0)="SO^1:Vendor Name/EIN;2:Traveler;3:Document Number;4:ARMS Invoice Number"
S DIR("A")="Which one"
W !
D DIR^ACRFDIC
Q:'Y
I Y=1 D VN S Y=1
I Y=2 D TV S Y=2
I Y=3 D DN S Y=3
I Y=4 D IN S Y=4
I $G(ACRX)]"",$G(ACRXREF)]"" D ZIS
K ACRQUIT
Q
VN S DIC="^AUTTVNDR("
S DIC(0)="AEMQZ"
S DIC("A")="Which Vendor: "
S DIC("S")="I $D(^AFSLAFP(""E"",+Y))"
W !
D DIC^ACRFDIC
I +Y<1 S ACRQUIT="" Q
S ACRX=+Y
S ACRXREF="E"
S ACRXX=$P($G(^AUTTVNDR(ACRX,0)),U)
D ^ACRFDATE
Q
TV S DIC="^ACRAU("
S DIC(0)="AEMQZ"
S DIC("A")="Which Traveler: "
S DIC("S")="I $D(^AFSLAFP(""H"",+Y))"
W !
D DIC^ACRFDIC
I +Y<1 S ACRQUIT="" Q
S ACRX=+Y
S ACRXREF="H"
;S ACRXX=$P($G(^VA(200,ACRX,0)),U) ;ACR*2.1*19.02 IM16848
S ACRXX=$$NAME2^ACRFUTL1(ACRX) ;ACR*2.1*19.02 IM16848
D ^ACRFDATE
Q
DN S DIR(0)="FO^10:10"
S DIR("A")="Document NUMBER"
S DIR("?",1)="Enter the 10 character document number"
S DIR("?")="for the document you want to locate."
W !
D DIR^ACRFDIC
I $L(Y)'=10 S ACRQUIT="" Q
DN1 S (ACRX,ACRXX)=ACRY
S ACRXREF="N"
I '$D(^AFSLAFP(ACRXREF,ACRX)) D Q
.W !!,"No payments on file in 1166 PAYMENT PACKAGE for ",ACRXX
.D PAUSE^ACRFWARN
.K ACRQUIT,ACRX,ACRXX,ACRXREF
Q
IN S DIC="^ACRINV("
S DIC(0)="AEMQZ"
S DIC("A")="Invoice Number: "
W !
D DIC^ACRFDIC
I +Y<1 K ACRQUIT Q
S ACRY=$P(^ACRINV(+Y,0),U,7)
S ACRDOCDA=$P(^ACRINV(+Y,0),U,2)
I ACRDOCDA D
. S ACRY=$P($G(^ACRDOC(ACRDOCDA,0)),U,2)
. I ACRY="" S ACRY=$E($TR($P($G(^ACRDOC(ACRDOCDA,0)),U),"-",""),1,10)
D DN1
Q
L2 ;EP;TO PRINT PAYMENT HISTORY
I '$D(^AFSLAFP(ACRXREF,ACRX)) D Q
.W !!,"No payments on file in 1166 PAYMENT PACKAGE for ",ACRXX
.D PAUSE^ACRFWARN
.K ACRQUIT
S ACRFYDA=99999
F S ACRFYDA=$O(^AFSLAFP(ACRXREF,ACRX,ACRFYDA),-1) Q:'ACRFYDA!$D(ACRQUIT) D
.S ACRBATDA=99999999
.F S ACRBATDA=$O(^AFSLAFP(ACRXREF,ACRX,ACRFYDA,ACRBATDA),-1) Q:'ACRBATDA!$D(ACRQUIT) D
..N X,Y,Z
..S X=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,0))
..S Y=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,2))
..I $D(ACRBEGIN),+Y,+Y<ACRBEGIN Q
..I $D(ACREND),+Y,+Y>ACREND Q
..I $D(ACRBEGIN),'+Y,$P(Y,U,2),$P(Y,U,2)<ACRBEGIN Q
..I $D(ACREND),'+Y,$P(Y,U,2),$P(Y,U,2)>ACREND Q
..D BATCH
..S ACRSEQDA=0
..F S ACRSEQDA=$O(^AFSLAFP(ACRXREF,ACRX,ACRFYDA,ACRBATDA,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))
...D SEQ
K ACRQUIT,ACROUT
Q
BATCH W !!,"FISCAL YEAR....: ",$P($G(^AFSLAFP(ACRFYDA,0)),U)
W !,"BATCH NUMBER...: ",$P(X,U)
W !,"SCHEDULE NUMBER: ",$P(Y,U,6)
I $P(Y,U) S Y=$P(Y,U) X ^DD("DD") W !,"EXPORT DATE....: ",Y
E I $P(Y,U,2) S Y=$P(Y,U,2) X ^DD("DD") W !,"EXPORT DUE.....: ",Y
Q
SEQ W !!?3,"SEQUENCE NO.: ",$P(X,U)
W !?3,"DOCUMENT NO.: ",$P(X,U,20),?35,"(",$P(X,U,5),")"
W !?3,"AMOUNT......: ",$J($FN($P(X,U,11),"P",2),11),?35,"(",$P($G(^AUTTCAN(+$P(X,U,7),0)),U),?$X+3,$P($G(^AUTTOBJC(+$P(X,U,8),0)),U),")"
I $P(X,U,10) W !?3,"VENDOR......: ",$P($G(^AUTTVNDR($P(X,U,10),0)),U)
;I $P(X,U,24) W !?3,"EMPLOYEE....: ",$P($G(^VA(200,$P(X,U,24),0)),U) ;ACR*2.1*19.02 IM16848
I $P(X,U,24) W !?3,"EMPLOYEE....: ",$$NAME2^ACRFUTL1($P(X,U,24)) ;ACR*2.1*19.02 IM16848
W !?3,"PAID FOR....: ",$P(Z,U,14)
W !?3,"ACH ADDENDUM: ",$P(Z,U,2)
D PAUSE^ACRFWARN
I $Y+4>IOSL W @IOF
Q
ZIS ;PRINT PAYMENT HISTORY
S (ZTRTN,ACRRTN)="L2^ACRFPAY2"
S ZTDESC="PRINT PAYMENT HISTORY"
D ^ACRFZIS
Q
DHR(ACRFYDA,ACRBATDA,ACRSEQDA) ;EP;TO CREATE PAYMENT DHR
Q:'ACRFYDA!'ACRBATDA!'ACRSEQDA
N X ;ACR*2.1*3.06
S X=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0))
Q:X=""
D DHR2(ACRFYDA,ACRBATDA,ACRSEQDA,X) ;ACR*2.1*3.06
Q ;ACR*2.1*3.06
DHR2(ACRFYDA,ACRBATDA,ACRSEQDA,X) ;EP; ;ACR*2.1*3.06
N Y,Z ;ACR*2.1*3.06
S Y=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,1))
Q:Y=""
S Z=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,2))
Q:Z=""
N ACRZ S ACRZ=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,3))
S ACR1=$P(X,U,4) ;RECORD TYPE ;ACR*2.1*3.07
S ACR2=DT
S ACR3=$E($P(X,U,18),1,3)
S ACR4=$E($P(X,U,18),4)
S ACR5=$E($P(X,U,18),5)
S ACR6=$P(X,U,5)
S ACR7=$P(X,U,20)
S ACR8=$P(X,U,6) ;ACR*2.1*3.06
S ACR9=$P(X,U,21) ;ACR*2.1*3.06
S ACR10=1
S ACR11=$P(X,U,2)
S ACR12=$P(X,U,7)
S ACR12=$P($G(^AUTTCAN(+ACR12,0)),U)
S ACR13=$P(X,U,8)
S ACR13=$P($G(^AUTTOBJC(+ACR13,0)),U)
S ACR14=$P(X,U,11)
S ACR14=$TR(ACR14,".","")
S ACR14=$E("000000000000",1,12-$L(ACR14))_ACR14
S ACR15=$P(X,U,15)
S ACR16=$P(X,U,10)
S ACR16=$P($G(^AUTTVNDR(+ACR16,11)),U,13)
S ACR16=ACR16_$E(" ",1,15-$L(ACR16))
S ACR17=" "
S ACR18=$P(Y,U,11)
S ACR19=" "
S ACR20=" "
S ACR21=" "
S ACR22=" "
S ACR23=" "
S ACR24=" "
S ACR25=" "
S ACR26=$P(ACRZ,U)
I $L(ACR26)'=4 S ACR26=" "
S ACR27=$P(ACRZ,U,2)
I $L(ACR27)'=4 S ACR27=" "
S ACR28=$P(ACRZ,U,3)
I $L(ACR28)'=2 S ACR28=" "
S ACR29=" "
S ACR30=" "
S DR=""
F J=1:1:30 S DR=DR_@("ACR"_J)
S:DR["^" DR=$TR(DR,"^","")
I $D(^ACRDHR("C",DR)) D Q
. S ACRFMS=$O(^ACRDHR("C",DR,0))
I $G(ACRDOCDA)="",ACR7]"" D ;ACR*2.1*3.06
.S ACRDOCDA=$O(^ACRDOC("B",ACR7,0)) ;ACR*2.1*3.06
.S:ACRDOCDA="" ACRDOCDA=$O(^ACRDOC("C",ACR7,0)) ;ACR*2.1*16.06 IM15505
S ACRDR="99////"_DR
S DIC="^ACRDHR("
S DIC(0)="L"
S X=".02////"_DT_";.03////"_DUZ_";.04////"_$G(ACRDOCDA)_";"
F J=1:1:16,18,26,27,28 S X=X_J_"////"_@("ACR"_J)_";"
S DIC("DR")=X
S X=ACR7
D FILE^ACRFDIC
S DA=+Y
S ACRFMS=+Y
S DIE="^ACRDHR("
S DR=ACRDR
D DIE^ACRFDIC
F J=1:1:30 K @("ACR"_J)
S DA=ACRSEQDA
S DIE="^AFSLAFP("_ACRFYDA_",1,"_ACRBATDA_",1,"
S DR=".04////"_ACRFMS
D ^DIE
K ACRFMS
Q
DHRPRINT ;EP;TO SELECT PAYMENT BATCH TO PRINT
K ACRFYDA,ACRBATDA,ACRSEQDA
F D DP1 Q:$D(ACRQUIT)!$D(ACROUT)
K ACRQUIT,ACROUT,ACRFYDA,ACRBATDA,ACRSEQDA
Q
DP1 ;SELECT FY
W @IOF
W !?20,"Select the Fiscal Year and Batch"
W !?20,"for Payment DHR's to be printed."
W !!
S ACRDHR=""
D FYBAT
Q:'$G(ACRFYDA)!'$G(ACRBATDA)
DHRZIS ;EP;TO SELECT DEVICE
S (ZTRTN,ACRRTN)="DP2^ACRFPAY2"
S ZTDESC="PRINT PAYMENT DHR'S"
D ^ACRFZIS
Q
DP2 ;EP;
K ACRQUIT,ACRDOC
N ACRSEQDA,ACRSCHNO
S ACRSCHNO=$P(^AFSLAFP(ACRFYDA,1,ACRBATDA,2),U,6)
Q:ACRSCHNO=""
S ACRSEQDA=0
F S ACRSEQDA=$O(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA)) Q:'ACRSEQDA!$D(ACRQUIT) D
.S ACRDOC=$P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0)),U,20)
.Q:ACRDOC=""
.Q:$D(ACRDOC(ACRDOC))
.S ACRDOC(ACRDOC)=""
.S D0=0
.F S D0=$O(^ACRDHR("B",ACRDOC,D0)) Q:'D0 D
..Q:$P($G(^ACRDHR(D0,1)),U,18)'=ACRSCHNO
..D DHRP
Q
DHRP ;EP;TO PRINT PAYMENT DHR'S
D ^ACRDHR
D PAUSE^ACRFWARN
W @IOF
Q
DHRPYN ;EP
S DIR(0)="YO"
S DIR("A")="Print Payment DHR's now"
S DIR("B")="NO"
W !
D DIR^ACRFDIC
I Y'=1 S ACRQUIT="" Q
D DP1
Q
FYBAT ;EP;SELECT FY AND BATCH
S DIC="^AFSLAFP("
S DIC(0)="AEMQZ"
S DIC("A")="Which FISCAL YEAR: "
S DIC("B")=$S($E(DT,4,5)<10:$E(DT,1,3)+1700,1:($E(DT,1,3)+1)+1700)
S DIC("S")="I $P(^(0),U)=X"
S Y=""
I $G(ACRFYDA) S Y=ACRFYDA K DIC
E W ! D DIC^ACRFDIC
I +Y<1 S ACRQUIT="" K ACRFYDA Q
S (ACRFYDA,DA(1))=+Y
S ACRFY=$P(^AFSLAFP(+Y,0),U)
S DIC="^AFSLAFP("_DA(1)_",1,"
S DIC(0)="AEMQZ"
S DIC("A")="Batch or Sched #: "
I $D(ACRDIC("S"))#2 S DIC("S")=ACRDIC("S") K ACRDIC("S")
I $D(ACRDHR) K ACRDHR S DIC("S")="I +$G(^(2))"
S Y=""
I $G(ACRBATDA) S Y=ACRBATDA K DIC
E W ! D DIC^ACRFDIC
I +Y<1 S ACRQUIT="" K ACRBATDA Q
S ACRBATDA=+Y
S ACRBATNO=$P(^AFSLAFP(ACRFYDA,1,+Y,0),U)
S ACRSCHNO=$P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,2)),U,6)
I $D(ACREXP)#2,$P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,2)),U)]"" D Q
.W !!,"This Batch has already been exported."
.K ACRBATDA
.D PAUSE^ACRFWARN
Q
ACRFPAY2 ;IHS/OIRM/DSD/THL,AEF - CERTIFY AND EXPORT PAYMENT BATCH; [ 09/23/2005 9:22 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**3,16,19**;NOV 05, 2001
+2 ;;
TRANSFER ;EP;TO CREATE NEW SEQUENCE NUMBER AND TRANSFER PAYMENT TO ANOTHER BATCH
+1 NEW ACRBATDA,ACRFYDA
+2 SET ACRBATDA=+ACRDEST
+3 SET ACRFYDA=$PIECE(ACRDEST,U,2)
+4 DO NEWSEQ
+5 IF '$DATA(ACRSEQDA)
QUIT
+6 SET ACRSEQNO=$PIECE(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0),U)
+7 SET %X="^AFSLAFP("_ACRSFY_",1,"_ACRSBAT_",1,"_ACRSS_","
+8 SET %Y="^AFSLAFP("_ACRFYDA_",1,"_ACRBATDA_",1,"_ACRSEQDA_","
+9 DO %XY^%RCR
+10 SET $PIECE(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0),U)=ACRSEQNO
+11 SET DA=ACRSEQDA
+12 SET DA(2)=ACRFYDA
+13 SET DA(1)=ACRBATDA
+14 SET DIK="^AFSLAFP("_ACRFYDA_",1,"_ACRBATDA_",1,"
+15 DO IX1^ACRFDIC
+16 SET DA=ACRSS
+17 SET DA(2)=ACRSFY
+18 SET DA(1)=ACRSBAT
+19 SET DIK="^AFSLAFP("_ACRSFY_",1,"_ACRSBAT_",1,"
+20 DO DIK^ACRFDIC
+21 QUIT
NEWSEQ ;CREATE NEW SEQUENCE ENTRY
+1 ;D SEQNO^ACRFIV12 ;ACR*2.1*16.06 IM15505
+2 ;ACR*2.1*16.06 IM15505
DO SEQNO^ACRFIV12(ACRFYDA,ACRBATDA,.ACRSEQNO)
+3 IF '$GET(ACRSEQNO)
QUIT
+4 SET DA(2)=ACRFYDA
+5 SET DA(1)=ACRBATDA
+6 SET X=ACRSEQNO
+7 SET DIC="^AFSLAFP("_DA(2)_",1,"_DA(1)_",1,"
+8 SET DIC(0)="L"
+9 SET DIC("DR")="2////"_DUZ
+10 IF '$DATA(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,0))
SET ^(0)="^9002325.02"
+11 DO FILE^ACRFDIC
+12 SET ACRSEQDA=+Y
+13 QUIT
TRANS ;EP;TRANSFER A PAYMENT
+1 SET DIC="^AFSLAFP("
+2 SET DIC(0)="AEMQZ"
+3 SET DIC("A")="Fiscal Year of DESTINATION Batch.: "
+4 SET DIC("B")=$PIECE(^AFSLAFP(ACRFYDA,0),U)
+5 WRITE !
+6 DO DIC^ACRFDIC
+7 IF +Y<1
SET ACRQUIT=""
QUIT
+8 SET $PIECE(ACRDEST,U,2)=+Y
BAT SET DIC="^AFSLAFP("_+Y_",1,"
+1 SET DIC(0)="AEMQZ"
+2 SET DIC("A")="Batch Number of DESTINATION Batch: "
+3 SET DIC("S")="I $P($G(^(2)),U,3)=""O"""
+4 DO DIC^ACRFDIC
+5 IF +Y<1
SET ACRQUIT=""
QUIT
+6 SET $PIECE(ACRDEST,U)=+Y
+7 SET DIR(0)="LO^1:"_ACRMAX
+8 SET DIR("A")="TRANSFER Which PAYMENT(s)"
+9 WRITE !
+10 DO DIR^ACRFDIC
+11 IF '+Y
SET ACRQUIT=""
QUIT
+12 SET ACRXX=ACRY
+13 SET DIR("A",1)="Are you CERTAIN you want to TRANSFER"
+14 SET DIR("A")="payment(s) "_$EXTRACT(ACRY,1,$LENGTH(ACRY)-1)_" from this batch"
+15 SET DIR(0)="YO"
+16 SET DIR("B")="NO"
+17 WRITE !
+18 DO DIR^ACRFDIC
+19 IF +Y'=1
SET ACRQUIT=""
QUIT
+20 SET ACRSFY=ACRFYDA
+21 SET ACRSBAT=ACRBATDA
+22 FOR ACRJ=1:1
SET X=$PIECE(ACRXX,",",ACRJ)
IF 'X!'+$GET(^TMP("ACRPAY",$JOB,+X))!$DATA(ACRQUIT)
QUIT
SET ACRSS=+^TMP("ACRPAY",$JOB,X)
DO TRANSFER
+23 KILL ACRQUIT
+24 QUIT
LOCATOR ;EP;TO LOCATE A DOCUMENT
+1 FOR
DO L1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+2 QUIT
L1 WRITE @IOF
+1 NEW ACRXREF,ACRX
+2 WRITE !?17,"Document LOCATOR",!
+3 SET DIR(0)="SO^1:Vendor Name/EIN;2:Traveler;3:Document Number;4:ARMS Invoice Number"
+4 SET DIR("A")="Which one"
+5 WRITE !
+6 DO DIR^ACRFDIC
+7 IF 'Y
QUIT
+8 IF Y=1
DO VN
SET Y=1
+9 IF Y=2
DO TV
SET Y=2
+10 IF Y=3
DO DN
SET Y=3
+11 IF Y=4
DO IN
SET Y=4
+12 IF $GET(ACRX)]""
IF $GET(ACRXREF)]""
DO ZIS
+13 KILL ACRQUIT
+14 QUIT
VN SET DIC="^AUTTVNDR("
+1 SET DIC(0)="AEMQZ"
+2 SET DIC("A")="Which Vendor: "
+3 SET DIC("S")="I $D(^AFSLAFP(""E"",+Y))"
+4 WRITE !
+5 DO DIC^ACRFDIC
+6 IF +Y<1
SET ACRQUIT=""
QUIT
+7 SET ACRX=+Y
+8 SET ACRXREF="E"
+9 SET ACRXX=$PIECE($GET(^AUTTVNDR(ACRX,0)),U)
+10 DO ^ACRFDATE
+11 QUIT
TV SET DIC="^ACRAU("
+1 SET DIC(0)="AEMQZ"
+2 SET DIC("A")="Which Traveler: "
+3 SET DIC("S")="I $D(^AFSLAFP(""H"",+Y))"
+4 WRITE !
+5 DO DIC^ACRFDIC
+6 IF +Y<1
SET ACRQUIT=""
QUIT
+7 SET ACRX=+Y
+8 SET ACRXREF="H"
+9 ;S ACRXX=$P($G(^VA(200,ACRX,0)),U) ;ACR*2.1*19.02 IM16848
+10 ;ACR*2.1*19.02 IM16848
SET ACRXX=$$NAME2^ACRFUTL1(ACRX)
+11 DO ^ACRFDATE
+12 QUIT
DN SET DIR(0)="FO^10:10"
+1 SET DIR("A")="Document NUMBER"
+2 SET DIR("?",1)="Enter the 10 character document number"
+3 SET DIR("?")="for the document you want to locate."
+4 WRITE !
+5 DO DIR^ACRFDIC
+6 IF $LENGTH(Y)'=10
SET ACRQUIT=""
QUIT
DN1 SET (ACRX,ACRXX)=ACRY
+1 SET ACRXREF="N"
+2 IF '$DATA(^AFSLAFP(ACRXREF,ACRX))
Begin DoDot:1
+3 WRITE !!,"No payments on file in 1166 PAYMENT PACKAGE for ",ACRXX
+4 DO PAUSE^ACRFWARN
+5 KILL ACRQUIT,ACRX,ACRXX,ACRXREF
End DoDot:1
QUIT
+6 QUIT
IN SET DIC="^ACRINV("
+1 SET DIC(0)="AEMQZ"
+2 SET DIC("A")="Invoice Number: "
+3 WRITE !
+4 DO DIC^ACRFDIC
+5 IF +Y<1
KILL ACRQUIT
QUIT
+6 SET ACRY=$PIECE(^ACRINV(+Y,0),U,7)
+7 SET ACRDOCDA=$PIECE(^ACRINV(+Y,0),U,2)
+8 IF ACRDOCDA
Begin DoDot:1
+9 SET ACRY=$PIECE($GET(^ACRDOC(ACRDOCDA,0)),U,2)
+10 IF ACRY=""
SET ACRY=$EXTRACT($TRANSLATE($PIECE($GET(^ACRDOC(ACRDOCDA,0)),U),"-",""),1,10)
End DoDot:1
+11 DO DN1
+12 QUIT
L2 ;EP;TO PRINT PAYMENT HISTORY
+1 IF '$DATA(^AFSLAFP(ACRXREF,ACRX))
Begin DoDot:1
+2 WRITE !!,"No payments on file in 1166 PAYMENT PACKAGE for ",ACRXX
+3 DO PAUSE^ACRFWARN
+4 KILL ACRQUIT
End DoDot:1
QUIT
+5 SET ACRFYDA=99999
+6 FOR
SET ACRFYDA=$ORDER(^AFSLAFP(ACRXREF,ACRX,ACRFYDA),-1)
IF 'ACRFYDA!$DATA(ACRQUIT)
QUIT
Begin DoDot:1
+7 SET ACRBATDA=99999999
+8 FOR
SET ACRBATDA=$ORDER(^AFSLAFP(ACRXREF,ACRX,ACRFYDA,ACRBATDA),-1)
IF 'ACRBATDA!$DATA(ACRQUIT)
QUIT
Begin DoDot:2
+9 NEW X,Y,Z
+10 SET X=$GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,0))
+11 SET Y=$GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,2))
+12 IF $DATA(ACRBEGIN)
IF +Y
IF +Y<ACRBEGIN
QUIT
+13 IF $DATA(ACREND)
IF +Y
IF +Y>ACREND
QUIT
+14 IF $DATA(ACRBEGIN)
IF '+Y
IF $PIECE(Y,U,2)
IF $PIECE(Y,U,2)<ACRBEGIN
QUIT
+15 IF $DATA(ACREND)
IF '+Y
IF $PIECE(Y,U,2)
IF $PIECE(Y,U,2)>ACREND
QUIT
+16 DO BATCH
+17 SET ACRSEQDA=0
+18 FOR
SET ACRSEQDA=$ORDER(^AFSLAFP(ACRXREF,ACRX,ACRFYDA,ACRBATDA,ACRSEQDA))
IF 'ACRSEQDA!$DATA(ACRQUIT)
QUIT
Begin DoDot:3
+19 SET X=$GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0))
+20 SET Y=$GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,1))
+21 SET Z=$GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,2))
+22 DO SEQ
End DoDot:3
End DoDot:2
End DoDot:1
+23 KILL ACRQUIT,ACROUT
+24 QUIT
BATCH WRITE !!,"FISCAL YEAR....: ",$PIECE($GET(^AFSLAFP(ACRFYDA,0)),U)
+1 WRITE !,"BATCH NUMBER...: ",$PIECE(X,U)
+2 WRITE !,"SCHEDULE NUMBER: ",$PIECE(Y,U,6)
+3 IF $PIECE(Y,U)
SET Y=$PIECE(Y,U)
XECUTE ^DD("DD")
WRITE !,"EXPORT DATE....: ",Y
+4 IF '$TEST
IF $PIECE(Y,U,2)
SET Y=$PIECE(Y,U,2)
XECUTE ^DD("DD")
WRITE !,"EXPORT DUE.....: ",Y
+5 QUIT
SEQ WRITE !!?3,"SEQUENCE NO.: ",$PIECE(X,U)
+1 WRITE !?3,"DOCUMENT NO.: ",$PIECE(X,U,20),?35,"(",$PIECE(X,U,5),")"
+2 WRITE !?3,"AMOUNT......: ",$JUSTIFY($FNUMBER($PIECE(X,U,11),"P",2),11),?35,"(",$PIECE($GET(^AUTTCAN(+$PIECE(X,U,7),0)),U),?$X+3,$PIECE($GET(^AUTTOBJC(+$PIECE(X,U,8),0)),U),")"
+3 IF $PIECE(X,U,10)
WRITE !?3,"VENDOR......: ",$PIECE($GET(^AUTTVNDR($PIECE(X,U,10),0)),U)
+4 ;I $P(X,U,24) W !?3,"EMPLOYEE....: ",$P($G(^VA(200,$P(X,U,24),0)),U) ;ACR*2.1*19.02 IM16848
+5 ;ACR*2.1*19.02 IM16848
IF $PIECE(X,U,24)
WRITE !?3,"EMPLOYEE....: ",$$NAME2^ACRFUTL1($PIECE(X,U,24))
+6 WRITE !?3,"PAID FOR....: ",$PIECE(Z,U,14)
+7 WRITE !?3,"ACH ADDENDUM: ",$PIECE(Z,U,2)
+8 DO PAUSE^ACRFWARN
+9 IF $Y+4>IOSL
WRITE @IOF
+10 QUIT
ZIS ;PRINT PAYMENT HISTORY
+1 SET (ZTRTN,ACRRTN)="L2^ACRFPAY2"
+2 SET ZTDESC="PRINT PAYMENT HISTORY"
+3 DO ^ACRFZIS
+4 QUIT
DHR(ACRFYDA,ACRBATDA,ACRSEQDA) ;EP;TO CREATE PAYMENT DHR
+1 IF 'ACRFYDA!'ACRBATDA!'ACRSEQDA
QUIT
+2 ;ACR*2.1*3.06
NEW X
+3 SET X=$GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0))
+4 IF X=""
QUIT
+5 ;ACR*2.1*3.06
DO DHR2(ACRFYDA,ACRBATDA,ACRSEQDA,X)
+6 ;ACR*2.1*3.06
QUIT
DHR2(ACRFYDA,ACRBATDA,ACRSEQDA,X) ;EP; ;ACR*2.1*3.06
+1 ;ACR*2.1*3.06
NEW Y,Z
+2 SET Y=$GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,1))
+3 IF Y=""
QUIT
+4 SET Z=$GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,2))
+5 IF Z=""
QUIT
+6 NEW ACRZ
SET ACRZ=$GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,3))
+7 ;RECORD TYPE ;ACR*2.1*3.07
SET ACR1=$PIECE(X,U,4)
+8 SET ACR2=DT
+9 SET ACR3=$EXTRACT($PIECE(X,U,18),1,3)
+10 SET ACR4=$EXTRACT($PIECE(X,U,18),4)
+11 SET ACR5=$EXTRACT($PIECE(X,U,18),5)
+12 SET ACR6=$PIECE(X,U,5)
+13 SET ACR7=$PIECE(X,U,20)
+14 ;ACR*2.1*3.06
SET ACR8=$PIECE(X,U,6)
+15 ;ACR*2.1*3.06
SET ACR9=$PIECE(X,U,21)
+16 SET ACR10=1
+17 SET ACR11=$PIECE(X,U,2)
+18 SET ACR12=$PIECE(X,U,7)
+19 SET ACR12=$PIECE($GET(^AUTTCAN(+ACR12,0)),U)
+20 SET ACR13=$PIECE(X,U,8)
+21 SET ACR13=$PIECE($GET(^AUTTOBJC(+ACR13,0)),U)
+22 SET ACR14=$PIECE(X,U,11)
+23 SET ACR14=$TRANSLATE(ACR14,".","")
+24 SET ACR14=$EXTRACT("000000000000",1,12-$LENGTH(ACR14))_ACR14
+25 SET ACR15=$PIECE(X,U,15)
+26 SET ACR16=$PIECE(X,U,10)
+27 SET ACR16=$PIECE($GET(^AUTTVNDR(+ACR16,11)),U,13)
+28 SET ACR16=ACR16_$EXTRACT(" ",1,15-$LENGTH(ACR16))
+29 SET ACR17=" "
+30 SET ACR18=$PIECE(Y,U,11)
+31 SET ACR19=" "
+32 SET ACR20=" "
+33 SET ACR21=" "
+34 SET ACR22=" "
+35 SET ACR23=" "
+36 SET ACR24=" "
+37 SET ACR25=" "
+38 SET ACR26=$PIECE(ACRZ,U)
+39 IF $LENGTH(ACR26)'=4
SET ACR26=" "
+40 SET ACR27=$PIECE(ACRZ,U,2)
+41 IF $LENGTH(ACR27)'=4
SET ACR27=" "
+42 SET ACR28=$PIECE(ACRZ,U,3)
+43 IF $LENGTH(ACR28)'=2
SET ACR28=" "
+44 SET ACR29=" "
+45 SET ACR30=" "
+46 SET DR=""
+47 FOR J=1:1:30
SET DR=DR_@("ACR"_J)
+48 IF DR["^"
SET DR=$TRANSLATE(DR,"^","")
+49 IF $DATA(^ACRDHR("C",DR))
Begin DoDot:1
+50 SET ACRFMS=$ORDER(^ACRDHR("C",DR,0))
End DoDot:1
QUIT
+51 ;ACR*2.1*3.06
IF $GET(ACRDOCDA)=""
IF ACR7]""
Begin DoDot:1
+52 ;ACR*2.1*3.06
SET ACRDOCDA=$ORDER(^ACRDOC("B",ACR7,0))
+53 ;ACR*2.1*16.06 IM15505
IF ACRDOCDA=""
SET ACRDOCDA=$ORDER(^ACRDOC("C",ACR7,0))
End DoDot:1
+54 SET ACRDR="99////"_DR
+55 SET DIC="^ACRDHR("
+56 SET DIC(0)="L"
+57 SET X=".02////"_DT_";.03////"_DUZ_";.04////"_$GET(ACRDOCDA)_";"
+58 FOR J=1:1:16,18,26,27,28
SET X=X_J_"////"_@("ACR"_J)_";"
+59 SET DIC("DR")=X
+60 SET X=ACR7
+61 DO FILE^ACRFDIC
+62 SET DA=+Y
+63 SET ACRFMS=+Y
+64 SET DIE="^ACRDHR("
+65 SET DR=ACRDR
+66 DO DIE^ACRFDIC
+67 FOR J=1:1:30
KILL @("ACR"_J)
+68 SET DA=ACRSEQDA
+69 SET DIE="^AFSLAFP("_ACRFYDA_",1,"_ACRBATDA_",1,"
+70 SET DR=".04////"_ACRFMS
+71 DO ^DIE
+72 KILL ACRFMS
+73 QUIT
DHRPRINT ;EP;TO SELECT PAYMENT BATCH TO PRINT
+1 KILL ACRFYDA,ACRBATDA,ACRSEQDA
+2 FOR
DO DP1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+3 KILL ACRQUIT,ACROUT,ACRFYDA,ACRBATDA,ACRSEQDA
+4 QUIT
DP1 ;SELECT FY
+1 WRITE @IOF
+2 WRITE !?20,"Select the Fiscal Year and Batch"
+3 WRITE !?20,"for Payment DHR's to be printed."
+4 WRITE !!
+5 SET ACRDHR=""
+6 DO FYBAT
+7 IF '$GET(ACRFYDA)!'$GET(ACRBATDA)
QUIT
DHRZIS ;EP;TO SELECT DEVICE
+1 SET (ZTRTN,ACRRTN)="DP2^ACRFPAY2"
+2 SET ZTDESC="PRINT PAYMENT DHR'S"
+3 DO ^ACRFZIS
+4 QUIT
DP2 ;EP;
+1 KILL ACRQUIT,ACRDOC
+2 NEW ACRSEQDA,ACRSCHNO
+3 SET ACRSCHNO=$PIECE(^AFSLAFP(ACRFYDA,1,ACRBATDA,2),U,6)
+4 IF ACRSCHNO=""
QUIT
+5 SET ACRSEQDA=0
+6 FOR
SET ACRSEQDA=$ORDER(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA))
IF 'ACRSEQDA!$DATA(ACRQUIT)
QUIT
Begin DoDot:1
+7 SET ACRDOC=$PIECE($GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0)),U,20)
+8 IF ACRDOC=""
QUIT
+9 IF $DATA(ACRDOC(ACRDOC))
QUIT
+10 SET ACRDOC(ACRDOC)=""
+11 SET D0=0
+12 FOR
SET D0=$ORDER(^ACRDHR("B",ACRDOC,D0))
IF 'D0
QUIT
Begin DoDot:2
+13 IF $PIECE($GET(^ACRDHR(D0,1)),U,18)'=ACRSCHNO
QUIT
+14 DO DHRP
End DoDot:2
End DoDot:1
+15 QUIT
DHRP ;EP;TO PRINT PAYMENT DHR'S
+1 DO ^ACRDHR
+2 DO PAUSE^ACRFWARN
+3 WRITE @IOF
+4 QUIT
DHRPYN ;EP
+1 SET DIR(0)="YO"
+2 SET DIR("A")="Print Payment DHR's now"
+3 SET DIR("B")="NO"
+4 WRITE !
+5 DO DIR^ACRFDIC
+6 IF Y'=1
SET ACRQUIT=""
QUIT
+7 DO DP1
+8 QUIT
FYBAT ;EP;SELECT FY AND BATCH
+1 SET DIC="^AFSLAFP("
+2 SET DIC(0)="AEMQZ"
+3 SET DIC("A")="Which FISCAL YEAR: "
+4 SET DIC("B")=$SELECT($EXTRACT(DT,4,5)<10:$EXTRACT(DT,1,3)+1700,1:($EXTRACT(DT,1,3)+1)+1700)
+5 SET DIC("S")="I $P(^(0),U)=X"
+6 SET Y=""
+7 IF $GET(ACRFYDA)
SET Y=ACRFYDA
KILL DIC
+8 IF '$TEST
WRITE !
DO DIC^ACRFDIC
+9 IF +Y<1
SET ACRQUIT=""
KILL ACRFYDA
QUIT
+10 SET (ACRFYDA,DA(1))=+Y
+11 SET ACRFY=$PIECE(^AFSLAFP(+Y,0),U)
+12 SET DIC="^AFSLAFP("_DA(1)_",1,"
+13 SET DIC(0)="AEMQZ"
+14 SET DIC("A")="Batch or Sched #: "
+15 IF $DATA(ACRDIC("S"))#2
SET DIC("S")=ACRDIC("S")
KILL ACRDIC("S")
+16 IF $DATA(ACRDHR)
KILL ACRDHR
SET DIC("S")="I +$G(^(2))"
+17 SET Y=""
+18 IF $GET(ACRBATDA)
SET Y=ACRBATDA
KILL DIC
+19 IF '$TEST
WRITE !
DO DIC^ACRFDIC
+20 IF +Y<1
SET ACRQUIT=""
KILL ACRBATDA
QUIT
+21 SET ACRBATDA=+Y
+22 SET ACRBATNO=$PIECE(^AFSLAFP(ACRFYDA,1,+Y,0),U)
+23 SET ACRSCHNO=$PIECE($GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,2)),U,6)
+24 IF $DATA(ACREXP)#2
IF $PIECE($GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,2)),U)]""
Begin DoDot:1
+25 WRITE !!,"This Batch has already been exported."
+26 KILL ACRBATDA
+27 DO PAUSE^ACRFWARN
End DoDot:1
QUIT
+28 QUIT
