ACRFSSU ;IHS/OIRM/DSD/AEF - UTILITY ROUTINE: CALCULATE TRAVEL VOUCHER AMOUNTS [ 08/18/2006 3:00 PM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**5,17,20**;NOV 05, 2001
;
;
;This routine calculates the Total Expenses, Reimbursable,
;and other amounts for the travel voucher.
;
PERDIEM(ACRDOCDA) ;EP
;----- EXTRINSIC FUNCTION - CALCULATE PER DIEM
;
; INPUT:
; ACRDOCDA = DOCUMENT IEN
;
; RETURNS: PER DIEM AMOUNT
;
N X,Y
S X=$$TOTALS(ACRDOCDA)
S Y=$P(X,U,5)+$P(X,U,6)
Q Y
;
OTHER(ACRDOCDA) ;EP
;----- EXTRINSIC FUNCTION - CALCULATE OTHER CHARGES
;
; INPUT:
; ACRDOCDA = DOCUMENT IEN
;
; RETURNS: OTHER COLUMN AMOUNT
;
N X,Y
S X=$$TOTALS(ACRDOCDA)
S Y=$P(X,U,10)+$P(X,U,32)-$P(X,U,31)
Q Y
;
TOTOTH(ACRDOCDA) ;EP
;----- EXTRINSIC FUNCTION - CALCULATE GRAND TOTAL OTHER
;
; INPUT:
; ACRDOCDA = DOCUMENT IEN
;
; RETURNS: GRAND TOTAL OTHER AMOUNT
;
N X,Y
S X=$$TOTALS(ACRDOCDA)
S Y=$P(X,U,30)+$P(X,U,31)+$P(X,U,8)+$P(X,U,9)+$$OTHER(ACRDOCDA)
Q Y
;
REIMB(ACRDOCDA) ;EP
;----- EXTRINSIC FUNCTION - CALCULATE TRAVEL VOUCHER REIMBURSABLE
;
; INPUT:
; ACRDOCDA = DOCUMENT IEN
;
; RETURNS: TRAVEL VOUCHER REIMBURSABLE AMOUNT
;
N X,Y
S Y=0
S X=$$TOTALS(ACRDOCDA)
S Y=$P(X,U,5)+$P(X,U,6)+$P(X,U,8)+$P(X,U,9)+$P(X,U,10)+$P(X,U,15)+$P(X,U,30)+$P(X,U,32)+$P(X,U,36)
I $P($G(^ACRDOC(ACRDOCDA,"TOAU")),U,5)=1 S Y=Y+$P(X,U,33)
I $P($G(^ACRSYS(1,400)),U,4) S Y=Y+$P(X,U,37)
S Y=Y-$P(X,U,34)
S Y=$$DOL^ACRFUTL(Y)
Q Y
;
TOTAMT(ACRDOCDA) ;EP
;----- EXTRINSIC FUNCTION - CALCULATE TOTAL AMOUNT CLAIMED
;
; INPUT:
; ACRDOCDA = DOCUMENT IEN
;
; RETURNS: TRAVEL VOUCHER TOTAL AMOUNT CLAIMED
;
N X,Y
S X=$$TOTALS(ACRDOCDA)
S Y=$P(X,U,33)+$$PERDIEM(ACRDOCDA)+$P(X,U,37)+$P(X,U,15)+$$TOTOTH(ACRDOCDA)+$P(X,U,36)
Q Y
;
MILES(ACRDOCDA) ;EP
;----- EXTRINSIC FUNCTION - CALCULATE TOTAL MILEAGE COST
;
; INPUT:
; ACRDOCDA = DOCUMENT IEN
;
; RETURNS: TRAVEL VOUCHER TOTAL MILEAGE COST
;
N X,Y
S X=$$TOTALS(ACRDOCDA)
S Y=$P(X,U,30)+$P(X,U,31)
Q Y
;
TOTALS(ACRDOCDA) ;EP
;----- EXTRINSIC FUNCTION - RETURN STRING CONTAINING TOTALS
;
; INPUT:
; ACRDOCDA = DOCUMENT IEN
;
; RETURNS: STRING CONTAINING TRAVEL AMOUNT TOTALS
;
N ACRDAY,ACRDUZ,X,Y
S Y=""
S ACRDAY=0
F S ACRDAY=$O(^ACRTV("D",ACRDOCDA,ACRDAY)) Q:'ACRDAY D
. S X=^ACRTV(ACRDAY,"DT")
. S $P(Y,U,5)=$P(Y,U,5)+$P(X,U,5) ;MEALS M&IE
. S $P(Y,U,6)=$P(Y,U,6)+$P(X,U,6) ;LODGING
. S $P(Y,U,7)=$P(Y,U,7)+$P(X,U,7) ;MILES TO AIRPT
. S $P(Y,U,8)=$P(Y,U,8)+$P(X,U,8) ;TAXI/SHUTTLE
. S $P(Y,U,9)=$P(Y,U,9)+$P(X,U,9) ;PHONE HOME
. S $P(Y,U,10)=$P(Y,U,10)+$P(X,U,10) ;OTHER
. S $P(Y,U,15)=$P(Y,U,15)+$P(X,U,15) ;RENTAL CAR
. S $P(Y,U,20)=$P(Y,U,20) ;MILEAGE RATE
. S $P(Y,U,21)=$P(Y,U,21)+$P(X,U,21) ;POV/OTH MILES
. S $P(Y,U,22)=$P(Y,U,22)+$P(X,U,22) ;AIRPORT PARKING
. S $P(Y,U,23)=$P(X,U,23) ;POV MILE RATE
. S $P(Y,U,30)=$P(Y,U,30)+($P(X,U,21)*$P(X,U,23)) ;TOTAL POV MILEAGE COST
. S $P(Y,U,31)=$P(Y,U,31)+($P(X,U,7)*$P(X,U,20)) ;TOTAL MILES TO AIRPORT COST
. S $P(Y,U,32)=$P(Y,U,31)+$P(Y,U,22) ;AIRPT MLS+PK
. S $P(Y,U,38)=$P(Y,U,38)+1 ;# TRAVEL DAYS
S $P(Y,U,33)=$$AIRLINE(ACRDOCDA) ;AIRLINE COST
S $P(Y,U,34)=$P($G(^ACROTA(ACRDOCDA,0)),U,3) ;TRAVEL ADV
S $P(Y,U,35)=$P($G(^ACROTA(ACRDOCDA,0)),U,4) ;TA LIQUIDATED
S $P(Y,U,36)=$P($G(^ACRDOC(ACRDOCDA,"TO")),U,26) ;ATM CHG
S $P(Y,U,37)=$$TMFEE(ACRDOCDA) ;TRAVEL MGT FEE
;
;----- Adjust PHONE HOME rate to MAXIMUM AMOUNT whichever is less
I $P($G(^ACRSYS(1,"DT")),U,17) D
. S X=($P(Y,U,38)-1)*$P($G(^ACRSYS(1,"DT")),U,17)
. I X,X<$P(Y,U,9) D
. . S $P(Y,U,9)=X
;
;----- Adjust POV MILEAGE COST to MAXIMUM POV TRANSPORTATION EXPENSE
; whichever is less
S X=$P($G(^ACRDOC(ACRDOCDA,"TOAU")),U,6) ;MAX POV EXP
I X,X<$P(Y,U,30) D
. S $P(Y,U,30)=X
;
;----- Adjust MAXIMUM MILES TO AIRPORT+AIRPORT PARKING EXPENSE to
; AVERAGE ROUNDTRIP COST BY TAXI FROM HOME TO AIRPORT whichever
; is less
S ACRDUZ=$P($G(^ACRDOC(ACRDOCDA,"TO")),U,9)
S X=$P($G(^ACRAU(ACRDUZ,1)),U,9) ;MAX APT MLS+PK
I X,X<($P(Y,U,22)+$P(Y,U,31)) D
. S $P(Y,U,32)=X
Q Y
;
AIRLINE(ACRDOCDA) ;EP
;----- EXTRINSIC FUNCTION - CALCULATE AIRLINE COST
;
; INPUT:
; ACRDOCDA = DOCUMENT IEN
;
; RETURNS: AIRLINE COST FOR TRAVEL
;
N X,Y
S (X,Y)=0
F S X=$O(^ACRAL("E",ACRDOCDA,X)) Q:'X D
. S Y=Y+$P($G(^ACRAL(X,"DT")),U,9)
Q Y
;
TMFEE(ACRDOCDA) ;EP
;----- EXTRINSIC FUNCTION - RETURN TRAVEL MANAGEMENT FEE
;
; INPUT:
; ACRDOCDA = DOCUMENT IEN
;
; RETURNS: TRAVEL MANAGEMENT FEE
;
N X,Y
S (X,Y)=0
F S X=$O(^ACRSS("C",ACRDOCDA,X)) Q:'X D
. Q:$P($G(^ACRSS(X,"NMS")),U,5)'="Travel Mgt Fee"
. S Y=Y+$P($G(^ACRSS(X,"DT")),U,4)
Q Y
OBLS(ACRDOCDA) ;EP
;----- EXTRINSIC FUNCTION - RETURNS TOTAL OBLIGATIONS FOR A
; DOCUMENT
;
N AMT,D0,X,Y
S (D0,Y)=0
F S D0=$O(^ACRDHR("E",ACRDOCDA,D0)) Q:'D0 D
. S X=$G(^ACRDHR(D0,1))
. Q:$P(X,U,3)'="050"
. S AMT=$P(X,U,14)
. S AMT=+AMT/100
. I $P(X,U,4)=2 S AMT=0-AMT
. S Y=Y+AMT
Q Y
PMTS(ACRDOCDA) ;EP
;----- EXTRINSIC FUNCTION - RETURNS TOTAL PAYMENTS AGAINST A
; DOCUMENT
;
N AMT,D0,X,Y
S (D0,Y)=0
F S D0=$O(^ACRDHR("E",ACRDOCDA,D0)) Q:'D0 D
. S X=$G(^ACRDHR(D0,1))
. Q:"^181^182^190^191^192"'[$P(X,U,3)
. S AMT=$P(X,U,14)
. S AMT=+AMT/100
. I $P(X,U,4)=2 S AMT=0-AMT
. S Y=Y+AMT
Q Y
NET(D0,D1,D2) ;EP
;----- EXTRINSIC FUNCTION - USED BY ACR REVIEW PAYMENT-T SCREENMAN
; FORM TO RETURN THE NET TO TRAVELER AMOUNT FOR TRAVEL
; PAYMENTS
; RETURNS PAYMENT AMOUNT FOR ALL TRANSACTION CODES
; AMOUNT ADJUSTED TO SUBTRACT DIS-AMT IF PRESENT
; AMOUNT ADJUSTED; NOT SUBTRACTED IF TRAVEL ADVANCE
;
;N X,Y ;ACR*2.1*17.12 IM17438
N X,Y,ACRBTYP ;ACR*2.1*17.12 IM17438
S Y=0
S ACRBTYP=$P($G(^AFSLAFP(D0,1,D1,0)),U,4) ;ACR*2.1*17.12 IM17438
S X=$G(^AFSLAFP(D0,1,D1,1,D2,0))
S Y=$P(X,U,11) ;ACR*2.1*17.12 IM17438
I ACRBTYP="V" Q Y ;ACR*2.1*17.12 IM17438
S Y=$P(X,U,11)-$P(X,U,12) ;DEFAULT VALUE ;ACR*2.1*5.02
I $E($P(X,U,18),1,3)="061" D ;TRAVEL ADVANCE, DON'T SUBTRACT ;ACR*2.1*5.01
.I $P(X,U,12)>0 S Y=$P(X,U,12)
.I $P(X,U,12)'>0 S Y=$P(X,U,11)
Q Y
;
REQTP(X) ;EP ----- RETURNS REQUEST TYPE IEN^TRANSACTION TYPE NAME ;ACR*2.1*5.17 ACR*2.1*20.15
;
; X = DOCUMENT IEN
;
N Y
S Y=""
I X S Y=$P($G(^ACRDOC(X,0)),U,4)
I Y S Y=Y_U_$P($G(^ACRTXTYP(Y,0)),U)
Q Y
ACRFSSU ;IHS/OIRM/DSD/AEF - UTILITY ROUTINE: CALCULATE TRAVEL VOUCHER AMOUNTS [ 08/18/2006 3:00 PM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**5,17,20**;NOV 05, 2001
+2 ;
+3 ;
+4 ;This routine calculates the Total Expenses, Reimbursable,
+5 ;and other amounts for the travel voucher.
+6 ;
PERDIEM(ACRDOCDA) ;EP
+1 ;----- EXTRINSIC FUNCTION - CALCULATE PER DIEM
+2 ;
+3 ; INPUT:
+4 ; ACRDOCDA = DOCUMENT IEN
+5 ;
+6 ; RETURNS: PER DIEM AMOUNT
+7 ;
+8 NEW X,Y
+9 SET X=$$TOTALS(ACRDOCDA)
+10 SET Y=$PIECE(X,U,5)+$PIECE(X,U,6)
+11 QUIT Y
+12 ;
OTHER(ACRDOCDA) ;EP
+1 ;----- EXTRINSIC FUNCTION - CALCULATE OTHER CHARGES
+2 ;
+3 ; INPUT:
+4 ; ACRDOCDA = DOCUMENT IEN
+5 ;
+6 ; RETURNS: OTHER COLUMN AMOUNT
+7 ;
+8 NEW X,Y
+9 SET X=$$TOTALS(ACRDOCDA)
+10 SET Y=$PIECE(X,U,10)+$PIECE(X,U,32)-$PIECE(X,U,31)
+11 QUIT Y
+12 ;
TOTOTH(ACRDOCDA) ;EP
+1 ;----- EXTRINSIC FUNCTION - CALCULATE GRAND TOTAL OTHER
+2 ;
+3 ; INPUT:
+4 ; ACRDOCDA = DOCUMENT IEN
+5 ;
+6 ; RETURNS: GRAND TOTAL OTHER AMOUNT
+7 ;
+8 NEW X,Y
+9 SET X=$$TOTALS(ACRDOCDA)
+10 SET Y=$PIECE(X,U,30)+$PIECE(X,U,31)+$PIECE(X,U,8)+$PIECE(X,U,9)+$$OTHER(ACRDOCDA)
+11 QUIT Y
+12 ;
REIMB(ACRDOCDA) ;EP
+1 ;----- EXTRINSIC FUNCTION - CALCULATE TRAVEL VOUCHER REIMBURSABLE
+2 ;
+3 ; INPUT:
+4 ; ACRDOCDA = DOCUMENT IEN
+5 ;
+6 ; RETURNS: TRAVEL VOUCHER REIMBURSABLE AMOUNT
+7 ;
+8 NEW X,Y
+9 SET Y=0
+10 SET X=$$TOTALS(ACRDOCDA)
+11 SET Y=$PIECE(X,U,5)+$PIECE(X,U,6)+$PIECE(X,U,8)+$PIECE(X,U,9)+$PIECE(X,U,10)+$PIECE(X,U,15)+$PIECE(X,U,30)+$PIECE(X,U,32)+$PIECE(X,U,36)
+12 IF $PIECE($GET(^ACRDOC(ACRDOCDA,"TOAU")),U,5)=1
SET Y=Y+$PIECE(X,U,33)
+13 IF $PIECE($GET(^ACRSYS(1,400)),U,4)
SET Y=Y+$PIECE(X,U,37)
+14 SET Y=Y-$PIECE(X,U,34)
+15 SET Y=$$DOL^ACRFUTL(Y)
+16 QUIT Y
+17 ;
TOTAMT(ACRDOCDA) ;EP
+1 ;----- EXTRINSIC FUNCTION - CALCULATE TOTAL AMOUNT CLAIMED
+2 ;
+3 ; INPUT:
+4 ; ACRDOCDA = DOCUMENT IEN
+5 ;
+6 ; RETURNS: TRAVEL VOUCHER TOTAL AMOUNT CLAIMED
+7 ;
+8 NEW X,Y
+9 SET X=$$TOTALS(ACRDOCDA)
+10 SET Y=$PIECE(X,U,33)+$$PERDIEM(ACRDOCDA)+$PIECE(X,U,37)+$PIECE(X,U,15)+$$TOTOTH(ACRDOCDA)+$PIECE(X,U,36)
+11 QUIT Y
+12 ;
MILES(ACRDOCDA) ;EP
+1 ;----- EXTRINSIC FUNCTION - CALCULATE TOTAL MILEAGE COST
+2 ;
+3 ; INPUT:
+4 ; ACRDOCDA = DOCUMENT IEN
+5 ;
+6 ; RETURNS: TRAVEL VOUCHER TOTAL MILEAGE COST
+7 ;
+8 NEW X,Y
+9 SET X=$$TOTALS(ACRDOCDA)
+10 SET Y=$PIECE(X,U,30)+$PIECE(X,U,31)
+11 QUIT Y
+12 ;
TOTALS(ACRDOCDA) ;EP
+1 ;----- EXTRINSIC FUNCTION - RETURN STRING CONTAINING TOTALS
+2 ;
+3 ; INPUT:
+4 ; ACRDOCDA = DOCUMENT IEN
+5 ;
+6 ; RETURNS: STRING CONTAINING TRAVEL AMOUNT TOTALS
+7 ;
+8 NEW ACRDAY,ACRDUZ,X,Y
+9 SET Y=""
+10 SET ACRDAY=0
+11 FOR
SET ACRDAY=$ORDER(^ACRTV("D",ACRDOCDA,ACRDAY))
IF 'ACRDAY
QUIT
Begin DoDot:1
+12 SET X=^ACRTV(ACRDAY,"DT")
+13 ;MEALS M&IE
SET $PIECE(Y,U,5)=$PIECE(Y,U,5)+$PIECE(X,U,5)
+14 ;LODGING
SET $PIECE(Y,U,6)=$PIECE(Y,U,6)+$PIECE(X,U,6)
+15 ;MILES TO AIRPT
SET $PIECE(Y,U,7)=$PIECE(Y,U,7)+$PIECE(X,U,7)
+16 ;TAXI/SHUTTLE
SET $PIECE(Y,U,8)=$PIECE(Y,U,8)+$PIECE(X,U,8)
+17 ;PHONE HOME
SET $PIECE(Y,U,9)=$PIECE(Y,U,9)+$PIECE(X,U,9)
+18 ;OTHER
SET $PIECE(Y,U,10)=$PIECE(Y,U,10)+$PIECE(X,U,10)
+19 ;RENTAL CAR
SET $PIECE(Y,U,15)=$PIECE(Y,U,15)+$PIECE(X,U,15)
+20 ;MILEAGE RATE
SET $PIECE(Y,U,20)=$PIECE(Y,U,20)
+21 ;POV/OTH MILES
SET $PIECE(Y,U,21)=$PIECE(Y,U,21)+$PIECE(X,U,21)
+22 ;AIRPORT PARKING
SET $PIECE(Y,U,22)=$PIECE(Y,U,22)+$PIECE(X,U,22)
+23 ;POV MILE RATE
SET $PIECE(Y,U,23)=$PIECE(X,U,23)
+24 ;TOTAL POV MILEAGE COST
SET $PIECE(Y,U,30)=$PIECE(Y,U,30)+($PIECE(X,U,21)*$PIECE(X,U,23))
+25 ;TOTAL MILES TO AIRPORT COST
SET $PIECE(Y,U,31)=$PIECE(Y,U,31)+($PIECE(X,U,7)*$PIECE(X,U,20))
+26 ;AIRPT MLS+PK
SET $PIECE(Y,U,32)=$PIECE(Y,U,31)+$PIECE(Y,U,22)
+27 ;# TRAVEL DAYS
SET $PIECE(Y,U,38)=$PIECE(Y,U,38)+1
End DoDot:1
+28 ;AIRLINE COST
SET $PIECE(Y,U,33)=$$AIRLINE(ACRDOCDA)
+29 ;TRAVEL ADV
SET $PIECE(Y,U,34)=$PIECE($GET(^ACROTA(ACRDOCDA,0)),U,3)
+30 ;TA LIQUIDATED
SET $PIECE(Y,U,35)=$PIECE($GET(^ACROTA(ACRDOCDA,0)),U,4)
+31 ;ATM CHG
SET $PIECE(Y,U,36)=$PIECE($GET(^ACRDOC(ACRDOCDA,"TO")),U,26)
+32 ;TRAVEL MGT FEE
SET $PIECE(Y,U,37)=$$TMFEE(ACRDOCDA)
+33 ;
+34 ;----- Adjust PHONE HOME rate to MAXIMUM AMOUNT whichever is less
+35 IF $PIECE($GET(^ACRSYS(1,"DT")),U,17)
Begin DoDot:1
+36 SET X=($PIECE(Y,U,38)-1)*$PIECE($GET(^ACRSYS(1,"DT")),U,17)
+37 IF X
IF X<$PIECE(Y,U,9)
Begin DoDot:2
+38 SET $PIECE(Y,U,9)=X
End DoDot:2
End DoDot:1
+39 ;
+40 ;----- Adjust POV MILEAGE COST to MAXIMUM POV TRANSPORTATION EXPENSE
+41 ; whichever is less
+42 ;MAX POV EXP
SET X=$PIECE($GET(^ACRDOC(ACRDOCDA,"TOAU")),U,6)
+43 IF X
IF X<$PIECE(Y,U,30)
Begin DoDot:1
+44 SET $PIECE(Y,U,30)=X
End DoDot:1
+45 ;
+46 ;----- Adjust MAXIMUM MILES TO AIRPORT+AIRPORT PARKING EXPENSE to
+47 ; AVERAGE ROUNDTRIP COST BY TAXI FROM HOME TO AIRPORT whichever
+48 ; is less
+49 SET ACRDUZ=$PIECE($GET(^ACRDOC(ACRDOCDA,"TO")),U,9)
+50 ;MAX APT MLS+PK
SET X=$PIECE($GET(^ACRAU(ACRDUZ,1)),U,9)
+51 IF X
IF X<($PIECE(Y,U,22)+$PIECE(Y,U,31))
Begin DoDot:1
+52 SET $PIECE(Y,U,32)=X
End DoDot:1
+53 QUIT Y
+54 ;
AIRLINE(ACRDOCDA) ;EP
+1 ;----- EXTRINSIC FUNCTION - CALCULATE AIRLINE COST
+2 ;
+3 ; INPUT:
+4 ; ACRDOCDA = DOCUMENT IEN
+5 ;
+6 ; RETURNS: AIRLINE COST FOR TRAVEL
+7 ;
+8 NEW X,Y
+9 SET (X,Y)=0
+10 FOR
SET X=$ORDER(^ACRAL("E",ACRDOCDA,X))
IF 'X
QUIT
Begin DoDot:1
+11 SET Y=Y+$PIECE($GET(^ACRAL(X,"DT")),U,9)
End DoDot:1
+12 QUIT Y
+13 ;
TMFEE(ACRDOCDA) ;EP
+1 ;----- EXTRINSIC FUNCTION - RETURN TRAVEL MANAGEMENT FEE
+2 ;
+3 ; INPUT:
+4 ; ACRDOCDA = DOCUMENT IEN
+5 ;
+6 ; RETURNS: TRAVEL MANAGEMENT FEE
+7 ;
+8 NEW X,Y
+9 SET (X,Y)=0
+10 FOR
SET X=$ORDER(^ACRSS("C",ACRDOCDA,X))
IF 'X
QUIT
Begin DoDot:1
+11 IF $PIECE($GET(^ACRSS(X,"NMS")),U,5)'="Travel Mgt Fee"
QUIT
+12 SET Y=Y+$PIECE($GET(^ACRSS(X,"DT")),U,4)
End DoDot:1
+13 QUIT Y
OBLS(ACRDOCDA) ;EP
+1 ;----- EXTRINSIC FUNCTION - RETURNS TOTAL OBLIGATIONS FOR A
+2 ; DOCUMENT
+3 ;
+4 NEW AMT,D0,X,Y
+5 SET (D0,Y)=0
+6 FOR
SET D0=$ORDER(^ACRDHR("E",ACRDOCDA,D0))
IF 'D0
QUIT
Begin DoDot:1
+7 SET X=$GET(^ACRDHR(D0,1))
+8 IF $PIECE(X,U,3)'="050"
QUIT
+9 SET AMT=$PIECE(X,U,14)
+10 SET AMT=+AMT/100
+11 IF $PIECE(X,U,4)=2
SET AMT=0-AMT
+12 SET Y=Y+AMT
End DoDot:1
+13 QUIT Y
PMTS(ACRDOCDA) ;EP
+1 ;----- EXTRINSIC FUNCTION - RETURNS TOTAL PAYMENTS AGAINST A
+2 ; DOCUMENT
+3 ;
+4 NEW AMT,D0,X,Y
+5 SET (D0,Y)=0
+6 FOR
SET D0=$ORDER(^ACRDHR("E",ACRDOCDA,D0))
IF 'D0
QUIT
Begin DoDot:1
+7 SET X=$GET(^ACRDHR(D0,1))
+8 IF "^181^182^190^191^192"'[$PIECE(X,U,3)
QUIT
+9 SET AMT=$PIECE(X,U,14)
+10 SET AMT=+AMT/100
+11 IF $PIECE(X,U,4)=2
SET AMT=0-AMT
+12 SET Y=Y+AMT
End DoDot:1
+13 QUIT Y
NET(D0,D1,D2) ;EP
+1 ;----- EXTRINSIC FUNCTION - USED BY ACR REVIEW PAYMENT-T SCREENMAN
+2 ; FORM TO RETURN THE NET TO TRAVELER AMOUNT FOR TRAVEL
+3 ; PAYMENTS
+4 ; RETURNS PAYMENT AMOUNT FOR ALL TRANSACTION CODES
+5 ; AMOUNT ADJUSTED TO SUBTRACT DIS-AMT IF PRESENT
+6 ; AMOUNT ADJUSTED; NOT SUBTRACTED IF TRAVEL ADVANCE
+7 ;
+8 ;N X,Y ;ACR*2.1*17.12 IM17438
+9 ;ACR*2.1*17.12 IM17438
NEW X,Y,ACRBTYP
+10 SET Y=0
+11 ;ACR*2.1*17.12 IM17438
SET ACRBTYP=$PIECE($GET(^AFSLAFP(D0,1,D1,0)),U,4)
+12 SET X=$GET(^AFSLAFP(D0,1,D1,1,D2,0))
+13 ;ACR*2.1*17.12 IM17438
SET Y=$PIECE(X,U,11)
+14 ;ACR*2.1*17.12 IM17438
IF ACRBTYP="V"
QUIT Y
+15 ;DEFAULT VALUE ;ACR*2.1*5.02
SET Y=$PIECE(X,U,11)-$PIECE(X,U,12)
+16 ;TRAVEL ADVANCE, DON'T SUBTRACT ;ACR*2.1*5.01
IF $EXTRACT($PIECE(X,U,18),1,3)="061"
Begin DoDot:1
+17 IF $PIECE(X,U,12)>0
SET Y=$PIECE(X,U,12)
+18 IF $PIECE(X,U,12)'>0
SET Y=$PIECE(X,U,11)
End DoDot:1
+19 QUIT Y
+20 ;
REQTP(X) ;EP ----- RETURNS REQUEST TYPE IEN^TRANSACTION TYPE NAME ;ACR*2.1*5.17 ACR*2.1*20.15
+1 ;
+2 ; X = DOCUMENT IEN
+3 ;
+4 NEW Y
+5 SET Y=""
+6 IF X
SET Y=$PIECE($GET(^ACRDOC(X,0)),U,4)
+7 IF Y
SET Y=Y_U_$PIECE($GET(^ACRTXTYP(Y,0)),U)
+8 QUIT Y
