- 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 Mar 13, 2025@21:21:52 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
