source: FOIAVistA/trunk/r/PAID-PRS/PRSATD2.m@ 1681

Last change on this file since 1681 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.5 KB
Line 
1PRSATD2 ; HISC/REL-Display Tours for T&L ;4/5/93 13:16
2 ;;4.0;PAID;;Sep 21, 1995
3R0 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
8Q1 ; 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
12Q2 Q
13Q3 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
20HDR ; 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
25H1 I PG,$E(IOST,1,2)="C-" R !!,"Press RETURN to Continue.",X:DTIME S:'$T!(X["^") QT=1
26 Q
27EX G KILL^XUSCLEAN
Note: See TracBrowser for help on using the repository browser.