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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRNIGHT2 2407 printed Dec 13, 2024@02:18:07 Page 2
LRNIGHT2 ;AVAMC/REG - STUFF CAP DATA INTO LAM GLOBAL ;2/6/91 08:48 ;
+1 ;;5.2;LAB SERVICE;;Sep 27, 1994
+2 if 'LRCD
SET LRCD=LRAD
SET LRDAT=LRCD\1
SET LRSTAT=$SELECT(S7=1:1,1:0)
KILL LRINPAT
if S15
SET LRINPAT=1
+3 IF LRDPF=62.3
SET LRQC=1
+4 IF LRDPF'=2
IF LRDPF'=62.3
SET LREF=1
+5 SET LRSITE=$SELECT($DATA(DUZ(2)):DUZ(2),1:+$PIECE($GET(^XMB(1,1,"XUS")),U,17))
if 'LRSITE
QUIT
+6 FOR LRI=0:0
SET LRI=$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN,4,S3,1,LRI))
if 'LRI
QUIT
SET X=^(LRI,0)
IF '$PIECE(X,"^",3)
SET LRLN=+X
SET LR(2)=$PIECE(X,"^",2)
if 'LR(2)
SET LR(2)=1
SET LR(4)=$PIECE(X,"^",4)+LR(2)
SET ^(0)=LRLN_"^0^1^"_LR(4)_"^"_$PIECE(X,"^",5,6)
if '$DATA(^LAM(LRLN,0))
QUIT
DO A
+7 KILL LREF,LRSTAT,LRDAT,LRINPAT,LRQC,LRI,LRLN,LRSITE,N
QUIT
CHECK IF $DATA(^LAM(LRLN,1,LRSITE,1,LRDAT,1,N,0))
SET N=N+1
GOTO CHECK
+1 SET S4=$SELECT($LENGTH(S11):S11,1:S4)
SET ^LAM(LRLN,1,LRSITE,1,LRDAT,1,N,0)=S4
SET ^LAM(LRLN,1,LRSITE,1,LRDAT,1,"B",S4,N)=""
SET ^LAM(LRLN,1,LRSITE,1,LRDAT,1,0)="^64.03A^"_N_"^"_N
+2 QUIT
A SET LR(6)=$PIECE(X,"^",6)
if 'LR(6)
SET LR(6)=LRCD
DO CAP
if '$DATA(^LAM(LRLN,1,0))
SET ^(0)="^64.01P^^"
+1 IF '$DATA(^LAM(LRLN,1,LRSITE,0))
SET ^(0)=LRSITE
SET X=^LAM(LRLN,1,0)
SET ^(0)=$PIECE(X,"^",1,2)_"^"_LRSITE_"^"_($PIECE(X,"^",4)+1)
+2 if '$DATA(^LAM(LRLN,1,LRSITE,1,0))
SET ^(0)="^64.02DA^^"
+3 IF '$DATA(^LAM(LRLN,1,LRSITE,1,LRDAT,0))
SET ^(0)=LRDAT
SET X=^LAM(LRLN,1,LRSITE,1,0)
SET ^(0)=$PIECE(X,"^",1,2)_"^"_LRDAT_"^"_($PIECE(X,"^",4)+1)
+4 SET ^(5)=$SELECT($DATA(^LAM(LRLN,1,LRSITE,1,LRDAT,5)):LR(2)+^(5),1:LR(2))
if $DATA(LRQC)
SET ^(2)=$SELECT($DATA(^(2)):^(2)+LR(2),1:LR(2))
if $DATA(LRINPAT)
SET ^(4)=$SELECT($DATA(^(4)):^(4)+LR(2),1:LR(2))
+5 if LRSTAT&(LRDPF=2)
SET ^(7)=$SELECT($DATA(^LAM(LRLN,1,LRSITE,1,LRDAT,7)):^(7)+LR(2),1:LR(2))
if $DATA(LRINPAT)&LRSTAT
SET ^(8)=$SELECT($DATA(^(8)):^(8)+LR(2),1:LR(2))
+6 IF '$DATA(LRINPAT)
IF LRDPF=2
SET ^(10)=$SELECT($DATA(^LAM(LRLN,1,LRSITE,1,LRDAT,10)):LR(2)+^(10),1:LR(2))
+7 if $DATA(LREF)
SET ^(9)=$SELECT($DATA(^LAM(LRLN,1,LRSITE,1,LRDAT,9)):LR(2)+^(9),1:LR(2))
+8 IF '$DATA(^LAM(LRLN,1,LRSITE,1,LRDAT,1,0))
SET ^LAM(LRLN,1,LRSITE,1,LRDAT,1,0)="^64.03A^"
+9 IF $LENGTH(S11)
SET N=$ORDER(^LAM(LRLN,1,LRSITE,1,LRDAT,1,"B",S11,0))
IF 'N
SET N=1+$PIECE(^LAM(LRLN,1,LRSITE,1,LRDAT,1,0),"^",4)
DO CHECK
+10 IF '$LENGTH(S11)
SET N=$ORDER(^LAM(LRLN,1,LRSITE,1,LRDAT,1,"B",S4,0))
IF 'N
SET N=1+$PIECE(^LAM(LRLN,1,LRSITE,1,LRDAT,1,0),"^",4)
DO CHECK
+11 SET $PIECE(^(1),"^")=$SELECT($DATA(^LAM(LRLN,1,LRSITE,1,LRDAT,1,N,1)):^(1)+LR(2),1:LR(2))
if LRSTAT
SET $PIECE(^(3),"^")=$SELECT($DATA(^(3)):^(3)+LR(2),1:LR(2))
+12 QUIT
CAP if '$DATA(^LRO(67.9,LRC,1,0))
SET ^(0)="^67.9001P^^"
SET X=^(0)
SET Y=$PIECE(X,"^",3)+1
C IF $DATA(^LRO(67.9,LRC,1,Y,0))
SET Y=Y+1
GOTO C
+1 SET ^LRO(67.9,LRC,1,0)="^67.9001P^"_Y_"^"_($PIECE(X,"^",4)+1)
SET ^(Y,0)=LRLN_"^"_LR(2)_"^"_LR(6)
SET ^LRO(67.9,"AR",^LRO(67.9,LRC,0)\1,LRLN,LRC)=""
QUIT
