source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRLNCNLT.m@ 1783

Last change on this file since 1783 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.7 KB
Line 
1LRLNCNLT ;DALOI/FHS-PRINT LAB TEST W/O RESULT NLT CODE ;1-OCT-1998
2 ;;5.2;LAB SERVICE;**215,278**;Sep 27,1994
3EN ;
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)
9ASK ;
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
20DQ ;
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
38NLTPRT(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
49END ;
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
57TOF ;
58 Q:$Y<(IOSL-3)
59TOF1 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
62HDR ;
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
Note: See TracBrowser for help on using the repository browser.