42 lines
1.5 KiB
Mathematica
42 lines
1.5 KiB
Mathematica
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
|