source: WorldVistAEHR/trunk/r/LIBRARY-LBR-LBRS/LBRYCK4.m@ 1806

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

initial load of WorldVistAEHR

File size: 2.4 KB
RevLine 
[613]1LBRYCK4 ;ISC2/DJM-CHECK-IN QUEUEING & PRINTING ;[ 05/23/97 12:13 PM ]
2 ;;2.5;Library;**2,13**;Mar 11, 1996
3PARSE S LBRYL="" F I=1:1 S G=$P(X,",",I) G:G="" TOC D:G=+G ROUT Q:LBRYL=0 D:G["-" PARSE1
4 Q
5PARSE1 S G1=$P(G,"-",1),G2=$P(G,"-",2) I G2'<G1 F G=G1:1:G2 D ROUT Q:LBRYL=0
6 Q
7ROUT S NUM=$O(^LBRY(682,A(LBX),4,"B",G,0)) Q:NUM=""
8 S LBXX=^LBRY(682,A(LBX),4,NUM,0) Q:"45"'[$P(LBXX,U,2)
9 S DIC="^LBRY(682,A(LBX),4,",DA=NUM D LOCK^LBRYEDR Q:LBRYL=0
10 S LBC=$P(LBXX,U,3),LBC=$P(^LBRY(681,LBC,1),U,6)
11 S $P(^LBRY(682,A(LBX),4,NUM,0),U,2)=LBC,$P(^(0),U,7)=LDATE
12 W !,"c",$P(LBXX,U)," RECEIVED." D COMP
13 I $P(^LBRY(682,A(LBX),1),U,7)="" S $P(^(1),U,7)=LDATE
14 I $G(LBRYPTR)="" D ^LBRYASK I $G(LBRYPTR)="" S LBRYL=0 Q
15 I "12"[LBC,$P(^LBRY(680.6,LBRYPTR,0),U,5)="Y" W " Queued to printer ",$P(^(0),U,3),"."
16 L Q
17COMP I "12"[LBC,$P(LBXX,U,6)="" D
18 . S ^LBRY(682,"A2",A(LBX),NUM)=""
19 . S ^LBRY(682,"A4",LDATE,LBRYLOC,A(LBX),NUM)=""
20 I LBC<4 S $P(^LBRY(682,A(LBX),4,NUM,0),U,7)=LDATE,$P(^(0),U,8)=DUZ,$P(^LBRY(682,A(LBX),1),U,7)=LDATE
21 I $P(LBXX,U)'="ToC",$P(LBXX,U,2)=4 S $P(^LBRY(682,A(LBX),1),U,4)=$P(^LBRY(682,A(LBX),1),U,4)+1
22 Q
23TOC S NUM=$O(^LBRY(682,A(LBX),4,"B","ToC",0)) G:NUM="" QUEUE
24 S LBXX=^LBRY(682,A(LBX),4,NUM,0),DIC="^LBRY(682,A(LBX),4,",DA=NUM
25 D LOCK^LBRYEDR Q:LBRYL=0
26 I $P(^LBRY(682,A(LBX),4,NUM,0),U,2)=5 D
27 . S $P(^LBRY(682,A(LBX),4,NUM,0),U,2)=1,$P(^(0),U,7)=LDATE,LBC=1
28 . W !,"ToC ROUTING LIST" W:$P(^LBRY(680.6,LBRYPTR,0),U,5)="Y" " queued to printer ",$P(^(0),U,3),"." D COMP
29 L
30QUEUE W !!,"Check-in completed." S LTST=$O(^LBRY(682,"A2",0)) G:LTST="" FINI
31 S QUEUE=^LBRY(680.6,LBRYPTR,0),TERM=$P(QUEUE,U,3),QUEUE=$P(QUEUE,U,5)
32 I QUEUE="Y",TERM]"" S ZTIO=TERM,ZTDTH=$H G QUEUE1
33 S %ZIS="MQ",%IS("B")=$S(TERM]"":TERM,1:"") K IO("Q")
34 D ^%ZIS G:POP FINI I '$D(IO("Q")) U IO D ^LBRYCK2 D ^%ZISC G FINI
35QUEUE1 S ZTRTN="^LBRYCK2",ZTSAVE("LBRYPTR")="",ZTDESC="LBRY CHECK-IN REPORT"
36 D ^%ZTLOAD D ^%ZISC K ZTSK
37FINI S XZ="EXIT//" D PAUSE^LBRYCK0 G ^LBRYCK
38ASK W !!,"Enter copy number/s separated by commas or a hyphen."
39 W !,"Copy number/s: EXIT// " S Q=1
40ASK0 S DTOUT=0,X="" R X:DTIME E W $C(7) S DTOUT=1 G ^LBRYCK
41 I X="^" G ^LBRYCK
42 I X="" G DISPLAY^LBRYCK
43 I X?.N G PARSE
44ASK3 S G=$P(X,",",Q) G:G="" ASK1 G:G["-" ASK4 G:G'?.N ASK2 S Q=Q+1 G ASK3
45ASK1 G PARSE
46ASK2 W !!,"Please enter a copy number or a range of numbers separated by a hyphen '1-2'"
47 W !,"or a combination of the two separated by a comma '1,2-4' or <CR> to EXIT."
48 G ASK
49ASK4 G:G'?1N.N1"-"1N.N ASK2 S Q=Q+1 G ASK3
Note: See TracBrowser for help on using the repository browser.