source: WorldVistAEHR/trunk/r/LIBRARY-LBR-LBRS/LBRYCK1.m@ 1046

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