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