ACRPTO ; GENERATED FROM 'ACR TRAVEL ORDER' PRINT TEMPLATE (#3864) ; 09/30/09 ; (FILE 9002196, MARGIN=80)
G BEGIN
N W !
T W:$X ! I '$D(DIOT(2)),DN,$D(IOSL),$S('$D(DIWF):1,$P(DIWF,"B",2):$P(DIWF,"B",2),1:1)+$Y'<IOSL,$D(^UTILITY($J,1))#2,^(1)?1U1P1E.E X ^(1)
S DISTP=DISTP+1,DILCT=DILCT+1 D:'(DISTP#100) CSTP^DIO2
Q
DT I $G(DUZ("LANG"))>1,Y W $$OUT^DIALOGU(Y,"DD") Q
I Y W $P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC",U,$E(Y,4,5))_" " W:Y#100 $J(Y#100\1,2)_"," W Y\10000+1700 W:Y#1 " "_$E(Y_0,9,10)_":"_$E(Y_"000",11,12) Q
W Y Q
M D @DIXX
Q
BEGIN ;
S:'$D(DN) DN=1 S DISTP=$G(DISTP),DILCT=$G(DILCT)
I $D(DXS)<9 M DXS=^DIPT(3864,"DXS")
S I(0)="^ACRDOC(",J(0)=9002196
W ?0 S ACREMPDA=$P($G(^ACRDOC(D0,"TO")),U,9) K DIP K:DN Y
W ?11 S ACREMP=$G(^ACRAU(+ACREMPDA,1)) K DIP K:DN Y
W ?22 S ACRPBDA=$P($G(^ACROBL(D0,0)),U,5) K DIP K:DN Y
W ?33 S ACRPB=$$NAME2^ACRFUTL1(+ACRPBDA) K DIP K:DN Y
W ?44 S ACRPBPH=$P($G(^VA(200,+ACRPBDA,.13)),U) K DIP K:DN Y
S ACRDATE=$P(^ACROBL(D0,0),U,6) K DIP K:DN Y
I $E($G(IOST),1,2)="C-" W "ARMS REF: ",$P(^ACRDOC(D0,0),U,6),"/",D0 K DIP K:DN Y
D N:$X>0 Q:'DN W ?0 W "________________________________________________________________________________"
D N:$X>0 Q:'DN W ?0 W "| DHHS/INDIAN HEALTH SERVICE - OFFICIAL TRAVEL ORDER"
W ?$X+6,"(PREPARED: ",$E(ACRDATE,4,5),"-",$E(ACRDATE,6,7),"-",$E(ACRDATE,2,3),")" K DIP K:DN Y
D N:$X>79 Q:'DN W ?79 W "|"
D N:$X>0 Q:'DN W ?0 W "|"
S X=$G(^ACRDOC(D0,"TO")) W ?3 S Y=$P(X,U,1) W:Y]"" $S($D(DXS(2,Y)):DXS(2,Y),1:Y)
W ?14 W "TRAVEL ORDER #:"
S X=$G(^ACRDOC(D0,0)) W ?31,$E($P(X,U,1),1,17)
D N:$X>49 Q:'DN W ?49 W "APPROPRIATION #:"
W ?67 X DXS(1,9.2) S X=$P($G(^AUTTPRO(+$P(DIP(101),U,4),0)),U) S D0=I(0,0) K DIP K:DN Y W $E(X,1,10)
D N:$X>79 Q:'DN W ?79 W "|"
D N:$X>0 Q:'DN W ?0 W "|"
W ?3 W " DHHS DOCUMENT #: "
W $$EXPDN^ACRFUTL(D0) K DIP K:DN Y
D N:$X>79 Q:'DN W ?79 W "|"
D N:$X>0 Q:'DN W ?0 W "|------------------------------------------------------------------------------|"
D N:$X>0 Q:'DN W ?0 W "|TRAVELER........:"
S X=$G(^ACRDOC(D0,"TO")) D N:$X>19 Q:'DN W ?19 S Y=$P(X,U,9) S Y(0)=Y S Y=$$NAME2^ACRFUTL1(Y) W $E(Y,1,30)
D N:$X>51 Q:'DN W ?51 W "|SSN.....:"
W ?63 W $$PSSN^ACRFUTL(ACREMPDA,$G(DUZ),$G(IOST),$G(ACRSSNOK)) K DIP K:DN Y
D N:$X>79 Q:'DN W ?79 W "|"
D N:$X>0 Q:'DN W ?0 W "|POSITION........:"
D N:$X>19 Q:'DN W ?19 I $G(ACREMPDA) W $E($P($G(^VA(200,ACREMPDA,20)),U,3),1,30) K DIP K:DN Y
D N:$X>51 Q:'DN W ?51 W "|PAY PLAN:"
W ?63 I $D(ACREMP),$P(ACREMP,U,3)]"" W $P(ACREMP,U,3),"-",$P(ACREMP,U,4) K DIP K:DN Y
D N:$X>79 Q:'DN W ?79 W "|"
D N:$X>0 Q:'DN W ?0 W "|BUREAU/DIVISION.:"
S X=$G(^ACRDOC(D0,"TO")) D N:$X>19 Q:'DN W ?19 S Y=$P(X,U,12) S Y=$S(Y="":Y,$D(^AUTTPRG(Y,0))#2:$P(^(0),U),1:Y) W $E(Y,1,30)
D N:$X>51 Q:'DN W ?51 W "|DEPART..:"
W ?63 S Y=$P(X,U,14) D DT
D N:$X>79 Q:'DN W ?79 W "|"
D N:$X>0 Q:'DN W ?0 W "|OFFICIAL STATION:"
D N:$X>19 Q:'DN W ?19 S Y=$P(X,U,13) S Y=$S(Y="":Y,$D(^AUTTLOC(Y,0))#2:$P(^(0),U),1:Y) S Y=$S(Y="":Y,$D(^DIC(4,Y,0))#2:$P(^(0),U),1:Y) W $E(Y,1,30)
D N:$X>51 Q:'DN W ?51 W "|RETURN..:"
W ?63 S Y=$P(X,U,15) D DT
D N:$X>79 Q:'DN W ?79 W "|"
D N:$X>0 Q:'DN W ?0 W "|TO PREPARED BY..: "
W $G(ACRPB) K DIP K:DN Y
D N:$X>51 Q:'DN W ?51 W "|PHONE...:"
W ?63 W $E($G(ACRPBPH),1,16) K DIP K:DN Y
D N:$X>79 Q:'DN W ?79 W "|"
D T Q:'DN W ?2 K ACRPBDA,ACRPB,ACRPBPH K DIP K:DN Y
D PAUSE^ACRFWARN K DIP K:DN Y
D ITIN^ACRFSS43 K DIP K:DN Y
S ACRY="PURPOSE OF TRAVEL" D JUST^ACRFSSD1 K DIP K:DN Y
S ACRY="COMMENTS" D NOTES^ACRFSSD1 K DIP K:DN Y
I $D(^ACRTV("C",D0)) D ^ACRFSSRC K DIP K:DN Y
D PAUSE^ACRFWARN K DIP K:DN Y
D N:$X>0 Q:'DN W ?0 W "|------- SPECIAL AUTHORIZATIONS --------"
D N:$X>40 Q:'DN W ?40 W "---------- CHANGE OF STATION ----------"
D N:$X>79 Q:'DN W ?79 W "|"
D N:$X>0 Q:'DN W ?0 W "|TRAVEL BY POV...:"
S X=$G(^ACRDOC(D0,"TOSA")) W ?20 S Y=$P(X,U,1) W:Y]"" $S($D(DXS(3,Y)):DXS(3,Y),1:Y)
D N:$X>40 Q:'DN W ?40 W "|TRANS DEPENDENTS..:"
S X=$G(^ACRDOC(D0,"TOPCS")) W ?62 S Y=$P(X,U,1) W:Y]"" $S($D(DXS(4,Y)):DXS(4,Y),1:Y)
D N:$X>79 Q:'DN W ?79 W "|"
D N:$X>0 Q:'DN W ?0 W "|MILEAGE RATE....:"
S X=$G(^ACRDOC(D0,"TOSA")) W ?20 S Y=$P(X,U,10) W:Y]"" $J(Y,6,3)
D N:$X>40 Q:'DN W ?40 W "|TRANS H/H GOODS...:"
S X=$G(^ACRDOC(D0,"TOPCS")) W ?62 S Y=$P(X,U,8) W:Y]"" $S($D(DXS(5,Y)):DXS(5,Y),1:Y)
D N:$X>79 Q:'DN W ?79 W "|"
D N:$X>0 Q:'DN W ?0 W "|GSA AUTO........:"
S X=$G(^ACRDOC(D0,"TOSA")) W ?20 S Y=$P(X,U,2) W:Y]"" $S($D(DXS(6,Y)):DXS(6,Y),1:Y)
D N:$X>40 Q:'DN W ?40 W "|TEMPORARY QUARTERS:"
S X=$G(^ACRDOC(D0,"TOPCS")) W ?62 S Y=$P(X,U,2) W:Y]"" $S($D(DXS(7,Y)):DXS(7,Y),1:Y)
D N:$X>79 Q:'DN W ?79 W "|"
D N:$X>0 Q:'DN W ?0 W "|AUTO RENTAL.....:"
S X=$G(^ACRDOC(D0,"TOSA")) W ?20 S Y=$P(X,U,3) W:Y]"" $S($D(DXS(8,Y)):DXS(8,Y),1:Y)
D N:$X>40 Q:'DN W ?40 W "|RESIDENCE TRANS...:"
S X=$G(^ACRDOC(D0,"TOPCS")) W ?62 S Y=$P(X,U,3) W:Y]"" $S($D(DXS(9,Y)):DXS(9,Y),1:Y)
D N:$X>79 Q:'DN W ?79 W "|"
D N:$X>0 Q:'DN W ?0 W "|EXCESS BAGAGE...:"
S X=$G(^ACRDOC(D0,"TOSA")) W ?20 S Y=$P(X,U,5) W:Y]"" $S($D(DXS(10,Y)):DXS(10,Y),1:Y)
D N:$X>40 Q:'DN W ?40 W "|TEMPORARY STORAGE.:"
S X=$G(^ACRDOC(D0,"TOPCS")) W ?62 S Y=$P(X,U,4) W:Y]"" $S($D(DXS(11,Y)):DXS(11,Y),1:Y)
D N:$X>79 Q:'DN W ?79 W "|"
D N:$X>0 Q:'DN W ?0 W "|REGISTRATION FEE:"
S X=$G(^ACRDOC(D0,"TOSA")) W ?20 S Y=$P(X,U,6) W:Y]"" $S($D(DXS(12,Y)):DXS(12,Y),1:Y)
D N:$X>40 Q:'DN W ?40 W "|HOUSE HUNT TRIP...:"
S X=$G(^ACRDOC(D0,"TOPCS")) W ?62 S Y=$P(X,U,5) W:Y]"" $S($D(DXS(13,Y)):DXS(13,Y),1:Y)
D N:$X>79 Q:'DN W ?79 W "|"
D N:$X>0 Q:'DN W ?0 W "|TRAVEL ADVANCE..:"
S X=$G(^ACRDOC(D0,"TO")) W ?20 S Y=$P(X,U,19) W:Y]"" $S($D(DXS(14,Y)):DXS(14,Y),1:Y)
D N:$X>40 Q:'DN W ?40 W "|MISC EXP ALLOWANCE:"
S X=$G(^ACRDOC(D0,"TOPCS")) W ?62 S Y=$P(X,U,6) W:Y]"" $S($D(DXS(15,Y)):DXS(15,Y),1:Y)
D N:$X>79 Q:'DN W ?79 W "|"
D N:$X>0 Q:'DN W ?0 W "|ATM ALLOWED.....:"
S X=$G(^ACRDOC(D0,"TO")) W ?20 S Y=$P(X,U,22) W:Y]"" $S($D(DXS(16,Y)):DXS(16,Y),1:Y)
D N:$X>40 Q:'DN W ?40 W "|OTHER.............:"
S X=$G(^ACRDOC(D0,"TOSA")) W ?62 S Y=$P(X,U,4) W:Y]"" $S($D(DXS(17,Y)):DXS(17,Y),1:Y)
D N:$X>79 Q:'DN W ?79 W "|"
D N:$X>0 Q:'DN W ?0 W "|------------------------------------------------------------------------------|"
D N:$X>0 Q:'DN W ?0 W "| TRAVEL & PER DIEM ARE AUTHORIZED IN ACCORDANCE WITH DHHS POLICY AND:"
D N:$X>79 Q:'DN W ?79 W "|"
D N:$X>0 Q:'DN W ?0 W "|REGULATIONS........:"
S X=$G(^ACRDOC(D0,"TOTV")) W ?23 S Y=$P(X,U,1) W:Y]"" $S($D(DXS(18,Y)):DXS(18,Y),1:Y)
D N:$X>79 Q:'DN W ?79 W "|"
D N:$X>0 Q:'DN W ?0 W "|PER DIEM BASIS.....:"
W ?23 S Y=$P(X,U,2) W:Y]"" $S($D(DXS(19,Y)):DXS(19,Y),1:Y)
D N:$X>79 Q:'DN W ?79 W "|"
D N:$X>0 Q:'DN W ?0 W "|PER DIEM RATE BASIS:"
W ?23 S Y=$P(X,U,4) W:Y]"" $S($D(DXS(20,Y)):DXS(20,Y),1:Y)
D N:$X>79 Q:'DN W ?79 W "|"
D LODGE^ACRFSS43 K DIP K:DN Y
D N:$X>0 Q:'DN W ?0 W "|------------------------------------------------------------------------------|"
D N:$X>0 Q:'DN W ?0 W "| ADDITIONAL COSTS FOR CIRCUITOUS TRAVEL WILL BE BORNE BY THE TRAVELER"
D N:$X>79 Q:'DN W ?79 W "|"
D N:$X>0 Q:'DN W ?0 W "| EXCESS TRAVEL TIME WILL BE CHARGED TO ANNUAL LEAVE."
D N:$X>79 Q:'DN W ?79 W "|"
D PAUSE^ACRFWARN K DIP K:DN Y
D ^ACRFPSS K DIP K:DN Y
G ^ACRPTO1
ACRPTO ; GENERATED FROM 'ACR TRAVEL ORDER' PRINT TEMPLATE (#3864) ; 09/30/09 ; (FILE 9002196, MARGIN=80)
+1 GOTO BEGIN
N WRITE !
T IF $X
WRITE !
IF '$DATA(DIOT(2))
IF DN
IF $DATA(IOSL)
IF $SELECT('$DATA(DIWF):1,$PIECE(DIWF,"B",2):$PIECE(DIWF,"B",2),1:1)+$Y'<IOSL
IF $DATA(^UTILITY($JOB,1))#2
IF ^(1)?1U1P1E.E
XECUTE ^(1)
+1 SET DISTP=DISTP+1
SET DILCT=DILCT+1
IF '(DISTP#100)
DO CSTP^DIO2
+2 QUIT
DT IF $GET(DUZ("LANG"))>1
IF Y
WRITE $$OUT^DIALOGU(Y,"DD")
QUIT
+1 IF Y
WRITE $PIECE("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC",U,$EXTRACT(Y,4,5))_" "
IF Y#100
WRITE $JUSTIFY(Y#100\1,2)_","
WRITE Y\10000+1700
IF Y#1
WRITE " "_$EXTRACT(Y_0,9,10)_":"_$EXTRACT(Y_"000",11,12)
QUIT
+2 WRITE Y
QUIT
M DO @DIXX
+1 QUIT
BEGIN ;
+1 IF '$DATA(DN)
SET DN=1
SET DISTP=$GET(DISTP)
SET DILCT=$GET(DILCT)
+2 IF $DATA(DXS)<9
MERGE DXS=^DIPT(3864,"DXS")
+3 SET I(0)="^ACRDOC("
SET J(0)=9002196
+4 WRITE ?0
SET ACREMPDA=$PIECE($GET(^ACRDOC(D0,"TO")),U,9)
KILL DIP
IF DN
KILL Y
+5 WRITE ?11
SET ACREMP=$GET(^ACRAU(+ACREMPDA,1))
KILL DIP
IF DN
KILL Y
+6 WRITE ?22
SET ACRPBDA=$PIECE($GET(^ACROBL(D0,0)),U,5)
KILL DIP
IF DN
KILL Y
+7 WRITE ?33
SET ACRPB=$$NAME2^ACRFUTL1(+ACRPBDA)
KILL DIP
IF DN
KILL Y
+8 WRITE ?44
SET ACRPBPH=$PIECE($GET(^VA(200,+ACRPBDA,.13)),U)
KILL DIP
IF DN
KILL Y
+9 SET ACRDATE=$PIECE(^ACROBL(D0,0),U,6)
KILL DIP
IF DN
KILL Y
+10 IF $EXTRACT($GET(IOST),1,2)="C-"
WRITE "ARMS REF: ",$PIECE(^ACRDOC(D0,0),U,6),"/",D0
KILL DIP
IF DN
KILL Y
+11 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "________________________________________________________________________________"
+12 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "| DHHS/INDIAN HEALTH SERVICE - OFFICIAL TRAVEL ORDER"
+13 WRITE ?$X+6,"(PREPARED: ",$EXTRACT(ACRDATE,4,5),"-",$EXTRACT(ACRDATE,6,7),"-",$EXTRACT(ACRDATE,2,3),")"
KILL DIP
IF DN
KILL Y
+14 IF $X>79
DO N
IF 'DN
QUIT
WRITE ?79
WRITE "|"
+15 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "|"
+16 SET X=$GET(^ACRDOC(D0,"TO"))
WRITE ?3
SET Y=$PIECE(X,U,1)
IF Y]""
WRITE $SELECT($DATA(DXS(2,Y)):DXS(2,Y),1:Y)
+17 WRITE ?14
WRITE "TRAVEL ORDER #:"
+18 SET X=$GET(^ACRDOC(D0,0))
WRITE ?31,$EXTRACT($PIECE(X,U,1),1,17)
+19 IF $X>49
DO N
IF 'DN
QUIT
WRITE ?49
WRITE "APPROPRIATION #:"
+20 WRITE ?67
XECUTE DXS(1,9.2)
SET X=$PIECE($GET(^AUTTPRO(+$PIECE(DIP(101),U,4),0)),U)
SET D0=I(0,0)
KILL DIP
IF DN
KILL Y
WRITE $EXTRACT(X,1,10)
+21 IF $X>79
DO N
IF 'DN
QUIT
WRITE ?79
WRITE "|"
+22 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "|"
+23 WRITE ?3
WRITE " DHHS DOCUMENT #: "
+24 WRITE $$EXPDN^ACRFUTL(D0)
KILL DIP
IF DN
KILL Y
+25 IF $X>79
DO N
IF 'DN
QUIT
WRITE ?79
WRITE "|"
+26 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "|------------------------------------------------------------------------------|"
+27 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "|TRAVELER........:"
+28 SET X=$GET(^ACRDOC(D0,"TO"))
IF $X>19
DO N
IF 'DN
QUIT
WRITE ?19
SET Y=$PIECE(X,U,9)
SET Y(0)=Y
SET Y=$$NAME2^ACRFUTL1(Y)
WRITE $EXTRACT(Y,1,30)
+29 IF $X>51
DO N
IF 'DN
QUIT
WRITE ?51
WRITE "|SSN.....:"
+30 WRITE ?63
WRITE $$PSSN^ACRFUTL(ACREMPDA,$GET(DUZ),$GET(IOST),$GET(ACRSSNOK))
KILL DIP
IF DN
KILL Y
+31 IF $X>79
DO N
IF 'DN
QUIT
WRITE ?79
WRITE "|"
+32 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "|POSITION........:"
+33 IF $X>19
DO N
IF 'DN
QUIT
WRITE ?19
IF $GET(ACREMPDA)
WRITE $EXTRACT($PIECE($GET(^VA(200,ACREMPDA,20)),U,3),1,30)
KILL DIP
IF DN
KILL Y
+34 IF $X>51
DO N
IF 'DN
QUIT
WRITE ?51
WRITE "|PAY PLAN:"
+35 WRITE ?63
IF $DATA(ACREMP)
IF $PIECE(ACREMP,U,3)]""
WRITE $PIECE(ACREMP,U,3),"-",$PIECE(ACREMP,U,4)
KILL DIP
IF DN
KILL Y
+36 IF $X>79
DO N
IF 'DN
QUIT
WRITE ?79
WRITE "|"
+37 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "|BUREAU/DIVISION.:"
+38 SET X=$GET(^ACRDOC(D0,"TO"))
IF $X>19
DO N
IF 'DN
QUIT
WRITE ?19
SET Y=$PIECE(X,U,12)
SET Y=$SELECT(Y="":Y,$DATA(^AUTTPRG(Y,0))#2:$PIECE(^(0),U),1:Y)
WRITE $EXTRACT(Y,1,30)
+39 IF $X>51
DO N
IF 'DN
QUIT
WRITE ?51
WRITE "|DEPART..:"
+40 WRITE ?63
SET Y=$PIECE(X,U,14)
DO DT
+41 IF $X>79
DO N
IF 'DN
QUIT
WRITE ?79
WRITE "|"
+42 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "|OFFICIAL STATION:"
+43 IF $X>19
DO N
IF 'DN
QUIT
WRITE ?19
SET Y=$PIECE(X,U,13)
SET Y=$SELECT(Y="":Y,$DATA(^AUTTLOC(Y,0))#2:$PIECE(^(0),U),1:Y)
SET Y=$SELECT(Y="":Y,$DATA(^DIC(4,Y,0))#2:$PIECE(^(0),U),1:Y)
WRITE $EXTRACT(Y,1,30)
+44 IF $X>51
DO N
IF 'DN
QUIT
WRITE ?51
WRITE "|RETURN..:"
+45 WRITE ?63
SET Y=$PIECE(X,U,15)
DO DT
+46 IF $X>79
DO N
IF 'DN
QUIT
WRITE ?79
WRITE "|"
+47 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "|TO PREPARED BY..: "
+48 WRITE $GET(ACRPB)
KILL DIP
IF DN
KILL Y
+49 IF $X>51
DO N
IF 'DN
QUIT
WRITE ?51
WRITE "|PHONE...:"
+50 WRITE ?63
WRITE $EXTRACT($GET(ACRPBPH),1,16)
KILL DIP
IF DN
KILL Y
+51 IF $X>79
DO N
IF 'DN
QUIT
WRITE ?79
WRITE "|"
+52 DO T
IF 'DN
QUIT
WRITE ?2
KILL ACRPBDA,ACRPB,ACRPBPH
KILL DIP
IF DN
KILL Y
+53 DO PAUSE^ACRFWARN
KILL DIP
IF DN
KILL Y
+54 DO ITIN^ACRFSS43
KILL DIP
IF DN
KILL Y
+55 SET ACRY="PURPOSE OF TRAVEL"
DO JUST^ACRFSSD1
KILL DIP
IF DN
KILL Y
+56 SET ACRY="COMMENTS"
DO NOTES^ACRFSSD1
KILL DIP
IF DN
KILL Y
+57 IF $DATA(^ACRTV("C",D0))
DO ^ACRFSSRC
KILL DIP
IF DN
KILL Y
+58 DO PAUSE^ACRFWARN
KILL DIP
IF DN
KILL Y
+59 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "|------- SPECIAL AUTHORIZATIONS --------"
+60 IF $X>40
DO N
IF 'DN
QUIT
WRITE ?40
WRITE "---------- CHANGE OF STATION ----------"
+61 IF $X>79
DO N
IF 'DN
QUIT
WRITE ?79
WRITE "|"
+62 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "|TRAVEL BY POV...:"
+63 SET X=$GET(^ACRDOC(D0,"TOSA"))
WRITE ?20
SET Y=$PIECE(X,U,1)
IF Y]""
WRITE $SELECT($DATA(DXS(3,Y)):DXS(3,Y),1:Y)
+64 IF $X>40
DO N
IF 'DN
QUIT
WRITE ?40
WRITE "|TRANS DEPENDENTS..:"
+65 SET X=$GET(^ACRDOC(D0,"TOPCS"))
WRITE ?62
SET Y=$PIECE(X,U,1)
IF Y]""
WRITE $SELECT($DATA(DXS(4,Y)):DXS(4,Y),1:Y)
+66 IF $X>79
DO N
IF 'DN
QUIT
WRITE ?79
WRITE "|"
+67 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "|MILEAGE RATE....:"
+68 SET X=$GET(^ACRDOC(D0,"TOSA"))
WRITE ?20
SET Y=$PIECE(X,U,10)
IF Y]""
WRITE $JUSTIFY(Y,6,3)
+69 IF $X>40
DO N
IF 'DN
QUIT
WRITE ?40
WRITE "|TRANS H/H GOODS...:"
+70 SET X=$GET(^ACRDOC(D0,"TOPCS"))
WRITE ?62
SET Y=$PIECE(X,U,8)
IF Y]""
WRITE $SELECT($DATA(DXS(5,Y)):DXS(5,Y),1:Y)
+71 IF $X>79
DO N
IF 'DN
QUIT
WRITE ?79
WRITE "|"
+72 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "|GSA AUTO........:"
+73 SET X=$GET(^ACRDOC(D0,"TOSA"))
WRITE ?20
SET Y=$PIECE(X,U,2)
IF Y]""
WRITE $SELECT($DATA(DXS(6,Y)):DXS(6,Y),1:Y)
+74 IF $X>40
DO N
IF 'DN
QUIT
WRITE ?40
WRITE "|TEMPORARY QUARTERS:"
+75 SET X=$GET(^ACRDOC(D0,"TOPCS"))
WRITE ?62
SET Y=$PIECE(X,U,2)
IF Y]""
WRITE $SELECT($DATA(DXS(7,Y)):DXS(7,Y),1:Y)
+76 IF $X>79
DO N
IF 'DN
QUIT
WRITE ?79
WRITE "|"
+77 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "|AUTO RENTAL.....:"
+78 SET X=$GET(^ACRDOC(D0,"TOSA"))
WRITE ?20
SET Y=$PIECE(X,U,3)
IF Y]""
WRITE $SELECT($DATA(DXS(8,Y)):DXS(8,Y),1:Y)
+79 IF $X>40
DO N
IF 'DN
QUIT
WRITE ?40
WRITE "|RESIDENCE TRANS...:"
+80 SET X=$GET(^ACRDOC(D0,"TOPCS"))
WRITE ?62
SET Y=$PIECE(X,U,3)
IF Y]""
WRITE $SELECT($DATA(DXS(9,Y)):DXS(9,Y),1:Y)
+81 IF $X>79
DO N
IF 'DN
QUIT
WRITE ?79
WRITE "|"
+82 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "|EXCESS BAGAGE...:"
+83 SET X=$GET(^ACRDOC(D0,"TOSA"))
WRITE ?20
SET Y=$PIECE(X,U,5)
IF Y]""
WRITE $SELECT($DATA(DXS(10,Y)):DXS(10,Y),1:Y)
+84 IF $X>40
DO N
IF 'DN
QUIT
WRITE ?40
WRITE "|TEMPORARY STORAGE.:"
+85 SET X=$GET(^ACRDOC(D0,"TOPCS"))
WRITE ?62
SET Y=$PIECE(X,U,4)
IF Y]""
WRITE $SELECT($DATA(DXS(11,Y)):DXS(11,Y),1:Y)
+86 IF $X>79
DO N
IF 'DN
QUIT
WRITE ?79
WRITE "|"
+87 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "|REGISTRATION FEE:"
+88 SET X=$GET(^ACRDOC(D0,"TOSA"))
WRITE ?20
SET Y=$PIECE(X,U,6)
IF Y]""
WRITE $SELECT($DATA(DXS(12,Y)):DXS(12,Y),1:Y)
+89 IF $X>40
DO N
IF 'DN
QUIT
WRITE ?40
WRITE "|HOUSE HUNT TRIP...:"
+90 SET X=$GET(^ACRDOC(D0,"TOPCS"))
WRITE ?62
SET Y=$PIECE(X,U,5)
IF Y]""
WRITE $SELECT($DATA(DXS(13,Y)):DXS(13,Y),1:Y)
+91 IF $X>79
DO N
IF 'DN
QUIT
WRITE ?79
WRITE "|"
+92 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "|TRAVEL ADVANCE..:"
+93 SET X=$GET(^ACRDOC(D0,"TO"))
WRITE ?20
SET Y=$PIECE(X,U,19)
IF Y]""
WRITE $SELECT($DATA(DXS(14,Y)):DXS(14,Y),1:Y)
+94 IF $X>40
DO N
IF 'DN
QUIT
WRITE ?40
WRITE "|MISC EXP ALLOWANCE:"
+95 SET X=$GET(^ACRDOC(D0,"TOPCS"))
WRITE ?62
SET Y=$PIECE(X,U,6)
IF Y]""
WRITE $SELECT($DATA(DXS(15,Y)):DXS(15,Y),1:Y)
+96 IF $X>79
DO N
IF 'DN
QUIT
WRITE ?79
WRITE "|"
+97 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "|ATM ALLOWED.....:"
+98 SET X=$GET(^ACRDOC(D0,"TO"))
WRITE ?20
SET Y=$PIECE(X,U,22)
IF Y]""
WRITE $SELECT($DATA(DXS(16,Y)):DXS(16,Y),1:Y)
+99 IF $X>40
DO N
IF 'DN
QUIT
WRITE ?40
WRITE "|OTHER.............:"
+100 SET X=$GET(^ACRDOC(D0,"TOSA"))
WRITE ?62
SET Y=$PIECE(X,U,4)
IF Y]""
WRITE $SELECT($DATA(DXS(17,Y)):DXS(17,Y),1:Y)
+101 IF $X>79
DO N
IF 'DN
QUIT
WRITE ?79
WRITE "|"
+102 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "|------------------------------------------------------------------------------|"
+103 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "| TRAVEL & PER DIEM ARE AUTHORIZED IN ACCORDANCE WITH DHHS POLICY AND:"
+104 IF $X>79
DO N
IF 'DN
QUIT
WRITE ?79
WRITE "|"
+105 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "|REGULATIONS........:"
+106 SET X=$GET(^ACRDOC(D0,"TOTV"))
WRITE ?23
SET Y=$PIECE(X,U,1)
IF Y]""
WRITE $SELECT($DATA(DXS(18,Y)):DXS(18,Y),1:Y)
+107 IF $X>79
DO N
IF 'DN
QUIT
WRITE ?79
WRITE "|"
+108 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "|PER DIEM BASIS.....:"
+109 WRITE ?23
SET Y=$PIECE(X,U,2)
IF Y]""
WRITE $SELECT($DATA(DXS(19,Y)):DXS(19,Y),1:Y)
+110 IF $X>79
DO N
IF 'DN
QUIT
WRITE ?79
WRITE "|"
+111 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "|PER DIEM RATE BASIS:"
+112 WRITE ?23
SET Y=$PIECE(X,U,4)
IF Y]""
WRITE $SELECT($DATA(DXS(20,Y)):DXS(20,Y),1:Y)
+113 IF $X>79
DO N
IF 'DN
QUIT
WRITE ?79
WRITE "|"
+114 DO LODGE^ACRFSS43
KILL DIP
IF DN
KILL Y
+115 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "|------------------------------------------------------------------------------|"
+116 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "| ADDITIONAL COSTS FOR CIRCUITOUS TRAVEL WILL BE BORNE BY THE TRAVELER"
+117 IF $X>79
DO N
IF 'DN
QUIT
WRITE ?79
WRITE "|"
+118 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "| EXCESS TRAVEL TIME WILL BE CHARGED TO ANNUAL LEAVE."
+119 IF $X>79
DO N
IF 'DN
QUIT
WRITE ?79
WRITE "|"
+120 DO PAUSE^ACRFWARN
KILL DIP
IF DN
KILL Y
+121 DO ^ACRFPSS
KILL DIP
IF DN
KILL Y
+122 GOTO ^ACRPTO1
