source: WorldVistAEHR/trunk/r/LIBRARY-LBR-LBRS/LBRYCK.m@ 1078

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

initial load of WorldVistAEHR

File size: 3.6 KB
Line 
1LBRYCK ;ISC2/DJM-LIBRARY SERIALS CHECK-IN ;[ 02/04/98 4:07 PM ]
2 ;;2.5;Library;**2**;Mar 11, 1996
3 I $G(LBRYPTR)="" D I $G(LBRYPTR)="" W !!,$C(7),"No Site has been selected" Q
4 . D ^LBRYASK
5 S KL1=1 D CKIN G:Y<0 EXIT
6 S CLOSED=$P(^LBRY(680,LBRYLOC,0),U,2) G:CLOSED]"" CLOSED
7 D ^LBRYPPR,ALL^LBRYCK0 G:$D(ALL) NOT
8CONT S (E,E0,E1)=0 D MORE
9 G:'$D(A(1)) DISPLAY
10CONT1 S E=0,X1=YDT1,X2=$S($P(^LBRY(680,LBRYLOC,0),U,3)'="":$P(^(0),U,3),1:5)
11 D C^%DTC S (YDT1,YDT2)=X,V1=$O(^LBRY(682,"A1",LBRYLOC,9999998-YDT2))
12 I V1'="" S E1=$O(^LBRY(682,"A1",LBRYLOC,V1,0)) F I=1:1 Q:'$D(A(I)) S:A(I)=E1 E=I Q:E>0
13INIT S E1=E-3 S:E1<1 E1=1 S E0=E1 D FWD1^LBRYCK0 G DISPLAY
14CKIN W @IOF,?5,"VA Library Serials Check-In for "_LBRYNAM
15 S (YDT1,Y)=DT X ^DD("DD") W ?60,Y,! S YDT=Y
16 S DIC="^LBRY(680,",DIC(0)="AEMQZ",DIC("S")="I $P(^(0),U,4)=LBRYPTR&($P(^(0),U,2)="""")"
17 D ^DIC K DIC("S")
18 Q:Y<0 S (DA,LBRYLOC)=$P(Y,U),LBRYCLS=$P(Y,U,2)
19 S LA0=$P(^LBRY(680.5,LBRYCLS,0),U),LA00=""
20 I $G(^LBRY(680,LBRYLOC,1))'="" S LA00=" "_$P(^(1),U,5)
21 S LA0="TITLE: "_LA0
22 Q
23MORE K A S N="",A(1)="",LA1="JOURNAL",LA2="DATE",LA3="V(I)",LA4="CPY'S"
24 S LA5="COPIES",LA6="RECEIVED",LA7="ORD'D",LA8="COMPLETED"
25 S LA9="DISPOSITION",LA10="RCV'D"
26 F I=1:1 S:A(I)="" N=$O(^LBRY(682,"AC",LBRYLOC,N)) G:N="" MORE1 S A(I)=$O(^LBRY(682,"AC",LBRYLOC,N,A(I))) S:$O(^(A(I)))>0 A(I+1)=A(I) S:$O(^(A(I)))="" A(I+1)=""
27MORE1 S II=E K A(I) Q
28DISPLAY ;SHOW ISSUES
29DISP0 W @IOF,?5,"VA Library Serials Check-In",?60,YDT,!!,LA0,!,LA00
30 W !!,"ID",?6,LA1,?41,LA2,?52,LA4,?59,LA4,?66,LA9,!,"NUM"
31 W ?7,LA2,?20,LA3,?41,LA6,?52,LA7,?59,LA10,?66,LA8,!
32 F I=1:1:77 W "-"
33 W !
34 S AA="",RTD=0 G:E0=0 ASK1 G:'$D(A(1)) ASK1
35 F I=E0:1:E1 S AA=^LBRY(682,A(I),1),RTD=0,RFLAG=0,MR=0,RTD1="" D RTED,DISPX,DISP1
36ASK G:E=0 ASK1 G:KL1=0 ASK1
37 S KL1=0,AA=^LBRY(682,A(E),1),Y=$P(AA,U,1),AAX=$P(AA,U,5)-$P(AA,U,4)
38 G:AAX<1 ASK1
39 X ^DD("DD")
40AK W !!,"Do you want to check-in ",AAX," copies of ",Y," issue today" S %=1 D YN^DICN
41 I %=0 D G AK
42 . W !!,"'YES' will complete normal check-in process automatically."
43 . W !,"'NO' presents alternatives."
44 G:%=2 DISPLAY G:%=1 START1^LBRYCK1 G:%=-1 LBRYCK G ASK
45 ; Display to user his options
46ASK1 D ^LBRYCK1
47 ; Go select user's option. State error prompt if needed.
48ASK3 G ASK3^LBRYCK1
49RTED S MR=$O(^LBRY(682,A(I),4,MR)) Q:MR'>0 S BB=^LBRY(682,A(I),4,MR,0),BB2=$P(BB,U,2),BB1=$P(BB,U,1) S:BB2<4&(BB1'="ToC") RTD=RTD+1 S:BB1="ToC" BB1="T"
50 I BB2<4,RTD<5 S RTD1=RTD1_BB1_"," G RTED
51 I BB2<4,RTD'<5,RFLAG=0 S RTD1=$E(RTD1,1,$L(RTD1)-1)_"...",RFLAG=1
52 G RTED
53DISPX S AA1=$P(AA,U,1),AA2=$P(AA,U,2),AA3=$P(AA,U,3),AA4=$P(AA,U,4),AA5=$P(AA,U,5),AA6=""
54 S:$D(^LBRY(682,A(I),1)) AA6=$P(^(1),U,7) I AA4=0 S AA4=""
55 S RTDA=$S(RTD=AA5:" ALL",1:RTD1)
56 S:AA3'="" AA2=AA2_"("_AA3_")" S Y=AA1 X ^DD("DD") S AA1=Y I AA6'="" S Y=AA6 X ^DD("DD") S AA6=Y
57 Q
58DISP1 W !,I,?5,AA1,?18,AA2,?40,AA6,?54,AA5,?61,AA4,?66,RTDA Q
59CLOSED W !!,"This is a closed title. No check-in is allowed." G NOT1
60NOT W !!,LA0,!!,"This title is not fully initialized."
61 W !,"Please use Library Serials Management to set up this title."
62NOT1 S XZ="Exit// " D PAUSE^LBRYCK0 G LBRYCK
63EXIT K %,%DT,%X,LA0,LA1,LA2,LA3,LA4,LA5,LA6,LA7,LA8,LA9,LA10,A,I,II,IA,I1
64 K J,AA,AA1,AA2,AA3,AA4,AA5,AA6,AA7,AA8,AB,AB1,AB2,CA,CA1,DIC,DIW,DIWF
65 K DIWL,DIWR,DIWT,DIWTC,DIWX,CLR,LL,DN,DR,DX,DY,N,O,X1,X2,XX,Z,LB,LB1
66 K LB2,MM,AAX,ALL,BB,BB1,BB2,CLOSED,CO682,DIE,DIK,E,E0,E1,LBXX,LINE1
67 K LINE2,LS,LTST,QUEUE,TERM,XQH,XTA,XTB,XTC,XTD,XTE,XT1,XT2,XT3,XT4,H
68 K LA00,MR,IT,KL1,LBDA,LBRYDA,LBRYIF,LBRYL,LBRYNUM,LOOPX,QTY,CKIN
69 K LBRYD,RFLAG,RTG,RTD1,RTDA,V1,XZ,YDT,YDT1,YDT2,LBRYDT,NUMB,TITLE
70 K LDATE,LBX,N1,N2,RC,RR,RR1,RR2,RR4,RR5,RR7,RR8,RRX,RRY,RRX0,G,G1,G2
71 K %IS("B"),LBC,RTD,K,NUM
72 Q
Note: See TracBrowser for help on using the repository browser.