LRLNCLK.m

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 ---LRLNCLK   1495     printed  Apr 09, 2024@21:17:48                                                                                                                                                                                                     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