| 1 | PRSATD2 ; HISC/REL-Display Tours for T&L ;4/5/93 13:16
|
|---|
| 2 | ;;4.0;PAID;;Sep 21, 1995
|
|---|
| 3 | R0 R !!,"Select T&L Unit (or ALL): ",X:DTIME G:'$T!("^"[X) EX S X=$TR(X,"al","AL") I X="ALL" S TLI=0
|
|---|
| 4 | E K DIC S DIC="^PRST(455.5,",DIC(0)="EMQ" D ^DIC G EX:$D(DTOUT),R0:Y<1 S TLI=+Y
|
|---|
| 5 | W ! K IOP,%ZIS S %ZIS("A")="Select Device: ",%ZIS="MQ" D ^%ZIS K %ZIS,IOP G:POP EX
|
|---|
| 6 | I $D(IO("Q")) S PRSAPGM="Q1^PRSATD2",PRSALST="TLI" D QUE^PRSAUTL G EX
|
|---|
| 7 | U IO D Q1 D ^%ZISC K %ZIS,IOP G EX
|
|---|
| 8 | Q1 ; Process List
|
|---|
| 9 | D NOW^%DTC S X=%\1 D DTP^PRSAPPU S DTE=Y,(PG,QT)=0 D HDR
|
|---|
| 10 | S NX="" F S NX=$O(^PRST(457.1,"B",NX)) Q:NX="" F TD=0:0 S TD=$O(^PRST(457.1,"B",NX,TD)) Q:TD<1 D Q3 G:QT Q2
|
|---|
| 11 | D H1
|
|---|
| 12 | Q2 Q
|
|---|
| 13 | Q3 S Y0=$G(^PRST(457.1,TD,0)),ALL=$P(Y0,"^",4) I TLI,'ALL,'$D(^PRST(457.1,TD,"T","B",TLI)) Q
|
|---|
| 14 | S Y1=$G(^PRST(457.1,TD,1)) I $Y>(IOSL-6) D HDR Q:QT
|
|---|
| 15 | W !,$J(TD,3)," ",$P(Y0,"^",1),?35,$J($P(Y0,"^",6),6,2)," " I Y1="" W !
|
|---|
| 16 | E F K=1:3:19 Q:$P(Y1,"^",K)="" W $P(Y1,"^",K),"-",$P(Y1,"^",K+1) S Z=$P(Y1,"^",K+2) W:Z ?58,$P($G(^PRST(457.2,Z,0)),"^",1) W !?43
|
|---|
| 17 | Q:TLI W !?8,"T&Ls: " I ALL W "All",! Q
|
|---|
| 18 | F K=0:0 S K=$O(^PRST(457.1,TD,"T",K)) Q:K<1 S Z=$P($G(^(K,0)),"^",1) W:$X>73 !?14 W $P($G(^PRST(455.5,+Z,0)),"^",1)," "
|
|---|
| 19 | W ! Q
|
|---|
| 20 | HDR ; Display Header
|
|---|
| 21 | D H1 Q:QT W:'($E(IOST,1,2)'="C-"&'PG) @IOF
|
|---|
| 22 | S PG=PG+1 W !,DTE,?27,"T & L T O U R L I S T",?72,"Page ",PG
|
|---|
| 23 | I TLI S TLE=$P(^PRST(455.5,TLI,0),"^",1) W !!?(79-$L(TLE)\2),TLE
|
|---|
| 24 | W !!," # Tour",?37,"Hrs. Segment Special Indicator",! Q
|
|---|
| 25 | H1 I PG,$E(IOST,1,2)="C-" R !!,"Press RETURN to Continue.",X:DTIME S:'$T!(X["^") QT=1
|
|---|
| 26 | Q
|
|---|
| 27 | EX G KILL^XUSCLEAN
|
|---|
