| [613] | 1 | LRLNCHL7 ;DALCIOFO/RH-LEDI HL7 CODES ;1-OCT-1998
 | 
|---|
 | 2 |  ;;5.2;LAB SERVICE;**215**;Sep 27,1994
 | 
|---|
 | 3 | EN ;
 | 
|---|
 | 4 |  W @IOF,!,$$CJ^XLFSTR("This option prints a list of specimens from the",IOM)
 | 
|---|
 | 5 |  W !,$$CJ^XLFSTR("LAB ELECTRONICS CODE file (#64.061).",IOM)
 | 
|---|
 | 6 |  W !,$$CJ^XLFSTR("This list may assist you when linking your",IOM)
 | 
|---|
 | 7 |  W !,$$CJ^XLFSTR("local TOPOGRAPHY (#61) entries with the file 64.061.",IOM)
 | 
|---|
 | 8 |  K %ZIS S %ZIS="Q" D ^%ZIS G:POP EXIT
 | 
|---|
 | 9 |  I $D(IO("Q")) D QUE Q
 | 
|---|
 | 10 |  U IO D START Q
 | 
|---|
 | 11 | QUE S ZTRTN="START^LRLNCHL7",ZTDESC="LEDI HL7 REPORT"
 | 
|---|
 | 12 |  D ^%ZTLOAD
 | 
|---|
 | 13 |  I $D(ZTSK)'[0 W !!?5,"Report queued!"
 | 
|---|
 | 14 |  D HOME^%ZIS K IO("Q") Q
 | 
|---|
 | 15 | START ;BEGINS PRINTING THE REPORT
 | 
|---|
 | 16 |  S:$D(ZTQUEUED) ZTREQ="@"
 | 
|---|
 | 17 |  D INI
 | 
|---|
 | 18 |  S LRNODE="^LAB(64.061,""B"",0)"
 | 
|---|
 | 19 |  F  S LRNODE=$Q(@LRNODE) Q:$QS(LRNODE,2)'="B"!($G(LREND))  D
 | 
|---|
 | 20 |  . Q:$G(@LRNODE)  S LRI=+$QS(LRNODE,4)
 | 
|---|
 | 21 |  . I $Y+5>IOSL D HDR Q:LREND
 | 
|---|
 | 22 |  . 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 !
 | 
|---|
 | 23 |  D EXIT
 | 
|---|
 | 24 |  Q
 | 
|---|
 | 25 | INI ;INITIALIZE VARIABLES
 | 
|---|
 | 26 |  S (LREND,LRPAGE)=0,$P(LRLINE,"=",(IOM-1))="" W:$E(IOST,1,2)="C-" @IOF
 | 
|---|
 | 27 |  S LRPDT=$$FMTE^XLFDT($$NOW^XLFDT,"Z5M")
 | 
|---|
 | 28 | HDR ;PRINT HEADING
 | 
|---|
 | 29 |  I LRPAGE,$E(IOST,1,2)="C-" W !,"Press RETURN to continue or '^' to exit: " R LRN:DTIME S LREND='$T!(LRN="^") Q:LREND
 | 
|---|
 | 30 |  W:$G(LRPAGE) @IOF
 | 
|---|
 | 31 |  S LRPAGE=LRPAGE+1
 | 
|---|
 | 32 |  W !,$$CJ^XLFSTR("LEDI HL7 ELECTRONIC SPECIMEN CODES",IOM)
 | 
|---|
 | 33 |  W !?5,LRPDT,?(IOM-15)," Page ",$J(LRPAGE,3)
 | 
|---|
 | 34 |  W !,"* Source HL7 0070 Table"
 | 
|---|
 | 35 |  W !,LRLINE,!
 | 
|---|
 | 36 |  Q
 | 
|---|
 | 37 | EXIT ;
 | 
|---|
 | 38 |  I $E(IOST,1,2)="P-" W @IOF
 | 
|---|
 | 39 |  D ^%ZISC
 | 
|---|
 | 40 |  K LREND,LRI,LRLINE,LRNODE,LRPDT,LRN,LRPAGE,ZTDESC,ZTRTN,ZTSAVE
 | 
|---|
 | 41 |  Q
 | 
|---|