ACRFSS42.m

ACRFSS42 ;IHS/OIRM/DSD/THL,AEF - EDIT TRAVEL VOUCHER - CONT; [ 11/01/2001   9:44 AM ]

 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001

 ;;CONTINUATION OF ACRFSS4

DISPLAY ;EP;

 K ACRTV

 Q:$D(ACRDAILY)

 D CHK^ACRFSSA1

 K ACRQUIT

 D HEADSS4^ACRFSSD1

 Q:$D(ACRQUIT)!$D(ACROUT)

 I $P(^ACRDOC(ACRDOCDA,"TO"),U,26),'$P($G(^ACRDOC(ACRDOCDA,"TOAU")),U,8) D

 .S DA=ACRDOCDA

 .S DIE="^ACRDOC("

 .S DR="130170////0"

 .D DIE^ACRFDIC

 S ACRMRR=$P(^ACRDOC(ACRDOCDA,"TOSA"),U,10)

 S ACR4P=$P(^ACRDOC(ACRDOCDA,"TO"),U,26)

 S ACRDUZ=$P(^ACRDOC(ACRDOCDA,"TO"),U,9)

 S (ACRREIM,ACRJ,ACRTOT,ACRPD,ACRLDG,ACRMR,ACRTAX,ACRPHN,ACROTH,ACROTHT,ACRRC,ACRTVRC,ACRAIRPT,ACRAIRP,ACRAIRT)=0

 S ACRADV=+$G(ACRADV)

 S ACRALTOT=+$G(ACRALTOT)

 K ^TMP("ACRTV",$J)

 I '$D(^ACRTV("D",ACRDOCDA)) D  Q

 .W !?10,"NO TRAVEL DAYS RECORDED FOR THIS TRAVEL ORDER."

 .S ACRDAYS=0

 D LASTDAY

 S ACRTVDA=0

 F  S ACRTVDA=$O(^ACRTV("D",ACRDOCDA,ACRTVDA)) Q:'ACRTVDA  D

 .I $G(ACRREFX)'=600,$P($G(^ACRTV(ACRTVDA,0)),U,5)=1 Q

 .I '$D(^ACRTV(ACRTVDA,0)) K ^ACRTV("D",ACRDOCDA,ACRTVDA) Q

 .S ^TMP("ACRTV",$J,"D",+$P(^ACRTV(ACRTVDA,"DT"),U),ACRDOCDA,ACRTVDA)=""

 .S ACRJ=ACRJ+1

 .S ACRTV=ACRTVDA_"^"_^ACRTV(ACRTVDA,0)

 .S ACRTV1=^ACRTV(ACRTVDA,"DT")

 .S ACRTVDAY=+^ACRTV(ACRTVDA,0)

 .S ACRDESC=$G(^ACRTV(ACRTVDA,"DESC"))

 .S ACRTVEP=$G(^ACRTV(ACRTVDA,1))

 .I ACRTVDAY'=ACRJ D

 ..S DA=ACRTVDA

 ..S DIE="^ACRTV("

 ..S DR=".01///"_ACRJ

 ..D DIE^ACRFDIC

 .S ^TMP("ACRTV",$J,ACRJ)=ACRTV

 .S ACRTVDAT=$E($P($P(ACRTV1,U),","),4,7)

 .S Y=$P(ACRTV1,U,2)

 .X ^DD("DD")

 .S ACRTVLV=$P(Y,"@",2)

 .S ACRTVLV=$P(ACRTVLV,":")_$P(ACRTVLV,":",2)

 .S Y=$P(ACRTV1,U,3)

 .X ^DD("DD")

 .S ACRTVAR=$P(Y,"@",2)

 .S ACRTVAR=$P(ACRTVAR,":")_$P(ACRTVAR,":",2)

 .S ACRTVCIT=$S('$P(ACRTV1,U,4):"NOT SPECIFIED",'$D(^ACRPD($P(ACRTV1,U,4),0)):"NOT SPECIFIED",1:$E($P(^ACRPD($P(ACRTV1,U,4),0),U),1,7))

 .S ACRTVPD=$P(ACRTV1,U,5)

 .S:$P(ACRTV1,U,20)>0 ACRMRR=$P(ACRTV1,U,20)

 .S ACRPMRR=$P(ACRTV1,U,23)

 .S ACRAIRP=$P(ACRTV1,U,22)

 .S ACRAIRPT=ACRAIRPT+ACRAIRP

 .S ACRTVLDG=$P(ACRTV1,U,6)

 .S ACRTVMLS=$P(ACRTV1,U,7)

 .S ACRTVPML=$P(ACRTV1,U,21)

 .S ACRTVMR=ACRTVPML*ACRPMRR

 .S ACRTVTAX=$P(ACRTV1,U,8)

 .S ACRAIRT=ACRAIRT+(ACRTVMLS*ACRMRR)

 .S ACRTVPHN=$P(ACRTV1,U,9)

 .S ACRTVOTH=$P(ACRTV1,U,10)

 .S ACRTVEXP=$P(ACRTV1,U,17)

 .S ACRTVRC=$P(ACRTV1,U,15)

 .S:ACRTVEP]"" ACRTVEXP=ACRTVEXP_U_ACRTVEP

 .S ACRTVRCC=$P(ACRTV1,U,13)

 .I ACRTVRCC,$D(^ACRRCOMP(ACRTVRCC,0)) S ACRTVRCC=$P(^(0),U)

 .S ACROTH=ACROTH+ACRTVOTH

 .S ACRPD=ACRPD+ACRTVPD

 .S ACRLDG=ACRLDG+ACRTVLDG

 .S ACRMR=ACRMR+ACRTVMR

 .S ACRTAX=ACRTAX+ACRTVTAX

 .S ACRPHN=ACRPHN+ACRTVPHN

 .S ACRRC=ACRRC+ACRTVRC

 I $P(^ACRDOC(ACRDOCDA,"TOAU"),U,6),$P(^("TOAU"),U,6)<ACRMR S ACRMR=$P(^("TOAU"),U,6)

 S ACRDAYS=ACRJ

 S ACRPHNX=ACRJ-1*$P(^ACRSYS(1,"DT"),U,17)

 S ACRPHN=$S(ACRPHN>ACRPHNX:ACRPHNX,1:ACRPHN)

 D TAXI

 K ACRPHNX

 S (ACRTVDT,ACRJ)=0

 F  S ACRTVDT=$O(^TMP("ACRTV",$J,"D",ACRTVDT)) Q:'ACRTVDT!$D(ACRQUIT)  D

 .S ACRTVDA=0

 .F  S ACRTVDA=$O(^TMP("ACRTV",$J,"D",ACRTVDT,ACRDOCDA,ACRTVDA)) Q:'ACRTVDA!$D(ACRQUIT)  D

 ..S ACRJ=ACRJ+1

 ..D DP1^ACRFSS44

 I $D(^ACRAL("C",ACRDOCDA)) D

 .W !!,"Transportation cost to and from airport including airport parking not to exceed"

 .W !,"round trip taxi fare of ",$FN($P($G(^ACRAU(ACRDUZ,1)),U,9),"P",2),"  (Amount claimed:",$FN(ACRAIRPT(1),"P",2)," authorized:",$FN(ACRAIRPT,"P",2),")"

 W !?26,"---------"

 W ?36,"---------"

 W ?46,"-------"

 W ?54,"--------"

 W ?63,"--------"

 W ?72,"-------"

 W !?26,$J($FN(ACRPD,"P",2),8)

 W ?36,$J($FN(ACRLDG,"P",2),8)

 W ?46,$J($FN(ACRMR+ACRAIRT,"P",2),7)

 W ?54,$J($FN(ACRTAX,"P",2),7)

 S ACRTOT=ACRTOT+ACRPD+ACRLDG+ACRMR+ACRTAX+ACRPHN+ACROTH+ACRRC+ACR4P+ACRAIRPT+$$TMFEE(ACRDOCDA)

 S ACROTHT=ACROTHT+ACRMR+ACRTAX+ACRPHN+ACROTH+ACRAIRPT

 W ?63,$J($FN(ACRPHN,"P",2),7)

 W ?72,$J($FN(ACROTH+ACRAIRPT-ACRAIRT,"P",2),7)

 D ALTOT^ACRFSSA1

 D ADVANCE^ACRFSSA1

 S ACRTOT=ACRTOT+$G(ACRALTOT)

 S ACRREIM=ACRREIM+ACRRC+ACRPD+ACRLDG+ACROTHT+ACR4P+$S($P(^ACRDOC(ACRDOCDA,"TOAU"),U,5)=1:$G(ACRALTOT),1:0)

 I $P($G(^ACRSYS(1,400)),U,4) S ACRREIM=ACRREIM+$$TMFEE(ACRDOCDA) ; ADD TM FEE TO REIMBURSABLE IF CREATE TM FEE PMT DHR = YES

 D TOTAL^ACRFSSA1

 K ACRQUIT,ACRHOT

 Q

