Routine: LRMIPSZ4

LRMIPSZ4 ;DALOI/RBN - MICRO PATIENT REPORT - AFB, FUNGUS ;Jul 15, 2021@13:13

 ;;5.2;LAB SERVICE;**350,547**;Sep 27, 1994;Build 10

 ;Reference to ^DD supported by ICR #999

TB ;

 ; from LRMIPSZ1

 ; also called from RPT^LROR4

 N B,LRBLDTMP,LRQUIT,LRTA,LRX

 S (LRBLDTMP,LRQUIT)=0

 I '$D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT)) D  ;

 . S LRBLDTMP=1

 . M ^TMP("LRMI",$J,LRDFN,"MI",LRIDT)=^LR(LRDFN,"MI",LRIDT)

 . K ^TMP("LRMI",$J,LRDFN,"MI",LRIDT,32)

 I $P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,11),U)="",'$G(LRLABKY) D  S:'$D(LRWRDVEW) LRQUIT=1 S:LRSB'=11 LRQUIT=1

 . Q:'$D(^XTMP("LRMICRO EDIT",LRDFN,LRIDT,11))

 . ;LR*5.2*547: Display informational message if accession/test is currently being edited

 . ;            and results had previously been verified.

 . N LR7SB S LR7SB=11

 . D MES^LRMIPSZ2

 I LRQUIT D  Q

 . I LRBLDTMP K ^TMP("LRMI",$J,LRDFN,"MI",LRIDT)

 S LRX=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,11)

 S LRTUS=$P(LRX,U,2),DZ=$P(LRX,U,5),LRAFS=$P(LRX,U,3),LRAMT=$P(LRX,U,4),Y=$P(LRX,U)

 D D^LRU

 W:LRHC !

 W !,"* MYCOBACTERIOLOGY ",$S(LRTUS="F":"FINAL",LRTUS="P":"PRELIMINARY",1:"")," REPORT => "_Y_"   TECH CODE: "_DZ

 S LRPRE=23

 D PRE^LRMIPSU

 S LRTA=""

 I $O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,0)) S LRTA=0

 D:LRAFS'=""!(LRTA=0) AFS

 I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,13)) D  ;

 . W:LRHC !

 . W !,"Mycobacteriology Remark(s):"

 . D NP Q:LRABORT

 . S B=0

 . F  S B=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,13,B)) Q:B<1  W !,?3,^(B,0) D NP Q:LRABORT

 I LRBLDTMP K ^TMP("LRMI",$J,LRDFN,"MI",LRIDT)

AFS ; Acid Fast Stain results

 N LRX,X

 I LRAFS'="" D

 . S LRX="Acid Fast Stain:  "

 . I LRAFS?1(1"DP",1"DN",1"CP",1"CN") D

 . . S LRX=$S($E(LRAFS)="D":"Direct ",$E(LRAFS)="C":"Concentrate ",1:"")_LRX

 . . S LRX=LRX_$S($E(LRAFS,2)="P":"Positive",$E(LRAFS,2)="N":"Negative",1:LRAFS)

 . E  D

 . . S X=$$GET1^DIQ(63.05,LRIDT_","_LRDFN_",",24)

 . . I X'="" S LRX=LRX_X Q

 . . S LRX=LRX_LRAFS

 . W:LRHC ! W !,LRX

 . I LRAMT'="" W !,?3,"Quantity: ",LRAMT

 K ^TMP("LR",$J,"T"),LRTSTS

 I LRTA=0 D

 . S LRTSTS=0

 . F  S LRTA=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,LRTA)) Q:LRTA<1  D

 . . S (LRBUG(LRTA),LRTBC)=$P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,LRTA,0),U)

 . . S LRQU=$P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,LRTA,0),U,2)

 . . S LRTBC=$P(^LAB(61.2,LRTBC,0),U)

 . . D LIST

LIST ; List organisms

 N B,LRTB,LRTBA,LRTBS,LRX

 W:LRHC !

 D NP Q:LRABORT

 W !,"Mycobacterium: ",LRTBC

 D NP Q:LRABORT

 I LRQU'="" W !,?3,"Quantity: ",LRQU D NP Q:LRABORT

 S:$D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,LRTA,2)) LRTSTS=LRTSTS+1

 I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,LRTA)) D  Q:LRABORT  ;

 . W !,"   Comment: "

 . D NP Q:LRABORT

 . S B=0

 . F  S B=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,LRTA,1,B)) Q:B<1  W ?13,^(B,0),! D NP Q:LRABORT

