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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRLNCHL7 1540 printed Dec 13, 2024@02:16:35 Page 2
LRLNCHL7 ;DALCIOFO/RH-LEDI HL7 CODES ;1-OCT-1998
+1 ;;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
