source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRLNCPRT.m@ 1006

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

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1LRLNCPRT ;DALOI/FHS - PRINT WKLD/NLT CODE LOINC MAPPINGS ;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 WORKLOAD CODES and their LOINC CODES.",IOM)
6 W !,$$CJ^XLFSTR("You may use the option 'MAP LOINC TEST TO NLT' to make necessary changes.",IOM)
7ASK ;
8 K DIR S DIR(0)="S^1:Ready to print WORKLOAD CODES MAPPED TO LOINC;2:Abort"
9 D ^DIR K DIR
10 G END:$S($G(DIRUT):1,$G(DUOUT):1,$G(DTOUT):1,Y=2:1,1:0)
11 S LRSEL=Y K %ZIS S %ZIS="Q" D ^%ZIS
12 G END:POP
13 I IO'=IO(0) S ZTRTN="DQ^LRLNCPRT",ZTIO=ION,ZTDESC="Print WKLD CODES MAPPED TO LOINC",ZTSAVE("LRSEL")="" D ^%ZTLOAD I $D(ZTSK)'[0 W !!?5," Tasked to Print on : ",ION G END
14 W @IOF D DQ G END
15 Q
16DQ ;
17 N DIR,LREND
18 S $P(LRLINE,"=",IOM)="",LRTOP=1
19 S:$D(ZTQUEUED) ZTREQ="@" S LRPDT=$$FMTE^XLFDT($$NOW^XLFDT,"1P")
20 S (LRPAGE,LRCNT,LREND)=0
21 D HDR
22 S LRNODE="^LAM(""B"",0)",LRCNT=0
23 F S LRNODE=$Q(@LRNODE) Q:$QS(LRNODE,1)'="B" Q:$G(LREND) D
24 . Q:$G(@LRNODE)!($G(LREND))
25 . S LRIEN=+$QS(LRNODE,3)
26 . S LRX=$G(^LAM(LRIEN,0)) Q:$P(LRX,U,2)=""
27 . D SPEC(LRIEN,1)
28 D END
29 Q
30SPEC(LRIEN,LRTOP) ;
31 N LRCK
32 Q:'$D(^LAM(LRIEN,0))#2!($P($G(^LAM(LRIEN,0)),U,2)="") S LRNAME=$P(^(0),U),LRCN=$P(^(0),U,2)
33 Q:'$O(^LAM(LRIEN,5,0))
34 D TOP Q:$G(LREND)
35 S LRSPEC=0 F S LRSPEC=+$O(^LAM(LRIEN,5,LRSPEC)) Q:LRSPEC<1!($G(LREND)) D
36 . D TOP Q:$G(LREND)
37 . S (LRCK,LRASP)=0 F S LRASP=+$O(^LAM(LRIEN,5,LRSPEC,1,LRASP)) Q:LRASP<1 D
38 . . D TOP Q:$G(LREND) S LRCK=1
39 . . S LRX=+$G(^LAM(LRIEN,5,LRSPEC,1,LRASP,1))
40 . . I '$D(^LAB(95.3,LRX,0))!('$D(^LAB(95.3,LRX,80))) D Q
41 . . . W !?5,"*** WKLD CODE ",LRCN," ***",!?10," [ ",LRNAME," ] IS CORRUPTED ",!
42 . . D TOP Q:$G(LREND)
43 . . W !?2,LRIEN,?12,LRCN_" "_LRNAME
44 . . W !?5,"Specimen: ",$P($G(^LAB(61,LRSPEC,0)),U)
45 . . W !?10,"Collection Type: ",$P($G(^LAB(64.061,LRASP,0)),U)
46 . . W !,"LOINC= ",LRX," [",$G(^LAB(95.3,LRX,80)),"]"
47 . . S LRCNT=LRCNT+1
48 W:$G(LRCK) !,LRLINE
49 Q
50END ;
51 I $G(LRCNT) W !?15,"Total Number of Mapped WKLD CODES/Specimens: ",LRCNT,!
52 I $E(IOST)="P-" W @IOF
53 D ^%ZISC
54 K DIR,DIRUT,DUOUT,LRC,LRCNT,LREND,LRIEN,LRNAME,LRNODE,LRPAGE
55 K LRPDT,LRSEL,LRX,POP,ZTIO,ZTDESC,ZTRTN,ZTSAVE
56 ;
57 Q
58TOP ;
59 Q:$G(LREND)
60 Q:$Y<(IOSL-4)
61 I $E(IOST,1,2)="C-" D Q:$G(LREND)
62 . S DIR(0)="E" D ^DIR
63 . S:$S($G(DIRUT):1,$G(DUOUT):1,1:0) LREND=1
64HDR ;
65 I $G(LRPAGE) W @IOF
66 S LRPAGE=$G(LRPAGE)+1
67 Q:'$G(LRTOP)
68 W !,$$CJ^XLFSTR("Alphabetical Listing of Workload (WKLD) CODES ",IOM)
69 W !,$$CJ^XLFSTR("that are Mapped to LOINC Codes.",IOM)
70 W !,?5,LRPDT,?60,"Page: ",LRPAGE
71 W !!,"NLT IEN # WKLD CODE Name ",!
72 Q
Note: See TracBrowser for help on using the repository browser.