LRMIPSU ;DALOI/RBN - MICRO PATIENT REPORT ;05/09/12 17:03
;;5.2;LAB SERVICE;**350**;Sep 27, 1994;Build 230
;
Q
;
;
HDR ;
; Handle different callers
N X
I $D(LRPGDATA) D Q ;
. S X=$G(LRPGDATA("HDR"))
. I X'="" X X
D HDR1
Q
;
;
; Handle different callers
N X
I $D(LRPGDATA) D Q ;
. S X=$G(LRPGDATA("FTR"))
. I X'="" X X
D FOOT1
Q
;
;
FH ;
; from LRMIPSZ1, LRMIPSZ2, LRMIPSZ5. Also called from LROR4
; Handle different callers
I $D(LRPGDATA) D Q ;
. D NP
. I LRABORT S LREND=1
D:$Y>(IOSL-LRFLIP) FOOT,HDR
Q
;
;
FHR ; from LRMIPSZ1, LRMIPSZ2
D:$Y>(IOSL-LRFLIP) FOOT,HDR Q:LREND D REFS
Q
;
;
REFS ; from LRMIPSZ1
S B=1,LREF=0
F S LREF=$O(LRBUG(LREF)) Q:LREF="" S LRIFN=LRBUG(LREF) D LIST Q:LREND
K LRBUG
Q
;
;
LIST ;
Q:'$D(^LAB(61.2,LRIFN,"JR",0))
S LRNUM=0
F S LRNUM=$O(^LAB(61.2,LRIFN,"JR",LRNUM)) Q:LRNUM="" D WR Q:LREND
Q
;
WR ;
; Handle different callers
I $D(LRPGDATA) D Q ;
. D WR2
D WR1
Q
;
;
WR1 ;
;
S X1=^LAB(61.2,LRIFN,"JR",LRNUM,0) Q:$P(X1,U,7)'=1
D:$Y>(IOSL-LRFLIP-2) FOOT,HDR Q:LREND
W:B=1 !!,"Reference(s): " S B=0
W !!,$J(LREF,2),". ",$P(X1,U,2),!,$P(X1,U)
W ! W:$L($P(X1,U,3)) $P(^LAB(95,$P(X1,U,3),0),U)," ",$P(X1,U,4),":"
W $P(X1,U,5) W:$L($P(X1,U,6)) ",",$E($P(X1,U,6),1,3)+1700
Q
;
;
WR2 ;
;
S X1=^LAB(61.2,LRIFN,"JR",LRNUM,0) Q:$P(X1,U,7)'=1
D NP Q:LRABORT
I B=1 W !!,"Reference(s): "
D NP Q:LRABORT
S B=0
W !!,$J(LREF,2),". ",$P(X1,U,2)
D NP Q:LRABORT
W !,$P(X1,U)
D NP Q:LRABORT
W !
D NP Q:LRABORT
I $P(X1,U,3)'="" W $P(^LAB(95,$P(X1,U,3),0),U)," ",$P(X1,U,4),":"
W $P(X1,U,5)
W:$L($P(X1,U,6)) ",",$E($P(X1,U,6),1,3)+1700
D NP Q:LRABORT
Q
;
;
; Backward compatibility for pre NP^LRUTIL displays
; from LRMIPSZ1
N LRX
F W ! Q:$Y>(IOSL-LRFLIP)
Q:'LRHC
W !,"Collection sample: ",LRCS,?40,"Collection date: ",LRTK
W:LRCS'=LRST !,"Site/Specimen: ",LRST W !!
W !!,PNM,?$X+3,SSN,?$X+3 W:$D(IA) IA W ?60," ROUTING: ",LRPATLOC,!
S LRX=+$G(^LR(LRDFN,LRSS,LRIDT,"RF"))
I LRX>0 W $$NAME^XUAF4(LRX)
I LRX<1 W $$INS^LRU
W " LABORATORY ",?62,LRACC,!,"MICROBIOLOGY",?62,"page ",LRPG,!
Q
;
;
; for use with NP^LRUTIL displays
; from LRMIPSZ1
N LRX
I '$D(LRSS) N LRSS S LRSS="MI"
S LRX="=--"
W !,$$REPEAT^XLFSTR(LRX,IOM/$L(LRX))
W !,"Collection sample: ",LRCS,?40,"Collection date: ",LRTK
W:LRCS'=LRST !,"Site/Specimen: ",LRST
W !
S LRX=$$PNMSSN(PNM,SSN)
W !,LRX
W:$G(IA)'="" IA
W ?60," ROUTING: ",LRPATLOC
W !
S LRX=+$G(^LR(LRDFN,LRSS,LRIDT,"RF"))
I LRX>0 W $$NAME^XUAF4(LRX)
I LRX<1 W $$INS^LRU
W " LABORATORY ",?62,LRACC
W !,"MICROBIOLOGY",?62,"page ",LRPG
W !
Q
;
;
HDR1 ;
; Backward compatible for pre NP^LRUTIL displays
; from LRMIPSZ1
N LRX,X
S LRPG=LRPG+1 D:LRPG>1 WAIT Q:LREND
;
W:($G(LRJ02))!($G(LRJ0))!($E(IOST,1,2)="C-") @IOF S LRJ02=1
W !,PNM,?20," ",SSN,?35," AGE: ",AGE W:LRWRD'="" ?45," LOC: ",$E(LRWRD,1,(IOM-70))," "
;
S X=$$HTE^XLFDT($H,"1M")
W ?IOM-($L(X)+1),X
;
I LRPG=1 W !?27,"----MICROBIOLOGY----",?70
I '$D(LRH),LRHC W !?32,$S($D(^XUSEC("LRLAB",DUZ))&'$D(LRWRDVEW):"LAB",1:"CHART")," COPY"
W !
S LRSS="MI"
;
; Display printing facility
I $$GET^XPAR("DIV^PKG","LR REPORTS FACILITY PRINT",1,"Q")>1 D PFAC^LRRP1(DUZ(2),$G(LRPG))
;
; Display reporting lab
I $$GET^XPAR("DIV^PKG","LR REPORTS FACILITY PRINT",1,"Q")#2 D
. S LRX=+$G(^LR(LRDFN,LRSS,LRIDT,"RF"))
. I LRX D RL^LRRP1(LRX) W !
;
; LR*5.2*216 Modification - RBN
; Add banner to audit reports
;
I $D(^LR(LRDFN,"MI",LRIDT,LRSB)),(LRPG=1) D:LRPG=1 BANNER^LRMIAU2()
N LRBANIEN,LRBANFLG
S LRBANFLG=0
F LRBANIEN=1,5,8,11,16 I $D(^LR(LRDFN,"MI",LRIDT,LRBANIEN)) S LRBANFLG=1 Q
I LRPG=1 D
. D ORU^LRRP1
. S LRX=^LR(LRDFN,"MI",LRIDT,0)
. I $P(LRX,"^",3) W !,"Report Completed: ",$$FMTE^XLFDT($P(LRX,"^",3),"M")
;
I LRPG>1 W !?20,">> CONTINUATION OF ",LRACC," <<"
W !!,"Collection sample: ",LRCS,?40,"Collection date: ",LRTK
;
I LRPG=1 D
. I LRDOC?1"REF:"1.AN D
. . N LRX
. . S LRX=$$REFDOC^LRRP1(LRDFN,LRSS,LRIDT)
. . I LRX'="" S LRDOC=LRX
. W !,"Provider: ",LRDOC
. W !
. I LRCMNT'="" W "Comment on specimen: ",LRCMNT,!
Q
;
;
HDR2(LRPRNTED,LRABORT,LRPGDATA) ;
;
; Called from NP^LRUTIL via the LRPGDATA array setup in RPT^LRMIPSZ1
; Inputs
; LRPRNTED: <byref> Tracks when certain sections are printed
; LRABORT: <byref> Tracks if user entered "^" to stop
; LRPGDATA: <byref> Used by NP^LRUTIL
; Outputs
; LRPRNTED: "PFAC" -- Printing Facility address
; : "RF" -- Reporting Facility address
; : "ORU" -- Remote ordering info
; LRABORT: 1 if user aborts, 0 if not (set by NP^LRUTIL)
;
N I,ISCONS,LRX,LRY,X,WPGNM
S LRABORT=$G(LRABORT)
S LRPG=$G(LRPGDATA("PGNUM"))
S:LRPG<1 LRPG=1
S WPGNM=0 ; Page Number written?
S ISCONS=0
I '$D(LRSS) N LRSS S LRSS="MI"
I $E($G(IOST),1,2)="C-" S ISCONS=1 ;is console device
;
I LRPG=1,ISCONS,$G(IOF)'="" W @IOF
S LRX=$$PNMSSN(PNM,SSN)
W !,LRX,?39," AGE: ",AGE
I LRWRD'="",LRWRD'=0 W ?47," LOC: ",$E(LRWRD,1,(IOM-70))," "
;
S X=$$HTE^XLFDT($H,"1M")
W ?IOM-($L(X)+1),X
;
I LRPG=1 D
. W !?27,"----MICROBIOLOGY----"
. I 'WPGNM W ?IOM-5-4,"page ",LRPG S WPGNM=1
;
I '$D(LRH),'ISCONS W !?32,$S($D(^XUSEC("LRLAB",DUZ))&'$D(LRWRDVEW):"LAB",1:"CHART")," COPY"
;
; Display printing facility
I $$GET^XPAR("DIV^PKG","LR REPORTS FACILITY PRINT",1,"Q")>1,'$D(LRPRNTED("PFAC")) D
. S LRPRNTED("PFAC")=1
. K LRX
. D PFAC^LRRP1(DUZ(2),,1,.LRX)
. Q:'$D(LRX)
. S I=0
. F S I=$O(LRX(I)) Q:'I W !,LRX(I)
;
; Display reporting lab
I $$GET^XPAR("DIV^PKG","LR REPORTS FACILITY PRINT",1,"Q")#2,'$D(LRPRNTED("RF")) D
. S LRPRNTED("RF")=1
. S LRX=+$G(^LR(LRDFN,"MI",LRIDT,"RF"))
. W !
. Q:'LRX
. K LRY
. D RL^LRRP1(LRX,1,.LRY)
. Q:'$D(LRY)
. S I=0
. F S I=$O(LRY(I)) Q:'I W !,LRY(I)
. W !
;
I '$D(LRPRNTED("ORU")) D
. S LRPRNTED("ORU")=1
. D ORU^LRRP1
. S LRX=^LR(LRDFN,"MI",LRIDT,0)
. I $P(LRX,"^",3) W !,"Report Completed: ",$$FMTE^XLFDT($P(LRX,"^",3),"M")
;
I LRPG>1 D
. W !?20,">> CONTINUATION OF ",LRACC," <<"
. I 'WPGNM W ?IOM-5-4,"page ",LRPG S WPGNM=1
;
W !,"Collection sample: ",LRCS,?40,"Collection date: ",LRTK
;
I '$D(LRPRNTED("REF")) D
. N LRX,LRDOCZ
. S LRPRNTED("REF")=1
. I LRDOC?1"REF:"1.AN D
. . S LRX=$$REFDOC^LRRP1(LRDFN,LRSS,LRIDT)
. . I LRX'="" S LRDOCZ=LRX
. W !,"Provider: ",$S($D(LRDOCZ):LRDOCZ,1:LRDOC)
. I LRCMNT'="" W !,"Comment on specimen: ",LRCMNT
;
S LRX="=--"
W !,$$REPEAT^XLFSTR(LRX,IOM/$L(LRX)),!
;
Q
;
;
WAIT ;
; from LRMIPSZ1, LRMIPSZ2
F I=$Y:1:IOSL-3 W !
I 'LRHC W !,PNM,?25," ",SSN," ROUTING: ",LRPATLOC,?59," PRESS '^' TO STOP " R X:DTIME S:X="" X=1 S:(".^"[X)!('$T) LREND=1
Q
;
;
PRE ;
; from LRMIPSZ2, LRMIPSZ3, LRMIPSZ4
; also indirectly from RPT^LROR4
N J
I LRTUS'["F"!($D(^XUSEC("LRLAB",DUZ))&'$D(LRWRDVEW)) D ;
. W:+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,LRPRE,0)) !,"Preliminary Comments: "
. D NP Q:LRABORT
. S J=0
. F S J=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,LRPRE,J)) Q:J<1 W !?3,^(J,0) D NP Q:LRABORT
;
D NP Q:LRABORT
W !
D NP Q:LRABORT
Q
;
;
PROMPT() ;
; Creates the "more" prompt for display
; Expects PNM,SSN,LRPATLOC
; Outputs
; The prompt for display
N X,PNMX,PLOCX,STR
S STR=$$PNMSSN(PNM,SSN)
S PLOCX=$G(LRPATLOC)
S:$L(PLOCX)>14 PLOCX=$E(PLOCX,1,11)_"..."
I PLOCX'="" S STR=STR_" ROUTING: "_PLOCX
S X="'^' TO STOP"
S $E(STR,IOM-$L(X),IOM)=X
Q STR
;
;
PNMSSN(PNM,SSN) ;
; Creates the Patient Name/SSN banner
; Inputs
; PNM : Patient's Name
; SSN : SSN
; Outputs
; The formatted string for the patient name and SSN
N X,PNMX,STR
S PNM=$G(PNM)
S SSN=$G(SSN)
S PNMX=PNM
S:$L(PNMX)>25 PNMX=$E(PNMX,1,22)_"..."
S STR=PNMX
S $E(STR,27,27)=" "
S STR=STR_SSN
Q STR
;
;
NP ;
; Convenience method
D NP^LRMIPSZ1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRMIPSU 8057 printed Dec 13, 2024@02:17:11 Page 2
LRMIPSU ;DALOI/RBN - MICRO PATIENT REPORT ;05/09/12 17:03
+1 ;;5.2;LAB SERVICE;**350**;Sep 27, 1994;Build 230
+2 ;
+3 QUIT
+4 ;
+5 ;
HDR ;
+1 ; Handle different callers
+2 NEW X
+3 ;
IF $DATA(LRPGDATA)
Begin DoDot:1
+4 SET X=$GET(LRPGDATA("HDR"))
+5 IF X'=""
XECUTE X
End DoDot:1
QUIT
+6 DO HDR1
+7 QUIT
+8 ;
+9 ;
+1 ; Handle different callers
+2 NEW X
+3 ;
IF $DATA(LRPGDATA)
Begin DoDot:1
+4 SET X=$GET(LRPGDATA("FTR"))
+5 IF X'=""
XECUTE X
End DoDot:1
QUIT
+6 DO FOOT1
+7 QUIT
+8 ;
+9 ;
FH ;
+1 ; from LRMIPSZ1, LRMIPSZ2, LRMIPSZ5. Also called from LROR4
+2 ; Handle different callers
+3 ;
IF $DATA(LRPGDATA)
Begin DoDot:1
+4 DO NP
+5 IF LRABORT
SET LREND=1
End DoDot:1
QUIT
+6 if $Y>(IOSL-LRFLIP)
DO FOOT
DO HDR
+7 QUIT
+8 ;
+9 ;
FHR ; from LRMIPSZ1, LRMIPSZ2
+1 if $Y>(IOSL-LRFLIP)
DO FOOT
DO HDR
if LREND
QUIT
DO REFS
+2 QUIT
+3 ;
+4 ;
REFS ; from LRMIPSZ1
+1 SET B=1
SET LREF=0
+2 FOR
SET LREF=$ORDER(LRBUG(LREF))
if LREF=""
QUIT
SET LRIFN=LRBUG(LREF)
DO LIST
if LREND
QUIT
+3 KILL LRBUG
+4 QUIT
+5 ;
+6 ;
LIST ;
+1 if '$DATA(^LAB(61.2,LRIFN,"JR",0))
QUIT
+2 SET LRNUM=0
+3 FOR
SET LRNUM=$ORDER(^LAB(61.2,LRIFN,"JR",LRNUM))
if LRNUM=""
QUIT
DO WR
if LREND
QUIT
+4 QUIT
+5 ;
WR ;
+1 ; Handle different callers
+2 ;
IF $DATA(LRPGDATA)
Begin DoDot:1
+3 DO WR2
End DoDot:1
QUIT
+4 DO WR1
+5 QUIT
+6 ;
+7 ;
WR1 ;
+1 ;
+2 SET X1=^LAB(61.2,LRIFN,"JR",LRNUM,0)
if $PIECE(X1,U,7)'=1
QUIT
+3 if $Y>(IOSL-LRFLIP-2)
DO FOOT
DO HDR
if LREND
QUIT
+4 if B=1
WRITE !!,"Reference(s): "
SET B=0
+5 WRITE !!,$JUSTIFY(LREF,2),". ",$PIECE(X1,U,2),!,$PIECE(X1,U)
+6 WRITE !
if $LENGTH($PIECE(X1,U,3))
WRITE $PIECE(^LAB(95,$PIECE(X1,U,3),0),U)," ",$PIECE(X1,U,4),":"
+7 WRITE $PIECE(X1,U,5)
if $LENGTH($PIECE(X1,U,6))
WRITE ",",$EXTRACT($PIECE(X1,U,6),1,3)+1700
+8 QUIT
+9 ;
+10 ;
WR2 ;
+1 ;
+2 SET X1=^LAB(61.2,LRIFN,"JR",LRNUM,0)
if $PIECE(X1,U,7)'=1
QUIT
+3 DO NP
if LRABORT
QUIT
+4 IF B=1
WRITE !!,"Reference(s): "
+5 DO NP
if LRABORT
QUIT
+6 SET B=0
+7 WRITE !!,$JUSTIFY(LREF,2),". ",$PIECE(X1,U,2)
+8 DO NP
if LRABORT
QUIT
+9 WRITE !,$PIECE(X1,U)
+10 DO NP
if LRABORT
QUIT
+11 WRITE !
+12 DO NP
if LRABORT
QUIT
+13 IF $PIECE(X1,U,3)'=""
WRITE $PIECE(^LAB(95,$PIECE(X1,U,3),0),U)," ",$PIECE(X1,U,4),":"
+14 WRITE $PIECE(X1,U,5)
+15 if $LENGTH($PIECE(X1,U,6))
WRITE ",",$EXTRACT($PIECE(X1,U,6),1,3)+1700
+16 DO NP
if LRABORT
QUIT
+17 QUIT
+18 ;
+19 ;
+1 ; Backward compatibility for pre NP^LRUTIL displays
+2 ; from LRMIPSZ1
+3 NEW LRX
+4 FOR
WRITE !
if $Y>(IOSL-LRFLIP)
QUIT
+5 if 'LRHC
QUIT
+6 WRITE !,"Collection sample: ",LRCS,?40,"Collection date: ",LRTK
+7 if LRCS'=LRST
WRITE !,"Site/Specimen: ",LRST
WRITE !!
+8 WRITE !!,PNM,?$X+3,SSN,?$X+3
if $DATA(IA)
WRITE IA
WRITE ?60," ROUTING: ",LRPATLOC,!
+9 SET LRX=+$GET(^LR(LRDFN,LRSS,LRIDT,"RF"))
+10 IF LRX>0
WRITE $$NAME^XUAF4(LRX)
+11 IF LRX<1
WRITE $$INS^LRU
+12 WRITE " LABORATORY ",?62,LRACC,!,"MICROBIOLOGY",?62,"page ",LRPG,!
+13 QUIT
+14 ;
+15 ;
+1 ; for use with NP^LRUTIL displays
+2 ; from LRMIPSZ1
+3 NEW LRX
+4 IF '$DATA(LRSS)
NEW LRSS
SET LRSS="MI"
+5 SET LRX="=--"
+6 WRITE !,$$REPEAT^XLFSTR(LRX,IOM/$LENGTH(LRX))
+7 WRITE !,"Collection sample: ",LRCS,?40,"Collection date: ",LRTK
+8 if LRCS'=LRST
WRITE !,"Site/Specimen: ",LRST
+9 WRITE !
+10 SET LRX=$$PNMSSN(PNM,SSN)
+11 WRITE !,LRX
+12 if $GET(IA)'=""
WRITE IA
+13 WRITE ?60," ROUTING: ",LRPATLOC
+14 WRITE !
+15 SET LRX=+$GET(^LR(LRDFN,LRSS,LRIDT,"RF"))
+16 IF LRX>0
WRITE $$NAME^XUAF4(LRX)
+17 IF LRX<1
WRITE $$INS^LRU
+18 WRITE " LABORATORY ",?62,LRACC
+19 WRITE !,"MICROBIOLOGY",?62,"page ",LRPG
+20 WRITE !
+21 QUIT
+22 ;
+23 ;
HDR1 ;
+1 ; Backward compatible for pre NP^LRUTIL displays
+2 ; from LRMIPSZ1
+3 NEW LRX,X
+4 SET LRPG=LRPG+1
if LRPG>1
DO WAIT
if LREND
QUIT
+5 ;
+6 if ($GET(LRJ02))!($GET(LRJ0))!($EXTRACT(IOST,1,2)="C-")
WRITE @IOF
SET LRJ02=1
+7 WRITE !,PNM,?20," ",SSN,?35," AGE: ",AGE
if LRWRD'=""
WRITE ?45," LOC: ",$EXTRACT(LRWRD,1,(IOM-70))," "
+8 ;
+9 SET X=$$HTE^XLFDT($HOROLOG,"1M")
+10 WRITE ?IOM-($LENGTH(X)+1),X
+11 ;
+12 IF LRPG=1
WRITE !?27,"----MICROBIOLOGY----",?70
+13 IF '$DATA(LRH)
IF LRHC
WRITE !?32,$SELECT($DATA(^XUSEC("LRLAB",DUZ))&'$DATA(LRWRDVEW):"LAB",1:"CHART")," COPY"
+14 WRITE !
+15 SET LRSS="MI"
+16 ;
+17 ; Display printing facility
+18 IF $$GET^XPAR("DIV^PKG","LR REPORTS FACILITY PRINT",1,"Q")>1
DO PFAC^LRRP1(DUZ(2),$GET(LRPG))
+19 ;
+20 ; Display reporting lab
+21 IF $$GET^XPAR("DIV^PKG","LR REPORTS FACILITY PRINT",1,"Q")#2
Begin DoDot:1
+22 SET LRX=+$GET(^LR(LRDFN,LRSS,LRIDT,"RF"))
+23 IF LRX
DO RL^LRRP1(LRX)
WRITE !
End DoDot:1
+24 ;
+25 ; LR*5.2*216 Modification - RBN
+26 ; Add banner to audit reports
+27 ;
+28 IF $DATA(^LR(LRDFN,"MI",LRIDT,LRSB))
IF (LRPG=1)
if LRPG=1
DO BANNER^LRMIAU2()
+29 NEW LRBANIEN,LRBANFLG
+30 SET LRBANFLG=0
+31 FOR LRBANIEN=1,5,8,11,16
IF $DATA(^LR(LRDFN,"MI",LRIDT,LRBANIEN))
SET LRBANFLG=1
QUIT
+32 IF LRPG=1
Begin DoDot:1
+33 DO ORU^LRRP1
+34 SET LRX=^LR(LRDFN,"MI",LRIDT,0)
+35 IF $PIECE(LRX,"^",3)
WRITE !,"Report Completed: ",$$FMTE^XLFDT($PIECE(LRX,"^",3),"M")
End DoDot:1
+36 ;
+37 IF LRPG>1
WRITE !?20,">> CONTINUATION OF ",LRACC," <<"
+38 WRITE !!,"Collection sample: ",LRCS,?40,"Collection date: ",LRTK
+39 ;
+40 IF LRPG=1
Begin DoDot:1
+41 IF LRDOC?1"REF:"1.AN
Begin DoDot:2
+42 NEW LRX
+43 SET LRX=$$REFDOC^LRRP1(LRDFN,LRSS,LRIDT)
+44 IF LRX'=""
SET LRDOC=LRX
End DoDot:2
+45 WRITE !,"Provider: ",LRDOC
+46 WRITE !
+47 IF LRCMNT'=""
WRITE "Comment on specimen: ",LRCMNT,!
End DoDot:1
+48 QUIT
+49 ;
+50 ;
HDR2(LRPRNTED,LRABORT,LRPGDATA) ;
+1 ;
+2 ; Called from NP^LRUTIL via the LRPGDATA array setup in RPT^LRMIPSZ1
+3 ; Inputs
+4 ; LRPRNTED: <byref> Tracks when certain sections are printed
+5 ; LRABORT: <byref> Tracks if user entered "^" to stop
+6 ; LRPGDATA: <byref> Used by NP^LRUTIL
+7 ; Outputs
+8 ; LRPRNTED: "PFAC" -- Printing Facility address
+9 ; : "RF" -- Reporting Facility address
+10 ; : "ORU" -- Remote ordering info
+11 ; LRABORT: 1 if user aborts, 0 if not (set by NP^LRUTIL)
+12 ;
+13 NEW I,ISCONS,LRX,LRY,X,WPGNM
+14 SET LRABORT=$GET(LRABORT)
+15 SET LRPG=$GET(LRPGDATA("PGNUM"))
+16 if LRPG<1
SET LRPG=1
+17 ; Page Number written?
SET WPGNM=0
+18 SET ISCONS=0
+19 IF '$DATA(LRSS)
NEW LRSS
SET LRSS="MI"
+20 ;is console device
IF $EXTRACT($GET(IOST),1,2)="C-"
SET ISCONS=1
+21 ;
+22 IF LRPG=1
IF ISCONS
IF $GET(IOF)'=""
WRITE @IOF
+23 SET LRX=$$PNMSSN(PNM,SSN)
+24 WRITE !,LRX,?39," AGE: ",AGE
+25 IF LRWRD'=""
IF LRWRD'=0
WRITE ?47," LOC: ",$EXTRACT(LRWRD,1,(IOM-70))," "
+26 ;
+27 SET X=$$HTE^XLFDT($HOROLOG,"1M")
+28 WRITE ?IOM-($LENGTH(X)+1),X
+29 ;
+30 IF LRPG=1
Begin DoDot:1
+31 WRITE !?27,"----MICROBIOLOGY----"
+32 IF 'WPGNM
WRITE ?IOM-5-4,"page ",LRPG
SET WPGNM=1
End DoDot:1
+33 ;
+34 IF '$DATA(LRH)
IF 'ISCONS
WRITE !?32,$SELECT($DATA(^XUSEC("LRLAB",DUZ))&'$DATA(LRWRDVEW):"LAB",1:"CHART")," COPY"
+35 ;
+36 ; Display printing facility
+37 IF $$GET^XPAR("DIV^PKG","LR REPORTS FACILITY PRINT",1,"Q")>1
IF '$DATA(LRPRNTED("PFAC"))
Begin DoDot:1
+38 SET LRPRNTED("PFAC")=1
+39 KILL LRX
+40 DO PFAC^LRRP1(DUZ(2),,1,.LRX)
+41 if '$DATA(LRX)
QUIT
+42 SET I=0
+43 FOR
SET I=$ORDER(LRX(I))
if 'I
QUIT
WRITE !,LRX(I)
End DoDot:1
+44 ;
+45 ; Display reporting lab
+46 IF $$GET^XPAR("DIV^PKG","LR REPORTS FACILITY PRINT",1,"Q")#2
IF '$DATA(LRPRNTED("RF"))
Begin DoDot:1
+47 SET LRPRNTED("RF")=1
+48 SET LRX=+$GET(^LR(LRDFN,"MI",LRIDT,"RF"))
+49 WRITE !
+50 if 'LRX
QUIT
+51 KILL LRY
+52 DO RL^LRRP1(LRX,1,.LRY)
+53 if '$DATA(LRY)
QUIT
+54 SET I=0
+55 FOR
SET I=$ORDER(LRY(I))
if 'I
QUIT
WRITE !,LRY(I)
+56 WRITE !
End DoDot:1
+57 ;
+58 IF '$DATA(LRPRNTED("ORU"))
Begin DoDot:1
+59 SET LRPRNTED("ORU")=1
+60 DO ORU^LRRP1
+61 SET LRX=^LR(LRDFN,"MI",LRIDT,0)
+62 IF $PIECE(LRX,"^",3)
WRITE !,"Report Completed: ",$$FMTE^XLFDT($PIECE(LRX,"^",3),"M")
End DoDot:1
+63 ;
+64 IF LRPG>1
Begin DoDot:1
+65 WRITE !?20,">> CONTINUATION OF ",LRACC," <<"
+66 IF 'WPGNM
WRITE ?IOM-5-4,"page ",LRPG
SET WPGNM=1
End DoDot:1
+67 ;
+68 WRITE !,"Collection sample: ",LRCS,?40,"Collection date: ",LRTK
+69 ;
+70 IF '$DATA(LRPRNTED("REF"))
Begin DoDot:1
+71 NEW LRX,LRDOCZ
+72 SET LRPRNTED("REF")=1
+73 IF LRDOC?1"REF:"1.AN
Begin DoDot:2
+74 SET LRX=$$REFDOC^LRRP1(LRDFN,LRSS,LRIDT)
+75 IF LRX'=""
SET LRDOCZ=LRX
End DoDot:2
+76 WRITE !,"Provider: ",$SELECT($DATA(LRDOCZ):LRDOCZ,1:LRDOC)
+77 IF LRCMNT'=""
WRITE !,"Comment on specimen: ",LRCMNT
End DoDot:1
+78 ;
+79 SET LRX="=--"
+80 WRITE !,$$REPEAT^XLFSTR(LRX,IOM/$LENGTH(LRX)),!
+81 ;
+82 QUIT
+83 ;
+84 ;
WAIT ;
+1 ; from LRMIPSZ1, LRMIPSZ2
+2 FOR I=$Y:1:IOSL-3
WRITE !
+3 IF 'LRHC
WRITE !,PNM,?25," ",SSN," ROUTING: ",LRPATLOC,?59," PRESS '^' TO STOP "
READ X:DTIME
if X=""
SET X=1
if (".^"[X)!('$TEST)
SET LREND=1
+4 QUIT
+5 ;
+6 ;
PRE ;
+1 ; from LRMIPSZ2, LRMIPSZ3, LRMIPSZ4
+2 ; also indirectly from RPT^LROR4
+3 NEW J
+4 ;
IF LRTUS'["F"!($DATA(^XUSEC("LRLAB",DUZ))&'$DATA(LRWRDVEW))
Begin DoDot:1
+5 if +$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,LRPRE,0))
WRITE !,"Preliminary Comments: "
+6 DO NP
if LRABORT
QUIT
+7 SET J=0
+8 FOR
SET J=$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,LRPRE,J))
if J<1
QUIT
WRITE !?3,^(J,0)
DO NP
if LRABORT
QUIT
End DoDot:1
+9 ;
+10 DO NP
if LRABORT
QUIT
+11 WRITE !
+12 DO NP
if LRABORT
QUIT
+13 QUIT
+14 ;
+15 ;
PROMPT() ;
+1 ; Creates the "more" prompt for display
+2 ; Expects PNM,SSN,LRPATLOC
+3 ; Outputs
+4 ; The prompt for display
+5 NEW X,PNMX,PLOCX,STR
+6 SET STR=$$PNMSSN(PNM,SSN)
+7 SET PLOCX=$GET(LRPATLOC)
+8 if $LENGTH(PLOCX)>14
SET PLOCX=$EXTRACT(PLOCX,1,11)_"..."
+9 IF PLOCX'=""
SET STR=STR_" ROUTING: "_PLOCX
+10 SET X="'^' TO STOP"
+11 SET $EXTRACT(STR,IOM-$LENGTH(X),IOM)=X
+12 QUIT STR
+13 ;
+14 ;
PNMSSN(PNM,SSN) ;
+1 ; Creates the Patient Name/SSN banner
+2 ; Inputs
+3 ; PNM : Patient's Name
+4 ; SSN : SSN
+5 ; Outputs
+6 ; The formatted string for the patient name and SSN
+7 NEW X,PNMX,STR
+8 SET PNM=$GET(PNM)
+9 SET SSN=$GET(SSN)
+10 SET PNMX=PNM
+11 if $LENGTH(PNMX)>25
SET PNMX=$EXTRACT(PNMX,1,22)_"..."
+12 SET STR=PNMX
+13 SET $EXTRACT(STR,27,27)=" "
+14 SET STR=STR_SSN
+15 QUIT STR
+16 ;
+17 ;
NP ;
+1 ; Convenience method
+2 DO NP^LRMIPSZ1
+3 QUIT
