- 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
