| 1 | LRLNCSUF ;DALOI/RSH-PRINT WKLD/NLT CODE LOINC MAPPINGS ;1-OCT-1998
|
|---|
| 2 | ;;5.2;LAB SERVICE;**232**;Sep 27,1994
|
|---|
| 3 | EN ;
|
|---|
| 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)
|
|---|
| 7 | ASK ;
|
|---|
| 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^LRLNCSUF",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
|
|---|
| 15 | D END
|
|---|
| 16 | Q
|
|---|
| 17 | DQ ;
|
|---|
| 18 | N DIR,LREND
|
|---|
| 19 | S $P(LRLINE,"=",IOM)="",LRTOP=1
|
|---|
| 20 | S:$D(ZTQUEUED) ZTREQ="@" S LRPDT=$$FMTE^XLFDT($$NOW^XLFDT,"1P")
|
|---|
| 21 | S (LRPAGE,LRCNT,LREND)=0
|
|---|
| 22 | S LRDEF=""
|
|---|
| 23 | D HDR
|
|---|
| 24 | ;SORT BY TEST
|
|---|
| 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 LRTSTNM=$QS(LRNODE,3)
|
|---|
| 29 | . S LRIEN=+$QS(LRNODE,4)
|
|---|
| 30 | . S (LRLOINC,LRSMPIEN,LRVWKIEN,LRACCIEN)=""
|
|---|
| 31 | . S LRX=$G(^LAB(60,LRIEN,0)) Q:$P(LRX,U,3)="N"
|
|---|
| 32 | . S LRVACD=$P($G(^LAB(60,LRIEN,64)),U)
|
|---|
| 33 | . S LRRNLT=$P($G(^LAB(60,LRIEN,64)),U,2)
|
|---|
| 34 | . D SMPCD D:$G(LRSMPIEN) GRNLT(LRSMPIEN)
|
|---|
| 35 | . D VRWKD D:$G(LRVWKIEN) GRNLT(LRVWKIEN)
|
|---|
| 36 | . D ACWK D:$G(LRACCIEN) GRNLT(LRACCIEN)
|
|---|
| 37 | . I LRSMPIEN=""&(LRVWKIEN="")&(LRACCIEN="") D
|
|---|
| 38 | . . I ($G(LRRNLT)) D GRNLT(LRRNLT)
|
|---|
| 39 | . . I LRRNLT="" D
|
|---|
| 40 | . . . W !,LRTSTNM,?45,"THERE IS NO RESULT NLT CODE"
|
|---|
| 41 | . . . W !,LRLINE
|
|---|
| 42 | . . . I $Y>24 D HDR,TOP Q:$G(LREND)
|
|---|
| 43 | Q
|
|---|
| 44 | SMPCD ;GET SAMPLE WORKLOAD CODE
|
|---|
| 45 | S (LRD1,LRD2)=0
|
|---|
| 46 | F S LRD1=+$O(^LAB(60,LRIEN,3,LRD1)) Q:LRD1<1 D
|
|---|
| 47 | . Q:'$O(^LAB(60,LRIEN,3,LRD1,9,0))
|
|---|
| 48 | . F S LRD2=+$O(^LAB(60,LRIEN,3,LRD1,9,LRD2)) Q:LRD2<1 D
|
|---|
| 49 | . . S LRSREC=$G(^LAB(60,LRIEN,LRD1,9,LRD2,0))
|
|---|
| 50 | . . S LRSMPIEN=$P(LRSREC,U)
|
|---|
| 51 | Q
|
|---|
| 52 | VRWKD ;GET VERIFY WORKLOAD CODE
|
|---|
| 53 | S LRD1=0 Q:'$O(^LAB(60,LRIEN,9,0))
|
|---|
| 54 | F S LRD1=+$O(^LAB(60,LRIEN,9,LRD1)) Q:'LRD1 D
|
|---|
| 55 | . S LRVREC=$G(^LAB(60,LRIEN,9,LRD1,0))
|
|---|
| 56 | . S LRVWKIEN=$P(LRVREC,U)
|
|---|
| 57 | Q
|
|---|
| 58 | ACWK ;GET ACCESSION WORKLOAD CODE
|
|---|
| 59 | S LRSUB=0
|
|---|
| 60 | Q:'$O(^LAB(60,LRIEN,9.1,0))
|
|---|
| 61 | F S LRSUB=+$O(^LAB(60,LRIEN,9.1,LRSUB)) Q:LRSUB<1 D
|
|---|
| 62 | . S LRREC=$G(^LAB(60,LRIEN,9.1,LRSUB,0))
|
|---|
| 63 | . S LRACCIEN=$P(LRREC,U)
|
|---|
| 64 | Q
|
|---|
| 65 | GRNLT(LRNLTIEN) ;GET RESULT NLT CODE
|
|---|
| 66 | Q:$G(^LAM(LRNLTIEN,0))=""
|
|---|
| 67 | Q:'$D(^LAM(LRNLTIEN,0))#2!($P($G(^LAM(LRNLTIEN,0)),U,2)="") S LRNAME=$P(^(0),U),LRCODE=$P(^(0),U,2)
|
|---|
| 68 | D TOP Q:$G(LREND)
|
|---|
| 69 | I $O(^LAM(LRNLTIEN,5,0)) D GTLNC
|
|---|
| 70 | SDEFCD ;SET DEFAULT LOINC CODE
|
|---|
| 71 | I $G(^LAM(LRNLTIEN,9)) S LRDEF=$P(^(0),U)
|
|---|
| 72 | E S LRDEF="" ;USE GENERIC SUFFIX CODE
|
|---|
| 73 | I '$O(^LAM(LRNLTIEN,5,0)) D PRT
|
|---|
| 74 | Q
|
|---|
| 75 | GTLNC ;GET LOINC CODE BASED ON THE SPECIMEN
|
|---|
| 76 | S LRSPEC=0 F S LRSPEC=+$O(^LAM(LRNLTIEN,5,LRSPEC)) Q:LRSPEC<1!($G(LREND)) D
|
|---|
| 77 | . D TOP Q:$G(LREND)
|
|---|
| 78 | . S LRASP=0 F S LRASP=+$O(^LAM(LRNLTIEN,5,LRSPEC,1,LRASP)) Q:LRASP<1 D
|
|---|
| 79 | . . D TOP Q:$G(LREND)
|
|---|
| 80 | . . S LRX=+$G(^LAM(LRNLTIEN,5,LRSPEC,1,LRASP,1))
|
|---|
| 81 | . . I $D(^LAB(95.3,LRX,0))#2 S LRLOINC=$P(^(0),U)
|
|---|
| 82 | . . S LRSPNM=$P($G(^LAB(61,LRSPEC,0)),U),LRFULL=$G(^LAB(95.3,LRX,80))
|
|---|
| 83 | . . I $G(LRLOINC) D PRT
|
|---|
| 84 | . . S (LRLOINC,LRFULL)=""
|
|---|
| 85 | Q
|
|---|
| 86 | PRT ;PRINT INFO
|
|---|
| 87 | D TOP Q:$G(LREND)
|
|---|
| 88 | W !?2,$G(LRTSTNM),?47,$G(LRSPNM)
|
|---|
| 89 | W !?2,$G(LRNLTIEN),?12,LRCODE_" "_$G(LRNAME)
|
|---|
| 90 | I LRLOINC'="" W !,"LOINC CODE = ",LRLOINC," ",$G(LRFULL)
|
|---|
| 91 | I LRDEF'="" W !,"DEFAULT LOINC CODE = ",$G(LRDEF)
|
|---|
| 92 | I LRLOINC!LRDEF S LRCNT=LRCNT+1
|
|---|
| 93 | W !,LRLINE
|
|---|
| 94 | I $Y>24 D HDR,TOP Q:$G(LREND)
|
|---|
| 95 | Q
|
|---|
| 96 | END ;
|
|---|
| 97 | I $G(LRCNT) W !?15,"Total Number of Mapped WKLD CODES/Specimens: ",LRCNT,!
|
|---|
| 98 | I $E(IOST)="P-" W @IOF
|
|---|
| 99 | D ^%ZISC
|
|---|
| 100 | K DIR,DIRUT,DUOUT,LRACCIEN,LRASP,LRCODE,LRCNT,LRD1,LRD2,LRDEF
|
|---|
| 101 | K LREND,LRFULL,LRIEN,LRLINE,LRLOINC,LRNAME,LRNLTIEN,LRNODE,LRPAGE
|
|---|
| 102 | K LRPDT,LRREC,LRRNLT,LRSEL,LRSMPIEN,LRSPEC,LRSPNM,LRSREC,LRSUB
|
|---|
| 103 | K LRTOP,LRTSTNM,LRVACD,LRVREC,LRVWKIEN,LRX,POP,ZTIO,ZTDESC,ZTRTN,ZTSAVE
|
|---|
| 104 | ;
|
|---|
| 105 | Q
|
|---|
| 106 | TOP ;
|
|---|
| 107 | Q:$G(LREND)
|
|---|
| 108 | Q:$Y<(IOSL-4)
|
|---|
| 109 | I $E(IOST,1,2)="C-" D Q:$G(LREND)
|
|---|
| 110 | . S DIR(0)="E" D ^DIR
|
|---|
| 111 | . S:$S($G(DIRUT):1,$G(DUOUT):1,1:0) LREND=1
|
|---|
| 112 | HDR ;
|
|---|
| 113 | I $G(LRPAGE) W @IOF
|
|---|
| 114 | S LRPAGE=$G(LRPAGE)+1
|
|---|
| 115 | Q:'$G(LRTOP)
|
|---|
| 116 | W !,$$CJ^XLFSTR("Alphabetical Listing of Laboratory Tests ",IOM)
|
|---|
| 117 | W !,$$CJ^XLFSTR("that are Mapped to LOINC Codes.",IOM)
|
|---|
| 118 | W !,?5,LRPDT,?60,"Page: ",LRPAGE
|
|---|
| 119 | W !!,"LABORATORY TEST NAME",?45,"SPECIMEN"
|
|---|
| 120 | W !,"NLT IEN # WKLD CODE Name ",!
|
|---|
| 121 | Q
|
|---|