TAXI ;EP;TO CALCULATE IF AIRPORT PARKING PLUS TRIP TO AIRPORT IS GREATER

 ;THAN TAXI TO AIRPORT

 S ACRAIRPT(1)=ACRAIRPT+ACRAIRT

 I ACRAIRPT(1),$P($G(^ACRAU(ACRDUZ,1)),U,9),ACRAIRPT(1)>($P(^(1),U,9)) S ACRAIRPT=$P(^(1),U,9)

 E  S ACRAIRPT=ACRAIRPT(1)

 Q

LASTDAY ;EP;TO ADJUST FIRST AND LAST OFFICIAL TRAVEL DAY PERDIEM TO 3/4 ;THL

 ;;AND TO DISALLOW PERDIEM AND LODGING ON NON-OFFICIAL TRAVEL DAYS

 ;;IF FINAL APPROVAL OR DISAPPROVAL COMPLETED, NO ADJUSTMENT IS DONE

 Q:$P($G(^ACROBL(ACRDOCDA,"APV")),U,8)]""

 K ^TMP("ACRTV",$J,"D")

 N ACRJ,ACRXX,ACRY,Z,ACRTDY,ACRPDX,ACRHOT,ACRPD

 S (ACRXX,ACRJ)=0

 F  S ACRXX=$O(^ACRTV("D",ACRDOCDA,ACRXX)) Q:'ACRXX  D

 .Q:$P($G(^ACRTV(ACRXX,0)),U,4)'=1

 .S ACRJ=ACRJ+1

 Q:ACRJ<4

 S (ACRXX,ACRJ)=0

 F  S ACRXX=$O(^ACRTV("D",ACRDOCDA,ACRXX)) Q:'ACRXX  D

 .Q:$P($G(^ACRTV(ACRXX,0)),U,4)'=1

 .S ^TMP("ACRTV",$J,"D",+$P(^ACRTV(ACRXX,"DT"),U),ACRDOCDA,ACRXX)=""

 K ACRQUIT

 S ACRDAY=99999999

 S ACRDAY=$O(^TMP("ACRTV",$J,"D",ACRDAY),-1) Q:'ACRDAY!$D(ACRQUIT)  D

 .S ACRXX=99999999

 .S ACRXX=$O(^TMP("ACRTV",$J,"D",ACRDAY,ACRDOCDA,ACRXX),-1)

 .Q:'ACRXX!$D(ACRQUIT)

 .S ACRTDY=$P($G(^ACRTV(ACRXX,"DT")),U,4)

 .N ACRAMT

 .S ACRAMT=$P($G(^ACRTV(ACRXX,"DT")),U,5)

 .D:ACRTDY

 ..S ACRPDX=$P($G(^ACRPD(+ACRTDY,0)),U,4)

 ..Q:'ACRPDX

 ..Q:ACRPDX*.751>ACRAMT

 ..S DA=ACRXX

 ..S DIE="^ACRTV("

 ..S DR="5////"_(ACRPDX*.75)_";6////0"

 ..D DIE^ACRFDIC

 ..S ACRQUIT=""

 K ACRQUIT,^TMP("ACRTV",$J,"D"),ACRHOT

 Q

