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 ---[H[J[2J[HLRMISEZ4 1208 printed Dec 13, 2024@02:17:22 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
