source: WorldVistAEHR/trunk/r/LIBRARY-LBR-LBRS/LBRVCONS.m@ 1553

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

initial load of WorldVistAEHR
File size: 4.6 KB
Line 
1LBRVCONS ;SSI/ALA/JSR-Consolidate library files ;[ 07/06/2000 3:56 PM ]
2 ;;2.5;Library;**3,8**;Mar 11, 2000
3EN ;
4 D ^LBRVCOND
5 I LBRLEGP="LEGACY" D MES^XPDUTL("*Sorry Legacy Sites can not use this option ***") Q
6 Q:FLAG="YES"
7 ;
8STA D START^LBRYSITE
9 S:X'="" LBRSTS($P(Y(0),"^",7))=""
10 G:X'="" STA
11 M ^XTMP("LBRY","PRE-CON")=LBRSTS
12 S LBRVSTA=""
13 F S LBRVSTA=$O(^XTMP("LBRY","PRE-CON",LBRVSTA)) Q:LBRVSTA="" D
14 . I '$D(^XTMP("LBRY","LBRVCONP",LBRVSTA,"DONE")) D ^LBRVCONP
15 S LBRVSTA=""
16 F S LBRVSTA=$O(^XTMP("LBRY","LBRVCONP",LBRVSTA)) Q:LBRVSTA="" D
17 . Q:'$D(^A7RLBRY(LBRVSTA))
18 . Q:$D(^XTMP("LBRY",LBRVSTA,"DONE"))
19 . I '$D(^XTMP("LBRY",LBRVSTA,"DONE")) D ^LBRVCON9
20 . D STRT
21 . S ^XTMP("LBRY",LBRVSTA,"COMPLETE")=$H
22 G EXIT
23STRT ;
24MN G EXIT:LBRVSTA=""
25 S LBRVNM=$O(^LBRY(680.6,"C",LBRVSTA,""))
26 I '$D(^XTMP("LBRY",LBRVSTA,"ODA1","DONE")) D
27 . D STP1
28 . S ^XTMP("LBRY",LBRVSTA,"ODA1","DONE")=""
29 I '$D(^XTMP("LBRY",LBRVSTA,"ODA2","DONE")) D STP2 S ^XTMP("LBRY",LBRVSTA,"ODA2","DONE")=""
30 I '$D(^XTMP("LBRY",LBRVSTA,"ODA3","DONE")) D STP3 S ^XTMP("LBRY",LBRVSTA,"ODA3","DONE")=""
31 I '$D(^XTMP("LBRY",LBRVSTA,"CON2","DONE")) D ^LBRVCON2 S ^XTMP("LBRY",LBRVSTA,"CON2","DONE")=""
32 D MES^LBRPUTL("I am done with integrating "_LBRVSTA_"'s data at "_$$HTE^XLFDT($H))
33 K ^A7RLBRY(LBRVSTA)
34 Q
35STP1 S ODA=$P(^XTMP("LBRY",LBRVSTA,"ODA1"),"^",1)
36 D MES^LBRPUTL("I am beginning Step 1....for "_LBRVSTA_"'s data at "_$$HTE^XLFDT($H))
37 K ^A7RLBRY(LBRVSTA,680.3,"B")
38GDA1 S ODA=$O(^A7RLBRY(LBRVSTA,680.3,ODA)) Q:ODA'>0
39 S SUB=$P(^A7RLBRY(LBRVSTA,680.3,ODA,0),U)
40GD1 S NDA=$O(^LBRY(680.3,"B",SUB,""))
41 I NDA'="" D K ^A7RLBRY(LBRVSTA,680.3,ODA) S $P(^XTMP("LBRY",LBRVSTA,"ODA1"),"^",1)=ODA G GDA1
42 . I $G(^A7RLBRY(LBRVSTA,680.3,NDA,0))'="" Q
43 . S L1="" F S L1=$O(^A7RLBRY(LBRVSTA,680,"C",ODA,L1)) Q:L1="" D
44 . . S L0=$O(^A7RLBRY(LBRVSTA,680,"C",ODA,L1,""))
45 . . S $P(^A7RLBRY(LBRVSTA,680,L1,3,L0,0),U)=NDA
46 S DINUM=$P(^LBRY(680.3,0),"^",3)
47GD1RET F S DINUM=DINUM+1 Q:'$D(^LBRY(680.3,DINUM,0))
48 S X=DINUM,DLAYGO=680.3,DIC(0)="L",DIC="^LBRY(680.3,"
49 D FILE^DICN S DA=+Y
50 I DA=-1 S DINUM=X G GD1RET
51 S DIE=DIC,DR=".01////^S X=SUB" D ^DIE
52 G GDA1
53STP2 S ODA=$P(^XTMP("LBRY",LBRVSTA,"ODA2"),"^",1)
54 D MES^LBRPUTL("I am beginning Step 2....for "_LBRVSTA_" at "_$$HTE^XLFDT($H))
55GDA2 S ODA=$O(^A7RLBRY(LBRVSTA,680.4,ODA)) Q:ODA'>0
56 I '$D(^A7RLBRY(LBRVSTA,680,"ZN",ODA)),'$D(^A7RLBRY(LBRVSTA,681,"D",ODA)),'$D(^A7RLBRY(LBRVSTA,681,"ZN",ODA)) S $P(^XTMP("LBRY",LBRVSTA,"ODA2"),"^",1)=ODA G GDA2
57 S $P(^A7RLBRY(LBRVSTA,680.4,ODA,0),U,9)=LBRVNM
58 S SRV=$P($G(^A7RLBRY(LBRVSTA,680.4,ODA,0)),U,2)
59 I SRV'="" D
60 . S SRV=$P(SRV,"*",1),DIC(0)="X",DIC="^DIC(49,",X=SRV D ^DIC
61 . S SRVN=+Y
62 . I SRVN>0 S $P(^A7RLBRY(LBRVSTA,680.4,ODA,0),U,2)=SRVN
63 S DINUM=$P(^LBRY(680.4,0),"^",3)
64GDARET F S DINUM=DINUM+1 Q:'$D(^LBRY(680.4,DINUM,0))
65 S X=DINUM,DLAYGO=680.4,DIC(0)="L",DIC="^LBRY(680.4,"
66 D FILE^DICN S DA=+Y
67 I DA=-1 S DINUM=X G GDARET
68 S %X="^A7RLBRY(LBRVSTA,680.4,"_ODA_",",%Y="^LBRY(680.4,"_DA_"," D %XY^%RCR
69 S TDA=""
70 F S TDA=$O(^A7RLBRY(LBRVSTA,680,"ZN",ODA,TDA)) Q:TDA="" S $P(^A7RLBRY(LBRVSTA,680,TDA,10),U,7)=DA K ^A7RLBRY(LBRVSTA,680,"ZN",ODA,TDA)
71 F S TDA=$O(^A7RLBRY(LBRVSTA,681,"ZN",ODA,TDA)) Q:TDA="" S $P(^A7RLBRY(LBRVSTA,681,TDA,1),U,8)=DA K ^A7RLBRY(LBRVSTA,681,"ZN",ODA,TDA)
72 F S TDA=$O(^A7RLBRY(LBRVSTA,681,"D",ODA,TDA)) Q:TDA="" S NDA="" D
73 . K ^A7RLBRY(LBRVSTA,681,TDA,2,"AC"),^A7RLBRY(LBRVSTA,681,TDA,2,"B")
74 . F S NDA=$O(^A7RLBRY(LBRVSTA,681,"D",ODA,TDA,NDA)) Q:NDA="" S $P(^A7RLBRY(LBRVSTA,681,TDA,2,NDA,0),U)=DA K ^A7RLBRY(LBRVSTA,681,"D",ODA,TDA,NDA)
75 S $P(^XTMP("LBRY",LBRVSTA,"ODA2"),"^",1)=ODA
76 G GDA2
77STP3 S ODA=$P(^XTMP("LBRY",LBRVSTA,"ODA3"),"^",1)
78 D MES^LBRPUTL("I am beginning Step 3....for "_LBRVSTA_" at "_$$HTE^XLFDT($H))
79GDA3 S ODA=$O(^A7RLBRY(LBRVSTA,680.7,ODA)) Q:ODA'>0
80 I '$D(^A7RLBRY(LBRVSTA,680,"ZL",ODA))&('$D(^A7RLBRY(LBRVSTA,681,"ZL",ODA))) S $P(^XTMP("LBRY",LBRVSTA,"ODA3"),"^",1)=ODA G GDA3
81 S $P(^A7RLBRY(LBRVSTA,680.7,ODA,0),U,2)=LBRVNM
82 S DINUM=0
83GD3RET F S DINUM=DINUM+1 Q:'$D(^LBRY(680.7,DINUM,0))
84 S X=DINUM,DLAYGO=680.7,DIC(0)="L",DIC="^LBRY(680.7,"
85 D FILE^DICN S DA=+Y
86 I DA=-1 S DINUM=X G GD3RET
87 S %X="^A7RLBRY(LBRVSTA,680.7,"_ODA_",",%Y="^LBRY(680.7,"_DA_"," D %XY^%RCR
88 S TDA=""
89 F S TDA=$O(^A7RLBRY(LBRVSTA,680,"ZL",ODA,TDA)) Q:TDA="" S $P(^A7RLBRY(LBRVSTA,680,TDA,1),U,3)=DA K ^A7RLBRY(LBRVSTA,680,"ZL",ODA,TDA)
90 F S TDA=$O(^A7RLBRY(LBRVSTA,681,"ZL",ODA,TDA)) Q:TDA="" S $P(^A7RLBRY(LBRVSTA,681,TDA,1),U,2)=DA K ^A7RLBRY(LBRVSTA,681,"ZL",ODA,TDA)
91 S $P(^XTMP("LBRY",LBRVSTA,"ODA3"),"^",1)=ODA
92 G GDA3
93EXIT S LBRYINT=1 D ^LBRVCON1
94 K L0,L1,NDA,ODA,TDA,LBRVNM,DIC,DLAYGO,DA,LBRYINT
95 K Y,J,LX,DIK,SUB,SRV,SRVN,NUM,I,CODE
96 Q
Note: See TracBrowser for help on using the repository browser.