Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRNIGHT2

LRNIGHT2.m

Go to the documentation of this file.
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