88 lines
3.2 KiB
Mathematica
88 lines
3.2 KiB
Mathematica
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
|