ACRFPAY9 ;IHS/OIRM/DSD/THL,AEF - PAYMENT REPORTS, UTILITIES; [ 09/23/2005 9:51 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**5,19**;NOV 05, 2001
;;
TECHPAY ;EP;TO PRINT PAYMENTS MADE BY ONE ACCOUNTING TECH
D TPEXIT
F D TP Q:$D(ACRQUIT)!$D(ACROUT)
TPEXIT K ACR,ACRTDA,ACRQUIT,ACROUT,ACRBEGIN,ACROUT,ACRFY,ACRFYDA,ACRBATDA,ACRBATNO,ACREND,ACRRTN
K ^TMP("ACRPBAT",$J)
Q
TP ;
D TPHEAD
D TECH
Q:$D(ACRQUIT)!'$G(ACRTDA)
D FY
Q:$D(ACRQUIT)!'$G(ACRFYDA)
D DATES
Q:$D(ACRQUIT)!'$G(ACRBEGIN)!'$G(ACREND)
D ZIS
Q
TECH ;LOOK UP ACCOUNTING TECH
S DIC="^ACRAU("
S DIC(0)="AEMQZ"
S DIC("A")="Which ACCOUNTING TECH: "
S DIC("S")="I $D(^AFSLAFP(""D"",+Y))"
W !
D DIC^ACRFDIC
I Y<1 S ACRQUIT=""
S ACRTDA=+Y
Q
FY ;SELECT FISCAL YEAR FOR REPORT
S DIR(0)="NO^1000:9999"
S DIR("A")="Which FISCAL YEAR"
S DIR("B")=$S($E(DT,4,5)<10:$E(DT,1,3)+1700,1:($E(DT,1,3)+1)+1700)
W !
D DIR^ACRFDIC
Q:Y=""
S ACRFY=Y
S ACRFYDA=$O(^AFSLAFP("B",ACRFY,0))
Q
DATES ;SELECT DATE RANGE FOR PAYMENTS TO REVIEW
W !
D ^ACRFDATE
Q
ZIS ;SELECT DEVICE TO PRINT REPORT
S (ZTRTN,ACRRTN)="TP1^ACRFPAY9"
S ZTDESC="REVIEW PAYMENTS FOR SELECTED TECH"
D ^ACRFZIS
Q
TP1 ;EP;TO PRINT TECH PAYMENTS REPORT
Q:'$G(ACRFYDA)!'$G(ACRTDA)
N ACRBATDA
S ACRBATDA=0
F S ACRBATDA=$O(^AFSLAFP("D",ACRTDA,ACRFYDA,ACRBATDA)) Q:'ACRBATDA D
.Q:$P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,2)),U,2)<ACRBEGIN Q:$P(^(2),U,2)>ACREND
.N ACRSEQDA
.S ACRSEQDA=0
.F S ACRSEQDA=$O(^AFSLAFP("D",ACRTDA,ACRFYDA,ACRBATDA,ACRSEQDA)) Q:'ACRSEQDA D
..S X=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0))
..Q:'$P(X,U,10)&'$P(X,U,24)
..I $P(X,U,10) S X=$P($G(^AUTTVNDR($P(X,U,10),0)),U)
..;E S:$P(X,U,24) X=$P($G(^VA(200,$P(X,U,24),0)),U) ;ACR*2.1*19.02 IM16848
..E S:$P(X,U,24) X=$$NAME2^ACRFUTL1($P(X,U,24)) ;ACR*2.1*19.02 IM16848
..Q:X=""
..S ^TMP("ACRPBAT",$J,ACRFYDA,ACRBATDA,X,ACRSEQDA)=""
S ACRBATDA=0
F S ACRBATDA=$O(^TMP("ACRPBAT",$J,ACRFYDA,ACRBATDA)) Q:'ACRBATDA!$D(ACRQUIT) D
.S ACRBATNO=$P(^AFSLAFP(ACRFYDA,1,ACRBATDA,0),U)
.D PBHEAD^ACRFPAY7
.N ACRX
.S ACRX=""
.F S ACRX=$O(^TMP("ACRPBAT",$J,ACRFYDA,ACRBATDA,ACRX)) Q:ACRX=""!$D(ACRQUIT) D
..S ACRSEQDA=0
..F S ACRSEQDA=$O(^TMP("ACRPBAT",$J,ACRFYDA,ACRBATDA,ACRX,ACRSEQDA)) Q:'ACRSEQDA!$D(ACRQUIT) D PBD1^ACRFPAY7
D TPEXIT
Q
TPHEAD ;
W @IOF
W !?10,"Review Payments for a Selected Accounting Tech",!
Q
PTYPE ;EP;SELECT PAYMENT TYPE
S DIC="^AFSLPTYP("
S DIC(0)="AEMQZ"
S DIC("A")="PAYMENT TYPE........: "
S DIC("B")=$S(ACRBTYP="V"&$G(ACRDFYDA):"OBLIGATED PMT",ACRBTYP="V"&'$G(ACRDFYDA):"UNOBLIGATED PAYMENT (19013)",1:"TRAVEL DISBRSMENT")
D DIC^ACRFDIC
I X["^" S ACROUT="" Q
I +Y<1 W !!,"PAYMENT TYPE REQUIRED",! G PTYPE
S (ACR3,Y)=+Y
S ACRTCODE=$S(Y=2:"06115",Y=3:24219,Y=6:"06125",Y=11:19217,Y=12:19917,Y=14:19817,Y=15:19013,Y=16:23717,1:19114) ;ACR*2.1*5.01
I ACRTCODE="06115" D OTA ;ACR*2.1*5.01
Q
OTA ;EP;SYNCHRONIZE TRAVEL ADVANCE
S ACRREF=602
S ACRREFDA=$O(^AUTTDOCR("B",602,0))
N ACRDOCDA
S ACRDOCDA=$O(^ACRDOC("B",ACRDOC,0))
Q:'ACRDOCDA
S ACRADV=ACRIVT
D OTA^ACRFSSA1
Q
FYFUN ;EP;FISCAL YEAR OF FUNDS
K ACRFY
S DIR(0)="NO^1000:9999"
S DIR("A")="FISCAL YEAR OF FUNDS"
S DIR("B")=$S($E(DT,4,5)<10:$E(DT,1,3)+1700,1:($E(DT,1,3)+1)+1700)
D DIR^ACRFDIC
I X["^" S ACROUT="" Q
I $L(Y)'=4 W !!,"FISCAL YEAR OF FUNDS REQUIRED",! G FYFUN
S ACRFYFUN=Y
S $P(ACRLBDT,U)=ACRFYFUN
Q
ACRFPAY9 ;IHS/OIRM/DSD/THL,AEF - PAYMENT REPORTS, UTILITIES; [ 09/23/2005 9:51 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**5,19**;NOV 05, 2001
+2 ;;
TECHPAY ;EP;TO PRINT PAYMENTS MADE BY ONE ACCOUNTING TECH
+1 DO TPEXIT
+2 FOR
DO TP
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
TPEXIT KILL ACR,ACRTDA,ACRQUIT,ACROUT,ACRBEGIN,ACROUT,ACRFY,ACRFYDA,ACRBATDA,ACRBATNO,ACREND,ACRRTN
+1 KILL ^TMP("ACRPBAT",$JOB)
+2 QUIT
TP ;
+1 DO TPHEAD
+2 DO TECH
+3 IF $DATA(ACRQUIT)!'$GET(ACRTDA)
QUIT
+4 DO FY
+5 IF $DATA(ACRQUIT)!'$GET(ACRFYDA)
QUIT
+6 DO DATES
+7 IF $DATA(ACRQUIT)!'$GET(ACRBEGIN)!'$GET(ACREND)
QUIT
+8 DO ZIS
+9 QUIT
TECH ;LOOK UP ACCOUNTING TECH
+1 SET DIC="^ACRAU("
+2 SET DIC(0)="AEMQZ"
+3 SET DIC("A")="Which ACCOUNTING TECH: "
+4 SET DIC("S")="I $D(^AFSLAFP(""D"",+Y))"
+5 WRITE !
+6 DO DIC^ACRFDIC
+7 IF Y<1
SET ACRQUIT=""
+8 SET ACRTDA=+Y
+9 QUIT
FY ;SELECT FISCAL YEAR FOR REPORT
+1 SET DIR(0)="NO^1000:9999"
+2 SET DIR("A")="Which FISCAL YEAR"
+3 SET DIR("B")=$SELECT($EXTRACT(DT,4,5)<10:$EXTRACT(DT,1,3)+1700,1:($EXTRACT(DT,1,3)+1)+1700)
+4 WRITE !
+5 DO DIR^ACRFDIC
+6 IF Y=""
QUIT
+7 SET ACRFY=Y
+8 SET ACRFYDA=$ORDER(^AFSLAFP("B",ACRFY,0))
+9 QUIT
DATES ;SELECT DATE RANGE FOR PAYMENTS TO REVIEW
+1 WRITE !
+2 DO ^ACRFDATE
+3 QUIT
ZIS ;SELECT DEVICE TO PRINT REPORT
+1 SET (ZTRTN,ACRRTN)="TP1^ACRFPAY9"
+2 SET ZTDESC="REVIEW PAYMENTS FOR SELECTED TECH"
+3 DO ^ACRFZIS
+4 QUIT
TP1 ;EP;TO PRINT TECH PAYMENTS REPORT
+1 IF '$GET(ACRFYDA)!'$GET(ACRTDA)
QUIT
+2 NEW ACRBATDA
+3 SET ACRBATDA=0
+4 FOR
SET ACRBATDA=$ORDER(^AFSLAFP("D",ACRTDA,ACRFYDA,ACRBATDA))
IF 'ACRBATDA
QUIT
Begin DoDot:1
+5 IF $PIECE($GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,2)),U,2)<ACRBEGIN
QUIT
IF $PIECE(^(2),U,2)>ACREND
QUIT
+6 NEW ACRSEQDA
+7 SET ACRSEQDA=0
+8 FOR
SET ACRSEQDA=$ORDER(^AFSLAFP("D",ACRTDA,ACRFYDA,ACRBATDA,ACRSEQDA))
IF 'ACRSEQDA
QUIT
Begin DoDot:2
+9 SET X=$GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0))
+10 IF '$PIECE(X,U,10)&'$PIECE(X,U,24)
QUIT
+11 IF $PIECE(X,U,10)
SET X=$PIECE($GET(^AUTTVNDR($PIECE(X,U,10),0)),U)
+12 ;E S:$P(X,U,24) X=$P($G(^VA(200,$P(X,U,24),0)),U) ;ACR*2.1*19.02 IM16848
+13 ;ACR*2.1*19.02 IM16848
IF '$TEST
IF $PIECE(X,U,24)
SET X=$$NAME2^ACRFUTL1($PIECE(X,U,24))
+14 IF X=""
QUIT
+15 SET ^TMP("ACRPBAT",$JOB,ACRFYDA,ACRBATDA,X,ACRSEQDA)=""
End DoDot:2
End DoDot:1
+16 SET ACRBATDA=0
+17 FOR
SET ACRBATDA=$ORDER(^TMP("ACRPBAT",$JOB,ACRFYDA,ACRBATDA))
IF 'ACRBATDA!$DATA(ACRQUIT)
QUIT
Begin DoDot:1
+18 SET ACRBATNO=$PIECE(^AFSLAFP(ACRFYDA,1,ACRBATDA,0),U)
+19 DO PBHEAD^ACRFPAY7
+20 NEW ACRX
+21 SET ACRX=""
+22 FOR
SET ACRX=$ORDER(^TMP("ACRPBAT",$JOB,ACRFYDA,ACRBATDA,ACRX))
IF ACRX=""!$DATA(ACRQUIT)
QUIT
Begin DoDot:2
+23 SET ACRSEQDA=0
+24 FOR
SET ACRSEQDA=$ORDER(^TMP("ACRPBAT",$JOB,ACRFYDA,ACRBATDA,ACRX,ACRSEQDA))
IF 'ACRSEQDA!$DATA(ACRQUIT)
QUIT
DO PBD1^ACRFPAY7
End DoDot:2
End DoDot:1
+25 DO TPEXIT
+26 QUIT
TPHEAD ;
+1 WRITE @IOF
+2 WRITE !?10,"Review Payments for a Selected Accounting Tech",!
+3 QUIT
PTYPE ;EP;SELECT PAYMENT TYPE
+1 SET DIC="^AFSLPTYP("
+2 SET DIC(0)="AEMQZ"
+3 SET DIC("A")="PAYMENT TYPE........: "
+4 SET DIC("B")=$SELECT(ACRBTYP="V"&$GET(ACRDFYDA):"OBLIGATED PMT",ACRBTYP="V"&'$GET(ACRDFYDA):"UNOBLIGATED PAYMENT (19013)",1:"TRAVEL DISBRSMENT")
+5 DO DIC^ACRFDIC
+6 IF X["^"
SET ACROUT=""
QUIT
+7 IF +Y<1
WRITE !!,"PAYMENT TYPE REQUIRED",!
GOTO PTYPE
+8 SET (ACR3,Y)=+Y
+9 ;ACR*2.1*5.01
SET ACRTCODE=$SELECT(Y=2:"06115",Y=3:24219,Y=6:"06125",Y=11:19217,Y=12:19917,Y=14:19817,Y=15:19013,Y=16:23717,1:19114)
+10 ;ACR*2.1*5.01
IF ACRTCODE="06115"
DO OTA
+11 QUIT
OTA ;EP;SYNCHRONIZE TRAVEL ADVANCE
+1 SET ACRREF=602
+2 SET ACRREFDA=$ORDER(^AUTTDOCR("B",602,0))
+3 NEW ACRDOCDA
+4 SET ACRDOCDA=$ORDER(^ACRDOC("B",ACRDOC,0))
+5 IF 'ACRDOCDA
QUIT
+6 SET ACRADV=ACRIVT
+7 DO OTA^ACRFSSA1
+8 QUIT
FYFUN ;EP;FISCAL YEAR OF FUNDS
+1 KILL ACRFY
+2 SET DIR(0)="NO^1000:9999"
+3 SET DIR("A")="FISCAL YEAR OF FUNDS"
+4 SET DIR("B")=$SELECT($EXTRACT(DT,4,5)<10:$EXTRACT(DT,1,3)+1700,1:($EXTRACT(DT,1,3)+1)+1700)
+5 DO DIR^ACRFDIC
+6 IF X["^"
SET ACROUT=""
QUIT
+7 IF $LENGTH(Y)'=4
WRITE !!,"FISCAL YEAR OF FUNDS REQUIRED",!
GOTO FYFUN
+8 SET ACRFYFUN=Y
+9 SET $PIECE(ACRLBDT,U)=ACRFYFUN
+10 QUIT
