LREXEC ;SLC/RWF - EXECUTE CODE EXPANSION ; 6/2/86  7:54 AM ;
 ;;5.2;LAB SERVICE;;Sep 27, 1994
 F LREX1=1:1 S LREX2=$P(LREXEC,U,LREX1) Q:LREX2=""  D LR2
 K LREX1,LREX2 Q
LR2 I +LREX2'=LREX2 S LREX2=$O(^LAB(62.07,"B",LREX2,0)) I LREX2="" W " Execute code ",LREX2," not found." Q
 I $D(^LAB(62.07,+LREX2,.1)) X ^(.1)
 Q
DELTA ;
 F LREX1=1:1 S LREX2=$P(LREXEC,U,LREX1) Q:LREX2=""  D LR4
 K LREX1,LREX2 Q
LR4 S LREX2=$O(^LAB(62.1,"B",LREX2,0)) I LREX2="" W " Delta code ",LREX2," not found." Q
 I $D(^LAB(62.1,LREX2,1)) X ^(1)
 Q
SETVAL ;Set value in X into LRSB for test in X1.
 Q:'$D(X)!('$D(X1))  Q:X1=""  S Q2=$O(^LAB(60,"B",X1,0)) Q:Q2'>0  S Q1=$S($D(^LAB(60,Q2,0)):$P($P(^(0),"^",5),";",2),1:"") Q:Q1'>0
 S LRSB(Q1)=X Q
SETUTL ;Set ^TMP("LR",$J,"VTO",test) so that a test in X will be verified.
 Q:'$D(X1)  Q:X1=""  S Q2=$O(^LAB(60,"B",X1,0)) Q:Q2'>0  S ^TMP("LR",$J,"VTO",Q2)=""
 Q
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLREXEC   903     printed  Sep 23, 2025@19:50:22                                                                                                                                                                                                       Page 2
LREXEC    ;SLC/RWF - EXECUTE CODE EXPANSION ; 6/2/86  7:54 AM ;
 +1       ;;5.2;LAB SERVICE;;Sep 27, 1994
 +2        FOR LREX1=1:1
               SET LREX2=$PIECE(LREXEC,U,LREX1)
               if LREX2=""
                   QUIT 
               DO LR2
 +3        KILL LREX1,LREX2
           QUIT 
LR2        IF +LREX2'=LREX2
               SET LREX2=$ORDER(^LAB(62.07,"B",LREX2,0))
               IF LREX2=""
                   WRITE " Execute code ",LREX2," not found."
                   QUIT 
 +1        IF $DATA(^LAB(62.07,+LREX2,.1))
               XECUTE ^(.1)
 +2        QUIT 
DELTA     ;
 +1        FOR LREX1=1:1
               SET LREX2=$PIECE(LREXEC,U,LREX1)
               if LREX2=""
                   QUIT 
               DO LR4
 +2        KILL LREX1,LREX2
           QUIT 
LR4        SET LREX2=$ORDER(^LAB(62.1,"B",LREX2,0))
           IF LREX2=""
               WRITE " Delta code ",LREX2," not found."
               QUIT 
 +1        IF $DATA(^LAB(62.1,LREX2,1))
               XECUTE ^(1)
 +2        QUIT 
SETVAL    ;Set value in X into LRSB for test in X1.
 +1        if '$DATA(X)!('$DATA(X1))
               QUIT 
           if X1=""
               QUIT 
           SET Q2=$ORDER(^LAB(60,"B",X1,0))
           if Q2'>0
               QUIT 
           SET Q1=$SELECT($DATA(^LAB(60,Q2,0)):$PIECE($PIECE(^(0),"^",5),";",2),1:"")
           if Q1'>0
               QUIT 
 +2        SET LRSB(Q1)=X
           QUIT 
SETUTL    ;Set ^TMP("LR",$J,"VTO",test) so that a test in X will be verified.
 +1        if '$DATA(X1)
               QUIT 
           if X1=""
               QUIT 
           SET Q2=$ORDER(^LAB(60,"B",X1,0))
           if Q2'>0
               QUIT 
           SET ^TMP("LR",$JOB,"VTO",Q2)=""
 +2        QUIT