1 | LBRYRST ;ISC2/DJM-REMOVE SERIALS TITLE ;[ 05/23/97 12:13 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 | START W @IOF,?5,"VA Library Serials Remove a Title for "_LBRYNAM
|
---|
6 | D NOW^%DTC S Y=X X ^DD("DD") W ?60,Y,! S YDT=Y,DIC="^LBRY(680.5,"
|
---|
7 | S DIC(0)="AEMQZ",DIC("A")="Please select TITLE to remove: "
|
---|
8 | D ^DIC
|
---|
9 | K DIC("A") G:Y<0 EXIT1 S LBRYCLS=+Y,LBRTDA=""
|
---|
10 | F S LBRTDA=$O(^LBRY(680,"B",LBRYCLS,LBRTDA)) Q:LBRTDA="" D
|
---|
11 | . I $P(^LBRY(680,LBRTDA,0),U,4)=LBRYPTR S LBRYLOC=LBRTDA Q
|
---|
12 | I $G(LBRYLOC)="",$O(^LBRY(680,"B",LBRYCLS,0))'="" D G EXIT
|
---|
13 | . W !!,"** You do not have any holdings on file, but another site does **",!!
|
---|
14 | . R !,"Press return to continue: ",LBRC:DTIME
|
---|
15 | I $O(^LBRY(680,"B",LBRYCLS,0))="" W ! G DIE2
|
---|
16 | S LA0="TITLE: "_$P(^LBRY(680.5,LBRYCLS,0),U,1)
|
---|
17 | W @IOF,?5,"VA Library Serials Remove a Title",?60,YDT,!!,LA0
|
---|
18 | WARN W !!,"Removing this journal deletes it completely from the LOCAL SERIALS file."
|
---|
19 | I $G(LBRYLOC)="" Q
|
---|
20 | S LBRYDA=$O(^LBRY(681,"AC",LBRYLOC,0))
|
---|
21 | W:LBRYDA]"" !,"This will include data in the LBRY DISPOSITION file."
|
---|
22 | S LBRYDAT1=$O(^LBRY(682,"AC",LBRYLOC,0))
|
---|
23 | W:LBRYDAT1]"" !,"This will include data in the LBRY ISSUE file."
|
---|
24 | DIE W !!,"Do you want to remove this journal"
|
---|
25 | S %=2 D YN^DICN G:%=2 LBRYRST G:%=1 DIE1 G:%=-1 EXIT
|
---|
26 | W !!,"Answer YES to remove this journal from the data base."
|
---|
27 | W !,"Answer NO or <CR> to exit."
|
---|
28 | G DIE
|
---|
29 | DIE1 W !! F I=1:1:79 W "*"
|
---|
30 | W !,?9,"***WARNING***",?33,"***WARNING***",?57,"***WARNING***",!!
|
---|
31 | W "All data about this title, i.e., holdings, check-in and copy information will"
|
---|
32 | W !,"be REMOVED from the system upon title deletion. You may wish to set this"
|
---|
33 | W !,"title INACTIVE in Library Title Setup (LTS) instead.",!!
|
---|
34 | DIE2 W $C(7),$C(7),$C(7),$C(7),$C(7),!,"DO YOU REALLY WANT TO REMOVE THIS JOURNAL "
|
---|
35 | S %=2 D YN^DICN G:%=2 LBRYRST G:%=1 DOIT G:%=-1 EXIT
|
---|
36 | W !,"Enter <CR> to do nothing or enter Y(es) if you are certain you wish to"
|
---|
37 | W !,"REMOVE all data about this title from the module."
|
---|
38 | G DIE2
|
---|
39 | DOIT W !!,"Please be patient, this may take a few moments."
|
---|
40 | I $G(LBRYDAT1)="" G DOIT1
|
---|
41 | S DIK="^LBRY(682,",RMV=0
|
---|
42 | F S RMV=$O(^LBRY(682,"AC",LBRYLOC,RMV)) Q:RMV="" D
|
---|
43 | . S DA=$O(^LBRY(682,"AC",LBRYLOC,RMV,0)) D ^DIK
|
---|
44 | DOIT1 I $G(LBRYLOC)="" G DOIT2
|
---|
45 | S DIK="^LBRY(681,",DA=0
|
---|
46 | F S DA=$O(^LBRY(681,"C",LBRYLOC,DA)) Q:DA="" D:DA'="" ^DIK
|
---|
47 | S DIK="^LBRY(680,",DA=LBRYLOC D ^DIK
|
---|
48 | DOIT2 I $G(LA0)="" S LA0=$P(^LBRY(680.5,LBRYCLS,0),U)
|
---|
49 | S LA0=$E(LA0,1,70) W !!,LA0," Removed.",!
|
---|
50 | I $O(^LBRY(680,"B",LBRYCLS,""))="" D DEL
|
---|
51 | S XZ="EXIT//" D PAUSE^LBRYUTL K XZ
|
---|
52 | EXIT K LA0,LBRYCLS,LBRTDA,LBRC
|
---|
53 | G START
|
---|
54 | EXIT1 K Y,YDT,DIC,I,LA0,LBRYDA,LBRYDAT1,%,DIK,RMV,LBRTDA,LBRYCLS,LBRYLOC
|
---|
55 | Q
|
---|
56 | DEL S DA=LBRYCLS,DIK="^LBRY(680.5," D ^DIK
|
---|
57 | N ZTSK,ZTDTH,ZTUCI,ZTSAVE,ZTIO,ZTDESC,ZTRTN
|
---|
58 | S (ZTSAVE("LA0"),ZTSAVE("LBRYCLS"))="",ZTRTN="REM^LBRYRST"
|
---|
59 | S ZTDTH=$H,ZTIO="",ZTDESC="LIBRARY REMOVE TITLE" D ^%ZTLOAD
|
---|
60 | Q
|
---|
61 | REM S N=0
|
---|
62 | REM1 S N=$O(^LBRY(680.5,N)) Q:N'>0
|
---|
63 | I $P($G(^LBRY(680.5,N,3)),U,6)=LBRYCLS S $P(^(3),U,6)=LA0_"*"
|
---|
64 | I $P($G(^LBRY(680.5,N,3)),U,7)=LBRYCLS S $P(^(3),U,7)=LA0_"*"
|
---|
65 | G REM1
|
---|