LRMISEZ4.m

LRMISEZ4 ;AVAMC/REG/SLC/BA - MICRO INF CTRL SURVEY COND'T ; 3/28/87  6:41 PM ;

 ;;5.2;LAB SERVICE;**201**;Sep 27, 1994

 ;from LRMISEZ3

A S M=0 F I=0:0 S M=$O(^TMP($J,S,M)) Q:M=""  S LRAD=$E(M,1,3)_"0000",Y=M_"00" D D^LRU S LRMY=Y D LOC

 Q

LOC S LRLLOC=0 F I=0:0 S LRLLOC=$O(^TMP($J,S,M,LRLLOC)) Q:LRLLOC=""  D NAME

 Q

NAME S LRNAME=0 F I=0:0 S LRNAME=$O(^TMP($J,S,M,LRLLOC,LRNAME)) Q:LRNAME=""  D SIT

 Q

SIT S LRSIT=0 F I=0:0 S LRSIT=$O(^TMP($J,S,M,LRLLOC,LRNAME,LRSIT)) Q:LRSIT=""  D AC

 Q

AC S LRAC=0 F I=0:0 S LRAC=$O(^TMP($J,S,M,LRLLOC,LRNAME,LRSIT,LRAC)) Q:LRAC=""  D OR

 Q

OR S LROR=0 F I=0:0 S LROR=$O(^TMP($J,S,M,LRLLOC,LRNAME,LRSIT,LRAC,LROR)) Q:LROR=""  D BG

 Q

BG S LRBG=0 F I=0:0 S LRBG=$O(^TMP($J,S,M,LRLLOC,LRNAME,LRSIT,LRAC,LROR,LRBG)) Q:LRBG=""  S ^TMP($J,"SE",LRBG,M,LRLLOC,LRSIT,LRAC,LROR,LRNAME)=$P(^(LRBG),U,1,4) S LRBUG=$P(^LAB(61.2,+$E(LRBG,4,25),0),U) D FX

 Q

FX S X=^TMP($J,S,M,LRLLOC,LRNAME,LRSIT,LRAC,LROR,LRBG),SSN=$P(X,U,2),LRQUANT=$P(X,U,3),X=+X,LRDAT=$$Y2K^LRX(X)_" ",LRPNM=$P(LRNAME,U)

 S (B,LRBO,LRYA)=0 F I=0:0 S LRYA=$O(^TMP($J,S,M,LRLLOC,LRNAME,LRSIT,LRAC,LROR,LRBG,LRYA)) Q:LRYA=""  S ^TMP($J,"SE",LRBG,M,LRLLOC,LRSIT,LRAC,LROR,LRNAME,LRYA)=^(LRYA)

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---LRMISEZ4   1208     printed  Apr 09, 2024@21:07:47                                                                                                                                                                                                    Page 2

LRMISEZ4  ;AVAMC/REG/SLC/BA - MICRO INF CTRL SURVEY COND'T ; 3/28/87  6:41 PM ;

 +1       ;;5.2;LAB SERVICE;**201**;Sep 27, 1994

 +2       ;from LRMISEZ3

A          SET M=0

           FOR I=0:0

               SET M=$ORDER(^TMP($JOB,S,M))

               if M=""

                   QUIT 

               SET LRAD=$EXTRACT(M,1,3)_"0000"

               SET Y=M_"00"

               DO D^LRU

               SET LRMY=Y

               DO LOC

 +1        QUIT 

LOC        SET LRLLOC=0

           FOR I=0:0

               SET LRLLOC=$ORDER(^TMP($JOB,S,M,LRLLOC))

               if LRLLOC=""

                   QUIT 

               DO NAME

 +1        QUIT 

NAME       SET LRNAME=0

           FOR I=0:0

               SET LRNAME=$ORDER(^TMP($JOB,S,M,LRLLOC,LRNAME))

               if LRNAME=""

                   QUIT 

               DO SIT

 +1        QUIT 

SIT        SET LRSIT=0

           FOR I=0:0

               SET LRSIT=$ORDER(^TMP($JOB,S,M,LRLLOC,LRNAME,LRSIT))

               if LRSIT=""

                   QUIT 

               DO AC

 +1        QUIT 

AC         SET LRAC=0

           FOR I=0:0

               SET LRAC=$ORDER(^TMP($JOB,S,M,LRLLOC,LRNAME,LRSIT,LRAC))

               if LRAC=""

                   QUIT 

               DO OR

 +1        QUIT 

OR         SET LROR=0

           FOR I=0:0

               SET LROR=$ORDER(^TMP($JOB,S,M,LRLLOC,LRNAME,LRSIT,LRAC,LROR))

               if LROR=""

                   QUIT 

               DO BG

 +1        QUIT 

BG         SET LRBG=0

           FOR I=0:0

               SET LRBG=$ORDER(^TMP($JOB,S,M,LRLLOC,LRNAME,LRSIT,LRAC,LROR,LRBG))

               if LRBG=""

                   QUIT 

               SET ^TMP($JOB,"SE",LRBG,M,LRLLOC,LRSIT,LRAC,LROR,LRNAME)=$PIECE(^(LRBG),U,1,4)

               SET LRBUG=$PIECE(^LAB(61.2,+$EXTRACT(LRBG,4,25),0),U)

               DO FX

 +1        QUIT 

FX         SET X=^TMP($JOB,S,M,LRLLOC,LRNAME,LRSIT,LRAC,LROR,LRBG)

           SET SSN=$PIECE(X,U,2)

           SET LRQUANT=$PIECE(X,U,3)

           SET X=+X

           SET LRDAT=$$Y2K^LRX(X)_" "

           SET LRPNM=$PIECE(LRNAME,U)

 +1        SET (B,LRBO,LRYA)=0

           FOR I=0:0

               SET LRYA=$ORDER(^TMP($JOB,S,M,LRLLOC,LRNAME,LRSIT,LRAC,LROR,LRBG,LRYA))

               if LRYA=""

                   QUIT 

               SET ^TMP($JOB,"SE",LRBG,M,LRLLOC,LRSIT,LRAC,LROR,LRNAME,LRYA)=^(LRYA)

 +2        QUIT