source: WorldVistAEHR/trunk/r/LIBRARY-LBR-LBRS/LBRVCONV.m@ 1261

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

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1LBRVCONV ;SSI/ALA/JSR-Convert data for consolidating ;[ 06/14/2000 3:52 PM ]
2 ;;2.5;Library;**2,8**;Mar 31, 2000
3 ;
4EN D ^LBRVCOND
5 I LBRLEGP="PRIMARY" D MES^XPDUTL("*** Sorry Primary Sites can not use this option ***") Q
6 Q:FLAG="YES"
7COPY ; 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
57PROC ;
58 S LBRWSTA=""
59 F S LBRWSTA=$O(^A7RLBRY(LBRWSTA)) Q:LBRWSTA="" D ^LBRVCONX
60 ;
61 ;
62EXIT ;
63 K LDA,VND,SRV,SERV,VEND,USR,USER,ODA,QUIT
Note: See TracBrowser for help on using the repository browser.