LRMIPSZ2 ;DALOI/STAFF - MICRO PATIENT REPORT - BACTERIA, SIC/SBC, MIC ;Jul 15, 2021@13:13
;;5.2;LAB SERVICE;**388,350,427,547,581**;Sep 27, 1994;Build 7
;
;
Q
;
ANTI ;
; from LRMIPSZ1
N B,I
I $O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,14,0)) D
. W !!,?28,"Antibiotic Level(s):"
. W !,"ANTIBIOTIC",?20,"CONC RANGE (ug/ml)",?42,"DRAW TIME"
. S B=0
. F S B=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,14,B)) Q:B<1 D
. . W !,$P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,14,B,0),U),?20,$P(^(0),U,3),?42,$$EXTERNAL^DILFD(63.42,1,"",$P(^(0),U,2))
Q
;
MES ;LR*5.2*547: Display informational message if accession/test is currently being edited.
Q:'$G(LR7SB)
N LR7AREA
S LR7AREA=$S(LR7SB=1:"Bacteriology",LR7SB=5:"Parasitology",LR7SB=8:"Mycology",LR7SB=11:"Mycobacteriology",1:"Virology")
Q:'$D(^XTMP("LRMICRO EDIT",LRDFN,LRIDT,LR7SB))
W !,?22,"**** ATTENTION ****",!,?10,"The "_LR7AREA_" Report is being edited",!,?10,"by tech code ",^XTMP("LRMICRO EDIT",LRDFN,LRIDT,LR7SB)
W " and current results",!,?10,"may not be visible until approved.",!
Q
;
BACT ;
; from LRMIPSZ1
I $P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,1),U)="",'$G(LRLABKY) D Q:'$D(LRWRDVEW) Q:LRSB'=1
. Q:'$D(^XTMP("LRMICRO EDIT",LRDFN,LRIDT,1))
. ;LR*5.2*547: Display informational message if accession/test is currently being edited
. ; and results had previously been verified.
. N LR7SB S LR7SB=1
. D MES
D BUG
I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,2)) D Q:LRABORT ;
. D NP Q:LRABORT
. D GRAM
. D NP
Q:LRABORT
;
I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,25)) D Q:LRABORT ;
. D NP Q:LRABORT
. D BSMEAR
. D NP
;
I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3)) D Q:LRABORT ;
. D NP Q:LRABORT
. D BRMK Q:LREND
. D NP Q:LRABORT
. D BACT^LRMIPSZ5
. D NP
;
I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,4)) D Q:LRABORT ;
. N B,I
. D NP Q:LRABORT
. I LRHC W ! D NP Q:LRABORT
. W !,"Bacteriology Remark(s):"
. D NP Q:LRABORT
. S B=0
. F I=0:0 S B=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,4,B)) Q:B<1 W !,?3,^TMP("LRMI",$J,LRDFN,"MI",LRIDT,4,B,0) D NP Q:LRABORT
;
Q
;
;
BUG ;
N LRNS,LRTUS,LRUS,X
;
S X=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,1),LRTUS=$P(X,U,2),DZ=$P(X,U,3),LRUS=$P(X,U,6),LRNS=$P(X,U,5),Y=$P(X,U)
;
D D^LRU
D NP Q:LRABORT
W:LRHC !
D NP Q:LRABORT
W !,"* BACTERIOLOGY ",$S(LRTUS="F":"FINAL",LRTUS="P":"PRELIMINARY",1:"")," REPORT => "_Y_" TECH CODE: "_DZ
D NP Q:LRABORT
S LRPRE=19
D PRE^LRMIPSU
I LRUS'="" D NP Q:LRABORT W !,"URINE SCREEN: "_$S(LRUS="N":"Negative",LRUS="P":"Positive",1:LRUS) D NP Q:LRABORT W:LRHC ! D NP Q:LRABORT
I LRNS'="" D NP Q:LRABORT W !,"SPUTUM SCREEN: ",LRNS D NP Q:LRABORT W:LRHC ! D NP Q:LRABORT
Q
;
;
GRAM ;
N CNT
;
D NP Q:LRABORT
W !,"GRAM STAIN:"
S (CNT,LRGRM)=0
F S LRGRM=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,2,LRGRM)) Q:LRGRM<1 S CNT=CNT+1 W:CNT>1 ! W ?12,^(LRGRM,0) D NP Q:LRABORT
I LRHC W !
D NP
Q
;
;
BSMEAR ;
W !,"BACTERIOLOGY SMEAR/PREP:",!
S LRMYC=0
F S LRMYC=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,25,LRMYC)) Q:LRMYC<1 W ?5,^(LRMYC,0),!
Q
;
;
BRMK ;
; also called from T51^LRMIV1
N LRBLDTMP
S LRBLDTMP=0
I '$D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3)) D ;
. S LRBLDTMP=1
. M ^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3)=^LR(LRDFN,"MI",LRIDT,3)
;
S (LRBUG,LR2ORMOR)=0
F LRAX=1,2 S LRBUG=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,LRBUG)) Q:LRBUG<1 S:LRAX=2 LR2ORMOR=1
I LRAX'=1 S (LRBUG,LRTSTS)=0 F LRAX=1:1 S LRBUG=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,LRBUG)) Q:LRBUG<1 D LST
; delete ^TMP if built just for this entrypoint
I LRBLDTMP K ^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3)
Q
;
;
LST ;
;
N LRX
;LR*5.2*581: When accepting instrument interfaced results, detect
; if organism information was not filed at the ^LAH subscript
; LREND = discontinue display and prevent downstream errors
; LRXPROB = pass back to routine LRVR0 to inform user of setup issue
S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,LRBUG,0))
I LRX="",$G(LRINTYPE) S (LREND,LRXPROB)=1 Q
S (LRBUG(LRAX),LRORG)=$P(LRX,U),LRQU=$P(LRX,U,2),LRSSD=$P(LRX,U,3,8),LRORG=$P(^LAB(61.2,LRORG,0),U)
;
I LRSSD'?."^" S LRSIC1=$P(LRSSD,U),LRSBC1=$P(LRSSD,U,2),LRDRTM1=$P(LRSSD,U,3),LRSIC2=$P(LRSSD,U,4),LRSBC2=$P(LRSSD,U,5),LRDRTM2=$P(LRSSD,U,6),LRSSD=1
D NP Q:LRABORT
W:LRHC !
I LRAX=1 W !,"CULTURE RESULTS:"
E W !
W ?17,$S(LR2ORMOR:$J(LRBUG,2)_". ",1:" "),LRORG
;
; Display quantity/colony count
I LRQU'="" D
. S LRX=" - Quantity: "_LRQU
. I (IOM-$X-1)<$L(LRX) W !,?21
. W LRX
;
I LRSSD D FH^LRMIPSU Q:LREND D SSD W:LRHC !
S:$D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,LRBUG,2)) LRTSTS=LRTSTS+1
I $O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,LRBUG,3,0)) D MIC
D CMNT
Q
;
;
SSD ;
D NP Q:LRABORT
W !
;
D NP Q:LRABORT
S LRDRTM1=$S(LRDRTM1="P":"PEAK",LRDRTM1="T":"TROUGH",1:LRDRTM1),LRDRTM2=$S(LRDRTM2="P":"PEAK",LRDRTM2="T":"TROUGH",1:LRDRTM2)
;
I LRSIC1'="" D
. W !,?20,"SIT " W:LRDRTM1'="" "(",LRDRTM1,")" W ": ",LRSIC1
. D NP
Q:LRABORT
;
I LRSBC1'="" D
. W !,?20,"SBT " W:LRDRTM1'="" "(",LRDRTM1,")" W ": ",LRSBC1
. D NP
Q:LRABORT
;
I LRSIC2'="" D
. W !,?20,"SIT " W:LRDRTM2'="" "(",LRDRTM2,")" W ": ",LRSIC2
. D NP
Q:LRABORT
;
I LRSBC2'="" D
. W !,?20,"SBT " W:LRDRTM2'="" "(",LRDRTM2,")" W ": ",LRSBC2
. D NP
;
Q
;
;
MIC ;
;
N B
W !,?21,"Antibiotic"
;
; If data in 2/3rd pieces then print header
S B=0
F S B=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,LRBUG,3,B)) Q:B<1 I $P(^(B,0),U,2,3)'="" W ?38,"MIC (ug/ml)",?53,"MBC (ug/ml)" Q
;
; Print results
S B=0
F S B=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,LRBUG,3,B)) Q:B<1 W !,?21,$P(^(B,0),U),?38,$J($P(^(0),U,2),7),?53,$J($P(^(0),U,3),7)
Q
;
;
CMNT ;
N A,LRX,X,DIWL,DIWR,DIWF,LRIDX
;
S LRPC=0,DIWL=31,DIWR=IOM,DIWF="|"
F A=0:1 S LRPC=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,LRBUG,1,LRPC)) Q:LRPC<1 D Q:LRABORT
. S LRX=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,LRBUG,1,LRPC,0),X=LRX
. K ^UTILITY($J,"W")
. D ^DIWP
. I A=0,$D(^UTILITY($J,"W",31,1,0)) D
. . W !,?21,"Comment: "_^UTILITY($J,"W",31,1,0)
. . K ^UTILITY($J,"W",31,1,0)
. D NP Q:LRABORT
. S LRIDX=0
. F S LRIDX=$O(^UTILITY($J,"W",31,LRIDX)) Q:'LRIDX D
. . Q:'$D(^UTILITY($J,"W",31,LRIDX,0))
. . W !,?21," "_^UTILITY($J,"W",31,LRIDX,0)
. . D NP
K ^UTILITY($J,"W")
Q
;
;
NP ;
; Convenience method
D NP^LRMIPSZ1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRMIPSZ2 6458 printed Sep 23, 2025@19:52:53 Page 2
LRMIPSZ2 ;DALOI/STAFF - MICRO PATIENT REPORT - BACTERIA, SIC/SBC, MIC ;Jul 15, 2021@13:13
+1 ;;5.2;LAB SERVICE;**388,350,427,547,581**;Sep 27, 1994;Build 7
+2 ;
+3 ;
+4 QUIT
+5 ;
ANTI ;
+1 ; from LRMIPSZ1
+2 NEW B,I
+3 IF $ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,14,0))
Begin DoDot:1
+4 WRITE !!,?28,"Antibiotic Level(s):"
+5 WRITE !,"ANTIBIOTIC",?20,"CONC RANGE (ug/ml)",?42,"DRAW TIME"
+6 SET B=0
+7 FOR
SET B=$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,14,B))
if B<1
QUIT
Begin DoDot:2
+8 WRITE !,$PIECE(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,14,B,0),U),?20,$PIECE(^(0),U,3),?42,$$EXTERNAL^DILFD(63.42,1,"",$PIECE(^(0),U,2))
End DoDot:2
End DoDot:1
+9 QUIT
+10 ;
MES ;LR*5.2*547: Display informational message if accession/test is currently being edited.
+1 if '$GET(LR7SB)
QUIT
+2 NEW LR7AREA
+3 SET LR7AREA=$SELECT(LR7SB=1:"Bacteriology",LR7SB=5:"Parasitology",LR7SB=8:"Mycology",LR7SB=11:"Mycobacteriology",1:"Virology")
+4 if '$DATA(^XTMP("LRMICRO EDIT",LRDFN,LRIDT,LR7SB))
QUIT
+5 WRITE !,?22,"**** ATTENTION ****",!,?10,"The "_LR7AREA_" Report is being edited",!,?10,"by tech code ",^XTMP("LRMICRO EDIT",LRDFN,LRIDT,LR7SB)
+6 WRITE " and current results",!,?10,"may not be visible until approved.",!
+7 QUIT
+8 ;
BACT ;
+1 ; from LRMIPSZ1
+2 IF $PIECE(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,1),U)=""
IF '$GET(LRLABKY)
Begin DoDot:1
+3 if '$DATA(^XTMP("LRMICRO EDIT",LRDFN,LRIDT,1))
QUIT
+4 ;LR*5.2*547: Display informational message if accession/test is currently being edited
+5 ; and results had previously been verified.
+6 NEW LR7SB
SET LR7SB=1
+7 DO MES
End DoDot:1
if '$DATA(LRWRDVEW)
QUIT
if LRSB'=1
QUIT
+8 DO BUG
+9 ;
IF $DATA(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,2))
Begin DoDot:1
+10 DO NP
if LRABORT
QUIT
+11 DO GRAM
+12 DO NP
End DoDot:1
if LRABORT
QUIT
+13 if LRABORT
QUIT
+14 ;
+15 ;
IF $DATA(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,25))
Begin DoDot:1
+16 DO NP
if LRABORT
QUIT
+17 DO BSMEAR
+18 DO NP
End DoDot:1
if LRABORT
QUIT
+19 ;
+20 ;
IF $DATA(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,3))
Begin DoDot:1
+21 DO NP
if LRABORT
QUIT
+22 DO BRMK
if LREND
QUIT
+23 DO NP
if LRABORT
QUIT
+24 DO BACT^LRMIPSZ5
+25 DO NP
End DoDot:1
if LRABORT
QUIT
+26 ;
+27 ;
IF $DATA(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,4))
Begin DoDot:1
+28 NEW B,I
+29 DO NP
if LRABORT
QUIT
+30 IF LRHC
WRITE !
DO NP
if LRABORT
QUIT
+31 WRITE !,"Bacteriology Remark(s):"
+32 DO NP
if LRABORT
QUIT
+33 SET B=0
+34 FOR I=0:0
SET B=+$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,4,B))
if B<1
QUIT
WRITE !,?3,^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,4,B,0)
DO NP
if LRABORT
QUIT
End DoDot:1
if LRABORT
QUIT
+35 ;
+36 QUIT
+37 ;
+38 ;
BUG ;
+1 NEW LRNS,LRTUS,LRUS,X
+2 ;
+3 SET X=^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,1)
SET LRTUS=$PIECE(X,U,2)
SET DZ=$PIECE(X,U,3)
SET LRUS=$PIECE(X,U,6)
SET LRNS=$PIECE(X,U,5)
SET Y=$PIECE(X,U)
+4 ;
+5 DO D^LRU
+6 DO NP
if LRABORT
QUIT
+7 if LRHC
WRITE !
+8 DO NP
if LRABORT
QUIT
+9 WRITE !,"* BACTERIOLOGY ",$SELECT(LRTUS="F":"FINAL",LRTUS="P":"PRELIMINARY",1:"")," REPORT => "_Y_" TECH CODE: "_DZ
+10 DO NP
if LRABORT
QUIT
+11 SET LRPRE=19
+12 DO PRE^LRMIPSU
+13 IF LRUS'=""
DO NP
if LRABORT
QUIT
WRITE !,"URINE SCREEN: "_$SELECT(LRUS="N":"Negative",LRUS="P":"Positive",1:LRUS)
DO NP
if LRABORT
QUIT
if LRHC
WRITE !
DO NP
if LRABORT
QUIT
+14 IF LRNS'=""
DO NP
if LRABORT
QUIT
WRITE !,"SPUTUM SCREEN: ",LRNS
DO NP
if LRABORT
QUIT
if LRHC
WRITE !
DO NP
if LRABORT
QUIT
+15 QUIT
+16 ;
+17 ;
GRAM ;
+1 NEW CNT
+2 ;
+3 DO NP
if LRABORT
QUIT
+4 WRITE !,"GRAM STAIN:"
+5 SET (CNT,LRGRM)=0
+6 FOR
SET LRGRM=+$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,2,LRGRM))
if LRGRM<1
QUIT
SET CNT=CNT+1
if CNT>1
WRITE !
WRITE ?12,^(LRGRM,0)
DO NP
if LRABORT
QUIT
+7 IF LRHC
WRITE !
+8 DO NP
+9 QUIT
+10 ;
+11 ;
BSMEAR ;
+1 WRITE !,"BACTERIOLOGY SMEAR/PREP:",!
+2 SET LRMYC=0
+3 FOR
SET LRMYC=+$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,25,LRMYC))
if LRMYC<1
QUIT
WRITE ?5,^(LRMYC,0),!
+4 QUIT
+5 ;
+6 ;
BRMK ;
+1 ; also called from T51^LRMIV1
+2 NEW LRBLDTMP
+3 SET LRBLDTMP=0
+4 ;
IF '$DATA(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,3))
Begin DoDot:1
+5 SET LRBLDTMP=1
+6 MERGE ^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,3)=^LR(LRDFN,"MI",LRIDT,3)
End DoDot:1
+7 ;
+8 SET (LRBUG,LR2ORMOR)=0
+9 FOR LRAX=1,2
SET LRBUG=+$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,3,LRBUG))
if LRBUG<1
QUIT
if LRAX=2
SET LR2ORMOR=1
+10 IF LRAX'=1
SET (LRBUG,LRTSTS)=0
FOR LRAX=1:1
SET LRBUG=+$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,3,LRBUG))
if LRBUG<1
QUIT
DO LST
+11 ; delete ^TMP if built just for this entrypoint
+12 IF LRBLDTMP
KILL ^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,3)
+13 QUIT
+14 ;
+15 ;
LST ;
+1 ;
+2 NEW LRX
+3 ;LR*5.2*581: When accepting instrument interfaced results, detect
+4 ; if organism information was not filed at the ^LAH subscript
+5 ; LREND = discontinue display and prevent downstream errors
+6 ; LRXPROB = pass back to routine LRVR0 to inform user of setup issue
+7 SET LRX=$GET(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,3,LRBUG,0))
+8 IF LRX=""
IF $GET(LRINTYPE)
SET (LREND,LRXPROB)=1
QUIT
+9 SET (LRBUG(LRAX),LRORG)=$PIECE(LRX,U)
SET LRQU=$PIECE(LRX,U,2)
SET LRSSD=$PIECE(LRX,U,3,8)
SET LRORG=$PIECE(^LAB(61.2,LRORG,0),U)
+10 ;
+11 IF LRSSD'?."^"
SET LRSIC1=$PIECE(LRSSD,U)
SET LRSBC1=$PIECE(LRSSD,U,2)
SET LRDRTM1=$PIECE(LRSSD,U,3)
SET LRSIC2=$PIECE(LRSSD,U,4)
SET LRSBC2=$PIECE(LRSSD,U,5)
SET LRDRTM2=$PIECE(LRSSD,U,6)
SET LRSSD=1
+12 DO NP
if LRABORT
QUIT
+13 if LRHC
WRITE !
+14 IF LRAX=1
WRITE !,"CULTURE RESULTS:"
+15 IF '$TEST
WRITE !
+16 WRITE ?17,$SELECT(LR2ORMOR:$JUSTIFY(LRBUG,2)_". ",1:" "),LRORG
+17 ;
+18 ; Display quantity/colony count
+19 IF LRQU'=""
Begin DoDot:1
+20 SET LRX=" - Quantity: "_LRQU
+21 IF (IOM-$X-1)<$LENGTH(LRX)
WRITE !,?21
+22 WRITE LRX
End DoDot:1
+23 ;
+24 IF LRSSD
DO FH^LRMIPSU
if LREND
QUIT
DO SSD
if LRHC
WRITE !
+25 if $DATA(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,3,LRBUG,2))
SET LRTSTS=LRTSTS+1
+26 IF $ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,3,LRBUG,3,0))
DO MIC
+27 DO CMNT
+28 QUIT
+29 ;
+30 ;
SSD ;
+1 DO NP
if LRABORT
QUIT
+2 WRITE !
+3 ;
+4 DO NP
if LRABORT
QUIT
+5 SET LRDRTM1=$SELECT(LRDRTM1="P":"PEAK",LRDRTM1="T":"TROUGH",1:LRDRTM1)
SET LRDRTM2=$SELECT(LRDRTM2="P":"PEAK",LRDRTM2="T":"TROUGH",1:LRDRTM2)
+6 ;
+7 IF LRSIC1'=""
Begin DoDot:1
+8 WRITE !,?20,"SIT "
if LRDRTM1'=""
WRITE "(",LRDRTM1,")"
WRITE ": ",LRSIC1
+9 DO NP
End DoDot:1
+10 if LRABORT
QUIT
+11 ;
+12 IF LRSBC1'=""
Begin DoDot:1
+13 WRITE !,?20,"SBT "
if LRDRTM1'=""
WRITE "(",LRDRTM1,")"
WRITE ": ",LRSBC1
+14 DO NP
End DoDot:1
+15 if LRABORT
QUIT
+16 ;
+17 IF LRSIC2'=""
Begin DoDot:1
+18 WRITE !,?20,"SIT "
if LRDRTM2'=""
WRITE "(",LRDRTM2,")"
WRITE ": ",LRSIC2
+19 DO NP
End DoDot:1
+20 if LRABORT
QUIT
+21 ;
+22 IF LRSBC2'=""
Begin DoDot:1
+23 WRITE !,?20,"SBT "
if LRDRTM2'=""
WRITE "(",LRDRTM2,")"
WRITE ": ",LRSBC2
+24 DO NP
End DoDot:1
+25 ;
+26 QUIT
+27 ;
+28 ;
MIC ;
+1 ;
+2 NEW B
+3 WRITE !,?21,"Antibiotic"
+4 ;
+5 ; If data in 2/3rd pieces then print header
+6 SET B=0
+7 FOR
SET B=+$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,3,LRBUG,3,B))
if B<1
QUIT
IF $PIECE(^(B,0),U,2,3)'=""
WRITE ?38,"MIC (ug/ml)",?53,"MBC (ug/ml)"
QUIT
+8 ;
+9 ; Print results
+10 SET B=0
+11 FOR
SET B=+$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,3,LRBUG,3,B))
if B<1
QUIT
WRITE !,?21,$PIECE(^(B,0),U),?38,$JUSTIFY($PIECE(^(0),U,2),7),?53,$JUSTIFY($PIECE(^(0),U,3),7)
+12 QUIT
+13 ;
+14 ;
CMNT ;
+1 NEW A,LRX,X,DIWL,DIWR,DIWF,LRIDX
+2 ;
+3 SET LRPC=0
SET DIWL=31
SET DIWR=IOM
SET DIWF="|"
+4 FOR A=0:1
SET LRPC=+$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,3,LRBUG,1,LRPC))
if LRPC<1
QUIT
Begin DoDot:1
+5 SET LRX=^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,3,LRBUG,1,LRPC,0)
SET X=LRX
+6 KILL ^UTILITY($JOB,"W")
+7 DO ^DIWP
+8 IF A=0
IF $DATA(^UTILITY($JOB,"W",31,1,0))
Begin DoDot:2
+9 WRITE !,?21,"Comment: "_^UTILITY($JOB,"W",31,1,0)
+10 KILL ^UTILITY($JOB,"W",31,1,0)
End DoDot:2
+11 DO NP
if LRABORT
QUIT
+12 SET LRIDX=0
+13 FOR
SET LRIDX=$ORDER(^UTILITY($JOB,"W",31,LRIDX))
if 'LRIDX
QUIT
Begin DoDot:2
+14 if '$DATA(^UTILITY($JOB,"W",31,LRIDX,0))
QUIT
+15 WRITE !,?21," "_^UTILITY($JOB,"W",31,LRIDX,0)
+16 DO NP
End DoDot:2
End DoDot:1
if LRABORT
QUIT
+17 KILL ^UTILITY($JOB,"W")
+18 QUIT
+19 ;
+20 ;
NP ;
+1 ; Convenience method
+2 DO NP^LRMIPSZ1
+3 QUIT
