| 1 | LRLNCLK ;DALOI/RSH/FHS - LOOK UP LOINC CODE AND DISPLAY;31 -AUG-2001
 | 
|---|
| 2 |  ;;5.2;LAB SERVICE;**232,278**;Sep 27,1994
 | 
|---|
| 3 | START ;
 | 
|---|
| 4 |  D ENTERLNC
 | 
|---|
| 5 |  I $G(LREND) D EXIT
 | 
|---|
| 6 |  E  G START
 | 
|---|
| 7 |  Q
 | 
|---|
| 8 | ENTERLNC ;Enter LOINC code for lookup
 | 
|---|
| 9 |  W !! K DIR S LREND=0,DIR(0)="PO^95.3:AQEMZ",DIR("A")="Enter LOINC Code/Name "
 | 
|---|
| 10 |  S DIR("?")="You can see possible LOINC CODES/Specimen by entering the"
 | 
|---|
| 11 |  S DIR("?",1)="LOINC Test Name..Specimen   example( GLUCOSE..UR )"
 | 
|---|
| 12 |  S DIR("?",2)=" "
 | 
|---|
| 13 |  D ^DIR K DIR
 | 
|---|
| 14 |  I $D(DUOUT)!($D(DTOUT))!(Y=-1) K DTOUT,DUOUT S LREND=1 Q
 | 
|---|
| 15 |  S LRCODE=+Y
 | 
|---|
| 16 | SP D DISPL
 | 
|---|
| 17 |  Q
 | 
|---|
| 18 | DISPL ;Show LOINC entry selected in file 95.3
 | 
|---|
| 19 |  ;display header-system and class
 | 
|---|
| 20 |  ;display LOINC code, component, property, time aspect, scale type and method type
 | 
|---|
| 21 |  S DA=LRCODE
 | 
|---|
| 22 |  S LRLNC0=^LAB(95.3,DA,0)
 | 
|---|
| 23 |  F I=2,6,7,8,9,10,11,14,15 S LRLNC0(I)=$P(LRLNC0,U,I)
 | 
|---|
| 24 |  S LRLNCNAM=$P($G(^LAB(95.3,DA,80)),U)
 | 
|---|
| 25 |  W @IOF
 | 
|---|
| 26 |  W !,"LOINC CODE: ",LRCODE_"-"_LRLNC0(15),"   ",LRLNCNAM
 | 
|---|
| 27 |  W !,"SYSTEM: ",$P($G(^LAB(64.061,+LRLNC0(8),0)),U),?40,"CLASS: ",$P($G(^LAB(64.061,+LRLNC0(11),0)),U)
 | 
|---|
| 28 |  W:LRLNC0(2) !,"COMPONENT: ",$P($G(^LAB(95.31,+LRLNC0(2),0)),U)
 | 
|---|
| 29 |  W:LRLNC0(6) !,"PROPERTY: ",$P($G(^LAB(64.061,+LRLNC0(6),0)),U)
 | 
|---|
| 30 |  W:LRLNC0(7) !,"TIME ASPECT: ",$P($G(^LAB(64.061,+LRLNC0(7),0)),U)
 | 
|---|
| 31 |  W:LRLNC0(9) !,"SCALE TYPE: ",$P($G(^LAB(64.061,+LRLNC0(9),0)),U)
 | 
|---|
| 32 |  W:LRLNC0(10) !,"METHOD TYPE: ",$P($G(^LAB(64.2,+LRLNC0(10),0)),U)
 | 
|---|
| 33 |  W:LRLNC0(14) !,"UNITS: ",$P($G(^LAB(64.061,+LRLNC0(14),0)),U)
 | 
|---|
| 34 |  Q
 | 
|---|
| 35 | EXIT K DA,DIR,DIRUT,DTOUT,LRCODE,LREND,LRLNCNAM,LRLNC0,X,Y
 | 
|---|
| 36 |  Q
 | 
|---|