80 lines
3.6 KiB
Mathematica
80 lines
3.6 KiB
Mathematica
|
LBRVCON2 ;SSI/ALA/JSR-Consolidate files continued ;[ 07/06/2000 3:41 PM ]
|
||
|
|
;;2.5;Library;**3,8**;APR 19, 1996
|
||
|
|
EN ; Continue with update
|
||
|
|
I $P(^LBRY(680.6,0),U,4)=1 Q
|
||
|
|
I '$D(^XTMP("LBRY",LBRVSTA,"ODA4","DONE")) D STP4 S ^XTMP("LBRY",LBRVSTA,"ODA4","DONE")=""
|
||
|
|
S DA=0 F S DA=$O(^A7RLBRY(LBRVSTA,681,DA)) Q:'DA D
|
||
|
|
. S TDA=$P(^A7RLBRY(LBRVSTA,681,DA,0),U,2)
|
||
|
|
. I TDA="" K ^A7RLBRY(LBRVSTA,681,DA) Q
|
||
|
|
. S ^A7RLBRY(LBRVSTA,681,"C",TDA,DA)=""
|
||
|
|
S DA=0 F S DA=$O(^A7RLBRY(LBRVSTA,682,DA)) Q:'DA D
|
||
|
|
. S TDA=$P(^A7RLBRY(LBRVSTA,682,DA,0),U,2)
|
||
|
|
. I TDA="" K ^A7RLBRY(LBRVSTA,682,DA) Q
|
||
|
|
. S ^A7RLBRY(LBRVSTA,682,"C",TDA,DA)=""
|
||
|
|
I '$D(^XTMP("LBRY",LBRVSTA,"ODA5","DONE")) D STP5 S ^XTMP("LBRY",LBRVSTA,"ODA5","DONE")=""
|
||
|
|
I '$D(^XTMP("LBRY",LBRVSTA,"CON3","DONE")) D ^LBRVCON3 S ^XTMP("LBRY",LBRVSTA,"CON3","DONE")="",^XTMP("LBRY",LBRVSTA,"CON2","DONE")=""
|
||
|
|
K NDA,ODA,USRN,LDA,TDA,Y,%X,%Y,DA,TDA1,VNDN,X,LBRYCLS,USR
|
||
|
|
Q
|
||
|
|
STP4 D MES^LBRPUTL("I am beginning Step 4....for "_LBRVSTA_" at "_$$HTE^XLFDT($H))
|
||
|
|
; For each local title moved from original site, set into new site
|
||
|
|
S T1=99000 F S T1=$O(^A7RLBRY(LBRVSTA,680.5,T1)) Q:'T1 S LT1=T1
|
||
|
|
S T2=99000 F S T2=$O(^LBRY(680.5,T2)) Q:'T2 S LT2=T2
|
||
|
|
Q:'$D(LT1)
|
||
|
|
S LT=$S(LT1>$G(LT2):LT1,1:$G(LT2))
|
||
|
|
S $P(^LBRY(680.5,0),"^",3)=LT
|
||
|
|
S ODA=$P(^XTMP("LBRY",LBRVSTA,"ODA4"),"^",1)
|
||
|
|
GDA4 S ODA=$O(^A7RLBRY(LBRVSTA,680.5,ODA)) Q:ODA'>0
|
||
|
|
S DINUM=LT
|
||
|
|
GD4RET F S DINUM=DINUM+1 Q:'$D(^LBRY(680.5,DINUM,0))
|
||
|
|
S X=DINUM,DLAYGO=680.5,DIC(0)="L",DIC="^LBRY(680.5,"
|
||
|
|
D FILE^DICN S (NDA,LBRYCLS)=+Y
|
||
|
|
I NDA=-1 S DINUM=X G GD4RET
|
||
|
|
; Set Local Serials
|
||
|
|
S TDA="" F S TDA=$O(^A7RLBRY(LBRVSTA,680,"B",ODA,TDA)) Q:TDA="" D
|
||
|
|
. K ^A7RLBRY(LBRVSTA,680,"B",ODA,TDA)
|
||
|
|
. S $P(^A7RLBRY(LBRVSTA,680,TDA,0),U,1)=NDA
|
||
|
|
S TDA="" F S TDA=$O(^A7RLBRY(LBRVSTA,681,"C",ODA,TDA)) Q:TDA="" D
|
||
|
|
. K ^A7RLBRY(LBRVSTA,681,"C",ODA,TDA)
|
||
|
|
. S $P(^A7RLBRY(LBRVSTA,681,TDA,0),U,2)=NDA
|
||
|
|
S TDA="" F S TDA=$O(^A7RLBRY(LBRVSTA,682,"C",ODA,TDA)) Q:TDA="" D
|
||
|
|
. K ^A7RLBRY(LBRVSTA,682,"C",ODA,TDA)
|
||
|
|
. S $P(^A7RLBRY(LBRVSTA,682,TDA,0),U,2)=NDA
|
||
|
|
; Move data over in TAF
|
||
|
|
S %X="^A7RLBRY(LBRVSTA,680.5,"_ODA_",",%Y="^LBRY(680.5,"_NDA_"," D %XY^%RCR
|
||
|
|
; Reset cross-references
|
||
|
|
;S DA=NDA D ^LBRYX53
|
||
|
|
; Create transaction for FORUM
|
||
|
|
; I ODA>99000&(NDA>99000) D ^LBRYLTF ;ask per Nancy do not send titles to forum 4/6/2000 jsr
|
||
|
|
S $P(^XTMP("LBRY",LBRVSTA,"ODA4"),"^",1)=ODA G GDA4
|
||
|
|
STP5 D MES^LBRPUTL("I am beginning Step 5....for "_LBRVSTA_" at "_$$HTE^XLFDT($H))
|
||
|
|
S $P(^LBRY(680,0),"^",3)=1,ODA=$P(^XTMP("LBRY",LBRVSTA,"ODA5"),"^",1)
|
||
|
|
GDA5 S ODA=$O(^A7RLBRY(LBRVSTA,680,ODA)) Q:ODA'>0
|
||
|
|
S VND=$P($G(^A7RLBRY(LBRVSTA,680,ODA,2)),U,5)
|
||
|
|
I VND'="" D
|
||
|
|
. S VND=$P(VND,"*",1)
|
||
|
|
. S VNDN=$O(^PRC(440,"B",VND,""))
|
||
|
|
. I VNDN'="" S $P(^A7RLBRY(LBRVSTA,680,ODA,2),U,5)=VND
|
||
|
|
NNDA ; Get next available DA
|
||
|
|
S DINUM=0
|
||
|
|
NNDRET F S DINUM=DINUM+1 Q:'$D(^LBRY(680,DINUM,0))
|
||
|
|
S X=DINUM,DLAYGO=680,DIC(0)="L",DIC="^LBRY(680,"
|
||
|
|
D FILE^DICN S (DA,NDA)=+Y
|
||
|
|
I NDA=-1 S DINUM=X G NNDRET
|
||
|
|
S %X="^A7RLBRY(LBRVSTA,680,"_ODA_",",%Y="^LBRY(680,"_NDA_"," D %XY^%RCR
|
||
|
|
S OTDA=$P(^A7RLBRY(LBRVSTA,680,ODA,0),U)
|
||
|
|
S DIE=DIC,DR=".01////^S X=OTDA" D ^DIE
|
||
|
|
F I=3,4,6,13 K ^LBRY(680,NDA,I,"B")
|
||
|
|
I $G(^LBRY(680,NDA,3,0))'="" S $P(^(0),U,2)="680.03PA"
|
||
|
|
I $G(^LBRY(680,NDA,4,0))'="" S $P(^(0),U,2)="680.01SA"
|
||
|
|
I $G(^LBRY(680,NDA,6,0))'="" S $P(^(0),U,2)="680.02SA"
|
||
|
|
S DA=ODA D ^LBRYX12 S DA=NDA D ^LBRYX14
|
||
|
|
S PDA=$P(^LBRY(680,NDA,0),U)
|
||
|
|
S TDA=""
|
||
|
|
F S TDA=$O(^A7RLBRY(LBRVSTA,681,"C",PDA,TDA)) Q:TDA="" D
|
||
|
|
. S $P(^A7RLBRY(LBRVSTA,681,TDA,0),U,2)=NDA K ^A7RLBRY(LBRVSTA,681,"C",ODA,TDA)
|
||
|
|
F S TDA=$O(^A7RLBRY(LBRVSTA,682,"C",PDA,TDA)) Q:TDA="" D
|
||
|
|
. S $P(^A7RLBRY(LBRVSTA,682,TDA,0),U,2)=NDA
|
||
|
|
. K ^A7RLBRY(LBRVSTA,682,"C",ODA,TDA)
|
||
|
|
; W "STEP 5 "_ODA
|
||
|
|
S $P(^XTMP("LBRY",LBRVSTA,"ODA5"),"^",1)=ODA G GDA5
|