97 lines
4.6 KiB
Mathematica
97 lines
4.6 KiB
Mathematica
LBRVCONS ;SSI/ALA/JSR-Consolidate library files ;[ 07/06/2000 3:56 PM ]
|
|
;;2.5;Library;**3,8**;Mar 11, 2000
|
|
EN ;
|
|
D ^LBRVCOND
|
|
I LBRLEGP="LEGACY" D MES^XPDUTL("*Sorry Legacy Sites can not use this option ***") Q
|
|
Q:FLAG="YES"
|
|
;
|
|
STA D START^LBRYSITE
|
|
S:X'="" LBRSTS($P(Y(0),"^",7))=""
|
|
G:X'="" STA
|
|
M ^XTMP("LBRY","PRE-CON")=LBRSTS
|
|
S LBRVSTA=""
|
|
F S LBRVSTA=$O(^XTMP("LBRY","PRE-CON",LBRVSTA)) Q:LBRVSTA="" D
|
|
. I '$D(^XTMP("LBRY","LBRVCONP",LBRVSTA,"DONE")) D ^LBRVCONP
|
|
S LBRVSTA=""
|
|
F S LBRVSTA=$O(^XTMP("LBRY","LBRVCONP",LBRVSTA)) Q:LBRVSTA="" D
|
|
. Q:'$D(^A7RLBRY(LBRVSTA))
|
|
. Q:$D(^XTMP("LBRY",LBRVSTA,"DONE"))
|
|
. I '$D(^XTMP("LBRY",LBRVSTA,"DONE")) D ^LBRVCON9
|
|
. D STRT
|
|
. S ^XTMP("LBRY",LBRVSTA,"COMPLETE")=$H
|
|
G EXIT
|
|
STRT ;
|
|
MN G EXIT:LBRVSTA=""
|
|
S LBRVNM=$O(^LBRY(680.6,"C",LBRVSTA,""))
|
|
I '$D(^XTMP("LBRY",LBRVSTA,"ODA1","DONE")) D
|
|
. D STP1
|
|
. S ^XTMP("LBRY",LBRVSTA,"ODA1","DONE")=""
|
|
I '$D(^XTMP("LBRY",LBRVSTA,"ODA2","DONE")) D STP2 S ^XTMP("LBRY",LBRVSTA,"ODA2","DONE")=""
|
|
I '$D(^XTMP("LBRY",LBRVSTA,"ODA3","DONE")) D STP3 S ^XTMP("LBRY",LBRVSTA,"ODA3","DONE")=""
|
|
I '$D(^XTMP("LBRY",LBRVSTA,"CON2","DONE")) D ^LBRVCON2 S ^XTMP("LBRY",LBRVSTA,"CON2","DONE")=""
|
|
D MES^LBRPUTL("I am done with integrating "_LBRVSTA_"'s data at "_$$HTE^XLFDT($H))
|
|
K ^A7RLBRY(LBRVSTA)
|
|
Q
|
|
STP1 S ODA=$P(^XTMP("LBRY",LBRVSTA,"ODA1"),"^",1)
|
|
D MES^LBRPUTL("I am beginning Step 1....for "_LBRVSTA_"'s data at "_$$HTE^XLFDT($H))
|
|
K ^A7RLBRY(LBRVSTA,680.3,"B")
|
|
GDA1 S ODA=$O(^A7RLBRY(LBRVSTA,680.3,ODA)) Q:ODA'>0
|
|
S SUB=$P(^A7RLBRY(LBRVSTA,680.3,ODA,0),U)
|
|
GD1 S NDA=$O(^LBRY(680.3,"B",SUB,""))
|
|
I NDA'="" D K ^A7RLBRY(LBRVSTA,680.3,ODA) S $P(^XTMP("LBRY",LBRVSTA,"ODA1"),"^",1)=ODA G GDA1
|
|
. I $G(^A7RLBRY(LBRVSTA,680.3,NDA,0))'="" Q
|
|
. S L1="" F S L1=$O(^A7RLBRY(LBRVSTA,680,"C",ODA,L1)) Q:L1="" D
|
|
. . S L0=$O(^A7RLBRY(LBRVSTA,680,"C",ODA,L1,""))
|
|
. . S $P(^A7RLBRY(LBRVSTA,680,L1,3,L0,0),U)=NDA
|
|
S DINUM=$P(^LBRY(680.3,0),"^",3)
|
|
GD1RET F S DINUM=DINUM+1 Q:'$D(^LBRY(680.3,DINUM,0))
|
|
S X=DINUM,DLAYGO=680.3,DIC(0)="L",DIC="^LBRY(680.3,"
|
|
D FILE^DICN S DA=+Y
|
|
I DA=-1 S DINUM=X G GD1RET
|
|
S DIE=DIC,DR=".01////^S X=SUB" D ^DIE
|
|
G GDA1
|
|
STP2 S ODA=$P(^XTMP("LBRY",LBRVSTA,"ODA2"),"^",1)
|
|
D MES^LBRPUTL("I am beginning Step 2....for "_LBRVSTA_" at "_$$HTE^XLFDT($H))
|
|
GDA2 S ODA=$O(^A7RLBRY(LBRVSTA,680.4,ODA)) Q:ODA'>0
|
|
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
|
|
S $P(^A7RLBRY(LBRVSTA,680.4,ODA,0),U,9)=LBRVNM
|
|
S SRV=$P($G(^A7RLBRY(LBRVSTA,680.4,ODA,0)),U,2)
|
|
I SRV'="" D
|
|
. S SRV=$P(SRV,"*",1),DIC(0)="X",DIC="^DIC(49,",X=SRV D ^DIC
|
|
. S SRVN=+Y
|
|
. I SRVN>0 S $P(^A7RLBRY(LBRVSTA,680.4,ODA,0),U,2)=SRVN
|
|
S DINUM=$P(^LBRY(680.4,0),"^",3)
|
|
GDARET F S DINUM=DINUM+1 Q:'$D(^LBRY(680.4,DINUM,0))
|
|
S X=DINUM,DLAYGO=680.4,DIC(0)="L",DIC="^LBRY(680.4,"
|
|
D FILE^DICN S DA=+Y
|
|
I DA=-1 S DINUM=X G GDARET
|
|
S %X="^A7RLBRY(LBRVSTA,680.4,"_ODA_",",%Y="^LBRY(680.4,"_DA_"," D %XY^%RCR
|
|
S TDA=""
|
|
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)
|
|
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)
|
|
F S TDA=$O(^A7RLBRY(LBRVSTA,681,"D",ODA,TDA)) Q:TDA="" S NDA="" D
|
|
. K ^A7RLBRY(LBRVSTA,681,TDA,2,"AC"),^A7RLBRY(LBRVSTA,681,TDA,2,"B")
|
|
. 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)
|
|
S $P(^XTMP("LBRY",LBRVSTA,"ODA2"),"^",1)=ODA
|
|
G GDA2
|
|
STP3 S ODA=$P(^XTMP("LBRY",LBRVSTA,"ODA3"),"^",1)
|
|
D MES^LBRPUTL("I am beginning Step 3....for "_LBRVSTA_" at "_$$HTE^XLFDT($H))
|
|
GDA3 S ODA=$O(^A7RLBRY(LBRVSTA,680.7,ODA)) Q:ODA'>0
|
|
I '$D(^A7RLBRY(LBRVSTA,680,"ZL",ODA))&('$D(^A7RLBRY(LBRVSTA,681,"ZL",ODA))) S $P(^XTMP("LBRY",LBRVSTA,"ODA3"),"^",1)=ODA G GDA3
|
|
S $P(^A7RLBRY(LBRVSTA,680.7,ODA,0),U,2)=LBRVNM
|
|
S DINUM=0
|
|
GD3RET F S DINUM=DINUM+1 Q:'$D(^LBRY(680.7,DINUM,0))
|
|
S X=DINUM,DLAYGO=680.7,DIC(0)="L",DIC="^LBRY(680.7,"
|
|
D FILE^DICN S DA=+Y
|
|
I DA=-1 S DINUM=X G GD3RET
|
|
S %X="^A7RLBRY(LBRVSTA,680.7,"_ODA_",",%Y="^LBRY(680.7,"_DA_"," D %XY^%RCR
|
|
S TDA=""
|
|
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)
|
|
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)
|
|
S $P(^XTMP("LBRY",LBRVSTA,"ODA3"),"^",1)=ODA
|
|
G GDA3
|
|
EXIT S LBRYINT=1 D ^LBRVCON1
|
|
K L0,L1,NDA,ODA,TDA,LBRVNM,DIC,DLAYGO,DA,LBRYINT
|
|
K Y,J,LX,DIK,SUB,SRV,SRVN,NUM,I,CODE
|
|
Q
|