ACRFPAYE ;IHS/OIRM/DSD/THL,AEF - MISC PM REPORTS; [ 01/03/2003 9:52 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**5**;NOV 05, 2001
;;
EFTRPT ;EP;TO PRINT ELECTRONIC FUNDS TRANSFER PROFILE
F D EFT1 Q:$D(ACRQUIT)!$D(ACROUT)
EFTEXIT K ACRQUIT,ACROUT
K ^TMP("ACREFTR",$J)
Q
EFT1 ;
N ACRBEGIN,ACREND,ACRDATE
K ^TMP("ACREFTR",$J)
W @IOF
W !?10,"Select beginning and ending dates for the"
W !?10,"ELECTRONIC FUNDS TRANSFER TO TREASURY PROFILE"
W !
D ^ACRFDATE
I '$G(ACRBEGIN)!'$G(ACREND) S ACRQUIT="" Q
S (ACRRTN,ZTRTN)="EFT2^ACRFPAYE"
S ZTDESC="ELECTRONIC FUNDS TRANSFER TO TREASURY PROFILE"
D ^ACRFZIS
Q
EFT2 ;EP;TO PRINT ELECTRONIC FUNDS TRANSFER PROFILE
D EFTHEAD
N ACROBJ,ACR0,ACRBAT,ACRVT,ACRREF,ACRREF2,ACRF,ACRF,ACRV,ACRB
N ACRFYDA,ACRBATDA,ACRSEQDA,ACRX,ACRXM,ACRP
S ACRDATE=ACRBEGIN-1
S ACRF="ACREFTR"
F S ACRDATE=$O(^AFSLAFP("EXP",ACRDATE)) Q:'ACRDATE!(ACRDATE>ACREND) D
.S ACRFYDA=0
.F S ACRFYDA=$O(^AFSLAFP("EXP",ACRDATE,ACRFYDA)) Q:'ACRFYDA D
..S ACRBATDA=0
..F S ACRBATDA=$O(^AFSLAFP("EXP",ACRDATE,ACRFYDA,ACRBATDA)) Q:'ACRBATDA D
...S ACR0=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,0))
...Q:ACR0=""
...S ACRBAT=$$BATCH^ACRFPAYE(ACRFYDA,ACRBATDA) ; Batch Type
...Q:ACRBAT=""
...Q:ACRBAT="G"
...S ACRVT=$P(ACR0,U,4) ; Vendor or Travel
...Q:ACRVT=""
...I ACRVT="T" D
....S ACRBAT=$S(ACRBAT="A":"D",ACRBAT="B":"E",ACRBAT="C":"F",ACRBAT="N":"O",1:ACRBAT)
...S ACRSEQDA=0
...F S ACRSEQDA=$O(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA)) Q:'ACRSEQDA D
....S ACRVT=$P(ACR0,U,4) ; Vendor or Travel
....S ACRX=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0))
....S ACROBJ=$P(ACRX,U,8)
....Q:ACROBJ=""
....S ACROBJ=$P(^AUTTOBJC(ACROBJ,0),U)
....Q:ACROBJ=""
....S ACRREF=$P(ACRX,U,5)
....S ACRREF2=$P(ACRX,U,6)
....S ACRP=$$NET^ACRFSSU(ACRFYDA,ACRBATDA,ACRSEQDA) ;NET TO TREASURY
....S ACRVT=$$BAT(ACRVT,ACRREF,ACRREF2,ACROBJ)
....I ACRREF=326 D Q ;COUNT CONTRACTS
.....I $E(ACROBJ,1,3)=418!(ACROBJ>2581&(ACROBJ<2586)) D Q
......D CNT(ACRF,"I",ACRBAT,ACRP) Q ; Tribal
.....D CNT(ACRF,"X",ACRBAT,ACRP)
....D CNT(ACRF,ACRVT,ACRBAT,ACRP)
;
N A,B,C,D,E,F,G,STR,STR1,STR2,CNT
F A="V","X","VTOT","T","AIR","TTOT","I","ITOT","TOT" D
.I A["TOT" D Q
..S STR=$G(^TMP(ACRF,$J,A,"TOT"))
..S (B1,B2)=" "
..S STR1=$G(^TMP(ACRF,$J,A,"ACH"))
..S STR2=$G(^TMP(ACRF,$J,A,"CHK"))
..D WRITE(A,B1,STR1,B2,STR2,STR,.CNT)
.S G="" K CNT F S G=$O(^TMP(ACRF,$J,A,G)) Q:G="" D
..S STR=$G(^TMP(ACRF,$J,A,G))
..S B1=$E(G,1),B2=$E(G,2)
..S STR1=$G(^TMP(ACRF,$J,A,G,B1))
..S STR2=$G(^TMP(ACRF,$J,A,G,B2))
..D WRITE(A,B1,STR1,B2,STR2,STR,.CNT)
W $$DASH^ACRFMENU
D PAUSE^ACRFWARN
Q
WRITE(A,B,C,D,E,F,CNT) ;LOCAL ENTRY TO WRITE PROFILE
N T
D TITLE(A,.CNT,.T)
N C1,C2,E1,E2
S C1=$P(C,U)
S C2=$P(C,U,2)
S E1=$P(E,U)
S E2=$P(E,U,2)
S F1=$P(F,U)
S F2=$P(F,U,2)
I A["TOT" D W !
.I A'="TOT" D
..W !,?13,"|-----",?19,"|---------------",?35,"|-----"
..W ?41,"|---------------",?57,"|-----",?63,"|----------------"
.W !?13 F J=1:1:67 W "_"
W !,T,?13,"|"_B,$J(C1,4),?19,"|",$J($FN(C2,"P,",2),15)
W ?35,"|"_D,$J(E1,4),?41,"|",$J($FN(E2,"P,",2),15)
W ?57,"|",$J(F1,5),"|"
W ?63,$J($FN(F2,"P,",2),16)
Q
TITLE(A,CNT,T) ;LOCAL ENTRY
; RETURNS TITLE
S T=""
I A="V",'$G(CNT) S T="VENDOR" W ! S CNT=1
I A="T",'$G(CNT) S T="TRAVEL" W !,$$DASH^ACRFMENU,! S CNT=1
I A="I",'$G(CNT) S T="TRIBAL" W !,$$DASH^ACRFMENU,! S CNT=1
I A="X",'$G(CNT) S T=" CONTRACT" D WRT(.CNT)
I A="AIR",'$G(CNT) S T=" AIRLINE" D WRT(.CNT)
I A="VTOT" S T=" VENDOR TOTAL"
I A="TTOT" S T=" TRAVEL TOTAL"
I A="ITOT" S T=" TRIBAL TOTAL"
I A="TOT" S T="GRAND TOTAL",CNT=1
Q
WRT(CNT) ;LOCAL ENTRY
S CNT=1
W !,?13,"|-----",?19,"|---------------",?35,"|-----"
W ?41,"|---------------",?57,"|-----",?63,"|----------------"
W !
Q
EFTHEAD ;
W @IOF
W !?10,"INDIAN HEALTH SERVICE"
W !?10,$P($G(^AUTTAREA(+$G(^ACRSYS(1,0)),0)),U)," AREA OFFICE"
W !!?10,"ELECTRONIC FUNDS TRANSFER TO TREASURY PROFILE"
W !?10,"REPORT DATE: "
S Y=DT
X ^DD("DD")
W Y
W !?10,"REPORT FROM: "
S Y=ACRBEGIN
X ^DD("DD")
W Y
W !?10,"REPORT TO..: "
S Y=ACREND
X ^DD("DD")
W Y
W $$DASH^ACRFMENU
W !!,?13,"| EFT",?35,"| NON-EFT",?57,"|TOTAL",?63,"| TOTAL"
W !,"PAYMENT TYPE",?13,"| NO. ",?19,"| DOLLARS",?35,"| NO. "
W ?41,"| DOLLARS",?57,"| NO. ",?63,"| DOLLARS"
W $$DASH^ACRFMENU
Q
CNT(F,V,B,P) ;LOCAL ENTRY - COUNT NON-CHECKS
;
N T,G
S T="UNKNOWN"_ACRX
I "ABDE"[B S T="ACH"
I "CFNO"[B S T="CHK"
S G=$$GRP(B)
I G="UNKNOWN" S ^TMP(F,$J,"ERROR",X)="" Q
;
S $P(^TMP(F,$J,V,G,B),U)=$P($G(^TMP(F,$J,V,G,B)),U)+1
S $P(^TMP(F,$J,V,G,B),U,2)=$P($G(^TMP(F,$J,V,G,B)),U,2)+P
S $P(^TMP(F,$J,V,G),U)=$P($G(^TMP(F,$J,V,G)),U)+1
S $P(^TMP(F,$J,V,G),U,2)=$P($G(^TMP(F,$J,V,G)),U,2)+P
;
;SUB AND GRAND TOTALS
S $P(^TMP(F,$J,"TOT",T),U)=$P($G(^TMP(F,$J,"TOT",T)),U)+1
S $P(^TMP(F,$J,"TOT",T),U,2)=$P($G(^TMP(F,$J,"TOT",T)),U,2)+P
S $P(^TMP(F,$J,"TOT","TOT"),U)=$P($G(^TMP(F,$J,"TOT","TOT")),U)+1
S $P(^TMP(F,$J,"TOT","TOT"),U,2)=$P($G(^TMP(F,$J,"TOT","TOT")),U,2)+P
I V["X"!(V["AIR") D
.S:V["X" V="V"
.S:V["AIR" V="T"
S $P(^TMP(F,$J,V_"TOT",T),U)=$P($G(^TMP(F,$J,V_"TOT",T)),U)+1
S $P(^TMP(F,$J,V_"TOT",T),U,2)=$P($G(^TMP(F,$J,V_"TOT",T)),U,2)+P
S $P(^TMP(F,$J,V_"TOT","TOT"),U)=$P($G(^TMP(F,$J,V_"TOT","TOT")),U)+1
S $P(^TMP(F,$J,V_"TOT","TOT"),U,2)=$P($G(^TMP(F,$J,V_"TOT","TOT")),U,2)+P
Q
BAT(VT,ACRR,ACRR2,ACRO) ;LOCAL EXTRINSIC FUNCTION
; ENTERS WITH REFERENCE CODES
;CHANGES VENDOR TO TRAVEL IF AIRLINE PAYMENT
;
I VT="V",ACRR=130,$E(ACRO,1,3)=221!($E(ACRO,1,3)=121) Q "T"
I ACRR=602!(ACRR2=602) Q "T" ; TRAVEL ADVANCE
I ACRO="219M"!(ACRR=618) Q "AIR"
I VT="V",ACRR=130 Q "AIR"
I ACRR'=618,ACRR2'=618 Q VT ; NOT AIRLINE
Q "AIR" ; AIRLINE, CHANGE TO TRAVEL
;
GRP(B) ;LOCAL FORENSIC FUNCTION
;ENTERS WITH BATCH PREFIX
;RETURN GROUP DESIGNATION
I "AC"[B Q "AC"
I "BN"[B Q "BN"
I "DF"[B Q "DF"
I "EO"[B Q "EO"
Q B
;
BATCH(ACRFYDA,ACRBATDA) ;LOCAL ENTRY; EXTRINSIC FUNCTION
; Enters with EIN for 1166 Approvals for Payment file
; Returns Batch type
N ACRTMP,ACRBAT
S ACRTMP=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,2))
S ACRBAT=$P(ACRTMP,U,8)
Q ACRBAT
ACRFPAYE ;IHS/OIRM/DSD/THL,AEF - MISC PM REPORTS; [ 01/03/2003 9:52 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**5**;NOV 05, 2001
+2 ;;
EFTRPT ;EP;TO PRINT ELECTRONIC FUNDS TRANSFER PROFILE
+1 FOR
DO EFT1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
EFTEXIT KILL ACRQUIT,ACROUT
+1 KILL ^TMP("ACREFTR",$JOB)
+2 QUIT
EFT1 ;
+1 NEW ACRBEGIN,ACREND,ACRDATE
+2 KILL ^TMP("ACREFTR",$JOB)
+3 WRITE @IOF
+4 WRITE !?10,"Select beginning and ending dates for the"
+5 WRITE !?10,"ELECTRONIC FUNDS TRANSFER TO TREASURY PROFILE"
+6 WRITE !
+7 DO ^ACRFDATE
+8 IF '$GET(ACRBEGIN)!'$GET(ACREND)
SET ACRQUIT=""
QUIT
+9 SET (ACRRTN,ZTRTN)="EFT2^ACRFPAYE"
+10 SET ZTDESC="ELECTRONIC FUNDS TRANSFER TO TREASURY PROFILE"
+11 DO ^ACRFZIS
+12 QUIT
EFT2 ;EP;TO PRINT ELECTRONIC FUNDS TRANSFER PROFILE
+1 DO EFTHEAD
+2 NEW ACROBJ,ACR0,ACRBAT,ACRVT,ACRREF,ACRREF2,ACRF,ACRF,ACRV,ACRB
+3 NEW ACRFYDA,ACRBATDA,ACRSEQDA,ACRX,ACRXM,ACRP
+4 SET ACRDATE=ACRBEGIN-1
+5 SET ACRF="ACREFTR"
+6 FOR
SET ACRDATE=$ORDER(^AFSLAFP("EXP",ACRDATE))
IF 'ACRDATE!(ACRDATE>ACREND)
QUIT
Begin DoDot:1
+7 SET ACRFYDA=0
+8 FOR
SET ACRFYDA=$ORDER(^AFSLAFP("EXP",ACRDATE,ACRFYDA))
IF 'ACRFYDA
QUIT
Begin DoDot:2
+9 SET ACRBATDA=0
+10 FOR
SET ACRBATDA=$ORDER(^AFSLAFP("EXP",ACRDATE,ACRFYDA,ACRBATDA))
IF 'ACRBATDA
QUIT
Begin DoDot:3
+11 SET ACR0=$GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,0))
+12 IF ACR0=""
QUIT
+13 ; Batch Type
SET ACRBAT=$$BATCH^ACRFPAYE(ACRFYDA,ACRBATDA)
+14 IF ACRBAT=""
QUIT
+15 IF ACRBAT="G"
QUIT
+16 ; Vendor or Travel
SET ACRVT=$PIECE(ACR0,U,4)
+17 IF ACRVT=""
QUIT
+18 IF ACRVT="T"
Begin DoDot:4
+19 SET ACRBAT=$SELECT(ACRBAT="A":"D",ACRBAT="B":"E",ACRBAT="C":"F",ACRBAT="N":"O",1:ACRBAT)
End DoDot:4
+20 SET ACRSEQDA=0
+21 FOR
SET ACRSEQDA=$ORDER(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA))
IF 'ACRSEQDA
QUIT
Begin DoDot:4
+22 ; Vendor or Travel
SET ACRVT=$PIECE(ACR0,U,4)
+23 SET ACRX=$GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0))
+24 SET ACROBJ=$PIECE(ACRX,U,8)
+25 IF ACROBJ=""
QUIT
+26 SET ACROBJ=$PIECE(^AUTTOBJC(ACROBJ,0),U)
+27 IF ACROBJ=""
QUIT
+28 SET ACRREF=$PIECE(ACRX,U,5)
+29 SET ACRREF2=$PIECE(ACRX,U,6)
+30 ;NET TO TREASURY
SET ACRP=$$NET^ACRFSSU(ACRFYDA,ACRBATDA,ACRSEQDA)
+31 SET ACRVT=$$BAT(ACRVT,ACRREF,ACRREF2,ACROBJ)
+32 ;COUNT CONTRACTS
IF ACRREF=326
Begin DoDot:5
+33 IF $EXTRACT(ACROBJ,1,3)=418!(ACROBJ>2581&(ACROBJ<2586))
Begin DoDot:6
+34 ; Tribal
DO CNT(ACRF,"I",ACRBAT,ACRP)
QUIT
End DoDot:6
QUIT
+35 DO CNT(ACRF,"X",ACRBAT,ACRP)
End DoDot:5
QUIT
+36 DO CNT(ACRF,ACRVT,ACRBAT,ACRP)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+37 ;
+38 NEW A,B,C,D,E,F,G,STR,STR1,STR2,CNT
+39 FOR A="V","X","VTOT","T","AIR","TTOT","I","ITOT","TOT"
Begin DoDot:1
+40 IF A["TOT"
Begin DoDot:2
+41 SET STR=$GET(^TMP(ACRF,$JOB,A,"TOT"))
+42 SET (B1,B2)=" "
+43 SET STR1=$GET(^TMP(ACRF,$JOB,A,"ACH"))
+44 SET STR2=$GET(^TMP(ACRF,$JOB,A,"CHK"))
+45 DO WRITE(A,B1,STR1,B2,STR2,STR,.CNT)
End DoDot:2
QUIT
+46 SET G=""
KILL CNT
FOR
SET G=$ORDER(^TMP(ACRF,$JOB,A,G))
IF G=""
QUIT
Begin DoDot:2
+47 SET STR=$GET(^TMP(ACRF,$JOB,A,G))
+48 SET B1=$EXTRACT(G,1)
SET B2=$EXTRACT(G,2)
+49 SET STR1=$GET(^TMP(ACRF,$JOB,A,G,B1))
+50 SET STR2=$GET(^TMP(ACRF,$JOB,A,G,B2))
+51 DO WRITE(A,B1,STR1,B2,STR2,STR,.CNT)
End DoDot:2
End DoDot:1
+52 WRITE $$DASH^ACRFMENU
+53 DO PAUSE^ACRFWARN
+54 QUIT
WRITE(A,B,C,D,E,F,CNT) ;LOCAL ENTRY TO WRITE PROFILE
+1 NEW T
+2 DO TITLE(A,.CNT,.T)
+3 NEW C1,C2,E1,E2
+4 SET C1=$PIECE(C,U)
+5 SET C2=$PIECE(C,U,2)
+6 SET E1=$PIECE(E,U)
+7 SET E2=$PIECE(E,U,2)
+8 SET F1=$PIECE(F,U)
+9 SET F2=$PIECE(F,U,2)
+10 IF A["TOT"
Begin DoDot:1
+11 IF A'="TOT"
Begin DoDot:2
+12 WRITE !,?13,"|-----",?19,"|---------------",?35,"|-----"
+13 WRITE ?41,"|---------------",?57,"|-----",?63,"|----------------"
End DoDot:2
+14 WRITE !?13
FOR J=1:1:67
WRITE "_"
End DoDot:1
WRITE !
+15 WRITE !,T,?13,"|"_B,$JUSTIFY(C1,4),?19,"|",$JUSTIFY($FNUMBER(C2,"P,",2),15)
+16 WRITE ?35,"|"_D,$JUSTIFY(E1,4),?41,"|",$JUSTIFY($FNUMBER(E2,"P,",2),15)
+17 WRITE ?57,"|",$JUSTIFY(F1,5),"|"
+18 WRITE ?63,$JUSTIFY($FNUMBER(F2,"P,",2),16)
+19 QUIT
TITLE(A,CNT,T) ;LOCAL ENTRY
+1 ; RETURNS TITLE
+2 SET T=""
+3 IF A="V"
IF '$GET(CNT)
SET T="VENDOR"
WRITE !
SET CNT=1
+4 IF A="T"
IF '$GET(CNT)
SET T="TRAVEL"
WRITE !,$$DASH^ACRFMENU,!
SET CNT=1
+5 IF A="I"
IF '$GET(CNT)
SET T="TRIBAL"
WRITE !,$$DASH^ACRFMENU,!
SET CNT=1
+6 IF A="X"
IF '$GET(CNT)
SET T=" CONTRACT"
DO WRT(.CNT)
+7 IF A="AIR"
IF '$GET(CNT)
SET T=" AIRLINE"
DO WRT(.CNT)
+8 IF A="VTOT"
SET T=" VENDOR TOTAL"
+9 IF A="TTOT"
SET T=" TRAVEL TOTAL"
+10 IF A="ITOT"
SET T=" TRIBAL TOTAL"
+11 IF A="TOT"
SET T="GRAND TOTAL"
SET CNT=1
+12 QUIT
WRT(CNT) ;LOCAL ENTRY
+1 SET CNT=1
+2 WRITE !,?13,"|-----",?19,"|---------------",?35,"|-----"
+3 WRITE ?41,"|---------------",?57,"|-----",?63,"|----------------"
+4 WRITE !
+5 QUIT
EFTHEAD ;
+1 WRITE @IOF
+2 WRITE !?10,"INDIAN HEALTH SERVICE"
+3 WRITE !?10,$PIECE($GET(^AUTTAREA(+$GET(^ACRSYS(1,0)),0)),U)," AREA OFFICE"
+4 WRITE !!?10,"ELECTRONIC FUNDS TRANSFER TO TREASURY PROFILE"
+5 WRITE !?10,"REPORT DATE: "
+6 SET Y=DT
+7 XECUTE ^DD("DD")
+8 WRITE Y
+9 WRITE !?10,"REPORT FROM: "
+10 SET Y=ACRBEGIN
+11 XECUTE ^DD("DD")
+12 WRITE Y
+13 WRITE !?10,"REPORT TO..: "
+14 SET Y=ACREND
+15 XECUTE ^DD("DD")
+16 WRITE Y
+17 WRITE $$DASH^ACRFMENU
+18 WRITE !!,?13,"| EFT",?35,"| NON-EFT",?57,"|TOTAL",?63,"| TOTAL"
+19 WRITE !,"PAYMENT TYPE",?13,"| NO. ",?19,"| DOLLARS",?35,"| NO. "
+20 WRITE ?41,"| DOLLARS",?57,"| NO. ",?63,"| DOLLARS"
+21 WRITE $$DASH^ACRFMENU
+22 QUIT
CNT(F,V,B,P) ;LOCAL ENTRY - COUNT NON-CHECKS
+1 ;
+2 NEW T,G
+3 SET T="UNKNOWN"_ACRX
+4 IF "ABDE"[B
SET T="ACH"
+5 IF "CFNO"[B
SET T="CHK"
+6 SET G=$$GRP(B)
+7 IF G="UNKNOWN"
SET ^TMP(F,$JOB,"ERROR",X)=""
QUIT
+8 ;
+9 SET $PIECE(^TMP(F,$JOB,V,G,B),U)=$PIECE($GET(^TMP(F,$JOB,V,G,B)),U)+1
+10 SET $PIECE(^TMP(F,$JOB,V,G,B),U,2)=$PIECE($GET(^TMP(F,$JOB,V,G,B)),U,2)+P
+11 SET $PIECE(^TMP(F,$JOB,V,G),U)=$PIECE($GET(^TMP(F,$JOB,V,G)),U)+1
+12 SET $PIECE(^TMP(F,$JOB,V,G),U,2)=$PIECE($GET(^TMP(F,$JOB,V,G)),U,2)+P
+13 ;
+14 ;SUB AND GRAND TOTALS
+15 SET $PIECE(^TMP(F,$JOB,"TOT",T),U)=$PIECE($GET(^TMP(F,$JOB,"TOT",T)),U)+1
+16 SET $PIECE(^TMP(F,$JOB,"TOT",T),U,2)=$PIECE($GET(^TMP(F,$JOB,"TOT",T)),U,2)+P
+17 SET $PIECE(^TMP(F,$JOB,"TOT","TOT"),U)=$PIECE($GET(^TMP(F,$JOB,"TOT","TOT")),U)+1
+18 SET $PIECE(^TMP(F,$JOB,"TOT","TOT"),U,2)=$PIECE($GET(^TMP(F,$JOB,"TOT","TOT")),U,2)+P
+19 IF V["X"!(V["AIR")
Begin DoDot:1
+20 IF V["X"
SET V="V"
+21 IF V["AIR"
SET V="T"
End DoDot:1
+22 SET $PIECE(^TMP(F,$JOB,V_"TOT",T),U)=$PIECE($GET(^TMP(F,$JOB,V_"TOT",T)),U)+1
+23 SET $PIECE(^TMP(F,$JOB,V_"TOT",T),U,2)=$PIECE($GET(^TMP(F,$JOB,V_"TOT",T)),U,2)+P
+24 SET $PIECE(^TMP(F,$JOB,V_"TOT","TOT"),U)=$PIECE($GET(^TMP(F,$JOB,V_"TOT","TOT")),U)+1
+25 SET $PIECE(^TMP(F,$JOB,V_"TOT","TOT"),U,2)=$PIECE($GET(^TMP(F,$JOB,V_"TOT","TOT")),U,2)+P
+26 QUIT
BAT(VT,ACRR,ACRR2,ACRO) ;LOCAL EXTRINSIC FUNCTION
+1 ; ENTERS WITH REFERENCE CODES
+2 ;CHANGES VENDOR TO TRAVEL IF AIRLINE PAYMENT
+3 ;
+4 IF VT="V"
IF ACRR=130
IF $EXTRACT(ACRO,1,3)=221!($EXTRACT(ACRO,1,3)=121)
QUIT "T"
+5 ; TRAVEL ADVANCE
IF ACRR=602!(ACRR2=602)
QUIT "T"
+6 IF ACRO="219M"!(ACRR=618)
QUIT "AIR"
+7 IF VT="V"
IF ACRR=130
QUIT "AIR"
+8 ; NOT AIRLINE
IF ACRR'=618
IF ACRR2'=618
QUIT VT
+9 ; AIRLINE, CHANGE TO TRAVEL
QUIT "AIR"
+10 ;
GRP(B) ;LOCAL FORENSIC FUNCTION
+1 ;ENTERS WITH BATCH PREFIX
+2 ;RETURN GROUP DESIGNATION
+3 IF "AC"[B
QUIT "AC"
+4 IF "BN"[B
QUIT "BN"
+5 IF "DF"[B
QUIT "DF"
+6 IF "EO"[B
QUIT "EO"
+7 QUIT B
+8 ;
BATCH(ACRFYDA,ACRBATDA) ;LOCAL ENTRY; EXTRINSIC FUNCTION
+1 ; Enters with EIN for 1166 Approvals for Payment file
+2 ; Returns Batch type
+3 NEW ACRTMP,ACRBAT
+4 SET ACRTMP=$GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,2))
+5 SET ACRBAT=$PIECE(ACRTMP,U,8)
+6 QUIT ACRBAT