SEN ; Display AFB sensitivities.

 S LRTB=2

 F  S LRTB=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,LRTA,LRTB)) Q:LRTB'["2."!(LRTB="")  D  ;

 . S LRTBS=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,LRTA,LRTB)

 . I LRTBS="" Q

 . S LRTBA=""

 . I $D(^LAB(62.06,"AD1",LRTB)) D

 . . S LRX=$O(^LAB(62.06,"AD1",LRTB,0)),LRX(0)=""

 . . I LRX S LRX(0)=$G(^LAB(62.06,LRX,0))

 . . S LRTBA=$P(LRX(0),"^")

 . I LRTBA="" D

 . . S LRTBA=$O(^DD(63.39,"GL",LRTB,1,0))

 . . S LRTBA=$P(^DD(63.39,LRTBA,0),U)

 . W !,?3,$$LJ^XLFSTR(LRTBA,30,"."),?34,LRTBS

FUNG ;

 ; from LRMIPSZ1

 ; also called from RPT^LROR4

 N LRBLDTMP,LRQUIT

 S (LRBLDTMP,LRQUIT)=0

 I '$D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT)) D  ;

 . S LRBLDTMP=1

 . M ^TMP("LRMI",$J,LRDFN,"MI",LRIDT)=^LR(LRDFN,"MI",LRIDT)

 . K ^TMP("LRMI",$J,LRDFN,"MI",LRIDT,32)

 I $P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,8),U)="",'$G(LRLABKY) D  S:'$D(LRWRDVEW) LRQUIT=1 S:LRSB'=8 LRQUIT=1

 . Q:'$D(^XTMP("LRMICRO EDIT",LRDFN,LRIDT,8))

 . ;LR*5.2*547: Display informational message if accession/test is currently being edited

 . ;            and results had previously been verified.

 . N LR7SB S LR7SB=8

 . D MES^LRMIPSZ2

 I LRQUIT D  Q

 . I LRBLDTMP K ^TMP("LRMI",$J,LRDFN,"MI",LRIDT)

 S LRTUS=$P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,8),U,2)

 S DZ=$P(^(8),U,3),Y=$P(^(8),U)

 D D^LRU

 W:LRHC !

 D NP Q:LRABORT

 W !,"* MYCOLOGY ",$S(LRTUS="F":"FINAL",LRTUS="P":"PRELIMINARY",1:"")," REPORT => ",Y,"   TECH CODE: ",DZ

 D NP Q:LRABORT

 S LRPRE=22 D PRE^LRMIPSU

 D QA

 I LRBLDTMP K ^TMP("LRMI",$J,LRDFN,"MI",LRIDT)

QA ;

 I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,15)) D  ;

 . W:LRHC !

 . D NP Q:LRABORT

 . W !,"MYCOLOGY SMEAR/PREP:"

 . S LRMYC=0

 . F  S LRMYC=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,15,LRMYC)) Q:LRMYC<1  W !?5,^(LRMYC,0) D NP Q:LRABORT

 I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,9)) D  ;

 . W:LRHC !

 . D NP Q:LRABORT

 . W !,"Fungus/Yeast: "

 . D NP Q:LRABORT

 . D SHOW

 I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,10)) D  ;

 . W:LRHC !

 . D NP Q:LRABORT

 . W !,"Mycology Remark(s):"

 . D NP Q:LRABORT

 . S LRMYC=0

 . F  S LRMYC=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,10,LRMYC)) Q:LRMYC<1  W !,?3,^(LRMYC,0) D NP Q:LRABORT

SHOW ;

 S LRTA=0

 F  S LRTA=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,9,LRTA)) Q:LRTA?.N2A.E!(LRTA<1)  D

 . S LRTA=+LRTA

 . S (LRBUG(LRTA),LRTBC)=$P(^(LRTA,0),U)

 . S LRQU=$P(^(0),U,2)

 . S LRTBC=$P(^LAB(61.2,LRTBC,0),U)

 . D LIST1

LIST1 ;

N B

 W !,LRTBC

 D NP Q:LRABORT

 I LRQU'="" W !,?3,"Quantity: ",LRQU

 D NP Q:LRABORT

 I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,9,LRTA,1,0)) D  ;

 . W !,?3,"Comment:"

 . S B=0

 . F  S B=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,9,LRTA,1,B)) Q:B<1  W ?13,^(B,0),! D NP Q:LRABORT

NP ;

 ; Convenience method

 D NP^LRMIPSZ1

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRMIPSZ4   5701     printed  Feb 18, 2025@23:43:08                                                                                                                                                                                                    Page 2

