LRLLP4 ;SLC/RWF - SET UP DISPLAY ORDER FOR PRINT ;2/5/91 14:38 ;
;;5.2;LAB SERVICE;;Sep 27, 1994
BUILD K ^TMP("LR",$J),S1,J1 S S1=0,J=0,S2=0
F I=0:0 S I=$O(^LRO(68.2,LRINST,10,LRPROF,1,I)) Q:I'>0 S X=+^(I,0) I '$P(^(0),"^",3) D TREE
F I=0:0 S I=$O(^LRO(68.2,LRINST,10,LRPROF,1,I)) Q:I'>0 S X=+^(I,0) I $P(^(0),"^",3),'$D(^TMP("LR",$J,X)) D TREE
K S1,S2,J1,^TMP("LR",$J) Q
TREE I '$D(^LAB(60,X,0)) Q ;BAD LRTEST NUMBER
S Z=^(0) Q:$D(^TMP("LR",$J,X)) S S2=S2+1,^LRO(68.2,LRINST,10,LRPROF,1,"AO",X)=S2,^TMP("LR",$J,X)="" ;ADD TO LIST
Q:'$D(^LAB(60,X,2,0)) Q:$O(^(0))<1 ;NOT A PANEL
S S1=S1+1,S1(S1)=X,J1(S1)=J
S J=0 F S J=$O(^LAB(60,S1(S1),2,J)) Q:J<1 S X=+^(J,0) D TREE
S J=J1(S1),X=S1(S1),S1=S1-1
Q
DIC S LRINST=DA(2),LRPROF=DA(1),DIC("X")=X D BUILD S X=DIC("X") K DIC("X") Q
MOVE ;from LRLLP2
I $O(^LRO(68.2,LRINST,10,LRPROF,1,"AO",0))="" D BUILD
F I=0:0 S I=$O(^LRO(68.2,LRINST,10,LRPROF,1,"AO",I)) Q:I<1 S X=^(I),^TMP($J,LRPROF,I)=X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRLLP4 978 printed Nov 22, 2024@17:26:26 Page 2
LRLLP4 ;SLC/RWF - SET UP DISPLAY ORDER FOR PRINT ;2/5/91 14:38 ;
+1 ;;5.2;LAB SERVICE;;Sep 27, 1994
BUILD KILL ^TMP("LR",$JOB),S1,J1
SET S1=0
SET J=0
SET S2=0
+1 FOR I=0:0
SET I=$ORDER(^LRO(68.2,LRINST,10,LRPROF,1,I))
if I'>0
QUIT
SET X=+^(I,0)
IF '$PIECE(^(0),"^",3)
DO TREE
+2 FOR I=0:0
SET I=$ORDER(^LRO(68.2,LRINST,10,LRPROF,1,I))
if I'>0
QUIT
SET X=+^(I,0)
IF $PIECE(^(0),"^",3)
IF '$DATA(^TMP("LR",$JOB,X))
DO TREE
+3 KILL S1,S2,J1,^TMP("LR",$JOB)
QUIT
TREE ;BAD LRTEST NUMBER
IF '$DATA(^LAB(60,X,0))
QUIT
+1 ;ADD TO LIST
SET Z=^(0)
if $DATA(^TMP("LR",$JOB,X))
QUIT
SET S2=S2+1
SET ^LRO(68.2,LRINST,10,LRPROF,1,"AO",X)=S2
SET ^TMP("LR",$JOB,X)=""
+2 ;NOT A PANEL
if '$DATA(^LAB(60,X,2,0))
QUIT
if $ORDER(^(0))<1
QUIT
+3 SET S1=S1+1
SET S1(S1)=X
SET J1(S1)=J
+4 SET J=0
FOR
SET J=$ORDER(^LAB(60,S1(S1),2,J))
if J<1
QUIT
SET X=+^(J,0)
DO TREE
+5 SET J=J1(S1)
SET X=S1(S1)
SET S1=S1-1
+6 QUIT
DIC SET LRINST=DA(2)
SET LRPROF=DA(1)
SET DIC("X")=X
DO BUILD
SET X=DIC("X")
KILL DIC("X")
QUIT
MOVE ;from LRLLP2
+1 IF $ORDER(^LRO(68.2,LRINST,10,LRPROF,1,"AO",0))=""
DO BUILD
+2 FOR I=0:0
SET I=$ORDER(^LRO(68.2,LRINST,10,LRPROF,1,"AO",I))
if I<1
QUIT
SET X=^(I)
SET ^TMP($JOB,LRPROF,I)=X
+3 QUIT
