| [613] | 1 | LRLNCNLT ;DALOI/FHS-PRINT LAB TEST W/O RESULT NLT CODE ;1-OCT-1998
|
|---|
| 2 | ;;5.2;LAB SERVICE;**215,278**;Sep 27,1994
|
|---|
| 3 | EN ;
|
|---|
| 4 | W @IOF,!! S LREND=0
|
|---|
| 5 | W $$CJ^XLFSTR("This option will print tests and their RESULT NLT CODES",IOM)
|
|---|
| 6 | W !,$$CJ^XLFSTR("assigned. Result NLT codes are required for LEDI and LOINC",IOM)
|
|---|
| 7 | W !,$$CJ^XLFSTR("Mapping software to function properly.",IOM)
|
|---|
| 8 | W !,$$CJ^XLFSTR("You may use the option 'Link Result NLT Manual' to make necessary changes.",IOM)
|
|---|
| 9 | ASK ;
|
|---|
| 10 | K DIR S DIR(0)="S^0:All Lab Tests;1:Lab Tests with Result NLT Codes;2:Lab Tests without Result NLT Codes"
|
|---|
| 11 | S DIR("?")="All will print Lab Tests with and w/o result NLT codes tests"
|
|---|
| 12 | D ^DIR K DIR
|
|---|
| 13 | G END:$S($G(DIRUT):1,$G(DUOUT):1,$G(DTOUT):1,1:0)
|
|---|
| 14 | S LRSEL=Y
|
|---|
| 15 | K %ZIS S %ZIS="Q" D ^%ZIS
|
|---|
| 16 | G END:POP
|
|---|
| 17 | I IO'=IO(0) S ZTRTN="DQ^LRLNCNLT",ZTIO=ION,ZTDESC="Print Lab Tests and Result Codes",ZTSAVE("LRSEL")="" D ^%ZTLOAD I $D(ZTSK)'[0 W !!?5," Tasked to Print on : ",ION G END
|
|---|
| 18 | W @IOF D DQ G END
|
|---|
| 19 | Q
|
|---|
| 20 | DQ ;
|
|---|
| 21 | N DIR,LREND
|
|---|
| 22 | S:$D(ZTQUEUED) ZTREQ="@" S LRPDT=$$FMTE^XLFDT($$NOW^XLFDT,1)
|
|---|
| 23 | S (LRPAGE,LRCNT,LREND)=0
|
|---|
| 24 | D HDR
|
|---|
| 25 | S LRNODE="^LAB(60,""B"",0)",LRCNT=0
|
|---|
| 26 | F S LRNODE=$Q(@LRNODE) Q:$QS(LRNODE,2)'="B" Q:$G(LREND) D
|
|---|
| 27 | . Q:$G(@LRNODE)!($G(LREND))
|
|---|
| 28 | . S LRIEN=$QS(LRNODE,4),LRNAME=$QS(LRNODE,3),LRC=$P($G(^LAB(60,LRIEN,64)),U,2)
|
|---|
| 29 | . S LRX=$G(^LAB(60,+$G(LRIEN),0)) Q:$P(LRX,U,3)=""
|
|---|
| 30 | . Q:"BO"'[$P(LRX,U,3)
|
|---|
| 31 | . I $G(LRSEL)=2,LRC Q
|
|---|
| 32 | . I $G(LRSEL)=1,'LRC Q
|
|---|
| 33 | . S LRCNT=$G(LRCNT)+1
|
|---|
| 34 | . D TOF Q:$G(LREND)
|
|---|
| 35 | . W !,$$RJ^XLFSTR(LRIEN,5),?8,LRNAME
|
|---|
| 36 | . I $G(LRC) D NLTPRT(LRC)
|
|---|
| 37 | Q
|
|---|
| 38 | NLTPRT(LRC) ;
|
|---|
| 39 | D TOF Q:LREND
|
|---|
| 40 | N LRSPEC
|
|---|
| 41 | I '$D(^LAM(LRC,0))#2 W !?15," **** Corrupt DATABASE ****" Q
|
|---|
| 42 | W !?5,"[ ",$P(^LAM(LRC,0),U,2),?18,$P(^(0),U)," ]",!
|
|---|
| 43 | S LRSPEC=0 F S LRSPEC=$O(^LAB(60,LRIEN,1,LRSPEC)) Q:LRSPEC<1!($G(LREND)) D
|
|---|
| 44 | . S LRX=+$G(^LAB(60,LRIEN,1,LRSPEC,95.3)) Q:'LRX
|
|---|
| 45 | . I $Y>(IOSL-4) D TOF1 Q:$G(LREND) W !,$$RJ^XLFSTR(LRIEN,5),?8,LRNAME
|
|---|
| 46 | . W !?10,"Specimen [ ",$P($G(^LAB(61,LRSPEC,0)),U),"] Mapped to LOINC CODE"
|
|---|
| 47 | . W !,$G(^LAB(95.3,LRX,80)),!
|
|---|
| 48 | Q
|
|---|
| 49 | END ;
|
|---|
| 50 | I $G(LRCNT) W !?20,"Total Printed Tests: ",LRCNT,!
|
|---|
| 51 | I $E(IOST)="P-" W @IOF
|
|---|
| 52 | D ^%ZISC
|
|---|
| 53 | K DIR,DIRUT,DUOUT,LRC,LRCNT,LREND,LRIEN,LRNAME,LRNODE,LRPAGE
|
|---|
| 54 | K LRPDT,LRSEL,LRX,POP,ZTIO,ZTDESC,ZTRTN,ZTSAVE
|
|---|
| 55 | ;
|
|---|
| 56 | Q
|
|---|
| 57 | TOF ;
|
|---|
| 58 | Q:$Y<(IOSL-3)
|
|---|
| 59 | TOF1 I $E(IOST,1,2)="C-" D Q:$G(LREND)
|
|---|
| 60 | . S DIR(0)="E" D ^DIR
|
|---|
| 61 | . S:$S($G(DIRUT):1,$G(DUOUT):1,1:0) LREND=1
|
|---|
| 62 | HDR ;
|
|---|
| 63 | I $G(LRPAGE) W @IOF
|
|---|
| 64 | S LRPAGE=$G(LRPAGE)+1 W !,?5,LRPDT,?60,"Page: ",LRPAGE
|
|---|
| 65 | W !,$$CJ^XLFSTR("Alphabetical Listing of CH Subscripted Lab Tests",IOM)
|
|---|
| 66 | I $G(LRSEL)=1 W !,$$CJ^XLFSTR("That have RESULT NLT CODES assigned",IOM),!
|
|---|
| 67 | I $G(LRSEL)=2 W !,$$CJ^XLFSTR("That do not have RESULT NLT CODES assigned",IOM),!
|
|---|
| 68 | W !," IEN Lab Test Name " I $G(LRSEL)=2 W ! Q
|
|---|
| 69 | W !," NLT # Result NLT Code Name ",!
|
|---|
| 70 | Q
|
|---|
