BLR7OMZ5 ; IHS/MSC/MKK - Silent Micro Rpt - BACTERIA, ANTIBIOTICS ; 22-Oct-2013 09:22 ; MKK
;;5.2;IHS LABORATORY;**1033**;NOV 01, 1997
;
; Code below is cloned from the LEDI IV version of the LR7OSMZ5 routine.
;
BACT ; EP - from LR7OSMZ2
NEW A,I,J,K,L,LRABCNT,LRCOMMAX,LRCOMTAB,LRBUG,LRDCOM,LRFMT,LR1PASS,LRBN,LRI
NEW LRINT,LRMAX,LRORG,LRRES,LRSECT,LRTAB,LRWIDTH,LRX,LRY,X,Y
;
D ENTRYAUD^BLRUTIL("BACT^BLR7OMZ5 0.0")
Q:+$O(^LR(LRDFN,"MI",LRIDT,3,0))<1 ; If no organism, skip
;
S LRFMT=$P(^LAB(69.9,1,0),U,11),LRFMT=$S(LRFMT="":"I",1:LRFMT)
;
; Check each organism identified on the specimen.
; A = number of organisms on report that have susceptibilities
S (A,LRBUG)=0
F S LRBUG=+$O(^LR(LRDFN,"MI",LRIDT,3,LRBUG)) Q:LRBUG<1 D
. I +$O(^LR(LRDFN,"MI",LRIDT,3,LRBUG,2))'["2." Q
. S A=A+1 D CHECK
;
S (LRBN,LRABCNT)=0
F S LRBN=+$O(LRRES(LRBN)) Q:LRBN<1 S LRABCNT=LRABCNT+1
Q:'LRABCNT
;
; Scan result to find longest value, set mininium field width = 4
S (LRI,LRMAX(1))=0
F S LRI=$O(LRRES(LRI)) Q:'LRI D
. F I=1:1:A D
. . S X=$L($P(LRRES(LRI),"^",I))
. . I X<4 S X=4
. . I X>$G(LRWIDTH(I,1)) S LRWIDTH(I,1)=X
. . I X>LRMAX(1) S LRMAX(1)=X
;
; Scan interpretations to find longest value
S (LRI,LRMAX(2))=0
F S LRI=$O(LRINT(LRI)) Q:'LRI D
. F I=1:1:A D
. . S X=$L($P(LRINT(LRI),"^",I))
. . I X<4 S X=4
. . I X>$G(LRWIDTH(I,2)) S LRWIDTH(I,2)=X
. . I X>LRMAX(2) S LRMAX(2)=X
;
; Find longest antibiotic display comment to display on report
S (LRCOMMAX,LRI)=0
F S LRI=$O(^LAB(62.06,LRI)) Q:'LRI D
. S LRX=$G(^LAB(62.06,LRI,0)) Q:$P(LRX,"^",3)=""
. I '$P(LRX,"^",2) Q
. S LRY=0
. F S LRY=$O(^LR(LRDFN,"MI",LRIDT,3,LRY)) Q:'LRY D
. . I $D(^LR(LRDFN,"MI",LRIDT,3,LRY,$P(LRX,"^",2))) S X=$L($P(LRX,"^",3)) S:X>LRCOMMAX LRCOMMAX=X
;
; Check display width so that at least one organsism's values will display when display width is limited
; 31 character for antibiotic name, possibly 40 character display comments does not leave much space for actual results.
I LRCOMMAX>10,GIOM'>80 D
. I LRFMT="B" S X=LRMAX(1)+LRMAX(2)+4
. I LRFMT="R" S X=LRMAX(1)+2
. I LRFMT="I" S X=LRMAX(2)+2
. S X=X+31
. I (X+LRCOMMAX)>GIOM S LRCOMMAX=GIOM-X
;
; Determine tab position (column) of each organism and associated results
; LRSECT will indicate if multiple sections needed when number of organisms, results and display comments exceed right margin.
S (LRI,LRWIDTH(0,1),LRWIDTH(0,2))=0,LRSECT=1,LRTAB(LRSECT,0)=29
F S LRI=$O(LRWIDTH(LRI)) Q:'LRI D
. S LRX=LRTAB(LRSECT,LRI-1)
. I LRFMT="B" D Q
. . S LRY=LRX+LRWIDTH(LRI-1,1)+LRWIDTH(LRI-1,2)+4
. . I (LRY+LRCOMMAX+LRWIDTH(LRI,1)+LRWIDTH(LRI,2))>GIOM S LRCOMTAB(LRSECT)=LRY,LRY=LRTAB(1,0)+4,LRSECT=LRSECT+1
. . S LRTAB(LRSECT,LRI)=LRY
. . S LRTAB(LRSECT,LRI,1)=LRTAB(LRSECT,LRI)
. . S LRTAB(LRSECT,LRI,2)=LRTAB(LRSECT,LRI)+LRWIDTH(LRI,1)+2
. . S LRSECT(LRSECT)=$G(LRSECT(LRSECT))_LRI_"^"
. . S LRCOMTAB(LRSECT)=LRTAB(LRSECT,LRI)+LRWIDTH(LRI,1)+LRWIDTH(LRI,2)+4
. I LRFMT="I" D Q
. . S LRY=LRX+LRWIDTH(LRI-1,2)+4
. . I (LRY+LRCOMMAX+LRWIDTH(LRI,2))>GIOM S LRCOMTAB(LRSECT)=LRY,LRY=LRTAB(1,0)+4,LRSECT=LRSECT+1
. . S LRTAB(LRSECT,LRI)=LRY
. . S LRTAB(LRSECT,LRI,1)=LRTAB(LRSECT,LRI)
. . S LRTAB(LRSECT,LRI,2)=LRTAB(LRSECT,LRI)
. . S LRSECT(LRSECT)=$G(LRSECT(LRSECT))_LRI_"^"
. . S LRCOMTAB(LRSECT)=LRTAB(LRSECT,LRI)+LRWIDTH(LRI,2)+2
. I LRFMT="R" D Q
. . S LRY=LRX+LRWIDTH(LRI-1,1)+4
. . I (LRY+LRCOMMAX+LRWIDTH(LRI,1))>GIOM S LRCOMTAB(LRSECT)=LRY,LRY=LRTAB(1,0)+4,LRSECT=LRSECT+1
. . S LRTAB(LRSECT,LRI)=LRY
. . S LRTAB(LRSECT,LRI,1)=LRTAB(LRSECT,LRI)
. . S LRTAB(LRSECT,LRI,2)=LRTAB(LRSECT,LRI)
. . S LRSECT(LRSECT)=$G(LRSECT(LRSECT))_LRI_"^"
. . S LRCOMTAB(LRSECT)=LRTAB(LRSECT,LRI)+LRWIDTH(LRI,1)+2
;
D LINE^LR7OSUM4,LINE^LR7OSUM4
;
S X="ANTIBIOTIC SUSCEPTIBILITY TEST RESULTS:"
I $D(^XUSEC("LRLAB",DUZ))&'$D(LRWRDVEW) S X=X_" ('*' indicates display is suppressed)"
S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,X)
D LINE^LR7OSUM4
;
S LRSECT=0
F S LRSECT=$O(LRTAB(LRSECT)) Q:'LRSECT D SECT
;
Q
;
;
SECT ; EP - Print antibiotic susceptibility for each section
;
N LRAO
;
D BUGHDR
;
; Display antibiotics by print order
S LRAO=0
F S LRAO=$O(^LAB(62.06,"AO",LRAO)) Q:LRAO<.001 D
. S B=$O(^LAB(62.06,"AO",LRAO,0))
. I B>0,$D(^LAB(62.06,B,0)) D AB
;
D LINE^LR7OSUM4
;
Q
;
;
CHECK ; EP
;
N B,B1,B2,B3,LRBN,LRFLAG,LR1PASS
;
S LRFLAG=0,LRBN=2
F S LRBN=+$O(^LR(LRDFN,"MI",LRIDT,3,LRBUG,LRBN)) Q:LRBN'["2." D
. S B=^LR(LRDFN,"MI",LRIDT,3,LRBUG,LRBN),B1=$P(B,U),B2=$P(B,U,2)
. I B1'="" D FIRST
;
S LRBN=2
F S LRBN=+$O(LR1PASS(LRBN)) Q:LRBN<1 D
. S B=LR1PASS(LRBN),B1=$P(B,U),B2=$P(B,U,2),B3=$P(B,U,3)
. D LAB
;
S LRBUG(A)=LRBUG
;
Q
;
;
FIRST ; EP
;
; If format is 'interpretation only' and no interpretation for this sensitivity then display sensitivity result in it's place.
I B2="" S B2=$S(LRFMT="I":B1,1:" ")
;
S B3=$P(B,U,3)
I B2'=" ",$E(B2)'="R","A"[B3 S LRFLAG=1
S LR1PASS(LRBN)=B1_U_B2_U_B3
Q
;
;
LAB ; EP
I $D(^XUSEC("LRLAB",DUZ)),'$D(LRWRDVEW) D Q
. S $P(LRRES(LRBN),U,A)=$S(B3="N"!(B3="R"&LRFLAG):B1_"*",1:B1)
. S $P(LRINT(LRBN),U,A)=$S(B3="N"!(B3="R"&LRFLAG):B2_"*",1:B2)
;
I B3=""!(B3="A")!(B3="R"&'LRFLAG) S $P(LRRES(LRBN),U,A)=B1,$P(LRINT(LRBN),U,A)=B2
Q
;
;
AB ; EP
;
N LRX
;
S LRX=$G(^LAB(62.06,B,0)),J=$P(LRX,"^",2)
I J<1 Q
;
I '$D(LRINT(J)) Q
I LRINT(J)'="",LRINT(J)?."^" Q
;
D LINE^LR7OSUM4
;
; Write name of antibiotic
S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,$$LJ^XLFSTR($P(LRX,U),30,"."))
;
; Antibiotic display comment from file #62.06
K LRDCOM(0)
S LRDCOM=$P(LRX,U,3)
; If longer than comment window (GIOM-LRCOMTAB) then format to fit within window.
I $L(LRDCOM)>(GIOM-LRCOMTAB(LRSECT)) D
. N J,K,L
. S J=$L(LRDCOM),K=0,L=GIOM-LRCOMTAB(LRSECT)-1
. F Q:LRDCOM="" S K=K+1,LRDCOM(0,K)=$E(LRDCOM,1,L),LRDCOM=$E(LRDCOM,L+1,J)
;
D SIR
Q
;
;
BUGHDR ; EP
;
N A,J
F J=1:1 S LRBUG=$P(LRSECT(LRSECT),"^",J) Q:LRBUG="" D
. S LRORG=$P(^LR(LRDFN,"MI",LRIDT,3,LRBUG(LRBUG),0),U),LRORG=$P(^LAB(61.2,LRORG,0),U)
. I +$O(^LR(LRDFN,"MI",LRIDT,3,LRBUG(LRBUG),2))'["2." Q
. D ORG
;
I LRFMT="B" D
. D LN^LR7OSMZ1
. S ^TMP("LRC",$J,GCNT,0)=""
. F J=1:1 S A=$P(LRSECT(LRSECT),"^",J) Q:A="" S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(LRTAB(LRSECT,A),CCNT,":")
;
D LN^LR7OSMZ1
S ^TMP("LRC",$J,GCNT,0)=""
;
F J=1:1 S A=$P(LRSECT(LRSECT),"^",J) Q:A="" D
. I LRFMT'="B" S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(LRTAB(LRSECT,A),CCNT,":")
. I LRFMT="B" D
. . S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(LRTAB(LRSECT,A,1),CCNT,"SUSC")
. . S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(LRTAB(LRSECT,A,2),CCNT,"INTP")
;
Q
;
;
ORG ; EP
;
; LR2ORMOR flag indicating 2 or more organsims on report - set in LRMIPSZ2.
;
N J
;
D LINE^LR7OSUM4
;
S ^TMP("LRC",$J,GCNT,0)=""
;
I LRBUG>$P(LRSECT(LRSECT),"^") F J=1:1 Q:$P(LRSECT(LRSECT),"^",J)=LRBUG S ^TMP("LRC",$J,GCNT,0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(LRTAB(LRSECT,$P(LRSECT(LRSECT),"^",J)),CCNT,":")
;
S ^TMP("LRC",$J,GCNT,0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(LRTAB(LRSECT,LRBUG),CCNT,$S(LR2ORMOR:LRBUG(LRBUG)_". ",1:"")_LRORG)
;
Q
;
;
SIR ; EP - Display the susceptibility results/interpretations
;
N II,K
;
F K=1:1 S II=$P(LRSECT(LRSECT),"^",K) Q:II="" D
. I LRFMT="B" D Q
. . S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(LRTAB(LRSECT,II,1),CCNT,$P(LRRES(J),U,II))
. . S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(LRTAB(LRSECT,II,2),CCNT,$P(LRINT(J),U,II))
. I LRFMT="I" S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(LRTAB(LRSECT,II,2),CCNT,$P(LRINT(J),U,II)) Q
. I LRFMT="R" S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(LRTAB(LRSECT,II,1),CCNT,$P(LRRES(J),U,II)) Q
;
D DCOM
Q
;
;
DCOM ; EP - Show antibiotic's display comments
;
I LRDCOM'="" D
. I LRCOMTAB(LRSECT)<$X,$L(LRDCOM)>(GIOM-$X) D LINE^LR7OSUM4 S ^TMP("LRC",$J,GCNT,0)=""
. S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(LRCOMTAB(LRSECT),CCNT,LRDCOM)
;
I $D(LRDCOM(0)) D
. N J
. S J=0
. F S J=$O(LRDCOM(0,J)) Q:'J D
. . I J>1 D LINE^LR7OSUM4 S ^TMP("LRC",$J,GCNT,0)=""
. . S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(LRCOMTAB(LRSECT),CCNT,LRDCOM(0,J))
;
I $D(LRDCOM(J)) D
. S K=0,A=0
. F S A=+$O(LRDCOM(J,A)) Q:A<1 D
. . D:'('K&(LRDCOM="")) LINE^LR7OSUM4
. . S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(LRCOMTAB(LRSECT),CCNT,LRDCOM(J,A)),K=1
Q
BLR7OMZ5 ; IHS/MSC/MKK - Silent Micro Rpt - BACTERIA, ANTIBIOTICS ; 22-Oct-2013 09:22 ; MKK
+1 ;;5.2;IHS LABORATORY;**1033**;NOV 01, 1997
+2 ;
+3 ; Code below is cloned from the LEDI IV version of the LR7OSMZ5 routine.
+4 ;
BACT ; EP - from LR7OSMZ2
+1 NEW A,I,J,K,L,LRABCNT,LRCOMMAX,LRCOMTAB,LRBUG,LRDCOM,LRFMT,LR1PASS,LRBN,LRI
+2 NEW LRINT,LRMAX,LRORG,LRRES,LRSECT,LRTAB,LRWIDTH,LRX,LRY,X,Y
+3 ;
+4 DO ENTRYAUD^BLRUTIL("BACT^BLR7OMZ5 0.0")
+5 ; If no organism, skip
IF +$ORDER(^LR(LRDFN,"MI",LRIDT,3,0))<1
QUIT
+6 ;
+7 SET LRFMT=$PIECE(^LAB(69.9,1,0),U,11)
SET LRFMT=$SELECT(LRFMT="":"I",1:LRFMT)
+8 ;
+9 ; Check each organism identified on the specimen.
+10 ; A = number of organisms on report that have susceptibilities
+11 SET (A,LRBUG)=0
+12 FOR
SET LRBUG=+$ORDER(^LR(LRDFN,"MI",LRIDT,3,LRBUG))
IF LRBUG<1
QUIT
Begin DoDot:1
+13 IF +$ORDER(^LR(LRDFN,"MI",LRIDT,3,LRBUG,2))'["2."
QUIT
+14 SET A=A+1
DO CHECK
End DoDot:1
+15 ;
+16 SET (LRBN,LRABCNT)=0
+17 FOR
SET LRBN=+$ORDER(LRRES(LRBN))
IF LRBN<1
QUIT
SET LRABCNT=LRABCNT+1
+18 IF 'LRABCNT
QUIT
+19 ;
+20 ; Scan result to find longest value, set mininium field width = 4
+21 SET (LRI,LRMAX(1))=0
+22 FOR
SET LRI=$ORDER(LRRES(LRI))
IF 'LRI
QUIT
Begin DoDot:1
+23 FOR I=1:1:A
Begin DoDot:2
+24 SET X=$LENGTH($PIECE(LRRES(LRI),"^",I))
+25 IF X<4
SET X=4
+26 IF X>$GET(LRWIDTH(I,1))
SET LRWIDTH(I,1)=X
+27 IF X>LRMAX(1)
SET LRMAX(1)=X
End DoDot:2
End DoDot:1
+28 ;
+29 ; Scan interpretations to find longest value
+30 SET (LRI,LRMAX(2))=0
+31 FOR
SET LRI=$ORDER(LRINT(LRI))
IF 'LRI
QUIT
Begin DoDot:1
+32 FOR I=1:1:A
Begin DoDot:2
+33 SET X=$LENGTH($PIECE(LRINT(LRI),"^",I))
+34 IF X<4
SET X=4
+35 IF X>$GET(LRWIDTH(I,2))
SET LRWIDTH(I,2)=X
+36 IF X>LRMAX(2)
SET LRMAX(2)=X
End DoDot:2
End DoDot:1
+37 ;
+38 ; Find longest antibiotic display comment to display on report
+39 SET (LRCOMMAX,LRI)=0
+40 FOR
SET LRI=$ORDER(^LAB(62.06,LRI))
IF 'LRI
QUIT
Begin DoDot:1
+41 SET LRX=$GET(^LAB(62.06,LRI,0))
IF $PIECE(LRX,"^",3)=""
QUIT
+42 IF '$PIECE(LRX,"^",2)
QUIT
+43 SET LRY=0
+44 FOR
SET LRY=$ORDER(^LR(LRDFN,"MI",LRIDT,3,LRY))
IF 'LRY
QUIT
Begin DoDot:2
+45 IF $DATA(^LR(LRDFN,"MI",LRIDT,3,LRY,$PIECE(LRX,"^",2)))
SET X=$LENGTH($PIECE(LRX,"^",3))
IF X>LRCOMMAX
SET LRCOMMAX=X
End DoDot:2
End DoDot:1
+46 ;
+47 ; Check display width so that at least one organsism's values will display when display width is limited
+48 ; 31 character for antibiotic name, possibly 40 character display comments does not leave much space for actual results.
+49 IF LRCOMMAX>10
IF GIOM'>80
Begin DoDot:1
+50 IF LRFMT="B"
SET X=LRMAX(1)+LRMAX(2)+4
+51 IF LRFMT="R"
SET X=LRMAX(1)+2
+52 IF LRFMT="I"
SET X=LRMAX(2)+2
+53 SET X=X+31
+54 IF (X+LRCOMMAX)>GIOM
SET LRCOMMAX=GIOM-X
End DoDot:1
+55 ;
+56 ; Determine tab position (column) of each organism and associated results
+57 ; LRSECT will indicate if multiple sections needed when number of organisms, results and display comments exceed right margin.
+58 SET (LRI,LRWIDTH(0,1),LRWIDTH(0,2))=0
SET LRSECT=1
SET LRTAB(LRSECT,0)=29
+59 FOR
SET LRI=$ORDER(LRWIDTH(LRI))
IF 'LRI
QUIT
Begin DoDot:1
+60 SET LRX=LRTAB(LRSECT,LRI-1)
+61 IF LRFMT="B"
Begin DoDot:2
+62 SET LRY=LRX+LRWIDTH(LRI-1,1)+LRWIDTH(LRI-1,2)+4
+63 IF (LRY+LRCOMMAX+LRWIDTH(LRI,1)+LRWIDTH(LRI,2))>GIOM
SET LRCOMTAB(LRSECT)=LRY
SET LRY=LRTAB(1,0)+4
SET LRSECT=LRSECT+1
+64 SET LRTAB(LRSECT,LRI)=LRY
+65 SET LRTAB(LRSECT,LRI,1)=LRTAB(LRSECT,LRI)
+66 SET LRTAB(LRSECT,LRI,2)=LRTAB(LRSECT,LRI)+LRWIDTH(LRI,1)+2
+67 SET LRSECT(LRSECT)=$GET(LRSECT(LRSECT))_LRI_"^"
+68 SET LRCOMTAB(LRSECT)=LRTAB(LRSECT,LRI)+LRWIDTH(LRI,1)+LRWIDTH(LRI,2)+4
End DoDot:2
QUIT
+69 IF LRFMT="I"
Begin DoDot:2
+70 SET LRY=LRX+LRWIDTH(LRI-1,2)+4
+71 IF (LRY+LRCOMMAX+LRWIDTH(LRI,2))>GIOM
SET LRCOMTAB(LRSECT)=LRY
SET LRY=LRTAB(1,0)+4
SET LRSECT=LRSECT+1
+72 SET LRTAB(LRSECT,LRI)=LRY
+73 SET LRTAB(LRSECT,LRI,1)=LRTAB(LRSECT,LRI)
+74 SET LRTAB(LRSECT,LRI,2)=LRTAB(LRSECT,LRI)
+75 SET LRSECT(LRSECT)=$GET(LRSECT(LRSECT))_LRI_"^"
+76 SET LRCOMTAB(LRSECT)=LRTAB(LRSECT,LRI)+LRWIDTH(LRI,2)+2
End DoDot:2
QUIT
+77 IF LRFMT="R"
Begin DoDot:2
+78 SET LRY=LRX+LRWIDTH(LRI-1,1)+4
+79 IF (LRY+LRCOMMAX+LRWIDTH(LRI,1))>GIOM
SET LRCOMTAB(LRSECT)=LRY
SET LRY=LRTAB(1,0)+4
SET LRSECT=LRSECT+1
+80 SET LRTAB(LRSECT,LRI)=LRY
+81 SET LRTAB(LRSECT,LRI,1)=LRTAB(LRSECT,LRI)
+82 SET LRTAB(LRSECT,LRI,2)=LRTAB(LRSECT,LRI)
+83 SET LRSECT(LRSECT)=$GET(LRSECT(LRSECT))_LRI_"^"
+84 SET LRCOMTAB(LRSECT)=LRTAB(LRSECT,LRI)+LRWIDTH(LRI,1)+2
End DoDot:2
QUIT
End DoDot:1
+85 ;
+86 DO LINE^LR7OSUM4
DO LINE^LR7OSUM4
+87 ;
+88 SET X="ANTIBIOTIC SUSCEPTIBILITY TEST RESULTS:"
+89 IF $DATA(^XUSEC("LRLAB",DUZ))&'$DATA(LRWRDVEW)
SET X=X_" ('*' indicates display is suppressed)"
+90 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,X)
+91 DO LINE^LR7OSUM4
+92 ;
+93 SET LRSECT=0
+94 FOR
SET LRSECT=$ORDER(LRTAB(LRSECT))
IF 'LRSECT
QUIT
DO SECT
+95 ;
+96 QUIT
+97 ;
+98 ;
SECT ; EP - Print antibiotic susceptibility for each section
+1 ;
+2 NEW LRAO
+3 ;
+4 DO BUGHDR
+5 ;
+6 ; Display antibiotics by print order
+7 SET LRAO=0
+8 FOR
SET LRAO=$ORDER(^LAB(62.06,"AO",LRAO))
IF LRAO<.001
QUIT
Begin DoDot:1
+9 SET B=$ORDER(^LAB(62.06,"AO",LRAO,0))
+10 IF B>0
IF $DATA(^LAB(62.06,B,0))
DO AB
End DoDot:1
+11 ;
+12 DO LINE^LR7OSUM4
+13 ;
+14 QUIT
+15 ;
+16 ;
CHECK ; EP
+1 ;
+2 NEW B,B1,B2,B3,LRBN,LRFLAG,LR1PASS
+3 ;
+4 SET LRFLAG=0
SET LRBN=2
+5 FOR
SET LRBN=+$ORDER(^LR(LRDFN,"MI",LRIDT,3,LRBUG,LRBN))
IF LRBN'["2."
QUIT
Begin DoDot:1
+6 SET B=^LR(LRDFN,"MI",LRIDT,3,LRBUG,LRBN)
SET B1=$PIECE(B,U)
SET B2=$PIECE(B,U,2)
+7 IF B1'=""
DO FIRST
End DoDot:1
+8 ;
+9 SET LRBN=2
+10 FOR
SET LRBN=+$ORDER(LR1PASS(LRBN))
IF LRBN<1
QUIT
Begin DoDot:1
+11 SET B=LR1PASS(LRBN)
SET B1=$PIECE(B,U)
SET B2=$PIECE(B,U,2)
SET B3=$PIECE(B,U,3)
+12 DO LAB
End DoDot:1
+13 ;
+14 SET LRBUG(A)=LRBUG
+15 ;
+16 QUIT
+17 ;
+18 ;
FIRST ; EP
+1 ;
+2 ; If format is 'interpretation only' and no interpretation for this sensitivity then display sensitivity result in it's place.
+3 IF B2=""
SET B2=$SELECT(LRFMT="I":B1,1:" ")
+4 ;
+5 SET B3=$PIECE(B,U,3)
+6 IF B2'=" "
IF $EXTRACT(B2)'="R"
IF "A"[B3
SET LRFLAG=1
+7 SET LR1PASS(LRBN)=B1_U_B2_U_B3
+8 QUIT
+9 ;
+10 ;
LAB ; EP
+1 IF $DATA(^XUSEC("LRLAB",DUZ))
IF '$DATA(LRWRDVEW)
Begin DoDot:1
+2 SET $PIECE(LRRES(LRBN),U,A)=$SELECT(B3="N"!(B3="R"&LRFLAG):B1_"*",1:B1)
+3 SET $PIECE(LRINT(LRBN),U,A)=$SELECT(B3="N"!(B3="R"&LRFLAG):B2_"*",1:B2)
End DoDot:1
QUIT
+4 ;
+5 IF B3=""!(B3="A")!(B3="R"&'LRFLAG)
SET $PIECE(LRRES(LRBN),U,A)=B1
SET $PIECE(LRINT(LRBN),U,A)=B2
+6 QUIT
+7 ;
+8 ;
AB ; EP
+1 ;
+2 NEW LRX
+3 ;
+4 SET LRX=$GET(^LAB(62.06,B,0))
SET J=$PIECE(LRX,"^",2)
+5 IF J<1
QUIT
+6 ;
+7 IF '$DATA(LRINT(J))
QUIT
+8 IF LRINT(J)'=""
IF LRINT(J)?."^"
QUIT
+9 ;
+10 DO LINE^LR7OSUM4
+11 ;
+12 ; Write name of antibiotic
+13 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,$$LJ^XLFSTR($PIECE(LRX,U),30,"."))
+14 ;
+15 ; Antibiotic display comment from file #62.06
+16 KILL LRDCOM(0)
+17 SET LRDCOM=$PIECE(LRX,U,3)
+18 ; If longer than comment window (GIOM-LRCOMTAB) then format to fit within window.
+19 IF $LENGTH(LRDCOM)>(GIOM-LRCOMTAB(LRSECT))
Begin DoDot:1
+20 NEW J,K,L
+21 SET J=$LENGTH(LRDCOM)
SET K=0
SET L=GIOM-LRCOMTAB(LRSECT)-1
+22 FOR
IF LRDCOM=""
QUIT
SET K=K+1
SET LRDCOM(0,K)=$EXTRACT(LRDCOM,1,L)
SET LRDCOM=$EXTRACT(LRDCOM,L+1,J)
End DoDot:1
+23 ;
+24 DO SIR
+25 QUIT
+26 ;
+27 ;
BUGHDR ; EP
+1 ;
+2 NEW A,J
+3 FOR J=1:1
SET LRBUG=$PIECE(LRSECT(LRSECT),"^",J)
IF LRBUG=""
QUIT
Begin DoDot:1
+4 SET LRORG=$PIECE(^LR(LRDFN,"MI",LRIDT,3,LRBUG(LRBUG),0),U)
SET LRORG=$PIECE(^LAB(61.2,LRORG,0),U)
+5 IF +$ORDER(^LR(LRDFN,"MI",LRIDT,3,LRBUG(LRBUG),2))'["2."
QUIT
+6 DO ORG
End DoDot:1
+7 ;
+8 IF LRFMT="B"
Begin DoDot:1
+9 DO LN^LR7OSMZ1
+10 SET ^TMP("LRC",$JOB,GCNT,0)=""
+11 FOR J=1:1
SET A=$PIECE(LRSECT(LRSECT),"^",J)
IF A=""
QUIT
SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(LRTAB(LRSECT,A),CCNT,":")
End DoDot:1
+12 ;
+13 DO LN^LR7OSMZ1
+14 SET ^TMP("LRC",$JOB,GCNT,0)=""
+15 ;
+16 FOR J=1:1
SET A=$PIECE(LRSECT(LRSECT),"^",J)
IF A=""
QUIT
Begin DoDot:1
+17 IF LRFMT'="B"
SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(LRTAB(LRSECT,A),CCNT,":")
+18 IF LRFMT="B"
Begin DoDot:2
+19 SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(LRTAB(LRSECT,A,1),CCNT,"SUSC")
+20 SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(LRTAB(LRSECT,A,2),CCNT,"INTP")
End DoDot:2
End DoDot:1
+21 ;
+22 QUIT
+23 ;
+24 ;
ORG ; EP
+1 ;
+2 ; LR2ORMOR flag indicating 2 or more organsims on report - set in LRMIPSZ2.
+3 ;
+4 NEW J
+5 ;
+6 DO LINE^LR7OSUM4
+7 ;
+8 SET ^TMP("LRC",$JOB,GCNT,0)=""
+9 ;
+10 IF LRBUG>$PIECE(LRSECT(LRSECT),"^")
FOR J=1:1
IF $PIECE(LRSECT(LRSECT),"^",J)=LRBUG
QUIT
SET ^TMP("LRC",$JOB,GCNT,0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(LRTAB(LRSECT,$PIECE(LRSECT(LRSECT),"^",J)),CCNT,":")
+11 ;
+12 SET ^TMP("LRC",$JOB,GCNT,0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(LRTAB(LRSECT,LRBUG),CCNT,$SELECT(LR2ORMOR:LRBUG(LRBUG)_". ",1:"")_LRORG)
+13 ;
+14 QUIT
+15 ;
+16 ;
SIR ; EP - Display the susceptibility results/interpretations
+1 ;
+2 NEW II,K
+3 ;
+4 FOR K=1:1
SET II=$PIECE(LRSECT(LRSECT),"^",K)
IF II=""
QUIT
Begin DoDot:1
+5 IF LRFMT="B"
Begin DoDot:2
+6 SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(LRTAB(LRSECT,II,1),CCNT,$PIECE(LRRES(J),U,II))
+7 SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(LRTAB(LRSECT,II,2),CCNT,$PIECE(LRINT(J),U,II))
End DoDot:2
QUIT
+8 IF LRFMT="I"
SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(LRTAB(LRSECT,II,2),CCNT,$PIECE(LRINT(J),U,II))
QUIT
+9 IF LRFMT="R"
SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(LRTAB(LRSECT,II,1),CCNT,$PIECE(LRRES(J),U,II))
QUIT
End DoDot:1
+10 ;
+11 DO DCOM
+12 QUIT
+13 ;
+14 ;
DCOM ; EP - Show antibiotic's display comments
+1 ;
+2 IF LRDCOM'=""
Begin DoDot:1
+3 IF LRCOMTAB(LRSECT)<$X
IF $LENGTH(LRDCOM)>(GIOM-$X)
DO LINE^LR7OSUM4
SET ^TMP("LRC",$JOB,GCNT,0)=""
+4 SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(LRCOMTAB(LRSECT),CCNT,LRDCOM)
End DoDot:1
+5 ;
+6 IF $DATA(LRDCOM(0))
Begin DoDot:1
+7 NEW J
+8 SET J=0
+9 FOR
SET J=$ORDER(LRDCOM(0,J))
IF 'J
QUIT
Begin DoDot:2
+10 IF J>1
DO LINE^LR7OSUM4
SET ^TMP("LRC",$JOB,GCNT,0)=""
+11 SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(LRCOMTAB(LRSECT),CCNT,LRDCOM(0,J))
End DoDot:2
End DoDot:1
+12 ;
+13 IF $DATA(LRDCOM(J))
Begin DoDot:1
+14 SET K=0
SET A=0
+15 FOR
SET A=+$ORDER(LRDCOM(J,A))
IF A<1
QUIT
Begin DoDot:2
+16 IF '('K&(LRDCOM=""))
DO LINE^LR7OSUM4
+17 SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(LRCOMTAB(LRSECT),CCNT,LRDCOM(J,A))
SET K=1
End DoDot:2
End DoDot:1
+18 QUIT
