source: WorldVistAEHR/trunk/r/LIBRARY-LBR-LBRS/LBRYPG1.m@ 1800

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

initial load of WorldVistAEHR

File size: 1.6 KB
RevLine 
[613]1LBRYPG1 ;ISC2/DJM-SERIALS PURGE OUTPUT MESSAGE ;[ 05/23/97 12:13 PM ]
2 ;;2.5;Library;**2**;Mar 11, 1996
3START F I=1:1:5 S LS(I)=""
4 S XT1=$S($D(^LBRY(680,LBRYLOC,16,0)):1,1:0)
5 S XT2=$S($D(A(E0-1)):1,1:0),XT3=$S($D(A(E1+1)):1,1:0),LS(1)="Choose: "
6 S:$D(A(1)) LS(2)=$C(34)_"ID NUM"_$C(34)_" to Purge"
7 S:XT1 LS(3)="see check-in (N)otes" S:XT2 LS(4)="(B)ackup"
8 S:XT3 LS(5)="(F)orward"
9 S (LINE1,LINE2)="" F I=1:1:5 G:$L(LINE1)+$L(LS(I))'<78 L2 S:LS(I)]"" LINE1=LINE1_LS(I) K LS(I) I I>1,I<5,LS(I+1)]"" S LINE1=LINE1_", "
10L2 I '$D(LS(5)) S LINE1=LINE1_"." G PRINT
11 F J=I:1:5 S:LS(J)]"" LINE2=LINE2_LS(J) K LS(J) I J<5&($D(LS(J+1))) S:LS(J+1)]"" LINE2=LINE2_", "
12 S LINE2=LINE2_"."
13PRINT W !!,LINE1,! W:$D(LINE2) LINE2,! W "Exit// "
14EXIT K LINE1,LINE2,I,J Q
15 ; Library serials 'What-to-do' prompt
16ASK3 S DTOUT=0 R X:DTIME E W $C(7) S DTOUT=1 G ^LBRYPG
17 I X="" G ^LBRYPG
18 I X="??" S XQH="LBRY PURGE ??" D EN^XQH G DISPLAY^LBRYPG
19 I X="^" G ^LBRYPG
20 I $D(A(E0-1)),"Bb"[$E(X,1) D BACKUP^LBRYPG0 G DISPLAY^LBRYPG
21 I $D(A(E1+1)),"Ff"[$E(X,1) D FORWARD^LBRYPG0 G DISPLAY^LBRYPG
22 I $D(^LBRY(680,LBRYLOC,16,0)),"Nn"[X D ^LBRYPG3 G DISPLAY^LBRYPG
23ASK2 I $D(A($E(X))) G ASK^LBRYPG2
24WRONG S E=0,(XTA,XTB,XTC)="",XTA=$S(XT1&((XT2)!(XT3)):", N",1:"")
25 S XTB=$S(XT2&(XT3):", B or F.",XT2!(XT3):" or ",XTA]"":".",1:"")
26 G:XTC["." WRONG1 S XTC=$S(XT2:"B.",XT3:"F.",1:"")
27WRONG1 W !!,"Enter " W:$D(A(1)) "an ID NUM or a range of ID NUMs separated by a hyphen '1-2'"
28 W !,"or a combination of the two separated by a comma '1,3-5'"
29 W:XTA=""&(XTB="")&(XTC="") "."
30 W !,XTA,XTB,XTC W:$X>1 ! W "Enter '??' for more help."
31 W !!,"Choose: Exit// " D MORE^LBRYPG
32 G ASK3
Note: See TracBrowser for help on using the repository browser.