1 | LBRVCON2 ;SSI/ALA/JSR-Consolidate files continued ;[ 07/06/2000 3:41 PM ]
|
---|
2 | ;;2.5;Library;**3,8**;APR 19, 1996
|
---|
3 | EN ; Continue with update
|
---|
4 | I $P(^LBRY(680.6,0),U,4)=1 Q
|
---|
5 | I '$D(^XTMP("LBRY",LBRVSTA,"ODA4","DONE")) D STP4 S ^XTMP("LBRY",LBRVSTA,"ODA4","DONE")=""
|
---|
6 | S DA=0 F S DA=$O(^A7RLBRY(LBRVSTA,681,DA)) Q:'DA D
|
---|
7 | . S TDA=$P(^A7RLBRY(LBRVSTA,681,DA,0),U,2)
|
---|
8 | . I TDA="" K ^A7RLBRY(LBRVSTA,681,DA) Q
|
---|
9 | . S ^A7RLBRY(LBRVSTA,681,"C",TDA,DA)=""
|
---|
10 | S DA=0 F S DA=$O(^A7RLBRY(LBRVSTA,682,DA)) Q:'DA D
|
---|
11 | . S TDA=$P(^A7RLBRY(LBRVSTA,682,DA,0),U,2)
|
---|
12 | . I TDA="" K ^A7RLBRY(LBRVSTA,682,DA) Q
|
---|
13 | . S ^A7RLBRY(LBRVSTA,682,"C",TDA,DA)=""
|
---|
14 | I '$D(^XTMP("LBRY",LBRVSTA,"ODA5","DONE")) D STP5 S ^XTMP("LBRY",LBRVSTA,"ODA5","DONE")=""
|
---|
15 | I '$D(^XTMP("LBRY",LBRVSTA,"CON3","DONE")) D ^LBRVCON3 S ^XTMP("LBRY",LBRVSTA,"CON3","DONE")="",^XTMP("LBRY",LBRVSTA,"CON2","DONE")=""
|
---|
16 | K NDA,ODA,USRN,LDA,TDA,Y,%X,%Y,DA,TDA1,VNDN,X,LBRYCLS,USR
|
---|
17 | Q
|
---|
18 | STP4 D MES^LBRPUTL("I am beginning Step 4....for "_LBRVSTA_" at "_$$HTE^XLFDT($H))
|
---|
19 | ; For each local title moved from original site, set into new site
|
---|
20 | S T1=99000 F S T1=$O(^A7RLBRY(LBRVSTA,680.5,T1)) Q:'T1 S LT1=T1
|
---|
21 | S T2=99000 F S T2=$O(^LBRY(680.5,T2)) Q:'T2 S LT2=T2
|
---|
22 | Q:'$D(LT1)
|
---|
23 | S LT=$S(LT1>$G(LT2):LT1,1:$G(LT2))
|
---|
24 | S $P(^LBRY(680.5,0),"^",3)=LT
|
---|
25 | S ODA=$P(^XTMP("LBRY",LBRVSTA,"ODA4"),"^",1)
|
---|
26 | GDA4 S ODA=$O(^A7RLBRY(LBRVSTA,680.5,ODA)) Q:ODA'>0
|
---|
27 | S DINUM=LT
|
---|
28 | GD4RET F S DINUM=DINUM+1 Q:'$D(^LBRY(680.5,DINUM,0))
|
---|
29 | S X=DINUM,DLAYGO=680.5,DIC(0)="L",DIC="^LBRY(680.5,"
|
---|
30 | D FILE^DICN S (NDA,LBRYCLS)=+Y
|
---|
31 | I NDA=-1 S DINUM=X G GD4RET
|
---|
32 | ; Set Local Serials
|
---|
33 | S TDA="" F S TDA=$O(^A7RLBRY(LBRVSTA,680,"B",ODA,TDA)) Q:TDA="" D
|
---|
34 | . K ^A7RLBRY(LBRVSTA,680,"B",ODA,TDA)
|
---|
35 | . S $P(^A7RLBRY(LBRVSTA,680,TDA,0),U,1)=NDA
|
---|
36 | S TDA="" F S TDA=$O(^A7RLBRY(LBRVSTA,681,"C",ODA,TDA)) Q:TDA="" D
|
---|
37 | . K ^A7RLBRY(LBRVSTA,681,"C",ODA,TDA)
|
---|
38 | . S $P(^A7RLBRY(LBRVSTA,681,TDA,0),U,2)=NDA
|
---|
39 | S TDA="" F S TDA=$O(^A7RLBRY(LBRVSTA,682,"C",ODA,TDA)) Q:TDA="" D
|
---|
40 | . K ^A7RLBRY(LBRVSTA,682,"C",ODA,TDA)
|
---|
41 | . S $P(^A7RLBRY(LBRVSTA,682,TDA,0),U,2)=NDA
|
---|
42 | ; Move data over in TAF
|
---|
43 | S %X="^A7RLBRY(LBRVSTA,680.5,"_ODA_",",%Y="^LBRY(680.5,"_NDA_"," D %XY^%RCR
|
---|
44 | ; Reset cross-references
|
---|
45 | ;S DA=NDA D ^LBRYX53
|
---|
46 | ; Create transaction for FORUM
|
---|
47 | ; I ODA>99000&(NDA>99000) D ^LBRYLTF ;ask per Nancy do not send titles to forum 4/6/2000 jsr
|
---|
48 | S $P(^XTMP("LBRY",LBRVSTA,"ODA4"),"^",1)=ODA G GDA4
|
---|
49 | STP5 D MES^LBRPUTL("I am beginning Step 5....for "_LBRVSTA_" at "_$$HTE^XLFDT($H))
|
---|
50 | S $P(^LBRY(680,0),"^",3)=1,ODA=$P(^XTMP("LBRY",LBRVSTA,"ODA5"),"^",1)
|
---|
51 | GDA5 S ODA=$O(^A7RLBRY(LBRVSTA,680,ODA)) Q:ODA'>0
|
---|
52 | S VND=$P($G(^A7RLBRY(LBRVSTA,680,ODA,2)),U,5)
|
---|
53 | I VND'="" D
|
---|
54 | . S VND=$P(VND,"*",1)
|
---|
55 | . S VNDN=$O(^PRC(440,"B",VND,""))
|
---|
56 | . I VNDN'="" S $P(^A7RLBRY(LBRVSTA,680,ODA,2),U,5)=VND
|
---|
57 | NNDA ; Get next available DA
|
---|
58 | S DINUM=0
|
---|
59 | NNDRET F S DINUM=DINUM+1 Q:'$D(^LBRY(680,DINUM,0))
|
---|
60 | S X=DINUM,DLAYGO=680,DIC(0)="L",DIC="^LBRY(680,"
|
---|
61 | D FILE^DICN S (DA,NDA)=+Y
|
---|
62 | I NDA=-1 S DINUM=X G NNDRET
|
---|
63 | S %X="^A7RLBRY(LBRVSTA,680,"_ODA_",",%Y="^LBRY(680,"_NDA_"," D %XY^%RCR
|
---|
64 | S OTDA=$P(^A7RLBRY(LBRVSTA,680,ODA,0),U)
|
---|
65 | S DIE=DIC,DR=".01////^S X=OTDA" D ^DIE
|
---|
66 | F I=3,4,6,13 K ^LBRY(680,NDA,I,"B")
|
---|
67 | I $G(^LBRY(680,NDA,3,0))'="" S $P(^(0),U,2)="680.03PA"
|
---|
68 | I $G(^LBRY(680,NDA,4,0))'="" S $P(^(0),U,2)="680.01SA"
|
---|
69 | I $G(^LBRY(680,NDA,6,0))'="" S $P(^(0),U,2)="680.02SA"
|
---|
70 | S DA=ODA D ^LBRYX12 S DA=NDA D ^LBRYX14
|
---|
71 | S PDA=$P(^LBRY(680,NDA,0),U)
|
---|
72 | S TDA=""
|
---|
73 | F S TDA=$O(^A7RLBRY(LBRVSTA,681,"C",PDA,TDA)) Q:TDA="" D
|
---|
74 | . S $P(^A7RLBRY(LBRVSTA,681,TDA,0),U,2)=NDA K ^A7RLBRY(LBRVSTA,681,"C",ODA,TDA)
|
---|
75 | F S TDA=$O(^A7RLBRY(LBRVSTA,682,"C",PDA,TDA)) Q:TDA="" D
|
---|
76 | . S $P(^A7RLBRY(LBRVSTA,682,TDA,0),U,2)=NDA
|
---|
77 | . K ^A7RLBRY(LBRVSTA,682,"C",ODA,TDA)
|
---|
78 | ; W "STEP 5 "_ODA
|
---|
79 | S $P(^XTMP("LBRY",LBRVSTA,"ODA5"),"^",1)=ODA G GDA5
|
---|