source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRLNCTOP.m@ 789

LRLNCTOP ;DALOI/RH-LEDI HL7 CODES ;11-OCT-1998

 ;;5.2;LAB SERVICE;**215,232**;Sep 27,1994

EN ;

 W @IOF

 W !,$$CJ^XLFSTR("This option prints a list of SITE/SPECIMENS from the LABORATORY TEST FILE",IOM)

 W !,$$CJ^XLFSTR(" Standard LEDI HL7 specimen codes in the Topography file.",IOM)

 W !,$$CJ^XLFSTR("You will be prompted to print the specimen with or without the LEDI HL7 codes; ",IOM)

WHICH ;

 W !!

 W !,"Print Topography with or without a LEDI HL7 CODE and Time Aspect."

 K DIR S DIR("?")="Print Topography with or without a LEDI HL7 CODE and Time Aspect"

 S DIR(0)="S^1:WITH;2:WITHOUT" D ^DIR K DIR

 S LRANS=Y

 I $D(DIRUT) G EXIT Q

 K %ZIS S %ZIS="Q" D ^%ZIS G:POP EXIT

 I $D(IO("Q")) D QUE Q

 U IO D START,^%ZISC Q

QUE ;

 S ZTRTN="START^LRLNCTOP",ZTDESC="TOPOGRAPHY REPORT"

 S ZTSAVE("LRANS")=""

 D ^%ZTLOAD

 I $D(ZTSK)'[0 W !,"REQUEST QUEUED TO ",ION

 D HOME^%ZIS K IO("Q") Q

START ;BEGINS PRINTING THE REPORT

 I LRANS=1 D ALPHA

 I LRANS=2 D EN2

 D EXIT

 Q

ALPHA ;PRINTS THE ALPHABETIC LISTING OF SPECIMEN THAT HAVE A LEDI HL7 CODE IN THE TOPOGRAPHY FILE

 D INI,HDR1,EQUALS^LRX

 S LRTOP="^LAB(61,""B"",0)"

 F  S LRTOP=$Q(@LRTOP) Q:$QS(LRTOP,2)'="B"  Q:$G(LREND)  D

 . I $G(@LRTOP)!($G(LREND)) Q

 . S LRIEN=+$QS(LRTOP,4)

 . S LRY=$G(^LAB(61,LRIEN,0)) Q:'$L(LRY)

 . I $Y+4>IOSL D HDR D:'LREND HDR1,EQUALS^LRX Q:$G(LREND)

 . Q:'$P($G(^LAB(61,LRIEN,0)),U,9)!('$P($G(^LAB(61,LRIEN,0)),U,10))

 . W !?3,"[",$J(LRIEN,4),"]",?11,$E($P(LRY,U),1,20)

 . S LRIEN=$P(LRY,U,9) Q:'$D(^LAB(64.061,LRIEN,0))#2

 . W ?33,$E($P(^LAB(64.061,LRIEN,0),U),1,20)_"|"_$$GET1^DIQ(64.061,+$P(LRY,U,10),1)

 Q

EN2 ;PRINTS THE SPECIMEN THAT DO NOT HAVE A LEDI HL7 CODE

 D INI,HDR2,EQUALS^LRX

 S LRNODE="^LAB(60,""B"",0)"

 F  S LRNODE=$Q(@LRNODE) Q:$QS(LRNODE,2)'="B"  Q:$G(LREND)  D

 . I $G(@LRNODE)!($G(LREND)) Q

 . S LRI=+$QS(LRNODE,4)

 . S LRX=$G(^LAB(60,LRI,0)) Q:'$L($P(LRX,U))!($P(LRX,U,3)="")!($P(LRX,U,3)="N")

 . S LRIEN=0 F  S LRIEN=$O(^LAB(60,LRI,1,LRIEN)) Q:LRIEN<1!$G(LREND)  D

 .. S LRY=$G(^LAB(61,LRIEN,0)) Q:$P(LRY,U)=""

 .. I $P(LRY,U,9) Q

 .. I $Y+5>IOSL D HDR D:'LREND HDR2,EQUALS^LRX Q:$G(LREND)

 .. W !

 .. W:LRTEST'=$P(LRX,U) ?5,$P(LRX,U)

 .. W ?37,$E($P(LRY,U),1,30)

 .. S LRTEST=$P(LRX,U)

 Q

INI ;INITIALIZE VARIABLES

 S (LREND,LRPAGE)=0,LRTEST="" W:$E(IOST,1,2)="C-" @IOF

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

 S LRPAGE=LRPAGE+1

 S LRDT=$$FMTE^XLFDT($$NOW^XLFDT,"Z5M")

 Q

HDR1 ;PRINT HEADING FOR SPECIMENS WITH A LEDI HL7 CODE

 W @IOF

 W !?50,LRDT,?(IOM-10)," Page ",$J(LRPAGE,3)

 W !

 W !,$$CJ^XLFSTR("A LISTING FROM THE TOPOGRAPHY FILE OF SPECIMENS WITH LEDI HL7 CODE",IOM)

 W !,$$CJ^XLFSTR("AND HAVE TIME ASPECT ENTERED",IOM)

 W !

 W !?3,"FILE 61"

 W !?4,"[IEN]",?11,"SITE/SPECIMEN",?32,"ELEC CODE NAME|TIME ASPECT"

 Q

HDR2 ;PRINT HEADING FOR TESTS WITHOUT A LEDI HL7 CODE

 W @IOF

 W !?50,LRDT,?(IOM-10)," Page ",$J(LRPAGE,3)

 W !!?23,"LAB SPECIMEN WITHOUT LEDI HL7 CODE"

 W !,$$CJ^XLFSTR("THESE SPECIMENS NEED LEDI HL7 CODES DEFINED IN THE TOPOGRAPHY FILE",IOM)

 W !!?5,"LAB TEST NAME",?37,"SITE/SPECIMEN"

 Q

EXIT ;

 S:$D(ZTQUEUED) ZTREQ="@"

 K LREND,LRPAGE,LRI,LRX,LRANS,LRY,LRDT,LRIEN,LRTEST

 K DIR,DIRUT,DUOUT,ZTIO,ZTDESC,ZTRTN,ZTSAVE

 K LRN,Y,POP,ZTSK,ZTQUEUED,ZTREQ

 Q