LRMISEZB.m

LRMISEZB ; IHS/DIR/FJE - MICROBIOLOGY INFECTION CONTROL DATA 7/11/87 01:50 ;DEC 09, 2008 8:30 AM

 ;;5.2;LAB SERVICE;**1013,1025**;NOV 01, 1997

 ;

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

 ;from LRMISEZ1

START I $D(LRAP) D AP Q

 ; ----- BEGIN IHS/OIT/MKK -- IHS Lab Patch 1022

 I $G(LRLLOC)="" Q

 ; ------ END IHS/OIT/MKK -- IHS Lab Patch 1022

 ; 

 S LROR=0 F I=0:0 S LROR=$O(^LR(LRDFN,"MI",LRIDT,3,LROR)) Q:LROR=""  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=""  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 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_HRCN_U_LRQUANT  ;IHS/ANMC/CLS 08/18/96

 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

LRMISEZB  ; IHS/DIR/FJE - MICROBIOLOGY INFECTION CONTROL DATA 7/11/87 01:50 ;DEC 09, 2008 8:30 AM

 +1       ;;5.2;LAB SERVICE;**1013,1025**;NOV 01, 1997

 +2       ;

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

 +4       ;from LRMISEZ1

START      IF $DATA(LRAP)

               DO AP

               QUIT 

 +1       ; ----- BEGIN IHS/OIT/MKK -- IHS Lab Patch 1022

 +2        IF $GET(LRLLOC)=""

               QUIT 

 +3       ; ------ END IHS/OIT/MKK -- IHS Lab Patch 1022

 +4       ; 

 +5        SET LROR=0

           FOR I=0:0

               SET LROR=$ORDER(^LR(LRDFN,"MI",LRIDT,3,LROR))

               IF LROR=""

                   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

 +6        QUIT 

AP         SET LROR=0

           FOR I=0:0

               SET LROR=$ORDER(^LR(LRDFN,"MI",LRIDT,3,LROR))

               IF LROR=""

                   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 

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 

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

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

           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_HRCN_U_LRQUANT

 +2        IF LRM("L")="A"!(LRM("L")="S"&(LRM("L","S")=LRLLOC))

               SET ^TMP($JOB,"LOC",LRMY,LRLLOC,LRNAME,LRSIT,LRAC,LROR,LRBUG)=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)=LRESULT

 +4        IF LRM("D")="A"!(LRM("D")="S"&(LRM("D","S")=LRDOC))

               SET ^TMP($JOB,"DOC",LRMY,LRDOC,LRNAME,LRSIT,LRAC,LROR,LRBUG)=LRESULT

 +5        IF LRM("P")="A"!(LRM("P")="S"&(LRM("P","S")=LRDFN))

               SET ^TMP($JOB,"PAT",LRMY,LRNAME,LRNAME,LRSIT,LRAC,LROR,LRBUG)=LRESULT

 +6        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

 +7        QUIT 

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