| [613] | 1 | LBRVCONV ;SSI/ALA/JSR-Convert data for consolidating ;[ 06/14/2000 3:52 PM ]
|
|---|
| 2 | ;;2.5;Library;**2,8**;Mar 31, 2000
|
|---|
| 3 | ;
|
|---|
| 4 | EN D ^LBRVCOND
|
|---|
| 5 | I LBRLEGP="PRIMARY" D MES^XPDUTL("*** Sorry Primary Sites can not use this option ***") Q
|
|---|
| 6 | Q:FLAG="YES"
|
|---|
| 7 | COPY ; Copy data into scratch global
|
|---|
| 8 | S DA=0
|
|---|
| 9 | F S DA=$O(^LBRY(680,DA)) Q:'DA D
|
|---|
| 10 | . S DATA=^LBRY(680,DA,0)
|
|---|
| 11 | . S LBRWSTN=$P((DATA),"^",4)
|
|---|
| 12 | . S LBRTIT=$P((DATA),"^",1)
|
|---|
| 13 | . Q:LBRWSTN=""
|
|---|
| 14 | . S LBRWSTA=$P(^LBRY(680.6,LBRWSTN,0),"^",7)
|
|---|
| 15 | . M ^A7RLBRY(LBRWSTA,680.5,LBRTIT)=^LBRY(680.5,LBRTIT)
|
|---|
| 16 | . M ^A7RLBRY(LBRWSTA,680,DA)=^LBRY(680,DA)
|
|---|
| 17 | .Q
|
|---|
| 18 | D MES^LBRPUTL("File 680 AND 680.5 copied")
|
|---|
| 19 | S DA=0
|
|---|
| 20 | F S DA=$O(^LBRY(681,DA)) Q:'DA D
|
|---|
| 21 | . S LBRWSTN=$P(^LBRY(681,DA,0),"^",4)
|
|---|
| 22 | . Q:LBRWSTN=""
|
|---|
| 23 | . S LBRWSTA=$P(^LBRY(680.6,LBRWSTN,0),"^",7)
|
|---|
| 24 | . M ^A7RLBRY(LBRWSTA,681,DA)=^LBRY(681,DA)
|
|---|
| 25 | .Q
|
|---|
| 26 | D MES^LBRPUTL("File 681 copied")
|
|---|
| 27 | S DA=0
|
|---|
| 28 | F S DA=$O(^LBRY(682,DA)) Q:'DA D
|
|---|
| 29 | . S LBRWSTN=$P(^LBRY(682,DA,0),"^",4)
|
|---|
| 30 | . Q:LBRWSTN=""
|
|---|
| 31 | . S LBRWSTA=$P(^LBRY(680.6,LBRWSTN,0),"^",7)
|
|---|
| 32 | . M ^A7RLBRY(LBRWSTA,682,DA)=^LBRY(682,DA)
|
|---|
| 33 | .Q
|
|---|
| 34 | D MES^LBRPUTL("File 682 copied")
|
|---|
| 35 | S DA=0
|
|---|
| 36 | F S DA=$O(^LBRY(680.4,DA)) Q:'DA D
|
|---|
| 37 | . S LBRWSTN=$P(^LBRY(680.4,DA,0),"^",9)
|
|---|
| 38 | . Q:LBRWSTN=""
|
|---|
| 39 | . S LBRWSTA=$P(^LBRY(680.6,LBRWSTN,0),"^",7)
|
|---|
| 40 | . M ^A7RLBRY(LBRWSTA,680.4,DA)=^LBRY(680.4,DA)
|
|---|
| 41 | .Q
|
|---|
| 42 | D MES^LBRPUTL("File 680.4 copied")
|
|---|
| 43 | S DA=0 F S DA=$O(^LBRY(680.7,DA)) Q:'DA D
|
|---|
| 44 | . S LBRWSTN=$P(^LBRY(680.7,DA,0),"^",2)
|
|---|
| 45 | . Q:LBRWSTN=""
|
|---|
| 46 | . S LBRWSTA=$P(^LBRY(680.6,LBRWSTN,0),"^",7)
|
|---|
| 47 | . M ^A7RLBRY(LBRWSTA,680.7,DA)=^LBRY(680.7,DA)
|
|---|
| 48 | .Q
|
|---|
| 49 | D MES^LBRPUTL("File 680.7 copied")
|
|---|
| 50 | S LBRWSTA=0
|
|---|
| 51 | F S LBRWSTA=$O(^LBRY(680.6,"C",LBRWSTA)) Q:LBRWSTA="" D
|
|---|
| 52 | . M ^A7RLBRY(LBRWSTA,680.6)=^LBRY(680.6)
|
|---|
| 53 | . M ^A7RLBRY(LBRWSTA,680.3)=^LBRY(680.3)
|
|---|
| 54 | .Q
|
|---|
| 55 | D MES^LBRPUTL("File 680.6 AND 680.3 copied")
|
|---|
| 56 | K %X,%Y
|
|---|
| 57 | PROC ;
|
|---|
| 58 | S LBRWSTA=""
|
|---|
| 59 | F S LBRWSTA=$O(^A7RLBRY(LBRWSTA)) Q:LBRWSTA="" D ^LBRVCONX
|
|---|
| 60 | ;
|
|---|
| 61 | ;
|
|---|
| 62 | EXIT ;
|
|---|
| 63 | K LDA,VND,SRV,SERV,VEND,USR,USER,ODA,QUIT
|
|---|
