LRMIPSU.m

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

 ;

 ;

FOOT ;

 ; 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

 ;

 ;

FOOT1 ;

 ; 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

 ;

 ;

FOOT2 ;

 ; 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 ---LRMIPSU   8057     printed  Feb 18, 2025@23:43:03                                                                                                                                                                                                     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       ;

FOOT      ;

 +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      ;

FOOT1     ;

 +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      ;

FOOT2     ;

 +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'=""