| [613] | 1 | LRLNCC ;DALOI/CA-LOINC COMMON CODE;1-JAN-2001 ; 5/10/07 2:31pm
|
|---|
| 2 | ;;5.2;LAB SERVICE;**232,280,334**;Sep 27, 1994;Build 12
|
|---|
| 3 | ;============================================================
|
|---|
| 4 | ;Not valid entry call
|
|---|
| 5 | Q
|
|---|
| 6 | ;
|
|---|
| 7 | CODE ;ask which code to map
|
|---|
| 8 | I +LRLOINC("DILIST",0)=0 D Q
|
|---|
| 9 | .W !!,"No matches found."
|
|---|
| 10 | .S LRNO=1
|
|---|
| 11 | W !! S I=0
|
|---|
| 12 | F S I=$O(LRLOINC("DILIST","ID",I)) Q:'I!$G(LREND) D
|
|---|
| 13 | .I $E(IOST,1,2)="C-",'(I#18) D Q:$G(LREND)
|
|---|
| 14 | ..S DIR(0)="E" D ^DIR
|
|---|
| 15 | ..S:$S($G(DIRUT):1,$G(DUOUT):1,1:0) LREND=1
|
|---|
| 16 | .W !,I,":",LRLOINC("DILIST","ID",I,80)
|
|---|
| 17 | K DIRUT,DUOUT,DIR
|
|---|
| 18 | W !!
|
|---|
| 19 | S DIR(0)="N^1:"_$S($G(LREND):I-2,1:$P(LRLOINC("DILIST",0),U),1:0)
|
|---|
| 20 | S DIR("A")="LOINC code to map this test"
|
|---|
| 21 | D ^DIR K DIR,LREND
|
|---|
| 22 | I $D(DIRUT) S LREND=1 Q
|
|---|
| 23 | S LRCODE=LRLOINC("DILIST",1,+Y)
|
|---|
| 24 | DISPL ;Show LOINC entry selected in file 95.3
|
|---|
| 25 | ;display header-system and class
|
|---|
| 26 | ;display LOINC code, component, property, time aspect, scale type and method type
|
|---|
| 27 | ; LRDEL = Deprecated code
|
|---|
| 28 | K LRLNC0,DA S LRLNC0(8)=$P($G(^LAB(95.3,LRCODE,0)),U,8)
|
|---|
| 29 | N LRDEL,LRLNC0,LRLNCNAM,I
|
|---|
| 30 | S DA=LRCODE
|
|---|
| 31 | S LRLNC0=^LAB(95.3,DA,0) S:$G(^LAB(95.3,DA,4)) LRDEL=1
|
|---|
| 32 | F I=2,6,7,8,9,10,11,14,15 S LRLNC0(I)=$P(LRLNC0,U,I)
|
|---|
| 33 | S LRLNCNAM=$P($G(^LAB(95.3,DA,80)),U)
|
|---|
| 34 | W @IOF
|
|---|
| 35 | I $G(LRDEL) W !," **** Deprecated ****"
|
|---|
| 36 | W !,"LOINC CODE: ",LRCODE_"-"_LRLNC0(15)," ",LRLNCNAM
|
|---|
| 37 | W !,"SYSTEM: ",$P($G(^LAB(64.061,+LRLNC0(8),0)),U),?40,"CLASS: ",$P($G(^LAB(64.061,+LRLNC0(11),0)),U)
|
|---|
| 38 | W:LRLNC0(2) !,"COMPONENT: ",$P($G(^LAB(95.31,+LRLNC0(2),0)),U)
|
|---|
| 39 | W:LRLNC0(6) !,"PROPERTY: ",$P($G(^LAB(64.061,+LRLNC0(6),0)),U)
|
|---|
| 40 | W:LRLNC0(7) !,"TIME ASPECT: ",$P($G(^LAB(64.061,+LRLNC0(7),0)),U)
|
|---|
| 41 | W:LRLNC0(9) !,"SCALE TYPE: ",$P($G(^LAB(64.061,+LRLNC0(9),0)),U)
|
|---|
| 42 | W:LRLNC0(10) !,"METHOD TYPE: ",$P($G(^LAB(64.2,+LRLNC0(10),0)),U)
|
|---|
| 43 | W:LRLNC0(14) !,"UNITS: ",$P($G(^LAB(64.061,+LRLNC0(14),0)),U)
|
|---|
| 44 | Q
|
|---|
| 45 | ENTERLNC ;Enter LOINC code when already know the LOINC code
|
|---|
| 46 | W !! N DIR
|
|---|
| 47 | S LREND=0,DIR(0)="PO^95.3:AEMZ",DIR("A")="Enter LOINC Code/Name "
|
|---|
| 48 | S DIR("?")="Enter LOINC Code Name or LOINC Number"
|
|---|
| 49 | S DIR("?",1)="You can see possible LOINC CODES/Specimen by entering the"
|
|---|
| 50 | S DIR("?",2)="LOINC Test Name..Specimen example( GLUCOSE..UR )"
|
|---|
| 51 | S DIR("?",3)=" "
|
|---|
| 52 | D ^DIR K DIR
|
|---|
| 53 | I $D(DUOUT)!($D(DTOUT))!(Y=-1) K DTOUT,DUOUT S LREND=1 Q
|
|---|
| 54 | S LRCODE=+Y
|
|---|
| 55 | D DISPL
|
|---|
| 56 | Q
|
|---|