LRMIPSZ4  ;DALOI/RBN - MICRO PATIENT REPORT - AFB, FUNGUS ;Jul 15, 2021@13:13

 +1       ;;5.2;LAB SERVICE;**350,547**;Sep 27, 1994;Build 10

 +2       ;

 +3       ;Reference to ^DD supported by ICR #999

 +4       ;

 +5        QUIT

 +6       ;

TB        ;

 +1       ; from LRMIPSZ1

 +2       ; also called from RPT^LROR4

 +3        NEW B,LRBLDTMP,LRQUIT,LRTA,LRX

 +4        SET (LRBLDTMP,LRQUIT)=0

 +5       ;

           IF '$DATA(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT))

               Begin DoDot:1

 +6                SET LRBLDTMP=1

 +7                MERGE ^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT)=^LR(LRDFN,"MI",LRIDT)

 +8                KILL ^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,32)

               End DoDot:1

 +9       ;

 +10       IF $PIECE(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,11),U)=""

               IF '$GET(LRLABKY)

                   Begin DoDot:1

 +11                   if '$DATA(^XTMP("LRMICRO EDIT",LRDFN,LRIDT,11))

                           QUIT

 +12      ;LR*5.2*547: Display informational message if accession/test is currently being edited

 +13      ;            and results had previously been verified.

 +14                   NEW LR7SB

                       SET LR7SB=11

 +15                   DO MES^LRMIPSZ2

                   End DoDot:1

                   if '$DATA(LRWRDVEW)

                       SET LRQUIT=1

                   if LRSB'=11

                       SET LRQUIT=1

 +16      ;

 +17       IF LRQUIT

               Begin DoDot:1

 +18               IF LRBLDTMP

                       KILL ^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT)

               End DoDot:1

               QUIT

 +19      ;

 +20       SET LRX=^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,11)

 +21       SET LRTUS=$PIECE(LRX,U,2)

           SET DZ=$PIECE(LRX,U,5)

           SET LRAFS=$PIECE(LRX,U,3)

           SET LRAMT=$PIECE(LRX,U,4)

           SET Y=$PIECE(LRX,U)

 +22       DO D^LRU

 +23       if LRHC

               WRITE !

 +24       WRITE !,"* MYCOBACTERIOLOGY ",$SELECT(LRTUS="F":"FINAL",LRTUS="P":"PRELIMINARY",1:"")," REPORT => "_Y_"   TECH CODE: "_DZ

 +25       SET LRPRE=23

 +26       DO PRE^LRMIPSU

 +27      ;

 +28       SET LRTA=""

 +29       IF $ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,12,0))

               SET LRTA=0

 +30       if LRAFS'=""!(LRTA=0)

               DO AFS

 +31      ;

 +32      ;

           IF $DATA(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,13))

               Begin DoDot:1

 +33               if LRHC

                       WRITE !

 +34               WRITE !,"Mycobacteriology Remark(s):"

 +35               DO NP

                   if LRABORT

                       QUIT

 +36               SET B=0

 +37               FOR

                       SET B=+$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,13,B))

                       if B<1

                           QUIT

                       WRITE !,?3,^(B,0)

                       DO NP

                       if LRABORT

                           QUIT

               End DoDot:1

 +38      ;

 +39       IF LRBLDTMP

               KILL ^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT)

 +40       QUIT

 +41      ;

 +42      ;

AFS       ; Acid Fast Stain results

 +1       ;

 +2        NEW LRX,X

 +3       ;

 +4        IF LRAFS'=""

               Begin DoDot:1

 +5                SET LRX="Acid Fast Stain:  "

 +6                IF LRAFS?1(1"DP",1"DN",1"CP",1"CN")

                       Begin DoDot:2

 +7                        SET LRX=$SELECT($EXTRACT(LRAFS)="D":"Direct ",$EXTRACT(LRAFS)="C":"Concentrate ",1:"")_LRX

 +8                        SET LRX=LRX_$SELECT($EXTRACT(LRAFS,2)="P":"Positive",$EXTRACT(LRAFS,2)="N":"Negative",1:LRAFS)

                       End DoDot:2

 +9               IF '$TEST

                       Begin DoDot:2

 +10                       SET X=$$GET1^DIQ(63.05,LRIDT_","_LRDFN_",",24)

 +11                       IF X'=""

                               SET LRX=LRX_X

                               QUIT

 +12                       SET LRX=LRX_LRAFS

                       End DoDot:2

 +13               if LRHC

                       WRITE !

                   WRITE !,LRX

 +14               IF LRAMT'=""

                       WRITE !,?3,"Quantity: ",LRAMT

               End DoDot:1

 +15      ;

 +16       KILL ^TMP("LR",$JOB,"T"),LRTSTS

 +17      ;

 +18       IF LRTA=0

               Begin DoDot:1

 +19               SET LRTSTS=0

 +20               FOR

                       SET LRTA=+$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,12,LRTA))

                       if LRTA<1

                           QUIT

                       Begin DoDot:2

 +21                       SET (LRBUG(LRTA),LRTBC)=$PIECE(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,12,LRTA,0),U)

 +22                       SET LRQU=$PIECE(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,12,LRTA,0),U,2)

 +23                       SET LRTBC=$PIECE(^LAB(61.2,LRTBC,0),U)

 +24                       DO LIST

                       End DoDot:2

               End DoDot:1

 +25      ;

 +26       QUIT

 +27      ;

 +28      ;

