| 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
 | 
|---|