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