LIST      ; List organisms

 +1       ;

 +2        NEW B,LRTB,LRTBA,LRTBS,LRX

 +3        if LRHC

               WRITE !

 +4        DO NP

           if LRABORT

               QUIT

 +5        WRITE !,"Mycobacterium: ",LRTBC

 +6        DO NP

           if LRABORT

               QUIT

 +7        IF LRQU'=""

               WRITE !,?3,"Quantity: ",LRQU

               DO NP

               if LRABORT

                   QUIT

 +8        if $DATA(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,12,LRTA,2))

               SET LRTSTS=LRTSTS+1

 +9       ;

           IF $DATA(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,12,LRTA))

               Begin DoDot:1

 +10               WRITE !,"   Comment: "

 +11               DO NP

                   if LRABORT

                       QUIT

 +12               SET B=0

 +13               FOR

                       SET B=+$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,12,LRTA,1,B))

                       if B<1

                           QUIT

                       WRITE ?13,^(B,0),!

                       DO NP

                       if LRABORT

                           QUIT

               End DoDot:1

               if LRABORT

                   QUIT

 +14      ;

 +15      ;

SEN       ; Display AFB sensitivities.

 +1       ;

 +2        SET LRTB=2

 +3       ;

FOR

               SET LRTB=+$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,12,LRTA,LRTB))

               if LRTB'["2."!(LRTB="")

                   QUIT

               Begin DoDot:1

 +4                SET LRTBS=^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,12,LRTA,LRTB)

 +5                IF LRTBS=""

                       QUIT

 +6                SET LRTBA=""

 +7                IF $DATA(^LAB(62.06,"AD1",LRTB))

                       Begin DoDot:2

 +8                        SET LRX=$ORDER(^LAB(62.06,"AD1",LRTB,0))

                           SET LRX(0)=""

 +9                        IF LRX

                               SET LRX(0)=$GET(^LAB(62.06,LRX,0))

 +10                       SET LRTBA=$PIECE(LRX(0),"^")

                       End DoDot:2

 +11               IF LRTBA=""

                       Begin DoDot:2

 +12                       SET LRTBA=$ORDER(^DD(63.39,"GL",LRTB,1,0))

 +13                       SET LRTBA=$PIECE(^DD(63.39,LRTBA,0),U)

                       End DoDot:2

 +14               WRITE !,?3,$$LJ^XLFSTR(LRTBA,30,"."),?34,LRTBS

               End DoDot:1

 +15       QUIT

 +16      ;

 +17      ;

