VistA-WorldVistAEHR/r/LAB_SERVICE-LR-LS/LRNIGHT2.m

28 lines
2.3 KiB
Mathematica

LRNIGHT2 ;AVAMC/REG - STUFF CAP DATA INTO LAM GLOBAL ;2/6/91 08:48 ;
;;5.2;LAB SERVICE;;Sep 27, 1994
S:'LRCD LRCD=LRAD S LRDAT=LRCD\1,LRSTAT=$S(S7=1:1,1:0) K LRINPAT S:S15 LRINPAT=1
I LRDPF=62.3 S LRQC=1
I LRDPF'=2,LRDPF'=62.3 S LREF=1
S LRSITE=$S($D(DUZ(2)):DUZ(2),1:+$P($G(^XMB(1,1,"XUS")),U,17)) Q:'LRSITE
F LRI=0:0 S LRI=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,S3,1,LRI)) Q:'LRI S X=^(LRI,0) I '$P(X,"^",3) S LRLN=+X,LR(2)=$P(X,"^",2) S:'LR(2) LR(2)=1 S LR(4)=$P(X,"^",4)+LR(2),^(0)=LRLN_"^0^1^"_LR(4)_"^"_$P(X,"^",5,6) Q:'$D(^LAM(LRLN,0)) D A
K LREF,LRSTAT,LRDAT,LRINPAT,LRQC,LRI,LRLN,LRSITE,N Q
CHECK I $D(^LAM(LRLN,1,LRSITE,1,LRDAT,1,N,0)) S N=N+1 G CHECK
S S4=$S($L(S11):S11,1:S4),^LAM(LRLN,1,LRSITE,1,LRDAT,1,N,0)=S4,^LAM(LRLN,1,LRSITE,1,LRDAT,1,"B",S4,N)="",^LAM(LRLN,1,LRSITE,1,LRDAT,1,0)="^64.03A^"_N_"^"_N
Q
A S LR(6)=$P(X,"^",6) S:'LR(6) LR(6)=LRCD D CAP S:'$D(^LAM(LRLN,1,0)) ^(0)="^64.01P^^"
I '$D(^LAM(LRLN,1,LRSITE,0)) S ^(0)=LRSITE,X=^LAM(LRLN,1,0),^(0)=$P(X,"^",1,2)_"^"_LRSITE_"^"_($P(X,"^",4)+1)
S:'$D(^LAM(LRLN,1,LRSITE,1,0)) ^(0)="^64.02DA^^"
I '$D(^LAM(LRLN,1,LRSITE,1,LRDAT,0)) S ^(0)=LRDAT,X=^LAM(LRLN,1,LRSITE,1,0),^(0)=$P(X,"^",1,2)_"^"_LRDAT_"^"_($P(X,"^",4)+1)
S ^(5)=$S($D(^LAM(LRLN,1,LRSITE,1,LRDAT,5)):LR(2)+^(5),1:LR(2)) S:$D(LRQC) ^(2)=$S($D(^(2)):^(2)+LR(2),1:LR(2)) S:$D(LRINPAT) ^(4)=$S($D(^(4)):^(4)+LR(2),1:LR(2))
S:LRSTAT&(LRDPF=2) ^(7)=$S($D(^LAM(LRLN,1,LRSITE,1,LRDAT,7)):^(7)+LR(2),1:LR(2)) S:$D(LRINPAT)&LRSTAT ^(8)=$S($D(^(8)):^(8)+LR(2),1:LR(2))
I '$D(LRINPAT),LRDPF=2 S ^(10)=$S($D(^LAM(LRLN,1,LRSITE,1,LRDAT,10)):LR(2)+^(10),1:LR(2))
S:$D(LREF) ^(9)=$S($D(^LAM(LRLN,1,LRSITE,1,LRDAT,9)):LR(2)+^(9),1:LR(2))
I '$D(^LAM(LRLN,1,LRSITE,1,LRDAT,1,0)) S ^LAM(LRLN,1,LRSITE,1,LRDAT,1,0)="^64.03A^"
I $L(S11) S N=$O(^LAM(LRLN,1,LRSITE,1,LRDAT,1,"B",S11,0)) I 'N S N=1+$P(^LAM(LRLN,1,LRSITE,1,LRDAT,1,0),"^",4) D CHECK
I '$L(S11) S N=$O(^LAM(LRLN,1,LRSITE,1,LRDAT,1,"B",S4,0)) I 'N S N=1+$P(^LAM(LRLN,1,LRSITE,1,LRDAT,1,0),"^",4) D CHECK
S $P(^(1),"^")=$S($D(^LAM(LRLN,1,LRSITE,1,LRDAT,1,N,1)):^(1)+LR(2),1:LR(2)) S:LRSTAT $P(^(3),"^")=$S($D(^(3)):^(3)+LR(2),1:LR(2))
Q
CAP S:'$D(^LRO(67.9,LRC,1,0)) ^(0)="^67.9001P^^" S X=^(0),Y=$P(X,"^",3)+1
C I $D(^LRO(67.9,LRC,1,Y,0)) S Y=Y+1 G C
S ^LRO(67.9,LRC,1,0)="^67.9001P^"_Y_"^"_($P(X,"^",4)+1),^(Y,0)=LRLN_"^"_LR(2)_"^"_LR(6),^LRO(67.9,"AR",^LRO(67.9,LRC,0)\1,LRLN,LRC)="" Q