ACRFSSU.m

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