TMFEE(X) ;EP -- EXTRINSIC FUNCTION - CALCULATES TRAVEL MGT FEE

 ;

 ;      INPUT:

 ;        X = INTERNAL FMS DOCUMENT IEN

 ;

 ;      OUTPUT:

 ;        Y = TRAVEL MGT FEE AMOUNT

 ;

 N Z,Y

 S (Z,Y)=0

 F  S Z=$O(^ACRSS("C",X,Z)) Q:'Z  D

 . Q:$P($G(^ACRSS(Z,"NMS")),U,5)'="Travel Mgt Fee"

 . S Y=Y+$P($G(^ACRSS(Z,"DT")),U,4)

 Q Y

ACRFSS42  ;IHS/OIRM/DSD/THL,AEF - EDIT TRAVEL VOUCHER - CONT; [ 11/01/2001   9:44 AM ]

 +1       ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001

 +2       ;;CONTINUATION OF ACRFSS4

DISPLAY   ;EP;

 +1        KILL ACRTV

 +2        IF $DATA(ACRDAILY)

               QUIT 

 +3        DO CHK^ACRFSSA1

 +4        KILL ACRQUIT

 +5        DO HEADSS4^ACRFSSD1

 +6        IF $DATA(ACRQUIT)!$DATA(ACROUT)

               QUIT 

 +7        IF $PIECE(^ACRDOC(ACRDOCDA,"TO"),U,26)

               IF '$PIECE($GET(^ACRDOC(ACRDOCDA,"TOAU")),U,8)

                   Begin DoDot:1

 +8                    SET DA=ACRDOCDA

 +9                    SET DIE="^ACRDOC("

 +10                   SET DR="130170////0"

 +11                   DO DIE^ACRFDIC

                   End DoDot:1

 +12       SET ACRMRR=$PIECE(^ACRDOC(ACRDOCDA,"TOSA"),U,10)

 +13       SET ACR4P=$PIECE(^ACRDOC(ACRDOCDA,"TO"),U,26)

 +14       SET ACRDUZ=$PIECE(^ACRDOC(ACRDOCDA,"TO"),U,9)

 +15       SET (ACRREIM,ACRJ,ACRTOT,ACRPD,ACRLDG,ACRMR,ACRTAX,ACRPHN,ACROTH,ACROTHT,ACRRC,ACRTVRC,ACRAIRPT,ACRAIRP,ACRAIRT)=0

 +16       SET ACRADV=+$GET(ACRADV)

 +17       SET ACRALTOT=+$GET(ACRALTOT)

 +18       KILL ^TMP("ACRTV",$JOB)

 +19       IF '$DATA(^ACRTV("D",ACRDOCDA))

               Begin DoDot:1

 +20               WRITE !?10,"NO TRAVEL DAYS RECORDED FOR THIS TRAVEL ORDER."

 +21               SET ACRDAYS=0

               End DoDot:1

               QUIT 

 +22       DO LASTDAY

 +23       SET ACRTVDA=0

 +24       FOR 

               SET ACRTVDA=$ORDER(^ACRTV("D",ACRDOCDA,ACRTVDA))

               IF 'ACRTVDA

                   QUIT 

               Begin DoDot:1

 +25               IF $GET(ACRREFX)'=600

                       IF $PIECE($GET(^ACRTV(ACRTVDA,0)),U,5)=1

                           QUIT 

 +26               IF '$DATA(^ACRTV(ACRTVDA,0))

                       KILL ^ACRTV("D",ACRDOCDA,ACRTVDA)

                       QUIT 

 +27               SET ^TMP("ACRTV",$JOB,"D",+$PIECE(^ACRTV(ACRTVDA,"DT"),U),ACRDOCDA,ACRTVDA)=""

 +28               SET ACRJ=ACRJ+1

 +29               SET ACRTV=ACRTVDA_"^"_^ACRTV(ACRTVDA,0)

 +30               SET ACRTV1=^ACRTV(ACRTVDA,"DT")

 +31               SET ACRTVDAY=+^ACRTV(ACRTVDA,0)

 +32               SET ACRDESC=$GET(^ACRTV(ACRTVDA,"DESC"))

 +33               SET ACRTVEP=$GET(^ACRTV(ACRTVDA,1))

 +34               IF ACRTVDAY'=ACRJ

                       Begin DoDot:2

 +35                       SET DA=ACRTVDA

 +36                       SET DIE="^ACRTV("

 +37                       SET DR=".01///"_ACRJ

 +38                       DO DIE^ACRFDIC

                       End DoDot:2

 +39               SET ^TMP("ACRTV",$JOB,ACRJ)=ACRTV

 +40               SET ACRTVDAT=$EXTRACT($PIECE($PIECE(ACRTV1,U),","),4,7)

 +41               SET Y=$PIECE(ACRTV1,U,2)

 +42               XECUTE ^DD("DD")

 +43               SET ACRTVLV=$PIECE(Y,"@",2)

 +44               SET ACRTVLV=$PIECE(ACRTVLV,":")_$PIECE(ACRTVLV,":",2)

 +45               SET Y=$PIECE(ACRTV1,U,3)

 +46               XECUTE ^DD("DD")

 +47               SET ACRTVAR=$PIECE(Y,"@",2)

 +48               SET ACRTVAR=$PIECE(ACRTVAR,":")_$PIECE(ACRTVAR,":",2)

 +49               SET ACRTVCIT=$SELECT('$PIECE(ACRTV1,U,4):"NOT SPECIFIED",'$DATA(^ACRPD($PIECE(ACRTV1,U,4),0)):"NOT SPECIFIED",1:$EXTRACT($PIECE(^ACRPD($PIECE(ACRTV1,U,4),0),U),1,7))

 +50               SET ACRTVPD=$PIECE(ACRTV1,U,5)

 +51               IF $PIECE(ACRTV1,U,20)>0

                       SET ACRMRR=$PIECE(ACRTV1,U,20)

 +52               SET ACRPMRR=$PIECE(ACRTV1,U,23)

 +53               SET ACRAIRP=$PIECE(ACRTV1,U,22)

 +54               SET ACRAIRPT=ACRAIRPT+ACRAIRP

 +55               SET ACRTVLDG=$PIECE(ACRTV1,U,6)

 +56               SET ACRTVMLS=$PIECE(ACRTV1,U,7)

 +57               SET ACRTVPML=$PIECE(ACRTV1,U,21)

 +58               SET ACRTVMR=ACRTVPML*ACRPMRR

 +59               SET ACRTVTAX=$PIECE(ACRTV1,U,8)

 +60               SET ACRAIRT=ACRAIRT+(ACRTVMLS*ACRMRR)

 +61               SET ACRTVPHN=$PIECE(ACRTV1,U,9)

 +62               SET ACRTVOTH=$PIECE(ACRTV1,U,10)

 +63               SET ACRTVEXP=$PIECE(ACRTV1,U,17)

 +64               SET ACRTVRC=$PIECE(ACRTV1,U,15)

 +65               IF ACRTVEP]""

                       SET ACRTVEXP=ACRTVEXP_U_ACRTVEP

 +66               SET ACRTVRCC=$PIECE(ACRTV1,U,13)

 +67               IF ACRTVRCC

                       IF $DATA(^ACRRCOMP(ACRTVRCC,0))

                           SET ACRTVRCC=$PIECE(^(0),U)

 +68               SET ACROTH=ACROTH+ACRTVOTH

 +69               SET ACRPD=ACRPD+ACRTVPD

 +70               SET ACRLDG=ACRLDG+ACRTVLDG

 +71               SET ACRMR=ACRMR+ACRTVMR

 +72               SET ACRTAX=ACRTAX+ACRTVTAX

 +73               SET ACRPHN=ACRPHN+ACRTVPHN

 +74               SET ACRRC=ACRRC+ACRTVRC

               End DoDot:1

 +75       IF $PIECE(^ACRDOC(ACRDOCDA,"TOAU"),U,6)

               IF $PIECE(^("TOAU"),U,6)<ACRMR

                   SET ACRMR=$PIECE(^("TOAU"),U,6)

 +76       SET ACRDAYS=ACRJ

 +77       SET ACRPHNX=ACRJ-1*$PIECE(^ACRSYS(1,"DT"),U,17)

 +78       SET ACRPHN=$SELECT(ACRPHN>ACRPHNX:ACRPHNX,1:ACRPHN)

 +79       DO TAXI

 +80       KILL ACRPHNX

 +81       SET (ACRTVDT,ACRJ)=0

 +82       FOR 

               SET ACRTVDT=$ORDER(^TMP("ACRTV",$JOB,"D",ACRTVDT))

               IF 'ACRTVDT!$DATA(ACRQUIT)

                   QUIT 

               Begin DoDot:1

 +83               SET ACRTVDA=0

 +84               FOR 

                       SET ACRTVDA=$ORDER(^TMP("ACRTV",$JOB,"D",ACRTVDT,ACRDOCDA,ACRTVDA))

                       IF 'ACRTVDA!$DATA(ACRQUIT)

                           QUIT 

                       Begin DoDot:2

 +85                       SET ACRJ=ACRJ+1

 +86                       DO DP1^ACRFSS44

                       End DoDot:2

               End DoDot:1

 +87       IF $DATA(^ACRAL("C",ACRDOCDA))

               Begin DoDot:1

 +88               WRITE !!,"Transportation cost to and from airport including airport parking not to exceed"

 +89               WRITE !,"round trip taxi fare of ",$FNUMBER($PIECE($GET(^ACRAU(ACRDUZ,1)),U,9),"P",2),"  (Amount claimed:",$FNUMBER(ACRAIRPT(1),"P",2)," authorized:",$FNUMBER(ACRAIRPT,"P",2),")"

               End DoDot:1

 +90       WRITE !?26,"---------"

 +91       WRITE ?36,"---------"

 +92       WRITE ?46,"-------"

 +93       WRITE ?54,"--------"

 +94       WRITE ?63,"--------"

 +95       WRITE ?72,"-------"

 +96       WRITE !?26,$JUSTIFY($FNUMBER(ACRPD,"P",2),8)

 +97       WRITE ?36,$JUSTIFY($FNUMBER(ACRLDG,"P",2),8)

 +98       WRITE ?46,$JUSTIFY($FNUMBER(ACRMR+ACRAIRT,"P",2),7)

 +99       WRITE ?54,$JUSTIFY($FNUMBER(ACRTAX,"P",2),7)

 +100      SET ACRTOT=ACRTOT+ACRPD+ACRLDG+ACRMR+ACRTAX+ACRPHN+ACROTH+ACRRC+ACR4P+ACRAIRPT+$$TMFEE(ACRDOCDA)

 +101      SET ACROTHT=ACROTHT+ACRMR+ACRTAX+ACRPHN+ACROTH+ACRAIRPT

 +102      WRITE ?63,$JUSTIFY($FNUMBER(ACRPHN,"P",2),7)

 +103      WRITE ?72,$JUSTIFY($FNUMBER(ACROTH+ACRAIRPT-ACRAIRT,"P",2),7)

 +104      DO ALTOT^ACRFSSA1

 +105      DO ADVANCE^ACRFSSA1

 +106      SET ACRTOT=ACRTOT+$GET(ACRALTOT)

 +107      SET ACRREIM=ACRREIM+ACRRC+ACRPD+ACRLDG+ACROTHT+ACR4P+$SELECT($PIECE(^ACRDOC(ACRDOCDA,"TOAU"),U,5)=1:$GET(ACRALTOT),1:0)

 +108     ; ADD TM FEE TO REIMBURSABLE IF CREATE TM FEE PMT DHR = YES

           IF $PIECE($GET(^ACRSYS(1,400)),U,4)

               SET ACRREIM=ACRREIM+$$TMFEE(ACRDOCDA)

 +109      DO TOTAL^ACRFSSA1

 +110      KILL ACRQUIT,ACRHOT

 +111      QUIT 