FUNG      ;

 +1       ; from LRMIPSZ1

 +2       ; also called from RPT^LROR4

 +3        NEW LRBLDTMP,LRQUIT

 +4        SET (LRBLDTMP,LRQUIT)=0

 +5       ;

           IF '$DATA(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT))

               Begin DoDot:1

 +6                SET LRBLDTMP=1

 +7                MERGE ^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT)=^LR(LRDFN,"MI",LRIDT)

 +8                KILL ^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,32)

               End DoDot:1

 +9       ;

 +10       IF $PIECE(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,8),U)=""

               IF '$GET(LRLABKY)

                   Begin DoDot:1

 +11                   if '$DATA(^XTMP("LRMICRO EDIT",LRDFN,LRIDT,8))

                           QUIT

 +12      ;LR*5.2*547: Display informational message if accession/test is currently being edited

 +13      ;            and results had previously been verified.

 +14                   NEW LR7SB

                       SET LR7SB=8

 +15                   DO MES^LRMIPSZ2

                   End DoDot:1

                   if '$DATA(LRWRDVEW)

                       SET LRQUIT=1

                   if LRSB'=8

                       SET LRQUIT=1

 +16      ;

 +17       IF LRQUIT

               Begin DoDot:1

 +18               IF LRBLDTMP

                       KILL ^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT)

               End DoDot:1

               QUIT

 +19      ;

 +20       SET LRTUS=$PIECE(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,8),U,2)

 +21       SET DZ=$PIECE(^(8),U,3)

           SET Y=$PIECE(^(8),U)

 +22       DO D^LRU

 +23       if LRHC

               WRITE !

 +24       DO NP

           if LRABORT

               QUIT

 +25       WRITE !,"* MYCOLOGY ",$SELECT(LRTUS="F":"FINAL",LRTUS="P":"PRELIMINARY",1:"")," REPORT => ",Y,"   TECH CODE: ",DZ

 +26       DO NP

           if LRABORT

               QUIT

 +27       SET LRPRE=22

           DO PRE^LRMIPSU

 +28       DO QA

 +29      ;

 +30       IF LRBLDTMP

               KILL ^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT)

 +31       QUIT

 +32      ;

 +33      ;

QA        ;

 +1       ;

 +2       ;

           IF $DATA(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,15))

               Begin DoDot:1

 +3                if LRHC

                       WRITE !

 +4                DO NP

                   if LRABORT

                       QUIT

 +5                WRITE !,"MYCOLOGY SMEAR/PREP:"

 +6                SET LRMYC=0

 +7                FOR

                       SET LRMYC=+$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,15,LRMYC))

                       if LRMYC<1

                           QUIT

                       WRITE !?5,^(LRMYC,0)

                       DO NP

                       if LRABORT

                           QUIT

               End DoDot:1

 +8       ;

 +9       ;

           IF $DATA(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,9))

               Begin DoDot:1

 +10               if LRHC

                       WRITE !

 +11               DO NP

                   if LRABORT

                       QUIT

 +12               WRITE !,"Fungus/Yeast: "

 +13               DO NP

                   if LRABORT

                       QUIT

 +14               DO SHOW

               End DoDot:1

 +15      ;

 +16      ;

           IF $DATA(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,10))

               Begin DoDot:1

 +17               if LRHC

                       WRITE !

 +18               DO NP

                   if LRABORT

                       QUIT

 +19               WRITE !,"Mycology Remark(s):"

 +20               DO NP

                   if LRABORT

                       QUIT

 +21               SET LRMYC=0

 +22               FOR

                       SET LRMYC=+$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,10,LRMYC))

                       if LRMYC<1

                           QUIT

                       WRITE !,?3,^(LRMYC,0)

                       DO NP

                       if LRABORT

                           QUIT

               End DoDot:1

 +23      ;

 +24       QUIT

 +25      ;

 +26      ;

SHOW      ;

 +1       ;

 +2        SET LRTA=0

 +3        FOR

               SET LRTA=+$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,9,LRTA))

               if LRTA?.N2A.E!(LRTA<1)

                   QUIT

               Begin DoDot:1

 +4                SET LRTA=+LRTA

 +5                SET (LRBUG(LRTA),LRTBC)=$PIECE(^(LRTA,0),U)

 +6                SET LRQU=$PIECE(^(0),U,2)

 +7                SET LRTBC=$PIECE(^LAB(61.2,LRTBC,0),U)

 +8                DO LIST1

               End DoDot:1

 +9       ;

 +10       QUIT

 +11      ;

 +12      ;

LIST1     ;

 +1       ;

 +2        NEW B

 +3        WRITE !,LRTBC

 +4        DO NP

           if LRABORT

               QUIT

 +5        IF LRQU'=""

               WRITE !,?3,"Quantity: ",LRQU

 +6        DO NP

           if LRABORT

               QUIT

 +7       ;

           IF $DATA(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,9,LRTA,1,0))

               Begin DoDot:1

 +8                WRITE !,?3,"Comment:"

 +9                SET B=0

 +10               FOR

                       SET B=+$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,9,LRTA,1,B))

                       if B<1

                           QUIT

                       WRITE ?13,^(B,0),!

                       DO NP

                       if LRABORT

                           QUIT

               End DoDot:1

 +11       QUIT

 +12      ;

 +13      ;

NP        ;

 +1       ; Convenience method

 +2        DO NP^LRMIPSZ1

 +3        QUIT

LRMIPSZ4.m