64 lines
1.9 KiB
Mathematica
64 lines
1.9 KiB
Mathematica
LBRVCONV ;SSI/ALA/JSR-Convert data for consolidating ;[ 06/14/2000 3:52 PM ]
|
|
;;2.5;Library;**2,8**;Mar 31, 2000
|
|
;
|
|
EN D ^LBRVCOND
|
|
I LBRLEGP="PRIMARY" D MES^XPDUTL("*** Sorry Primary Sites can not use this option ***") Q
|
|
Q:FLAG="YES"
|
|
COPY ; Copy data into scratch global
|
|
S DA=0
|
|
F S DA=$O(^LBRY(680,DA)) Q:'DA D
|
|
. S DATA=^LBRY(680,DA,0)
|
|
. S LBRWSTN=$P((DATA),"^",4)
|
|
. S LBRTIT=$P((DATA),"^",1)
|
|
. Q:LBRWSTN=""
|
|
. S LBRWSTA=$P(^LBRY(680.6,LBRWSTN,0),"^",7)
|
|
. M ^A7RLBRY(LBRWSTA,680.5,LBRTIT)=^LBRY(680.5,LBRTIT)
|
|
. M ^A7RLBRY(LBRWSTA,680,DA)=^LBRY(680,DA)
|
|
.Q
|
|
D MES^LBRPUTL("File 680 AND 680.5 copied")
|
|
S DA=0
|
|
F S DA=$O(^LBRY(681,DA)) Q:'DA D
|
|
. S LBRWSTN=$P(^LBRY(681,DA,0),"^",4)
|
|
. Q:LBRWSTN=""
|
|
. S LBRWSTA=$P(^LBRY(680.6,LBRWSTN,0),"^",7)
|
|
. M ^A7RLBRY(LBRWSTA,681,DA)=^LBRY(681,DA)
|
|
.Q
|
|
D MES^LBRPUTL("File 681 copied")
|
|
S DA=0
|
|
F S DA=$O(^LBRY(682,DA)) Q:'DA D
|
|
. S LBRWSTN=$P(^LBRY(682,DA,0),"^",4)
|
|
. Q:LBRWSTN=""
|
|
. S LBRWSTA=$P(^LBRY(680.6,LBRWSTN,0),"^",7)
|
|
. M ^A7RLBRY(LBRWSTA,682,DA)=^LBRY(682,DA)
|
|
.Q
|
|
D MES^LBRPUTL("File 682 copied")
|
|
S DA=0
|
|
F S DA=$O(^LBRY(680.4,DA)) Q:'DA D
|
|
. S LBRWSTN=$P(^LBRY(680.4,DA,0),"^",9)
|
|
. Q:LBRWSTN=""
|
|
. S LBRWSTA=$P(^LBRY(680.6,LBRWSTN,0),"^",7)
|
|
. M ^A7RLBRY(LBRWSTA,680.4,DA)=^LBRY(680.4,DA)
|
|
.Q
|
|
D MES^LBRPUTL("File 680.4 copied")
|
|
S DA=0 F S DA=$O(^LBRY(680.7,DA)) Q:'DA D
|
|
. S LBRWSTN=$P(^LBRY(680.7,DA,0),"^",2)
|
|
. Q:LBRWSTN=""
|
|
. S LBRWSTA=$P(^LBRY(680.6,LBRWSTN,0),"^",7)
|
|
. M ^A7RLBRY(LBRWSTA,680.7,DA)=^LBRY(680.7,DA)
|
|
.Q
|
|
D MES^LBRPUTL("File 680.7 copied")
|
|
S LBRWSTA=0
|
|
F S LBRWSTA=$O(^LBRY(680.6,"C",LBRWSTA)) Q:LBRWSTA="" D
|
|
. M ^A7RLBRY(LBRWSTA,680.6)=^LBRY(680.6)
|
|
. M ^A7RLBRY(LBRWSTA,680.3)=^LBRY(680.3)
|
|
.Q
|
|
D MES^LBRPUTL("File 680.6 AND 680.3 copied")
|
|
K %X,%Y
|
|
PROC ;
|
|
S LBRWSTA=""
|
|
F S LBRWSTA=$O(^A7RLBRY(LBRWSTA)) Q:LBRWSTA="" D ^LBRVCONX
|
|
;
|
|
;
|
|
EXIT ;
|
|
K LDA,VND,SRV,SERV,VEND,USR,USER,ODA,QUIT
|