TAXI      ;EP;TO CALCULATE IF AIRPORT PARKING PLUS TRIP TO AIRPORT IS GREATER

 +1       ;THAN TAXI TO AIRPORT

 +2        SET ACRAIRPT(1)=ACRAIRPT+ACRAIRT

 +3        IF ACRAIRPT(1)

               IF $PIECE($GET(^ACRAU(ACRDUZ,1)),U,9)

                   IF ACRAIRPT(1)>($PIECE(^(1),U,9))

                       SET ACRAIRPT=$PIECE(^(1),U,9)

 +4       IF '$TEST

               SET ACRAIRPT=ACRAIRPT(1)

 +5        QUIT 

LASTDAY   ;EP;TO ADJUST FIRST AND LAST OFFICIAL TRAVEL DAY PERDIEM TO 3/4 ;THL

 +1       ;;AND TO DISALLOW PERDIEM AND LODGING ON NON-OFFICIAL TRAVEL DAYS

 +2       ;;IF FINAL APPROVAL OR DISAPPROVAL COMPLETED, NO ADJUSTMENT IS DONE

 +3        IF $PIECE($GET(^ACROBL(ACRDOCDA,"APV")),U,8)]""

               QUIT 

 +4        KILL ^TMP("ACRTV",$JOB,"D")

 +5        NEW ACRJ,ACRXX,ACRY,Z,ACRTDY,ACRPDX,ACRHOT,ACRPD

 +6        SET (ACRXX,ACRJ)=0

 +7        FOR 

               SET ACRXX=$ORDER(^ACRTV("D",ACRDOCDA,ACRXX))

               IF 'ACRXX

                   QUIT 

               Begin DoDot:1

 +8                IF $PIECE($GET(^ACRTV(ACRXX,0)),U,4)'=1

                       QUIT 

 +9                SET ACRJ=ACRJ+1

               End DoDot:1

 +10       IF ACRJ<4

               QUIT 

 +11       SET (ACRXX,ACRJ)=0

 +12       FOR 

               SET ACRXX=$ORDER(^ACRTV("D",ACRDOCDA,ACRXX))

               IF 'ACRXX

                   QUIT 

               Begin DoDot:1

 +13               IF $PIECE($GET(^ACRTV(ACRXX,0)),U,4)'=1

                       QUIT 

 +14               SET ^TMP("ACRTV",$JOB,"D",+$PIECE(^ACRTV(ACRXX,"DT"),U),ACRDOCDA,ACRXX)=""

               End DoDot:1

 +15       KILL ACRQUIT

 +16       SET ACRDAY=99999999

 +17       SET ACRDAY=$ORDER(^TMP("ACRTV",$JOB,"D",ACRDAY),-1)

           IF 'ACRDAY!$DATA(ACRQUIT)

               QUIT 

           Begin DoDot:1

 +18           SET ACRXX=99999999

 +19           SET ACRXX=$ORDER(^TMP("ACRTV",$JOB,"D",ACRDAY,ACRDOCDA,ACRXX),-1)

 +20           IF 'ACRXX!$DATA(ACRQUIT)

                   QUIT 

 +21           SET ACRTDY=$PIECE($GET(^ACRTV(ACRXX,"DT")),U,4)

 +22           NEW ACRAMT

 +23           SET ACRAMT=$PIECE($GET(^ACRTV(ACRXX,"DT")),U,5)

 +24           IF ACRTDY

                   Begin DoDot:2

 +25                   SET ACRPDX=$PIECE($GET(^ACRPD(+ACRTDY,0)),U,4)

 +26                   IF 'ACRPDX

                           QUIT 

 +27                   IF ACRPDX*.751>ACRAMT

                           QUIT 

 +28                   SET DA=ACRXX

 +29                   SET DIE="^ACRTV("

 +30                   SET DR="5////"_(ACRPDX*.75)_";6////0"

 +31                   DO DIE^ACRFDIC

 +32                   SET ACRQUIT=""

                   End DoDot:2

           End DoDot:1

 +33       KILL ACRQUIT,^TMP("ACRTV",$JOB,"D"),ACRHOT

 +34       QUIT 

TMFEE(X)  ;EP -- EXTRINSIC FUNCTION - CALCULATES TRAVEL MGT FEE

 +1       ;

 +2       ;      INPUT:

 +3       ;        X = INTERNAL FMS DOCUMENT IEN

 +4       ;

 +5       ;      OUTPUT:

 +6       ;        Y = TRAVEL MGT FEE AMOUNT

 +7       ;

 +8        NEW Z,Y

 +9        SET (Z,Y)=0

 +10       FOR 

               SET Z=$ORDER(^ACRSS("C",X,Z))

               IF 'Z

                   QUIT 

               Begin DoDot:1

 +11               IF $PIECE($GET(^ACRSS(Z,"NMS")),U,5)'="Travel Mgt Fee"

                       QUIT 

 +12               SET Y=Y+$PIECE($GET(^ACRSS(Z,"DT")),U,4)

               End DoDot:1

 +13       QUIT Y