source: WorldVistAEHR/trunk/r/LIBRARY-LBR-LBRS/LBRVCON2.m@ 1226

Last change on this file since 1226 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.6 KB
Line 
1LBRVCON2 ;SSI/ALA/JSR-Consolidate files continued ;[ 07/06/2000 3:41 PM ]
2 ;;2.5;Library;**3,8**;APR 19, 1996
3EN ; 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
18STP4 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)
26GDA4 S ODA=$O(^A7RLBRY(LBRVSTA,680.5,ODA)) Q:ODA'>0
27 S DINUM=LT
28GD4RET 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
49STP5 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)
51GDA5 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
57NNDA ; Get next available DA
58 S DINUM=0
59NNDRET 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
Note: See TracBrowser for help on using the repository browser.