ACRPTOS ; GENERATED FROM 'ACR TRAVEL ORDER SUMMARY' PRINT TEMPLATE (#3962) ; 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(3962,"DXS")
S I(0)="^ACRDOC(",J(0)=9002196
X DXS(1,9) 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(3,Y)):DXS(3,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(2,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 "|"
D N:$X>7 Q:'DN W ?7 W "DHHS ORDER #: "
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 $D(ACREMPDA) W $P($G(^VA(200,ACREMPDA,20)),U,3) 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 PAUSE^ACRFWARN K DIP K:DN Y
D ITIN^ACRFSS43 K DIP K:DN Y
S ACRY="COMMENTS" D NOTES^ACRFSSD1 K DIP K:DN Y
S ACRY="PURPOSE OF TRAVEL" D JUST^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(4,Y)):DXS(4,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(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 "|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(6,Y)):DXS(6,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(7,Y)):DXS(7,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(8,Y)):DXS(8,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(9,Y)):DXS(9,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(10,Y)):DXS(10,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(11,Y)):DXS(11,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(12,Y)):DXS(12,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(13,Y)):DXS(13,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(14,Y)):DXS(14,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(15,Y)):DXS(15,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(16,Y)):DXS(16,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(17,Y)):DXS(17,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(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 "|------------------------------------------------------------------------------|"
D ^ACRFPSS K DIP K:DN Y
K Y
Q
HEAD ;
W !,"--------------------------------------------------------------------------------",!!
ACRPTOS ; GENERATED FROM 'ACR TRAVEL ORDER SUMMARY' PRINT TEMPLATE (#3962) ; 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(3962,"DXS")
+3 SET I(0)="^ACRDOC("
SET J(0)=9002196
+4 XECUTE DXS(1,9)
KILL DIP
IF DN
KILL Y
+5 SET ACRDATE=$PIECE(^ACROBL(D0,0),U,6)
KILL DIP
IF DN
KILL Y
+6 IF $EXTRACT($GET(IOST),1,2)="C-"
WRITE "ARMS REF: ",$PIECE(^ACRDOC(D0,0),U,6),"/",D0
KILL DIP
IF DN
KILL Y
+7 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "________________________________________________________________________________"
+8 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "| DHHS/INDIAN HEALTH SERVICE - OFFICIAL TRAVEL ORDER"
+9 WRITE ?$X+6,"(PREPARED: ",$EXTRACT(ACRDATE,4,5),"-",$EXTRACT(ACRDATE,6,7),"-",$EXTRACT(ACRDATE,2,3),")"
KILL DIP
IF DN
KILL Y
+10 IF $X>79
DO N
IF 'DN
QUIT
WRITE ?79
WRITE "|"
+11 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "|"
+12 SET X=$GET(^ACRDOC(D0,"TO"))
WRITE ?3
SET Y=$PIECE(X,U,1)
IF Y]""
WRITE $SELECT($DATA(DXS(3,Y)):DXS(3,Y),1:Y)
+13 WRITE ?14
WRITE "TRAVEL ORDER #:"
+14 SET X=$GET(^ACRDOC(D0,0))
WRITE ?31,$EXTRACT($PIECE(X,U,1),1,17)
+15 IF $X>49
DO N
IF 'DN
QUIT
WRITE ?49
WRITE "APPROPRIATION #:"
+16 WRITE ?67
XECUTE DXS(2,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)
+17 IF $X>79
DO N
IF 'DN
QUIT
WRITE ?79
WRITE "|"
+18 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "|"
+19 IF $X>7
DO N
IF 'DN
QUIT
WRITE ?7
WRITE "DHHS ORDER #: "
+20 WRITE $$EXPDN^ACRFUTL(D0)
KILL DIP
IF DN
KILL Y
+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 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "|TRAVELER........:"
+24 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)
+25 IF $X>51
DO N
IF 'DN
QUIT
WRITE ?51
WRITE "|SSN.....:"
+26 WRITE ?63
WRITE $$PSSN^ACRFUTL(ACREMPDA,$GET(DUZ),$GET(IOST),$GET(ACRSSNOK))
KILL DIP
IF DN
KILL Y
+27 IF $X>79
DO N
IF 'DN
QUIT
WRITE ?79
WRITE "|"
+28 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "|POSITION........:"
+29 IF $X>19
DO N
IF 'DN
QUIT
WRITE ?19
IF $DATA(ACREMPDA)
WRITE $PIECE($GET(^VA(200,ACREMPDA,20)),U,3)
KILL DIP
IF DN
KILL Y
+30 IF $X>51
DO N
IF 'DN
QUIT
WRITE ?51
WRITE "|PAY PLAN:"
+31 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
+32 IF $X>79
DO N
IF 'DN
QUIT
WRITE ?79
WRITE "|"
+33 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "|BUREAU/DIVISION.:"
+34 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)
+35 IF $X>51
DO N
IF 'DN
QUIT
WRITE ?51
WRITE "|DEPART..:"
+36 WRITE ?63
SET Y=$PIECE(X,U,14)
DO DT
+37 IF $X>79
DO N
IF 'DN
QUIT
WRITE ?79
WRITE "|"
+38 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "|OFFICIAL STATION:"
+39 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)
+40 IF $X>51
DO N
IF 'DN
QUIT
WRITE ?51
WRITE "|RETURN..:"
+41 WRITE ?63
SET Y=$PIECE(X,U,15)
DO DT
+42 IF $X>79
DO N
IF 'DN
QUIT
WRITE ?79
WRITE "|"
+43 DO PAUSE^ACRFWARN
KILL DIP
IF DN
KILL Y
+44 DO ITIN^ACRFSS43
KILL DIP
IF DN
KILL Y
+45 SET ACRY="COMMENTS"
DO NOTES^ACRFSSD1
KILL DIP
IF DN
KILL Y
+46 SET ACRY="PURPOSE OF TRAVEL"
DO JUST^ACRFSSD1
KILL DIP
IF DN
KILL Y
+47 IF $DATA(^ACRTV("C",D0))
DO ^ACRFSSRC
KILL DIP
IF DN
KILL Y
+48 DO PAUSE^ACRFWARN
KILL DIP
IF DN
KILL Y
+49 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "|------- SPECIAL AUTHORIZATIONS --------"
+50 IF $X>40
DO N
IF 'DN
QUIT
WRITE ?40
WRITE "---------- CHANGE OF STATION ----------"
+51 IF $X>79
DO N
IF 'DN
QUIT
WRITE ?79
WRITE "|"
+52 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "|TRAVEL BY POV...:"
+53 SET X=$GET(^ACRDOC(D0,"TOSA"))
WRITE ?20
SET Y=$PIECE(X,U,1)
IF Y]""
WRITE $SELECT($DATA(DXS(4,Y)):DXS(4,Y),1:Y)
+54 IF $X>40
DO N
IF 'DN
QUIT
WRITE ?40
WRITE "|TRANS DEPENDENTS..:"
+55 SET X=$GET(^ACRDOC(D0,"TOPCS"))
WRITE ?62
SET Y=$PIECE(X,U,1)
IF Y]""
WRITE $SELECT($DATA(DXS(5,Y)):DXS(5,Y),1:Y)
+56 IF $X>79
DO N
IF 'DN
QUIT
WRITE ?79
WRITE "|"
+57 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "|MILEAGE RATE....:"
+58 SET X=$GET(^ACRDOC(D0,"TOSA"))
WRITE ?20
SET Y=$PIECE(X,U,10)
IF Y]""
WRITE $JUSTIFY(Y,6,3)
+59 IF $X>40
DO N
IF 'DN
QUIT
WRITE ?40
WRITE "|TRANS H/H GOODS...:"
+60 SET X=$GET(^ACRDOC(D0,"TOPCS"))
WRITE ?62
SET Y=$PIECE(X,U,8)
IF Y]""
WRITE $SELECT($DATA(DXS(6,Y)):DXS(6,Y),1:Y)
+61 IF $X>79
DO N
IF 'DN
QUIT
WRITE ?79
WRITE "|"
+62 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "|GSA AUTO........:"
+63 SET X=$GET(^ACRDOC(D0,"TOSA"))
WRITE ?20
SET Y=$PIECE(X,U,2)
IF Y]""
WRITE $SELECT($DATA(DXS(7,Y)):DXS(7,Y),1:Y)
+64 IF $X>40
DO N
IF 'DN
QUIT
WRITE ?40
WRITE "|TEMPORARY QUARTERS:"
+65 SET X=$GET(^ACRDOC(D0,"TOPCS"))
WRITE ?62
SET Y=$PIECE(X,U,2)
IF Y]""
WRITE $SELECT($DATA(DXS(8,Y)):DXS(8,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 "|AUTO RENTAL.....:"
+68 SET X=$GET(^ACRDOC(D0,"TOSA"))
WRITE ?20
SET Y=$PIECE(X,U,3)
IF Y]""
WRITE $SELECT($DATA(DXS(9,Y)):DXS(9,Y),1:Y)
+69 IF $X>40
DO N
IF 'DN
QUIT
WRITE ?40
WRITE "|RESIDENCE TRANS...:"
+70 SET X=$GET(^ACRDOC(D0,"TOPCS"))
WRITE ?62
SET Y=$PIECE(X,U,3)
IF Y]""
WRITE $SELECT($DATA(DXS(10,Y)):DXS(10,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 "|EXCESS BAGAGE...:"
+73 SET X=$GET(^ACRDOC(D0,"TOSA"))
WRITE ?20
SET Y=$PIECE(X,U,5)
IF Y]""
WRITE $SELECT($DATA(DXS(11,Y)):DXS(11,Y),1:Y)
+74 IF $X>40
DO N
IF 'DN
QUIT
WRITE ?40
WRITE "|TEMPORARY STORAGE.:"
+75 SET X=$GET(^ACRDOC(D0,"TOPCS"))
WRITE ?62
SET Y=$PIECE(X,U,4)
IF Y]""
WRITE $SELECT($DATA(DXS(12,Y)):DXS(12,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 "|REGISTRATION FEE:"
+78 SET X=$GET(^ACRDOC(D0,"TOSA"))
WRITE ?20
SET Y=$PIECE(X,U,6)
IF Y]""
WRITE $SELECT($DATA(DXS(13,Y)):DXS(13,Y),1:Y)
+79 IF $X>40
DO N
IF 'DN
QUIT
WRITE ?40
WRITE "|HOUSE HUNT TRIP...:"
+80 SET X=$GET(^ACRDOC(D0,"TOPCS"))
WRITE ?62
SET Y=$PIECE(X,U,5)
IF Y]""
WRITE $SELECT($DATA(DXS(14,Y)):DXS(14,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 "|TRAVEL ADVANCE..:"
+83 SET X=$GET(^ACRDOC(D0,"TO"))
WRITE ?20
SET Y=$PIECE(X,U,19)
IF Y]""
WRITE $SELECT($DATA(DXS(15,Y)):DXS(15,Y),1:Y)
+84 IF $X>40
DO N
IF 'DN
QUIT
WRITE ?40
WRITE "|MISC EXP ALLOWANCE:"
+85 SET X=$GET(^ACRDOC(D0,"TOPCS"))
WRITE ?62
SET Y=$PIECE(X,U,6)
IF Y]""
WRITE $SELECT($DATA(DXS(16,Y)):DXS(16,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 "|ATM ALLOWED.....:"
+88 SET X=$GET(^ACRDOC(D0,"TO"))
WRITE ?20
SET Y=$PIECE(X,U,22)
IF Y]""
WRITE $SELECT($DATA(DXS(17,Y)):DXS(17,Y),1:Y)
+89 IF $X>40
DO N
IF 'DN
QUIT
WRITE ?40
WRITE "|OTHER.............:"
+90 SET X=$GET(^ACRDOC(D0,"TOSA"))
WRITE ?62
SET Y=$PIECE(X,U,4)
IF Y]""
WRITE $SELECT($DATA(DXS(18,Y)):DXS(18,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 "|------------------------------------------------------------------------------|"
+93 DO ^ACRFPSS
KILL DIP
IF DN
KILL Y
+94 KILL Y
+95 QUIT
HEAD ;
+1 WRITE !,"--------------------------------------------------------------------------------",!!
