LRMIPSZ5 ;DALOI/STAFF - MICRO PATIENT REPORT - BACTERIA, ANTIBIOTICS ;05/24/11 14:37
;;5.2;LAB SERVICE;**350,437**;Sep 27, 1994;Build 3
;
Q
;
BACT ;
; from LRMIPSZ2
N A,I,J,K,L,LRABCNT,LRCOMMAX,LRCOMTAB,LRBUG,LRDCOM,LRFMT,LR1PASS,LRBN,LRI,LRINT,LRMAX,LRORG,LRRES,LRSECT,LRTAB,LRWIDTH,LRX,LRY,X,Y
Q:+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,0))<1
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(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,LRBUG)) Q:LRBUG<1 D
. I +$O(^TMP("LRMI",$J,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!($G(LREND))
;
; 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(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,LRY)) Q:'LRY D
. . I $D(^TMP("LRMI",$J,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,IOM'>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)>IOM S LRCOMMAX=IOM-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))>IOM 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))>IOM 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))>IOM 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 NP Q:LRABORT
W ! D NP Q:LRABORT
;
W !,"ANTIBIOTIC SUSCEPTIBILITY TEST RESULTS:"
I $D(^XUSEC("LRLAB",DUZ))&'$D(LRWRDVEW) W " ('*' indicates display is suppressed)"
;
D NP Q:LRABORT
;
; If hard copy (LRHC=1)
I LRHC W ! D NP Q:LRABORT
;
S LRSECT=0
F S LRSECT=$O(LRTAB(LRSECT)) Q:'LRSECT D SECT
;
Q
;
;
SECT ; Print antibiotic susceptibility for each section
;
N LRAO
;
D BUGHDR Q:LRABORT
;
; Display antibiotics by print order
S LRAO=0
F S LRAO=$O(^LAB(62.06,"AO",LRAO)) Q:LRAO<.001!($G(LREND)) D Q:LRABORT
. S B=$O(^LAB(62.06,"AO",LRAO,0))
. I B>0,$D(^LAB(62.06,B,0)) D AB
;
D NP Q:LRABORT
W !
D NP
;
Q
;
;
CHECK ;
;
N B,B1,B2,B3,LRBN,LRFLAG,LR1PASS
;
S LRFLAG=0,LRBN=2
F S LRBN=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,LRBUG,LRBN)) Q:LRBN'["2."!($G(LREND)) D
. S B=^TMP("LRMI",$J,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!($G(LREND)) 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 ;
;
; 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
S $P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,LRBUG,LRBN),U,1,3)=LR1PASS(LRBN)
Q
;
;
LAB ;
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 ;
N PGNUM,LRX
Q:$G(LREND)
S LRX=$G(^LAB(62.06,B,0)),J=$P(LRX,"^",2)
I J<1 Q
D NP Q:LRABORT
I '$D(LRINT(J)) Q
I LRINT(J)'="",LRINT(J)?."^" Q
D NP Q:LRABORT
;
; Write name of antibiotic
W !,$$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 (IOM-LRCOMTAB) then format to fit within window.
I $L(LRDCOM)>(IOM-LRCOMTAB(LRSECT)) D
. N J,K,L
. S J=$L(LRDCOM),K=0,L=IOM-LRCOMTAB(LRSECT)-1 S:L<1 L=1
. F Q:LRDCOM="" S K=K+1,LRDCOM(0,K)=$E(LRDCOM,1,L),LRDCOM=$E(LRDCOM,L+1,J)
;
D SIR
;
S PGNUM=LRPG
D NP Q:LRABORT
I LRPG>PGNUM D BUGHDR D NP
Q
;
;
BUGHDR ;
;
N A,J
F J=1:1 S LRBUG=$P(LRSECT(LRSECT),"^",J) Q:LRBUG=""!($G(LREND)) D
. S LRORG=$P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,LRBUG(LRBUG),0),U),LRORG=$P(^LAB(61.2,LRORG,0),U)
. I +$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,LRBUG(LRBUG),2))'["2." Q
. D ORG
;
I LRFMT="B" D
. W !
. F J=1:1 S A=$P(LRSECT(LRSECT),"^",J) Q:A="" W ?LRTAB(LRSECT,A),":"
;
D NP Q:LRABORT
W !
D NP Q:LRABORT
;
F J=1:1 S A=$P(LRSECT(LRSECT),"^",J) Q:A="" D
. I LRFMT'="B" W ?LRTAB(LRSECT,A),":"
. I LRFMT="B" W ?LRTAB(LRSECT,A,1),"SUSC",?LRTAB(LRSECT,A,2),"INTP"
;
D NP
Q
;
;
ORG ;
;
; LR2ORMOR flag indicating 2 or more organsims on report - set in LRMIPSZ2.
;
N J
W !
D NP Q:LRABORT
;
I LRBUG>$P(LRSECT(LRSECT),"^") F J=1:1 Q:$P(LRSECT(LRSECT),"^",J)=LRBUG W ?LRTAB(LRSECT,$P(LRSECT(LRSECT),"^",J)),":"
;
W ?LRTAB(LRSECT,LRBUG),$S(LR2ORMOR:LRBUG(LRBUG)_". ",1:""),LRORG
D NP
Q
;
;
SIR ; 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
. . W ?LRTAB(LRSECT,II,1),$P($G(LRRES(J)),U,II)
. . W ?LRTAB(LRSECT,II,2),$P(LRINT(J),U,II)," "
. I LRFMT="I" W ?LRTAB(LRSECT,II,2),$P(LRINT(J),U,II)," " Q
. I LRFMT="R" W ?LRTAB(LRSECT,II,1),$P(LRRES(J),U,II)," " Q
;
D DCOM
Q
;
;
DCOM ;
N A,K
;
I LRDCOM'="" D
. I LRCOMTAB(LRSECT)<$X,$L(LRDCOM)>(IOM-$X) W !
. W ?LRCOMTAB(LRSECT),LRDCOM
;
I $D(LRDCOM(0)) D
. N J
. S J=0
. F S J=$O(LRDCOM(0,J)) Q:'J W:J'=1 ! W ?LRCOMTAB(LRSECT),LRDCOM(0,J)
;
I $D(LRDCOM(J)) D
. S K=0,A=0
. F S A=+$O(LRDCOM(J,A)) Q:A<1 D
. . I '('K&(LRDCOM="")) W !
. . W ?LRCOMTAB(LRSECT),LRDCOM(J,A) S K=1
Q
;
;
NHDR ;
F X=1:1 W ! Q:$Y>(IOSL-LRFLIP)
Q:$G(LREND) I 'LRHC D FH^LRMIPSU Q
W ! F X=1:1:IOM W "-"
W !,"PATIENT'S IDENTIFICATION",?60,"MICROBIOLOGY REPORT"
W !!,PNM,?$X+3,SSN,?$X+3,SEX,?$X+3,"DOB: ",DOB," WARD: ",LRWRD,!,"ADM: ",LRADM," ADM DX: ",LRADX
S LRPG=LRPG+1
W @IOF,!,?18,"MICROBIOLOGY LAB ",$$INS^LRU
W ?$X+10,$$HTE^XLFDT($H,"D"),!
F X=1:1:IOM W "-"
W !,"ACCESSION: ",LRACC,?25,"TAKEN:",LRTK,?52,"RECEIVED:",LRRC
Q
;
;
NP ;
; Convenience method
D NP^LRMIPSZ1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRMIPSZ5 8432 printed Sep 23, 2025@19:52:56 Page 2
LRMIPSZ5 ;DALOI/STAFF - MICRO PATIENT REPORT - BACTERIA, ANTIBIOTICS ;05/24/11 14:37
+1 ;;5.2;LAB SERVICE;**350,437**;Sep 27, 1994;Build 3
+2 ;
+3 QUIT
+4 ;
BACT ;
+1 ; from LRMIPSZ2
+2 NEW A,I,J,K,L,LRABCNT,LRCOMMAX,LRCOMTAB,LRBUG,LRDCOM,LRFMT,LR1PASS,LRBN,LRI,LRINT,LRMAX,LRORG,LRRES,LRSECT,LRTAB,LRWIDTH,LRX,LRY,X,Y
+3 if +$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,3,0))<1
QUIT
+4 SET LRFMT=$PIECE(^LAB(69.9,1,0),U,11)
SET LRFMT=$SELECT(LRFMT="":"I",1:LRFMT)
+5 ;
+6 ; Check each organism identified on the specimen.
+7 ; A = number of organisms on report that have susceptibilities
+8 SET (A,LRBUG)=0
+9 FOR
SET LRBUG=+$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,3,LRBUG))
if LRBUG<1
QUIT
Begin DoDot:1
+10 IF +$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,3,LRBUG,2))'["2."
QUIT
+11 SET A=A+1
DO CHECK
End DoDot:1
+12 ;
+13 SET (LRBN,LRABCNT)=0
+14 FOR
SET LRBN=+$ORDER(LRRES(LRBN))
if LRBN<1
QUIT
SET LRABCNT=LRABCNT+1
+15 if 'LRABCNT!($GET(LREND))
QUIT
+16 ;
+17 ; Scan result to find longest value, set mininium field width = 4
+18 SET (LRI,LRMAX(1))=0
+19 FOR
SET LRI=$ORDER(LRRES(LRI))
if 'LRI
QUIT
Begin DoDot:1
+20 FOR I=1:1:A
Begin DoDot:2
+21 SET X=$LENGTH($PIECE(LRRES(LRI),"^",I))
+22 IF X<4
SET X=4
+23 IF X>$GET(LRWIDTH(I,1))
SET LRWIDTH(I,1)=X
+24 IF X>LRMAX(1)
SET LRMAX(1)=X
End DoDot:2
End DoDot:1
+25 ;
+26 ; Scan interpretations to find longest value
+27 SET (LRI,LRMAX(2))=0
+28 FOR
SET LRI=$ORDER(LRINT(LRI))
if 'LRI
QUIT
Begin DoDot:1
+29 FOR I=1:1:A
Begin DoDot:2
+30 SET X=$LENGTH($PIECE(LRINT(LRI),"^",I))
+31 IF X<4
SET X=4
+32 IF X>$GET(LRWIDTH(I,2))
SET LRWIDTH(I,2)=X
+33 IF X>LRMAX(2)
SET LRMAX(2)=X
End DoDot:2
End DoDot:1
+34 ;
+35 ; Find longest antibiotic display comment to display on report
+36 SET (LRCOMMAX,LRI)=0
+37 FOR
SET LRI=$ORDER(^LAB(62.06,LRI))
if 'LRI
QUIT
Begin DoDot:1
+38 SET LRX=$GET(^LAB(62.06,LRI,0))
if $PIECE(LRX,"^",3)=""
QUIT
+39 IF '$PIECE(LRX,"^",2)
QUIT
+40 SET LRY=0
+41 FOR
SET LRY=$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,3,LRY))
if 'LRY
QUIT
Begin DoDot:2
+42 IF $DATA(^TMP("LRMI",$JOB,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
+43 ;
+44 ; Check display width so that at least one organsism's values will display when display width is limited
+45 ; 31 character for antibiotic name, possibly 40 character display comments does not leave much space for actual results.
+46 IF LRCOMMAX>10
IF IOM'>80
Begin DoDot:1
+47 IF LRFMT="B"
SET X=LRMAX(1)+LRMAX(2)+4
+48 IF LRFMT="R"
SET X=LRMAX(1)+2
+49 IF LRFMT="I"
SET X=LRMAX(2)+2
+50 SET X=X+31
+51 IF (X+LRCOMMAX)>IOM
SET LRCOMMAX=IOM-X
End DoDot:1
+52 ;
+53 ; Determine tab position (column) of each organism and associated results
+54 ; LRSECT will indicate if multiple sections needed when number of organisms, results and display comments exceed right margin.
+55 SET (LRI,LRWIDTH(0,1),LRWIDTH(0,2))=0
SET LRSECT=1
SET LRTAB(LRSECT,0)=29
+56 FOR
SET LRI=$ORDER(LRWIDTH(LRI))
if 'LRI
QUIT
Begin DoDot:1
+57 SET LRX=LRTAB(LRSECT,LRI-1)
+58 IF LRFMT="B"
Begin DoDot:2
+59 SET LRY=LRX+LRWIDTH(LRI-1,1)+LRWIDTH(LRI-1,2)+4
+60 IF (LRY+LRCOMMAX+LRWIDTH(LRI,1)+LRWIDTH(LRI,2))>IOM
SET LRCOMTAB(LRSECT)=LRY
SET LRY=LRTAB(1,0)+4
SET LRSECT=LRSECT+1
+61 SET LRTAB(LRSECT,LRI)=LRY
+62 SET LRTAB(LRSECT,LRI,1)=LRTAB(LRSECT,LRI)
+63 SET LRTAB(LRSECT,LRI,2)=LRTAB(LRSECT,LRI)+LRWIDTH(LRI,1)+2
+64 SET LRSECT(LRSECT)=$GET(LRSECT(LRSECT))_LRI_"^"
+65 SET LRCOMTAB(LRSECT)=LRTAB(LRSECT,LRI)+LRWIDTH(LRI,1)+LRWIDTH(LRI,2)+4
End DoDot:2
QUIT
+66 IF LRFMT="I"
Begin DoDot:2
+67 SET LRY=LRX+LRWIDTH(LRI-1,2)+4
+68 IF (LRY+LRCOMMAX+LRWIDTH(LRI,2))>IOM
SET LRCOMTAB(LRSECT)=LRY
SET LRY=LRTAB(1,0)+4
SET LRSECT=LRSECT+1
+69 SET LRTAB(LRSECT,LRI)=LRY
+70 SET LRTAB(LRSECT,LRI,1)=LRTAB(LRSECT,LRI)
+71 SET LRTAB(LRSECT,LRI,2)=LRTAB(LRSECT,LRI)
+72 SET LRSECT(LRSECT)=$GET(LRSECT(LRSECT))_LRI_"^"
+73 SET LRCOMTAB(LRSECT)=LRTAB(LRSECT,LRI)+LRWIDTH(LRI,2)+2
End DoDot:2
QUIT
+74 IF LRFMT="R"
Begin DoDot:2
+75 SET LRY=LRX+LRWIDTH(LRI-1,1)+4
+76 IF (LRY+LRCOMMAX+LRWIDTH(LRI,1))>IOM
SET LRCOMTAB(LRSECT)=LRY
SET LRY=LRTAB(1,0)+4
SET LRSECT=LRSECT+1
+77 SET LRTAB(LRSECT,LRI)=LRY
+78 SET LRTAB(LRSECT,LRI,1)=LRTAB(LRSECT,LRI)
+79 SET LRTAB(LRSECT,LRI,2)=LRTAB(LRSECT,LRI)
+80 SET LRSECT(LRSECT)=$GET(LRSECT(LRSECT))_LRI_"^"
+81 SET LRCOMTAB(LRSECT)=LRTAB(LRSECT,LRI)+LRWIDTH(LRI,1)+2
End DoDot:2
QUIT
End DoDot:1
+82 ;
+83 DO NP
if LRABORT
QUIT
+84 WRITE !
DO NP
if LRABORT
QUIT
+85 ;
+86 WRITE !,"ANTIBIOTIC SUSCEPTIBILITY TEST RESULTS:"
+87 IF $DATA(^XUSEC("LRLAB",DUZ))&'$DATA(LRWRDVEW)
WRITE " ('*' indicates display is suppressed)"
+88 ;
+89 DO NP
if LRABORT
QUIT
+90 ;
+91 ; If hard copy (LRHC=1)
+92 IF LRHC
WRITE !
DO NP
if LRABORT
QUIT
+93 ;
+94 SET LRSECT=0
+95 FOR
SET LRSECT=$ORDER(LRTAB(LRSECT))
if 'LRSECT
QUIT
DO SECT
+96 ;
+97 QUIT
+98 ;
+99 ;
SECT ; Print antibiotic susceptibility for each section
+1 ;
+2 NEW LRAO
+3 ;
+4 DO BUGHDR
if LRABORT
QUIT
+5 ;
+6 ; Display antibiotics by print order
+7 SET LRAO=0
+8 FOR
SET LRAO=$ORDER(^LAB(62.06,"AO",LRAO))
if LRAO<.001!($GET(LREND))
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
if LRABORT
QUIT
+11 ;
+12 DO NP
if LRABORT
QUIT
+13 WRITE !
+14 DO NP
+15 ;
+16 QUIT
+17 ;
+18 ;
CHECK ;
+1 ;
+2 NEW B,B1,B2,B3,LRBN,LRFLAG,LR1PASS
+3 ;
+4 SET LRFLAG=0
SET LRBN=2
+5 FOR
SET LRBN=+$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,3,LRBUG,LRBN))
if LRBN'["2."!($GET(LREND))
QUIT
Begin DoDot:1
+6 SET B=^TMP("LRMI",$JOB,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!($GET(LREND))
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 ;
+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 SET $PIECE(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,3,LRBUG,LRBN),U,1,3)=LR1PASS(LRBN)
+9 QUIT
+10 ;
+11 ;
LAB ;
+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 ;
+1 NEW PGNUM,LRX
+2 if $GET(LREND)
QUIT
+3 SET LRX=$GET(^LAB(62.06,B,0))
SET J=$PIECE(LRX,"^",2)
+4 IF J<1
QUIT
+5 DO NP
if LRABORT
QUIT
+6 IF '$DATA(LRINT(J))
QUIT
+7 IF LRINT(J)'=""
IF LRINT(J)?."^"
QUIT
+8 DO NP
if LRABORT
QUIT
+9 ;
+10 ; Write name of antibiotic
+11 WRITE !,$$LJ^XLFSTR($PIECE(LRX,U),30,".")
+12 ;
+13 ; Antibiotic display comment from file #62.06
+14 KILL LRDCOM(0)
+15 SET LRDCOM=$PIECE(LRX,U,3)
+16 ; If longer than comment window (IOM-LRCOMTAB) then format to fit within window.
+17 IF $LENGTH(LRDCOM)>(IOM-LRCOMTAB(LRSECT))
Begin DoDot:1
+18 NEW J,K,L
+19 SET J=$LENGTH(LRDCOM)
SET K=0
SET L=IOM-LRCOMTAB(LRSECT)-1
if L<1
SET L=1
+20 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
+21 ;
+22 DO SIR
+23 ;
+24 SET PGNUM=LRPG
+25 DO NP
if LRABORT
QUIT
+26 IF LRPG>PGNUM
DO BUGHDR
DO NP
+27 QUIT
+28 ;
+29 ;
BUGHDR ;
+1 ;
+2 NEW A,J
+3 FOR J=1:1
SET LRBUG=$PIECE(LRSECT(LRSECT),"^",J)
if LRBUG=""!($GET(LREND))
QUIT
Begin DoDot:1
+4 SET LRORG=$PIECE(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,3,LRBUG(LRBUG),0),U)
SET LRORG=$PIECE(^LAB(61.2,LRORG,0),U)
+5 IF +$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,3,LRBUG(LRBUG),2))'["2."
QUIT
+6 DO ORG
End DoDot:1
+7 ;
+8 IF LRFMT="B"
Begin DoDot:1
+9 WRITE !
+10 FOR J=1:1
SET A=$PIECE(LRSECT(LRSECT),"^",J)
if A=""
QUIT
WRITE ?LRTAB(LRSECT,A),":"
End DoDot:1
+11 ;
+12 DO NP
if LRABORT
QUIT
+13 WRITE !
+14 DO NP
if LRABORT
QUIT
+15 ;
+16 FOR J=1:1
SET A=$PIECE(LRSECT(LRSECT),"^",J)
if A=""
QUIT
Begin DoDot:1
+17 IF LRFMT'="B"
WRITE ?LRTAB(LRSECT,A),":"
+18 IF LRFMT="B"
WRITE ?LRTAB(LRSECT,A,1),"SUSC",?LRTAB(LRSECT,A,2),"INTP"
End DoDot:1
+19 ;
+20 DO NP
+21 QUIT
+22 ;
+23 ;
ORG ;
+1 ;
+2 ; LR2ORMOR flag indicating 2 or more organsims on report - set in LRMIPSZ2.
+3 ;
+4 NEW J
+5 WRITE !
+6 DO NP
if LRABORT
QUIT
+7 ;
+8 IF LRBUG>$PIECE(LRSECT(LRSECT),"^")
FOR J=1:1
if $PIECE(LRSECT(LRSECT),"^",J)=LRBUG
QUIT
WRITE ?LRTAB(LRSECT,$PIECE(LRSECT(LRSECT),"^",J)),":"
+9 ;
+10 WRITE ?LRTAB(LRSECT,LRBUG),$SELECT(LR2ORMOR:LRBUG(LRBUG)_". ",1:""),LRORG
+11 DO NP
+12 QUIT
+13 ;
+14 ;
SIR ; 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 WRITE ?LRTAB(LRSECT,II,1),$PIECE($GET(LRRES(J)),U,II)
+7 WRITE ?LRTAB(LRSECT,II,2),$PIECE(LRINT(J),U,II)," "
End DoDot:2
QUIT
+8 IF LRFMT="I"
WRITE ?LRTAB(LRSECT,II,2),$PIECE(LRINT(J),U,II)," "
QUIT
+9 IF LRFMT="R"
WRITE ?LRTAB(LRSECT,II,1),$PIECE(LRRES(J),U,II)," "
QUIT
End DoDot:1
+10 ;
+11 DO DCOM
+12 QUIT
+13 ;
+14 ;
DCOM ;
+1 NEW A,K
+2 ;
+3 IF LRDCOM'=""
Begin DoDot:1
+4 IF LRCOMTAB(LRSECT)<$X
IF $LENGTH(LRDCOM)>(IOM-$X)
WRITE !
+5 WRITE ?LRCOMTAB(LRSECT),LRDCOM
End DoDot:1
+6 ;
+7 IF $DATA(LRDCOM(0))
Begin DoDot:1
+8 NEW J
+9 SET J=0
+10 FOR
SET J=$ORDER(LRDCOM(0,J))
if 'J
QUIT
if J'=1
WRITE !
WRITE ?LRCOMTAB(LRSECT),LRDCOM(0,J)
End DoDot:1
+11 ;
+12 IF $DATA(LRDCOM(J))
Begin DoDot:1
+13 SET K=0
SET A=0
+14 FOR
SET A=+$ORDER(LRDCOM(J,A))
if A<1
QUIT
Begin DoDot:2
+15 IF '('K&(LRDCOM=""))
WRITE !
+16 WRITE ?LRCOMTAB(LRSECT),LRDCOM(J,A)
SET K=1
End DoDot:2
End DoDot:1
+17 QUIT
+18 ;
+19 ;
NHDR ;
+1 FOR X=1:1
WRITE !
if $Y>(IOSL-LRFLIP)
QUIT
+2 if $GET(LREND)
QUIT
IF 'LRHC
DO FH^LRMIPSU
QUIT
+3 WRITE !
FOR X=1:1:IOM
WRITE "-"
+4 WRITE !,"PATIENT'S IDENTIFICATION",?60,"MICROBIOLOGY REPORT"
+5 WRITE !!,PNM,?$X+3,SSN,?$X+3,SEX,?$X+3,"DOB: ",DOB," WARD: ",LRWRD,!,"ADM: ",LRADM," ADM DX: ",LRADX
+6 SET LRPG=LRPG+1
+7 WRITE @IOF,!,?18,"MICROBIOLOGY LAB ",$$INS^LRU
+8 WRITE ?$X+10,$$HTE^XLFDT($HOROLOG,"D"),!
+9 FOR X=1:1:IOM
WRITE "-"
+10 WRITE !,"ACCESSION: ",LRACC,?25,"TAKEN:",LRTK,?52,"RECEIVED:",LRRC
+11 QUIT
+12 ;
+13 ;
NP ;
+1 ; Convenience method
+2 DO NP^LRMIPSZ1
+3 QUIT
