LRMISEZ4.m

LRMISEZ4 ; IHS/DIR/AAB - MICRO INF CTRL SURVEY COND'T 3/28/87 6:41 PM ;  [ 07/22/2002  1:25 PM ]

 ;;5.2;LR;**1006,1013**;JUL 15, 2002

 ;

 ;;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 X=^TMP($J,S,M,LRLLOC,LRNAME,LRSIT,LRAC,LROR,LRBG),SSN=$P(X,U,2),HRCN=$P(X,U,2),LRQUANT=$P(X,U,3),X=+X,LRDAT=$$Y2K^LRX(X)_" ",LRPNM=$P(LRNAME,U)  ;IHS/ANMC/CLS 08/18/96

 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

LRMISEZ4  ; IHS/DIR/AAB - MICRO INF CTRL SURVEY COND'T 3/28/87 6:41 PM ;  [ 07/22/2002  1:25 PM ]

 +1       ;;5.2;LR;**1006,1013**;JUL 15, 2002

 +2       ;

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

 +4       ;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        ;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)

 +1       ;IHS/ANMC/CLS 08/18/96

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

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

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

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

           SET X=+X

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

           SET LRPNM=$PIECE(LRNAME,U)

 +2        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)

 +3        QUIT