- 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
