- 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 Apr 23, 2025@18:32:08 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
