LRLNCLK ;DALOI/RSH/FHS - LOOK UP LOINC CODE AND DISPLAY;31 -AUG-2001
;;5.2;LAB SERVICE;**232,278**;Sep 27,1994
START ;
D ENTERLNC
I $G(LREND) D EXIT
E G START
Q
ENTERLNC ;Enter LOINC code for lookup
W !! K DIR S LREND=0,DIR(0)="PO^95.3:AQEMZ",DIR("A")="Enter LOINC Code/Name "
S DIR("?")="You can see possible LOINC CODES/Specimen by entering the"
S DIR("?",1)="LOINC Test Name..Specimen example( GLUCOSE..UR )"
S DIR("?",2)=" "
D ^DIR K DIR
I $D(DUOUT)!($D(DTOUT))!(Y=-1) K DTOUT,DUOUT S LREND=1 Q
S LRCODE=+Y
SP D DISPL
Q
DISPL ;Show LOINC entry selected in file 95.3
;display header-system and class
;display LOINC code, component, property, time aspect, scale type and method type
S DA=LRCODE
S LRLNC0=^LAB(95.3,DA,0)
F I=2,6,7,8,9,10,11,14,15 S LRLNC0(I)=$P(LRLNC0,U,I)
S LRLNCNAM=$P($G(^LAB(95.3,DA,80)),U)
W @IOF
W !,"LOINC CODE: ",LRCODE_"-"_LRLNC0(15)," ",LRLNCNAM
W !,"SYSTEM: ",$P($G(^LAB(64.061,+LRLNC0(8),0)),U),?40,"CLASS: ",$P($G(^LAB(64.061,+LRLNC0(11),0)),U)
W:LRLNC0(2) !,"COMPONENT: ",$P($G(^LAB(95.31,+LRLNC0(2),0)),U)
W:LRLNC0(6) !,"PROPERTY: ",$P($G(^LAB(64.061,+LRLNC0(6),0)),U)
W:LRLNC0(7) !,"TIME ASPECT: ",$P($G(^LAB(64.061,+LRLNC0(7),0)),U)
W:LRLNC0(9) !,"SCALE TYPE: ",$P($G(^LAB(64.061,+LRLNC0(9),0)),U)
W:LRLNC0(10) !,"METHOD TYPE: ",$P($G(^LAB(64.2,+LRLNC0(10),0)),U)
W:LRLNC0(14) !,"UNITS: ",$P($G(^LAB(64.061,+LRLNC0(14),0)),U)
Q
EXIT K DA,DIR,DIRUT,DTOUT,LRCODE,LREND,LRLNCNAM,LRLNC0,X,Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRLNCLK 1495 printed Sep 23, 2025@19:52:15 Page 2
LRLNCLK ;DALOI/RSH/FHS - LOOK UP LOINC CODE AND DISPLAY;31 -AUG-2001
+1 ;;5.2;LAB SERVICE;**232,278**;Sep 27,1994
START ;
+1 DO ENTERLNC
+2 IF $GET(LREND)
DO EXIT
+3 IF '$TEST
GOTO START
+4 QUIT
ENTERLNC ;Enter LOINC code for lookup
+1 WRITE !!
KILL DIR
SET LREND=0
SET DIR(0)="PO^95.3:AQEMZ"
SET DIR("A")="Enter LOINC Code/Name "
+2 SET DIR("?")="You can see possible LOINC CODES/Specimen by entering the"
+3 SET DIR("?",1)="LOINC Test Name..Specimen example( GLUCOSE..UR )"
+4 SET DIR("?",2)=" "
+5 DO ^DIR
KILL DIR
+6 IF $DATA(DUOUT)!($DATA(DTOUT))!(Y=-1)
KILL DTOUT,DUOUT
SET LREND=1
QUIT
+7 SET LRCODE=+Y
SP DO DISPL
+1 QUIT
DISPL ;Show LOINC entry selected in file 95.3
+1 ;display header-system and class
+2 ;display LOINC code, component, property, time aspect, scale type and method type
+3 SET DA=LRCODE
+4 SET LRLNC0=^LAB(95.3,DA,0)
+5 FOR I=2,6,7,8,9,10,11,14,15
SET LRLNC0(I)=$PIECE(LRLNC0,U,I)
+6 SET LRLNCNAM=$PIECE($GET(^LAB(95.3,DA,80)),U)
+7 WRITE @IOF
+8 WRITE !,"LOINC CODE: ",LRCODE_"-"_LRLNC0(15)," ",LRLNCNAM
+9 WRITE !,"SYSTEM: ",$PIECE($GET(^LAB(64.061,+LRLNC0(8),0)),U),?40,"CLASS: ",$PIECE($GET(^LAB(64.061,+LRLNC0(11),0)),U)
+10 if LRLNC0(2)
WRITE !,"COMPONENT: ",$PIECE($GET(^LAB(95.31,+LRLNC0(2),0)),U)
+11 if LRLNC0(6)
WRITE !,"PROPERTY: ",$PIECE($GET(^LAB(64.061,+LRLNC0(6),0)),U)
+12 if LRLNC0(7)
WRITE !,"TIME ASPECT: ",$PIECE($GET(^LAB(64.061,+LRLNC0(7),0)),U)
+13 if LRLNC0(9)
WRITE !,"SCALE TYPE: ",$PIECE($GET(^LAB(64.061,+LRLNC0(9),0)),U)
+14 if LRLNC0(10)
WRITE !,"METHOD TYPE: ",$PIECE($GET(^LAB(64.2,+LRLNC0(10),0)),U)
+15 if LRLNC0(14)
WRITE !,"UNITS: ",$PIECE($GET(^LAB(64.061,+LRLNC0(14),0)),U)
+16 QUIT
EXIT KILL DA,DIR,DIRUT,DTOUT,LRCODE,LREND,LRLNCNAM,LRLNC0,X,Y
+1 QUIT
