LBRYCK1 ;ISC2/DJM-SERIALS CHECK-IN OUTPUT MESSAGE ;[ 05/23/97 12:13 PM ] ;;2.5;Library;**2,13**;Mar 11, 1996 START F I=1:1:7 S LS(I)="" S XT1=$S($D(^LBRY(680,LBRYLOC,16,0)):1,1:0),XT2=$S($D(A(E0-1)):1,1:0) S XT3=$S($D(A(E1+1)):1,1:0),XT4=$S($D(A(1)):1,1:0),LS(1)="Choose: " I XT4 S LS(2)=$C(34)_"ID NUM"_$C(34)_" to check-in",LS(4)="(E)dit" S LS(3)="(I)nsert" S:XT1 LS(5)="see check-in (N)otes" S:XT2 LS(6)="(B)ackup" S:XT3 LS(7)="(F)orward" S (LINE1,LINE2)="" F I=1:1:7 Q:$L(LINE1)+$L(LS(I))'<78 S:LS(I)]"" LINE1=LINE1_LS(I) D LS2 K LS(I) I I>2&($D(LS(I+1))) S:LS(I+1)]"" LINE1=LINE1_", " I '$D(LS(7)) S LINE1=LINE1_"." G PRINT F J=I:1:7 S:LS(J)]"" LINE2=LINE2_LS(J) K LS(J) I J<7&($D(LS(J+1))) S:LS(J+1)]"" LINE2=LINE2_", " S LINE2=LINE2_"." PRINT W !!,LINE1,! W:$D(LINE2) LINE2,! W "Exit// " EXIT K LINE1,LINE2,I,J Q LS2 I I=2,$D(LS(2)) I LS(2)]"" S LINE1=LINE1_", " Q START1 ;LIBRARY ROUTING QUEUEING FOR "ALL" COPIES S LBRYC=0 D NOW^%DTC S LBRYD=%\1 ST S LBRYC=$O(^LBRY(682,A(E),4,LBRYC)) G:LBRYC'>0 QUEUE S LBXX=^LBRY(682,A(E),4,LBRYC,0) I $P(LBXX,U,2)>3 D LOCK G:LBRYL=0 FINI D:$P(LBXX,U,1)'="ToC" NUMB D:$P(LBXX,U,1)="ToC" TOC G ST NUMB S LBC=$P(LBXX,U,3),LBC=$P(^LBRY(681,LBC,1),U,6) S $P(^LBRY(682,A(E),4,LBRYC,0),U,2)=LBC,$P(^LBRY(682,A(E),1),U,7)=LBRYD W !,"c",$P(LBXX,U,1)," RECEIVED." D COMP I $G(LBRYPTR)="" D ^LBRYASK I $G(LBRYPTR)="" G FINI I "12"[LBC,$P(^LBRY(680.6,LBRYPTR,0),U,5)="Y" W " Queued to printer ",$P(^(0),U,3),"." L Q TOC S $P(^LBRY(682,A(E),4,LBRYC,0),U,2)=1,LBC=1 W !,"ToC ROUTING LIST" W:$P(^LBRY(680.6,LBRYPTR,0),U,5)="Y" " queued to printer ",$P(^(0),U,3),"." D COMP L Q COMP I "12"[LBC,$P(LBXX,U,6)="" D . S ^LBRY(682,"A2",A(E),LBRYC)="",^LBRY(682,"A4",LBRYD,LBRYCLS,A(E),LBRYC)="" I LBC<4 S $P(^LBRY(682,A(E),4,LBRYC,0),U,7)=LBRYD,$P(^(0),U,8)=DUZ,$P(^LBRY(682,A(E),1),U,7)=LBRYD I $P(LBXX,U,1)'="ToC",$P(LBXX,U,2)=4 S $P(^LBRY(682,A(E),1),U,4)=$P(^LBRY(682,A(E),1),U,4)+1 Q LOCK S DIC="^LBRY(682,A(E),4,",DA=LBRYC D LOCK^LBRYEDR Q QUEUE W !!,"Check-in completed." S LTST=$O(^LBRY(682,"A2",0)) G:LTST="" FINI S QUEUE=^LBRY(680.6,LBRYPTR,0),TERM=$P(QUEUE,U,3),QUEUE=$P(QUEUE,U,5) I QUEUE="Y",TERM]"" S ZTIO=TERM,ZTDTH=$H G QUEUE1 S %ZIS="MQ",%IS("B")=$S(TERM]"":TERM,1:"") K IO("Q") D ^%ZIS G:POP FINI I '$D(IO("Q")) U IO D ^LBRYCK2 D ^%ZISC G FINI QUEUE1 S ZTRTN="^LBRYCK2",ZTSAVE("LBRYPTR")="",ZTDESC="LBRY CHECK-IN REPORT" D ^%ZTLOAD D ^%ZISC K ZTSK FINI S XZ="EXIT//" D PAUSE^LBRYCK0 K CKIN,LBRYC,LBXX,LBC,%IS("B") G ^LBRYCK ASK3 ;LIBRARY SERIALS WHAT-TO-DO PROMPT (FROM LBRYCK) S DTOUT=0 R X:DTIME E W $C(7) S DTOUT=1 G ^LBRYCK I X="" G ^LBRYCK I X=" " S:$D(^TMP("LBRY",DUZ,1)) X=^(1) I X="??" S XQH="LBRY CHECK-IN EDIT ??" D EN^XQH G DISPLAY^LBRYCK I X="^" G ^LBRYCK I $D(A(E0-1)),"Bb"[$E(X,1) D BACKUP^LBRYCK0 G DISPLAY^LBRYCK I $D(A(E1+1)),"Ff"[$E(X,1) D FORWARD^LBRYCK0 G DISPLAY^LBRYCK I $D(^LBRY(680,DA,16,0)),"Nn"[X D UTIL,^LBRYCK5 G DISPLAY^LBRYCK I $D(A(1)),"Ee"[$E(X,1) D UTIL G EDIT^LBRYCK0 I "Ii"[X D UTIL G ENEDT^LBRYCK0 ASK2 I $D(A(X)) D UTIL G ^LBRYCK3 WRONG S E=0,XTA="",XTB="",XTC="",XTD="",XTE="" S:$D(A(1)) XTA="a number under heading "_$C(34)_"ID NUM"_$C(34)_", E" S XTB=$S(XT4&('XT1)&('XT2)&'(XT3):" or I.",'XT4&('XT1)&('XT2)&('XT3):"I.",1:", I") G:XTB["." WRONG1 S XTC=$S(XT1:", N",1:""),XTD=$S(XT2&(XT3):", B or F.",XT2!(XT3):" or ",1:".") G:XTD["." WRONG1 S XTE=$S(XT2:"B.",XT3:"F.",1:"") WRONG1 W !!,"Enter "_XTA_XTB_XTC_XTD_XTE,!,"Enter '??' for more help." W !!,"Choose: Exit// " D MORE^LBRYCK G ASK3 UTIL K ^TMP("LBRY",DUZ,1) S ^(1)=X Q