LRMISEZB ;DALOI/REG/SLC/BA - MICROBIOLOGY INFECTION CONTROL DATA ;11/18/11 16:13
;;5.2;LAB SERVICE;**350**;Sep 27, 1994;Build 230
;
;from LRMISEZ1
;
START I $D(LRAP) D AP Q
S LROR=0 F I=0:0 S LROR=$O(^LR(LRDFN,"MI",LRIDT,3,LROR)) Q:LROR<1 S LRBUG=+^(LROR,0),LRQUANT=$P(^(0),U,2),LRBUG=$S('$D(LRSGL):LRBUG,LRSGL=LRBUG:LRBUG,1:0) D:LRBUG SETUP
Q
;
;
AP S LROR=0 F I=0:0 S LROR=$O(^LR(LRDFN,"MI",LRIDT,3,LROR)) Q:LROR<1 S LROK=1 D APCHK I LROK S LRBUG=+^LR(LRDFN,"MI",LRIDT,3,LROR,0),LRQUANT=$P(^(0),U,2),LRBUG=$S('$D(LRSGL):LRBUG,LRSGL=LRBUG:LRBUG,1:0) D:LRBUG SETUP
Q
;
;
APCHK S LRBN=0 F I=0:0 S LRBN=$O(LRAP(LRBN)) Q:LRBN="" S:'$D(^LR(LRDFN,"MI",LRIDT,3,LROR,LRBN)) LROK=0 Q:'LROK I $L(^(LRBN)) S LROK=$S($L($P(^(LRBN),U,2)):$P(^(LRBN),U,2)=LRAP(LRBN),1:$P(^(LRBN),U)=LRAP(LRBN)) Q
Q
;
;
SETUP S X=$P(^LAB(61.2,LRBUG,0),U,3),LRBUG=$S($L(X):$E(X,1),1:" ")_$E(^(0),1,2)_LRBUG,LRESULT=LRDAT_U_SSN_U_LRQUANT
S:LRM("L")="A"!(LRM("L")="S"&(LRM("L","S")=LRLLOC)) ^TMP($J,"LOC",LRMY,LRLLOC,LRNAME,LRSIT,LRAC,LROR,LRBUG)=LRESULT
I LRM("L")'="A"!(LRM("O")'="A") S:LRM("O")="A"!(LRM("O")="S"&(LRM("O","S")=+$E(LRBUG,4,25))) ^TMP($J,"ORG",LRMY,LRLLOC,LRNAME,LRSIT,LRAC,LROR,LRBUG)=LRESULT
S:LRM("D")="A"!(LRM("D")="S"&(LRM("D","S")=LRDOC)) ^TMP($J,"DOC",LRMY,LRDOC,LRNAME,LRSIT,LRAC,LROR,LRBUG)=LRESULT
S:LRM("P")="A"!(LRM("P")="S"&(LRM("P","S")=LRDFN)) ^TMP($J,"PAT",LRMY,LRNAME,LRNAME,LRSIT,LRAC,LROR,LRBUG)=LRESULT
F S=2:0 S S=$O(^LR(LRDFN,"MI",LRIDT,3,LROR,S)) Q:S=""!(S'<3) I $D(^LAB(62.06,"AI",S)),$L($P(^(S),U,2)) D BUG2A
Q
;
;
BUG2A S R=^LR(LRDFN,"MI",LRIDT,3,LROR,S) Q:'$L($P(R,U))
S LRESULT=$S($L($P(R,U,2)):$E($P(R,U,2)),1:$P(R,U)),LRDRUG=$P(^LAB(62.06,"AI",S),U)
S:LRM("L")="A"!(LRM("L")="S"&(LRM("L","S")=LRLLOC)) ^TMP($J,"LOC",LRMY,LRLLOC,LRNAME,LRSIT,LRAC,LROR,LRBUG,LRDRUG)=LRESULT
I LRM("L")'="A"!(LRM("O")'="A") S:LRM("O")="A"!(LRM("O")="S"&(LRM("O","S")=+$E(LRBUG,4,25))) ^TMP($J,"ORG",LRMY,LRLLOC,LRNAME,LRSIT,LRAC,LROR,LRBUG,LRDRUG)=LRESULT
S:LRM("D")="A"!(LRM("D")="S"&(LRM("D","S")=LRDOC)) ^TMP($J,"DOC",LRMY,LRDOC,LRNAME,LRSIT,LRAC,LROR,LRBUG,LRDRUG)=LRESULT
S:LRM("P")="A"!(LRM("P")="S"&(LRM("P","S")=LRDFN)) ^TMP($J,"PAT",LRMY,LRNAME,LRNAME,LRSIT,LRAC,LROR,LRBUG,LRDRUG)=LRESULT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRMISEZB 2264 printed Nov 22, 2024@17:27:28 Page 2
LRMISEZB ;DALOI/REG/SLC/BA - MICROBIOLOGY INFECTION CONTROL DATA ;11/18/11 16:13
+1 ;;5.2;LAB SERVICE;**350**;Sep 27, 1994;Build 230
+2 ;
+3 ;from LRMISEZ1
+4 ;
START IF $DATA(LRAP)
DO AP
QUIT
+1 SET LROR=0
FOR I=0:0
SET LROR=$ORDER(^LR(LRDFN,"MI",LRIDT,3,LROR))
if LROR<1
QUIT
SET LRBUG=+^(LROR,0)
SET LRQUANT=$PIECE(^(0),U,2)
SET LRBUG=$SELECT('$DATA(LRSGL):LRBUG,LRSGL=LRBUG:LRBUG,1:0)
if LRBUG
DO SETUP
+2 QUIT
+3 ;
+4 ;
AP SET LROR=0
FOR I=0:0
SET LROR=$ORDER(^LR(LRDFN,"MI",LRIDT,3,LROR))
if LROR<1
QUIT
SET LROK=1
DO APCHK
IF LROK
SET LRBUG=+^LR(LRDFN,"MI",LRIDT,3,LROR,0)
SET LRQUANT=$PIECE(^(0),U,2)
SET LRBUG=$SELECT('$DATA(LRSGL):LRBUG,LRSGL=LRBUG:LRBUG,1:0)
if LRBUG
DO SETUP
+1 QUIT
+2 ;
+3 ;
APCHK SET LRBN=0
FOR I=0:0
SET LRBN=$ORDER(LRAP(LRBN))
if LRBN=""
QUIT
if '$DATA(^LR(LRDFN,"MI",LRIDT,3,LROR,LRBN))
SET LROK=0
if 'LROK
QUIT
IF $LENGTH(^(LRBN))
SET LROK=$SELECT($LENGTH($PIECE(^(LRBN),U,2)):$PIECE(^(LRBN),U,2)=LRAP(LRBN),1:$PIECE(^(LRBN),U)=LRAP(LRBN))
QUIT
+1 QUIT
+2 ;
+3 ;
SETUP SET X=$PIECE(^LAB(61.2,LRBUG,0),U,3)
SET LRBUG=$SELECT($LENGTH(X):$EXTRACT(X,1),1:" ")_$EXTRACT(^(0),1,2)_LRBUG
SET LRESULT=LRDAT_U_SSN_U_LRQUANT
+1 if LRM("L")="A"!(LRM("L")="S"&(LRM("L","S")=LRLLOC))
SET ^TMP($JOB,"LOC",LRMY,LRLLOC,LRNAME,LRSIT,LRAC,LROR,LRBUG)=LRESULT
+2 IF LRM("L")'="A"!(LRM("O")'="A")
if LRM("O")="A"!(LRM("O")="S"&(LRM("O","S")=+$EXTRACT(LRBUG,4,25)))
SET ^TMP($JOB,"ORG",LRMY,LRLLOC,LRNAME,LRSIT,LRAC,LROR,LRBUG)=LRESULT
+3 if LRM("D")="A"!(LRM("D")="S"&(LRM("D","S")=LRDOC))
SET ^TMP($JOB,"DOC",LRMY,LRDOC,LRNAME,LRSIT,LRAC,LROR,LRBUG)=LRESULT
+4 if LRM("P")="A"!(LRM("P")="S"&(LRM("P","S")=LRDFN))
SET ^TMP($JOB,"PAT",LRMY,LRNAME,LRNAME,LRSIT,LRAC,LROR,LRBUG)=LRESULT
+5 FOR S=2:0
SET S=$ORDER(^LR(LRDFN,"MI",LRIDT,3,LROR,S))
if S=""!(S'<3)
QUIT
IF $DATA(^LAB(62.06,"AI",S))
IF $LENGTH($PIECE(^(S),U,2))
DO BUG2A
+6 QUIT
+7 ;
+8 ;
BUG2A SET R=^LR(LRDFN,"MI",LRIDT,3,LROR,S)
if '$LENGTH($PIECE(R,U))
QUIT
+1 SET LRESULT=$SELECT($LENGTH($PIECE(R,U,2)):$EXTRACT($PIECE(R,U,2)),1:$PIECE(R,U))
SET LRDRUG=$PIECE(^LAB(62.06,"AI",S),U)
+2 if LRM("L")="A"!(LRM("L")="S"&(LRM("L","S")=LRLLOC))
SET ^TMP($JOB,"LOC",LRMY,LRLLOC,LRNAME,LRSIT,LRAC,LROR,LRBUG,LRDRUG)=LRESULT
+3 IF LRM("L")'="A"!(LRM("O")'="A")
if LRM("O")="A"!(LRM("O")="S"&(LRM("O","S")=+$EXTRACT(LRBUG,4,25)))
SET ^TMP($JOB,"ORG",LRMY,LRLLOC,LRNAME,LRSIT,LRAC,LROR,LRBUG,LRDRUG)=LRESULT
+4 if LRM("D")="A"!(LRM("D")="S"&(LRM("D","S")=LRDOC))
SET ^TMP($JOB,"DOC",LRMY,LRDOC,LRNAME,LRSIT,LRAC,LROR,LRBUG,LRDRUG)=LRESULT
+5 if LRM("P")="A"!(LRM("P")="S"&(LRM("P","S")=LRDFN))
SET ^TMP($JOB,"PAT",LRMY,LRNAME,LRNAME,LRSIT,LRAC,LROR,LRBUG,LRDRUG)=LRESULT
+6 QUIT
