LRLNCHL7 ;DALCIOFO/RH-LEDI HL7 CODES ;1-OCT-1998
 ;;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