| 1 | LBRVCONP ;SSI/ALA/JSR-Preinstall of consolidation ;[ 06/28/2000 1:19 PM ]
|
|---|
| 2 | ;;2.5;Library;**3,8**;APR 19, 2000
|
|---|
| 3 | CHKPT ;
|
|---|
| 4 | ; Clean up version number
|
|---|
| 5 | S N=679.9999 F S N=$O(^DD(N)) Q:N>689.4 I $G(^DD(N,0,"VR"))?1"2.5"1A.N S ^DD(N,0,"VR")=2.5
|
|---|
| 6 | ; If single primary site quit
|
|---|
| 7 | I $P(^LBRY(680.6,0),U,4)=1 Q
|
|---|
| 8 | S LBRVSTA=0
|
|---|
| 9 | STA ;get 5-letter code and number reference
|
|---|
| 10 | S LBRVSTA=$O(^A7RLBRY(LBRVSTA))
|
|---|
| 11 | I LBRVSTA="" G EXIT
|
|---|
| 12 | S LBRVNM=$O(^LBRY(680.6,"C",LBRVSTA,""))
|
|---|
| 13 | G EXIT:$G(DUOUT)=1
|
|---|
| 14 | D L680
|
|---|
| 15 | S ^XTMP("LBRY","LBRVCONP",LBRVSTA,"DONE")=$H
|
|---|
| 16 | G STA
|
|---|
| 17 | L680 ; Set those pointers that don't have a cross-reference
|
|---|
| 18 | D MES^XPDUTL("Starting pre-consolidation steps...")
|
|---|
| 19 | S TDA=0 D MES^XPDUTL("File 680 for "_LBRVSTA)
|
|---|
| 20 | F I="B","E" K ^A7RLBRY(LBRVSTA,680,I)
|
|---|
| 21 | F S TDA=$O(^A7RLBRY(LBRVSTA,680,TDA)) Q:TDA'>0 D W:TDA#50=0 "."
|
|---|
| 22 | . S $P(^A7RLBRY(LBRVSTA,680,TDA,0),U,4)=LBRVNM
|
|---|
| 23 | . S PDA=$P(^A7RLBRY(LBRVSTA,680,TDA,0),U)
|
|---|
| 24 | . I PDA'="" S ^A7RLBRY(LBRVSTA,680,"B",PDA,TDA)=""
|
|---|
| 25 | . S LD1=$P($G(^A7RLBRY(LBRVSTA,680,TDA,10)),U,7)
|
|---|
| 26 | . I LD1'="" S ^A7RLBRY(LBRVSTA,680,"ZN",LD1,TDA)=""
|
|---|
| 27 | . S LD2=$P($G(^A7RLBRY(LBRVSTA,680,TDA,1)),U,3)
|
|---|
| 28 | . I LD2'="" S ^A7RLBRY(LBRVSTA,680,"ZL",LD2,TDA)=""
|
|---|
| 29 | L681 S TDA=0 D MES^XPDUTL("File 681 for "_LBRVSTA)
|
|---|
| 30 | F I="AC","B","C","D","E" K ^A7RLBRY(LBRVSTA,681,I)
|
|---|
| 31 | F S TDA=$O(^A7RLBRY(LBRVSTA,681,TDA)) Q:TDA'>0 D W:TDA#50=0 "."
|
|---|
| 32 | . S $P(^A7RLBRY(LBRVSTA,681,TDA,0),U,4)=LBRVNM
|
|---|
| 33 | . S PDA=$P(^A7RLBRY(LBRVSTA,681,TDA,0),U,2)
|
|---|
| 34 | . I PDA'="" S ^A7RLBRY(LBRVSTA,681,"C",PDA,TDA)=""
|
|---|
| 35 | . S D1=0 F S D1=$O(^A7RLBRY(LBRVSTA,681,TDA,2,D1)) Q:'D1 D
|
|---|
| 36 | . . S PTR=$P(^A7RLBRY(LBRVSTA,681,TDA,2,D1,0),U)
|
|---|
| 37 | . . S ^A7RLBRY(LBRVSTA,681,"D",PTR,TDA,D1)=""
|
|---|
| 38 | . S LD1=$P($G(^A7RLBRY(LBRVSTA,681,TDA,1)),U,8)
|
|---|
| 39 | . I LD1'="" S ^A7RLBRY(LBRVSTA,681,"ZN",LD1,TDA)=""
|
|---|
| 40 | . S LD2=$P($G(^A7RLBRY(LBRVSTA,681,TDA,1)),U,2)
|
|---|
| 41 | . I LD2'="" S ^A7RLBRY(LBRVSTA,681,"ZL",LD2,TDA)=""
|
|---|
| 42 | L682 S TDA=0 D MES^LBRPUTL("File 682 for "_LBRVSTA)
|
|---|
| 43 | F I="A1","A3","A4","AC","B","C","D","E" K ^A7RLBRY(LBRVSTA,682,I)
|
|---|
| 44 | F S TDA=$O(^A7RLBRY(LBRVSTA,682,TDA)) Q:TDA'>0 D W:TDA#50=0 "."
|
|---|
| 45 | . S $P(^A7RLBRY(LBRVSTA,682,TDA,0),U,4)=LBRVNM
|
|---|
| 46 | . S PDA=$P(^A7RLBRY(LBRVSTA,682,TDA,0),U,2)
|
|---|
| 47 | . I PDA'="" S ^A7RLBRY(LBRVSTA,682,"C",PDA,TDA)=""
|
|---|
| 48 | . S TDA1=0 F S TDA1=$O(^A7RLBRY(LBRVSTA,682,TDA,4,TDA1)) Q:TDA1'>0 D
|
|---|
| 49 | .. S LD3=$P(^A7RLBRY(LBRVSTA,682,TDA,4,TDA1,0),U,3)
|
|---|
| 50 | .. I LD3'="" S ^A7RLBRY(LBRVSTA,682,"ZC",LD3,TDA,TDA1)=""
|
|---|
| 51 | L685 S TDA=0 D MES^LBRPUTL("File 680.5 for "_LBRVSTA)
|
|---|
| 52 | F S TDA=$O(^A7RLBRY(LBRVSTA,680.5,TDA)) Q:TDA>99000!(TDA="") D W:TDA#50=0 "."
|
|---|
| 53 | . I $D(^LBRY(680.5,TDA)) K ^A7RLBRY(LBRVSTA,680.5,TDA) Q
|
|---|
| 54 | . F ND=0,3,4 S:$G(^A7RLBRY(LBRVSTA,680.5,TDA,ND))'="" ^LBRY(680.5,TDA,ND)=^A7RLBRY(LBRVSTA,680.5,TDA,ND)
|
|---|
| 55 | . F ND=1,2 I $G(^A7RLBRY(LBRVSTA,680.5,TDA,ND,0))'="" D
|
|---|
| 56 | .. S ^LBRY(680.5,TDA,ND,0)=^A7RLBRY(LBRVSTA,680.5,TDA,ND,0)
|
|---|
| 57 | .. S NN=0 F S NN=$O(^A7RLBRY(LBRVSTA,680.5,TDA,ND,NN)) Q:'NN D
|
|---|
| 58 | ... S ^LBRY(680.5,TDA,ND,NN,0)=^A7RLBRY(LBRVSTA,680.5,TDA,ND,NN,0)
|
|---|
| 59 | . K ^A7RLBRY(LBRVSTA,680.5,TDA)
|
|---|
| 60 | S DIK="^LBRY(680.5," D IXALL^DIK
|
|---|
| 61 | Q
|
|---|
| 62 | EXIT ;
|
|---|
| 63 | K LBRVNM,TDA,LD1,PDA,TDA1,LD3,ND,NN,DIK,LD2,TDA1,DIC,DIE,D1,PTR
|
|---|
| 64 | Q
|
|---|
