75 lines
3.6 KiB
Mathematica
75 lines
3.6 KiB
Mathematica
LBRYLST ;ISC2/DJM-LIBRARY TITLE SETUP ;[ 05/23/97 12:13 PM ]
|
|
;;2.5;Library;**2,9**;Mar 11, 1996
|
|
I $G(LBRYPTR)="" D I $G(LBRYPTR)="" W !!,$C(7),"No Site has been selected" Q
|
|
. D ^LBRYASK
|
|
START W @IOF,?5,"VA Library Serials Title Setup for "_LBRYNAM
|
|
K CNT,COUNT,INACT,Y,LBRYLOC
|
|
D NOW^%DTC S Y=X X ^DD("DD") S YDT=Y W ?60,YDT,!
|
|
S DIC="^LBRY(680.5,",DIC(0)="AELMQZ",DLAYGO=680.5,LBRYNEW="",INACT=""
|
|
S DIC("A")="Select TITLE AUTHORITY TITLE: " D ^DIC
|
|
K DLAYGO,DIC("A") G:Y<0 EXIT1 S (LBRYCLS,DA)=+Y,LBRYNEW=$P(Y,U,3)
|
|
I $P(^LBRY(680.5,LBRYCLS,0),U,5)="N" K DR D G CONT1
|
|
. W @IOF,?5,"VA Library Serials Enter a Title",?60,YDT
|
|
. W !!,"TITLE: ",$P(^LBRY(680.5,LBRYCLS,0),U)
|
|
. W !!,"Displaying TITLE AUTHORITY file" S DR="0:3" D EN^DIQ
|
|
CONT W @IOF,?5,"VA Library Serials Enter a Title",?60,YDT
|
|
W !!,"TITLE: ",$P(^LBRY(680.5,LBRYCLS,0),U)
|
|
W !!,"Editing TITLE AUTHORITY file"
|
|
K DR S DIE="^LBRY(680.5,",DA=LBRYCLS,DR="[LBRY CHECK-IN SETUP]"
|
|
S DIE("NO^")=1,DIC=DIE D LOCK^LBRYEDR G:LBRYL=0 EXIT
|
|
D ^DIE
|
|
K DIE("NO^"),DA L G:($D(Y)!($D(DTOUT))) EXIT1
|
|
I $P(^LBRY(680.5,LBRYCLS,0),U,5)="L",LBRYNEW=1 D ^LBRYLTF
|
|
CONT1 S LBRTDA=""
|
|
F S LBRTDA=$O(^LBRY(680,"B",LBRYCLS,LBRTDA)) Q:LBRTDA="" D
|
|
. I $P(^LBRY(680,LBRTDA,0),U,4)=LBRYPTR S LBRYLOC=LBRTDA Q
|
|
I $G(LBRYLOC)="" K DO S LBRYNEW=1 D
|
|
. S DINUM=$P(^LBRY(680,0),U,3)
|
|
. F S DINUM=DINUM+1 Q:'$D(^LBRY(680,DINUM,0))
|
|
. S X=LBRYCLS,DIC="^LBRY(680,",LBRYNEW=1,DIC(0)="LNZ"
|
|
. D FILE^DICN S LBRYLOC=+Y
|
|
W !!,"Editing LOCAL SERIALS file" K DR S DIE="^LBRY(680,"
|
|
S DR="[LBRY LOCAL SETUP]",DIE("NO^")=1,DA=LBRYLOC,DIC=DIE
|
|
D LOCK^LBRYEDR G:LBRYL=0 EXIT
|
|
D ^DIE I '$D(^LBRY(680,DA,7)) D KILL
|
|
K DIE("NO^") L G:($D(Y)!($D(DTOUT))) EXIT1
|
|
S INACT=$P(^LBRY(680,LBRYLOC,0),U,2) I INACT]"","DCR"[INACT G START
|
|
G:LBRYNEW>0 COPY1
|
|
CHECK S (COUNT,LBX)=0
|
|
F S LBX=$O(^LBRY(681,"AC",LBRYLOC,LBX)) Q:LBX="" S:LBX=+LBX COUNT=COUNT+1
|
|
G:COUNT=0 COPY1 S CNT=$P(^LBRY(680,LBRYLOC,7),U) G:COUNT'<CNT START
|
|
S GOOD=$O(^LBRY(681,"AC",LBRYLOC,0))
|
|
I GOOD=1 S DA=$O(^LBRY(681,"AC",LBRYLOC,GOOD,0)) G REPL
|
|
COPY1 L ^LBRY(681,0) S LBRYNUM=$P(^LBRY(681,0),U,3)
|
|
F S LBRYNUM=LBRYNUM+1 Q:'$D(^LBRY(681,LBRYNUM,0))
|
|
W !!,"Entering Copy 1 information."
|
|
K DO S DIC="^LBRY(681,",DIC(0)="LZ",X=LBRYNUM D FILE^DICN
|
|
K DR S DIE=DIC,DA=+Y,DIE("NO^")=1,DR=$S(LBRYPTR&($P($G(^LBRY(680.6,LBRYPTR,0)),U,10)):"[LBRY D3]",1:"[LBRY D1]") D LOCK^LBRYEDR
|
|
Q:LBRYL=0 D ^DIE
|
|
K DIE("NO^") L G:($D(Y)!($D(DTOUT))) EXIT1
|
|
REPL S CNT=$P($G(^LBRY(680,LBRYLOC,7)),U) G:CNT=1 EDIT
|
|
W !!,"Now cop",$S(CNT=2:"y 2",1:"ies 2 through "_CNT)," will be created the same as copy 1."
|
|
L ^LBRY(681,0) S LBRYNUM=$P(^LBRY(681,0),U,3),%X="^LBRY(681,DA,",%Y="X(" D %XY^%RCR
|
|
K COPYNO S LCOPY=0
|
|
F S LCOPY=$O(^LBRY(681,"AC",LBRYLOC,LCOPY)) Q:LCOPY="" S:LCOPY=+LCOPY COPYNO(LCOPY)=""
|
|
S DIK="^LBRY(681," F I=2:1:CNT S $P(X(1),U,1)=I D:'$D(COPYNO(I)) NEXT
|
|
K %,%H,%I,A,CNT,COUNT,D,D0,DA,DC,DE,DIC,DIE,DIFLD,DIP,Y,LBRYL
|
|
K X1,Y
|
|
QUERY L W ! I LBRYNEW'=1 G START
|
|
EDIT W !!,"Do you want to EDIT any copy now" S %=2 D YN^DICN
|
|
G START:%<0,START:%=2
|
|
I %=0 W !!,"Answering YES will allow you to modify any or all copies now." G EDIT
|
|
S:'$D(E0) E0=1 D CON^LBRYCSE G CONT^LBRYCSE
|
|
NEXT F S LBRYNUM=LBRYNUM+1 Q:'$D(^LBRY(681,LBRYNUM,0)) S QUIT=$O(^LBRY(681,"AC",LBRYLOC,0)) Q:QUIT=LBRYNUM
|
|
S $P(X(0),U,1)=LBRYNUM,DA=LBRYNUM
|
|
S %X="X(",%Y="^LBRY(681,"_LBRYNUM_"," D %XY^%RCR
|
|
S $P(^LBRY(681,0),U,3)=LBRYNUM,$P(^(0),U,4)=$P(^(0),U,4)+1 D IX^DIK
|
|
W "."
|
|
Q
|
|
KILL ;KILL FILE#680 RECORD IF # OF COPIES NOT SPECIFIED
|
|
S DIK=DIE D ^DIK Q
|
|
EXIT K DIC("NO^") G QUERY
|
|
EXIT1 K %,%X,%Y,J,Y,Z,YDT,DIC,INACT,LBRYNEW,LBRYL,COUNT,DIE,DIK,DR,LBRYNUM
|
|
K I,X,LBX,GOOD,CNT,LCOPY,COPYNO,E0,QUIT,LBRYLOC
|
|
Q
|