- LRLNCHL7 ;VA/DALCIOFO/RH - LEDI HL7 CODES ;1-OCT-1998 [ 12/19/2002 6:36 AM ]
- ;;5.2;LR;**1015**;NOV 18,2002
- ;;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
- LRLNCHL7 ;VA/DALCIOFO/RH - LEDI HL7 CODES ;1-OCT-1998 [ 12/19/2002 6:36 AM ]
- +1 ;;5.2;LR;**1015**;NOV 18,2002
- +2 ;;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
