ACRFSS44 ;IHS/OIRM/DSD/THL,AEF - EDIT TRAVEL VOUCHER - CONT; [ 05/10/2005 12:34 PM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**17**;NOV 05, 2001
;;CONTINUATION OF ACRFSS42
DP1 ;EP;
N ACRTXEX
;S ACRTV=ACRTVDA_U_^ACRTV(ACRTVDA,0) ; ACR*2.1*17.04 IM17076
;S ACRTV1=^ACRTV(ACRTVDA,"DT") ; ACR*2.1*17.04 IM17076
;S ACRTVDAY=+^ACRTV(ACRTVDA,0) ; ACR*2.1*17.04 IM17076
S ACRTV=ACRTVDA_U_$G(^ACRTV(ACRTVDA,0)) ; ACR*2.1*17.04 IM17076
S ACRTV1=$G(^ACRTV(ACRTVDA,"DT")) ; ACR*2.1*17.04 IM17076
S ACRTVDAY=+$G(^ACRTV(ACRTVDA,0)) ; ACR*2.1*17.04 IM17076
S ACRDESC=$G(^ACRTV(ACRTVDA,"DESC"))
S X=$G(^ACRTV(ACRTVDA,1))
S ACRTXEX=$P(X,U,4)
S X=$P(X,U,1,3)
S X=$TR(X,U," ")
S ACRTVEP=X
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)
I $P(ACRTV1,U,23)>0 D
.S ACRPMRR=$P(ACRTV1,U,23)
.S ACRAIRP=$P(ACRTV1,U,22)
S ACRTVLDG=$P(ACRTV1,U,6)
S ACRTVMLS=$P(ACRTV1,U,7)
S ACRTVPML=$P(ACRTV1,U,21)
S ACRTVMR=ACRTVMLS*ACRMRR+(ACRTVPML*ACRPMRR)
S ACRTVTAX=$P(ACRTV1,U,8)
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_" "_ACRTVEP
S ACRTVRCC=$P(ACRTV1,U,13)
I ACRTVRCC,$D(^ACRRCOMP(ACRTVRCC,0)) S ACRTVRCC=$P(^(0),U)
W !,ACRJ
W ?3,ACRTVDAT
W ?8,ACRTVLV
W ?13,ACRTVAR
W ?18,ACRTVCIT
W ?26,$J($FN(ACRTVPD,"P",2),8)
W ?36,$J($FN(ACRTVLDG,"P",2),8)
I ACRTVMLS]"" W ?46,$J(ACRTVMLS,3),"*",ACRMRR
E I ACRTVPML]"" W ?46,$J(ACRTVPML,3),"*",ACRPMRR
W ?54,$J($FN(ACRTVTAX,"P",2),7)
W ?63,$J($FN(ACRTVPHN,"P",2),7)
W ?72,$J($FN(ACRTVOTH,"P",2),7)
I ACRTVMLS]"",ACRTVPML]"" W !?46,$J(ACRTVPML,3),"*",ACRPMRR
I ACRDESC]"" D
.W !?3
.N ACRI
.S ACRDESC=$TR(ACRDESC,U," ")
.F ACRI=1:1 W $P(ACRDESC," ",ACRI)," " W:$L($P(ACRDESC," ",ACRI+1))+$X>75 !?3 Q:$P(ACRDESC," ",ACRI+1,99)=""
I $P(ACRTV,U,5)>1!(($P(ACRTV,U,5)>0)&(+ACRTV1<$P(^ACRDOC(ACRDOCDA,"TO"),U,14)!(+ACRTV1>$P(^("TO"),U,15)))) D
.W !?3,"TRAVEL STATUS: ",$P($P($P(^DD(9002193.5,.04,0),U,3),$P(ACRTV,U,5)_":",2),";")
I $P(ACRTV1,U,18)>0 D
.W !?3,"DEPART FROM: ",$P($P($P(^DD(9002193.5,2.5,0),U,3),$P(ACRTV1,U,18)_":",2),";")
I $P(ACRTV1,U,19)>0 D
.W !?3,"RETURN TO: ",$P($P($P(^DD(9002193.5,3.5,0),U,3),$P(ACRTV1,U,19)_":",2),";")
I $P(ACRTV1,U,22)>0 D
.W !?3,"AIRPORT PARKING: "
.W ?72,$J($FN($P(ACRTV1,U,22),"P",2),7)
K ACRDESC
I ACRTVEXP]"" D
.N ACRI,X
.S X=ACRTVEXP
.F ACRI=1:1 S ACRX=$E(ACRTVEXP,ACRI) Q:ACRX=""!(ACRX?1AN) I ACRX'?1AN S X=$E(ACRTVEXP,ACRI+1,99999)
.S ACRTVEXP=X
.Q:X=""
.W !?3,"OTHER EXPENSE: "
.F ACRI=1:1 Q:$P(ACRTVEXP," ",ACRI,99)="" D
..W $P(ACRTVEXP," ",ACRI)," "
..W:$L($P(ACRTVEXP," ",ACRI+1))+$X>75 !?18
I ACRTXEX]"" D
.W !?3,"EXPLAIN TAXI: ",ACRTXEX
I ACRTVRCC]"" D
.W !?3,"RENTAL CAR COMPANY: ",ACRTVRCC
.W ?45,"EXPENSE:"
.W ?53,$J($FN(ACRTVRC,"P,",2),7)
I $P(ACRTV1,U,11),$G(ACRHOT)'=$P(ACRTV1,U,11) D
.S ACRHOT=$P(ACRTV1,U,11)
.Q:'ACRHOT
.N X,Y
.S X=$G(^ACRHOTEL(ACRHOT,0))
.S Y=$P(X,U,2)
.S X=$P(X,U)
.W !?3
.I Y="U"!(Y="") S Y="U" W "UNKNOW WHETHER "
.W X," "
.W $S(Y=0:"DOES NOT MEET",1:"MEETS")
.W " GSA FIRE SAFETY CODES."
I $E($G(IOST),1,2)="C-",IOSL-8<$Y D
.S DIR(0)="YO"
.S DIR("A")="Display Remaining Days"
.S DIR("B")="YES"
.W !
.D DIR^ACRFDIC
.S:Y'=1 ACRQUIT=""
.K ACROUT
.D:'$D(ACRQUIT) HEADSS4^ACRFSSD1
I $E($G(IOST),1,2)="P-",IOSL-4<$Y W @IOF D HEADSS4^ACRFSSD1
Q
ACRFSS44 ;IHS/OIRM/DSD/THL,AEF - EDIT TRAVEL VOUCHER - CONT; [ 05/10/2005 12:34 PM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**17**;NOV 05, 2001
+2 ;;CONTINUATION OF ACRFSS42
DP1 ;EP;
+1 NEW ACRTXEX
+2 ;S ACRTV=ACRTVDA_U_^ACRTV(ACRTVDA,0) ; ACR*2.1*17.04 IM17076
+3 ;S ACRTV1=^ACRTV(ACRTVDA,"DT") ; ACR*2.1*17.04 IM17076
+4 ;S ACRTVDAY=+^ACRTV(ACRTVDA,0) ; ACR*2.1*17.04 IM17076
+5 ; ACR*2.1*17.04 IM17076
SET ACRTV=ACRTVDA_U_$GET(^ACRTV(ACRTVDA,0))
+6 ; ACR*2.1*17.04 IM17076
SET ACRTV1=$GET(^ACRTV(ACRTVDA,"DT"))
+7 ; ACR*2.1*17.04 IM17076
SET ACRTVDAY=+$GET(^ACRTV(ACRTVDA,0))
+8 SET ACRDESC=$GET(^ACRTV(ACRTVDA,"DESC"))
+9 SET X=$GET(^ACRTV(ACRTVDA,1))
+10 SET ACRTXEX=$PIECE(X,U,4)
+11 SET X=$PIECE(X,U,1,3)
+12 SET X=$TRANSLATE(X,U," ")
+13 SET ACRTVEP=X
+14 IF ACRTVDAY'=ACRJ
Begin DoDot:1
+15 SET DA=ACRTVDA
+16 SET DIE="^ACRTV("
+17 SET DR=".01///"_ACRJ
+18 DO DIE^ACRFDIC
End DoDot:1
+19 SET ^TMP("ACRTV",$JOB,ACRJ)=ACRTV
+20 SET ACRTVDAT=$EXTRACT($PIECE($PIECE(ACRTV1,U),","),4,7)
+21 SET Y=$PIECE(ACRTV1,U,2)
+22 XECUTE ^DD("DD")
+23 SET ACRTVLV=$PIECE(Y,"@",2)
+24 SET ACRTVLV=$PIECE(ACRTVLV,":")_$PIECE(ACRTVLV,":",2)
+25 SET Y=$PIECE(ACRTV1,U,3)
+26 XECUTE ^DD("DD")
+27 SET ACRTVAR=$PIECE(Y,"@",2)
+28 SET ACRTVAR=$PIECE(ACRTVAR,":")_$PIECE(ACRTVAR,":",2)
+29 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))
+30 SET ACRTVPD=$PIECE(ACRTV1,U,5)
+31 IF $PIECE(ACRTV1,U,20)>0
SET ACRMRR=$PIECE(ACRTV1,U,20)
+32 IF $PIECE(ACRTV1,U,23)>0
Begin DoDot:1
+33 SET ACRPMRR=$PIECE(ACRTV1,U,23)
+34 SET ACRAIRP=$PIECE(ACRTV1,U,22)
End DoDot:1
+35 SET ACRTVLDG=$PIECE(ACRTV1,U,6)
+36 SET ACRTVMLS=$PIECE(ACRTV1,U,7)
+37 SET ACRTVPML=$PIECE(ACRTV1,U,21)
+38 SET ACRTVMR=ACRTVMLS*ACRMRR+(ACRTVPML*ACRPMRR)
+39 SET ACRTVTAX=$PIECE(ACRTV1,U,8)
+40 SET ACRTVPHN=$PIECE(ACRTV1,U,9)
+41 SET ACRTVOTH=$PIECE(ACRTV1,U,10)
+42 SET ACRTVEXP=$PIECE(ACRTV1,U,17)
+43 SET ACRTVRC=$PIECE(ACRTV1,U,15)
+44 IF ACRTVEP]""
SET ACRTVEXP=ACRTVEXP_" "_ACRTVEP
+45 SET ACRTVRCC=$PIECE(ACRTV1,U,13)
+46 IF ACRTVRCC
IF $DATA(^ACRRCOMP(ACRTVRCC,0))
SET ACRTVRCC=$PIECE(^(0),U)
+47 WRITE !,ACRJ
+48 WRITE ?3,ACRTVDAT
+49 WRITE ?8,ACRTVLV
+50 WRITE ?13,ACRTVAR
+51 WRITE ?18,ACRTVCIT
+52 WRITE ?26,$JUSTIFY($FNUMBER(ACRTVPD,"P",2),8)
+53 WRITE ?36,$JUSTIFY($FNUMBER(ACRTVLDG,"P",2),8)
+54 IF ACRTVMLS]""
WRITE ?46,$JUSTIFY(ACRTVMLS,3),"*",ACRMRR
+55 IF '$TEST
IF ACRTVPML]""
WRITE ?46,$JUSTIFY(ACRTVPML,3),"*",ACRPMRR
+56 WRITE ?54,$JUSTIFY($FNUMBER(ACRTVTAX,"P",2),7)
+57 WRITE ?63,$JUSTIFY($FNUMBER(ACRTVPHN,"P",2),7)
+58 WRITE ?72,$JUSTIFY($FNUMBER(ACRTVOTH,"P",2),7)
+59 IF ACRTVMLS]""
IF ACRTVPML]""
WRITE !?46,$JUSTIFY(ACRTVPML,3),"*",ACRPMRR
+60 IF ACRDESC]""
Begin DoDot:1
+61 WRITE !?3
+62 NEW ACRI
+63 SET ACRDESC=$TRANSLATE(ACRDESC,U," ")
+64 FOR ACRI=1:1
WRITE $PIECE(ACRDESC," ",ACRI)," "
IF $LENGTH($PIECE(ACRDESC," ",ACRI+1))+$X>75
WRITE !?3
IF $PIECE(ACRDESC," ",ACRI+1,99)=""
QUIT
End DoDot:1
+65 IF $PIECE(ACRTV,U,5)>1!(($PIECE(ACRTV,U,5)>0)&(+ACRTV1<$PIECE(^ACRDOC(ACRDOCDA,"TO"),U,14)!(+ACRTV1>$PIECE(^("TO"),U,15))))
Begin DoDot:1
+66 WRITE !?3,"TRAVEL STATUS: ",$PIECE($PIECE($PIECE(^DD(9002193.5,.04,0),U,3),$PIECE(ACRTV,U,5)_":",2),";")
End DoDot:1
+67 IF $PIECE(ACRTV1,U,18)>0
Begin DoDot:1
+68 WRITE !?3,"DEPART FROM: ",$PIECE($PIECE($PIECE(^DD(9002193.5,2.5,0),U,3),$PIECE(ACRTV1,U,18)_":",2),";")
End DoDot:1
+69 IF $PIECE(ACRTV1,U,19)>0
Begin DoDot:1
+70 WRITE !?3,"RETURN TO: ",$PIECE($PIECE($PIECE(^DD(9002193.5,3.5,0),U,3),$PIECE(ACRTV1,U,19)_":",2),";")
End DoDot:1
+71 IF $PIECE(ACRTV1,U,22)>0
Begin DoDot:1
+72 WRITE !?3,"AIRPORT PARKING: "
+73 WRITE ?72,$JUSTIFY($FNUMBER($PIECE(ACRTV1,U,22),"P",2),7)
End DoDot:1
+74 KILL ACRDESC
+75 IF ACRTVEXP]""
Begin DoDot:1
+76 NEW ACRI,X
+77 SET X=ACRTVEXP
+78 FOR ACRI=1:1
SET ACRX=$EXTRACT(ACRTVEXP,ACRI)
IF ACRX=""!(ACRX?1AN)
QUIT
IF ACRX'?1AN
SET X=$EXTRACT(ACRTVEXP,ACRI+1,99999)
+79 SET ACRTVEXP=X
+80 IF X=""
QUIT
+81 WRITE !?3,"OTHER EXPENSE: "
+82 FOR ACRI=1:1
IF $PIECE(ACRTVEXP," ",ACRI,99)=""
QUIT
Begin DoDot:2
+83 WRITE $PIECE(ACRTVEXP," ",ACRI)," "
+84 IF $LENGTH($PIECE(ACRTVEXP," ",ACRI+1))+$X>75
WRITE !?18
End DoDot:2
End DoDot:1
+85 IF ACRTXEX]""
Begin DoDot:1
+86 WRITE !?3,"EXPLAIN TAXI: ",ACRTXEX
End DoDot:1
+87 IF ACRTVRCC]""
Begin DoDot:1
+88 WRITE !?3,"RENTAL CAR COMPANY: ",ACRTVRCC
+89 WRITE ?45,"EXPENSE:"
+90 WRITE ?53,$JUSTIFY($FNUMBER(ACRTVRC,"P,",2),7)
End DoDot:1
+91 IF $PIECE(ACRTV1,U,11)
IF $GET(ACRHOT)'=$PIECE(ACRTV1,U,11)
Begin DoDot:1
+92 SET ACRHOT=$PIECE(ACRTV1,U,11)
+93 IF 'ACRHOT
QUIT
+94 NEW X,Y
+95 SET X=$GET(^ACRHOTEL(ACRHOT,0))
+96 SET Y=$PIECE(X,U,2)
+97 SET X=$PIECE(X,U)
+98 WRITE !?3
+99 IF Y="U"!(Y="")
SET Y="U"
WRITE "UNKNOW WHETHER "
+100 WRITE X," "
+101 WRITE $SELECT(Y=0:"DOES NOT MEET",1:"MEETS")
+102 WRITE " GSA FIRE SAFETY CODES."
End DoDot:1
+103 IF $EXTRACT($GET(IOST),1,2)="C-"
IF IOSL-8<$Y
Begin DoDot:1
+104 SET DIR(0)="YO"
+105 SET DIR("A")="Display Remaining Days"
+106 SET DIR("B")="YES"
+107 WRITE !
+108 DO DIR^ACRFDIC
+109 IF Y'=1
SET ACRQUIT=""
+110 KILL ACROUT
+111 IF '$DATA(ACRQUIT)
DO HEADSS4^ACRFSSD1
End DoDot:1
+112 IF $EXTRACT($GET(IOST),1,2)="P-"
IF IOSL-4<$Y
WRITE @IOF
DO HEADSS4^ACRFSSD1
+113 QUIT
