| 1 | LBRYCK4 ;ISC2/DJM-CHECK-IN QUEUEING & PRINTING ;[ 05/23/97 12:13 PM ]
|
|---|
| 2 | ;;2.5;Library;**2,13**;Mar 11, 1996
|
|---|
| 3 | PARSE 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
|
|---|
| 5 | PARSE1 S G1=$P(G,"-",1),G2=$P(G,"-",2) I G2'<G1 F G=G1:1:G2 D ROUT Q:LBRYL=0
|
|---|
| 6 | Q
|
|---|
| 7 | ROUT 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
|
|---|
| 17 | COMP 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
|
|---|
| 23 | TOC 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
|
|---|
| 30 | QUEUE 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
|
|---|
| 35 | QUEUE1 S ZTRTN="^LBRYCK2",ZTSAVE("LBRYPTR")="",ZTDESC="LBRY CHECK-IN REPORT"
|
|---|
| 36 | D ^%ZTLOAD D ^%ZISC K ZTSK
|
|---|
| 37 | FINI S XZ="EXIT//" D PAUSE^LBRYCK0 G ^LBRYCK
|
|---|
| 38 | ASK W !!,"Enter copy number/s separated by commas or a hyphen."
|
|---|
| 39 | W !,"Copy number/s: EXIT// " S Q=1
|
|---|
| 40 | ASK0 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
|
|---|
| 44 | ASK3 S G=$P(X,",",Q) G:G="" ASK1 G:G["-" ASK4 G:G'?.N ASK2 S Q=Q+1 G ASK3
|
|---|
| 45 | ASK1 G PARSE
|
|---|
| 46 | ASK2 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
|
|---|
| 49 | ASK4 G:G'?1N.N1"-"1N.N ASK2 S Q=Q+1 G ASK3
|
|---|
