LRLNCHL7.m

LRLNCHL7 ;VA/DALCIOFO/RH - LEDI HL7 CODES ;1-OCT-1998 [ 12/19/2002  6:36 AM ]

 ;;5.2;LR;**1015**;NOV 18,2002

 ;;5.2;LAB SERVICE;**215**;Sep 27,1994

EN ;

 W @IOF,!,$$CJ^XLFSTR("This option prints a list of specimens from the",IOM)

 W !,$$CJ^XLFSTR("LAB ELECTRONICS CODE file (#64.061).",IOM)

 W !,$$CJ^XLFSTR("This list may assist you when linking your",IOM)

 W !,$$CJ^XLFSTR("local TOPOGRAPHY (#61) entries with the file 64.061.",IOM)

 K %ZIS S %ZIS="Q" D ^%ZIS G:POP EXIT

 I $D(IO("Q")) D QUE Q

 U IO D START Q

QUE S ZTRTN="START^LRLNCHL7",ZTDESC="LEDI HL7 REPORT"

 D ^%ZTLOAD

 I $D(ZTSK)'[0 W !!?5,"Report queued!"

 D HOME^%ZIS K IO("Q") Q

START ;BEGINS PRINTING THE REPORT

 S:$D(ZTQUEUED) ZTREQ="@"

 D INI

 S LRNODE="^LAB(64.061,""B"",0)"

 F  S LRNODE=$Q(@LRNODE) Q:$QS(LRNODE,2)'="B"!($G(LREND))  D

 . Q:$G(@LRNODE)  S LRI=+$QS(LRNODE,4)

 . I $Y+5>IOSL D HDR Q:LREND

 . I $P($G(^LAB(64.061,LRI,0)),U,7)="S" W $S($P(^(0),U,5)="0070":"*",1:""),$P(^(0),U),?40 W:$X>40 !

 D EXIT

 Q

INI ;INITIALIZE VARIABLES

 S (LREND,LRPAGE)=0,$P(LRLINE,"=",(IOM-1))="" W:$E(IOST,1,2)="C-" @IOF

 S LRPDT=$$FMTE^XLFDT($$NOW^XLFDT,"Z5M")

HDR ;PRINT HEADING

 I LRPAGE,$E(IOST,1,2)="C-" W !,"Press RETURN to continue or '^' to exit: " R LRN:DTIME S LREND='$T!(LRN="^") Q:LREND

 W:$G(LRPAGE) @IOF

 S LRPAGE=LRPAGE+1

 W !,$$CJ^XLFSTR("LEDI HL7 ELECTRONIC SPECIMEN CODES",IOM)

 W !?5,LRPDT,?(IOM-15)," Page ",$J(LRPAGE,3)

 W !,"* Source HL7 0070 Table"

 W !,LRLINE,!

 Q

EXIT ;

 I $E(IOST,1,2)="P-" W @IOF

 D ^%ZISC

 K LREND,LRI,LRLINE,LRNODE,LRPDT,LRN,LRPAGE,ZTDESC,ZTRTN,ZTSAVE

 Q

LRLNCHL7  ;VA/DALCIOFO/RH - LEDI HL7 CODES ;1-OCT-1998 [ 12/19/2002  6:36 AM ]

 +1       ;;5.2;LR;**1015**;NOV 18,2002

 +2       ;;5.2;LAB SERVICE;**215**;Sep 27,1994

EN        ;

 +1        WRITE @IOF,!,$$CJ^XLFSTR("This option prints a list of specimens from the",IOM)

 +2        WRITE !,$$CJ^XLFSTR("LAB ELECTRONICS CODE file (#64.061).",IOM)

 +3        WRITE !,$$CJ^XLFSTR("This list may assist you when linking your",IOM)

 +4        WRITE !,$$CJ^XLFSTR("local TOPOGRAPHY (#61) entries with the file 64.061.",IOM)

 +5        KILL %ZIS

           SET %ZIS="Q"

           DO ^%ZIS

           IF POP

               GOTO EXIT

 +6        IF $DATA(IO("Q"))

               DO QUE

               QUIT 

 +7        USE IO

           DO START

           QUIT 

QUE        SET ZTRTN="START^LRLNCHL7"

           SET ZTDESC="LEDI HL7 REPORT"

 +1        DO ^%ZTLOAD

 +2        IF $DATA(ZTSK)'[0

               WRITE !!?5,"Report queued!"

 +3        DO HOME^%ZIS

           KILL IO("Q")

           QUIT 

START     ;BEGINS PRINTING THE REPORT

 +1        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +2        DO INI

 +3        SET LRNODE="^LAB(64.061,""B"",0)"

 +4        FOR 

               SET LRNODE=$QUERY(@LRNODE)

               IF $QSUBSCRIPT(LRNODE,2)'="B"!($GET(LREND))

                   QUIT 

               Begin DoDot:1

 +5                IF $GET(@LRNODE)

                       QUIT 

                   SET LRI=+$QSUBSCRIPT(LRNODE,4)

 +6                IF $Y+5>IOSL

                       DO HDR

                       IF LREND

                           QUIT 

 +7                IF $PIECE($GET(^LAB(64.061,LRI,0)),U,7)="S"

                       WRITE $SELECT($PIECE(^(0),U,5)="0070":"*",1:""),$PIECE(^(0),U),?40

                       IF $X>40

                           WRITE !

               End DoDot:1

 +8        DO EXIT

 +9        QUIT 

INI       ;INITIALIZE VARIABLES

 +1        SET (LREND,LRPAGE)=0

           SET $PIECE(LRLINE,"=",(IOM-1))=""

           IF $EXTRACT(IOST,1,2)="C-"

               WRITE @IOF

 +2        SET LRPDT=$$FMTE^XLFDT($$NOW^XLFDT,"Z5M")

HDR       ;PRINT HEADING

 +1        IF LRPAGE

               IF $EXTRACT(IOST,1,2)="C-"

                   WRITE !,"Press RETURN to continue or '^' to exit: "

                   READ LRN:DTIME

                   SET LREND='$TEST!(LRN="^")

                   IF LREND

                       QUIT 

 +2        IF $GET(LRPAGE)

               WRITE @IOF

 +3        SET LRPAGE=LRPAGE+1

 +4        WRITE !,$$CJ^XLFSTR("LEDI HL7 ELECTRONIC SPECIMEN CODES",IOM)

 +5        WRITE !?5,LRPDT,?(IOM-15)," Page ",$JUSTIFY(LRPAGE,3)

 +6        WRITE !,"* Source HL7 0070 Table"

 +7        WRITE !,LRLINE,!

 +8        QUIT 

EXIT      ;

 +1        IF $EXTRACT(IOST,1,2)="P-"

               WRITE @IOF

 +2        DO ^%ZISC

 +3        KILL LREND,LRI,LRLINE,LRNODE,LRPDT,LRN,LRPAGE,ZTDESC,ZTRTN,ZTSAVE

 +4        QUIT