source: FOIAVistA/trunk/r/LIBRARY-LBR-LBRS/LBRYLST.m@ 1015

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