ACRPTO.m

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