LRLNC1.m

LRLNC1 ;VA/DALOI/CA-LOOKUP LOINC CODE ;1-OCT-1998

 ;;5.2;LAB SERVICE;**215,278,418**;NOV 01, 1997;Build 31

 ;Reference to ^DD supported by IA 10154

 ;=================================================================

 ; Ask VistA test to Lookup LOINC code in Lab Test file #60

 N LRLOINC

 W @IOF

START ;entry point from option LR LOINC LOOKUP

 D TEST

 I $G(LREND) G EXIT

 D SPEC

 I $G(LREND) D EXIT G START

 K DIC

ENT S DIC="^LAB(95.3,",DIC(0)="AEQMZ"

 S LRLOINC=$G(^LAB(60,LRIEN,1,LRSPEC,95.3))

 S:+LRLOINC DIC("B")=LRLOINC

 I '+LRLOINC D

 . S DIC("B")=LRTEST_".."_$G(LRSPECL)

 . S DIC("A")="LOINC Name..Specimen: "

 W !,$$CJ^XLFSTR(" Your initial lookup entry is ",IOM)

 W !,$$CJ^XLFSTR(LRTEST_".."_$G(LRSPECL),IOM)

 W !,$$CJ^XLFSTR("e.g. TEST NAME..SPECIMEN",IOM),!

 D ^DIC

 I $D(DIRUT) G START

 I Y=-1 W !!,"NO MATCHES FOUND" G START

 S LRCODE=+Y

 D DISPL

 G START

EXIT K DA,DIC,DIE,DINUM,DIR,DIRUT,DR,DTOUT,I,LRCODE,LRDATA,LREND,LRLNC,LRLNC0,LRLOINC,LRELEC,LRIEN,LRNLT,LRSPEC,LRSPECL,LRSPECN,LRTIME,LRTEST,LRUNITS,S,Y

 QUIT

TEST W !! K DIR,DIRUT

 S DIR(0)="PO^60:QNEMZ,",DIR("A")="VistA Lab Test to Lookup LOINC "

 S DIR("?")="Select Lab test you wish to lookup LOINC Code"

 D ^DIR K DIR

 I $D(DIRUT)!'Y K DIRUT S LREND=1 Q

 S LRIEN=+Y,LRTEST=$P(Y,U,2)

 Q

SPEC ; Ask Specimen- Lookup in Specimen multiple in Lab Test file #60

 K DA,DIC,DIE,DR

 S DA(1)=LRIEN

 S DIC="^LAB(60,"_LRIEN_",1,"

 S DIC(0)="AQEMZ"

 S DIC("A")="Specimen source: "

 S DIC("P")=$P(^DD(60.01,0),"^",2)

 D ^DIC

 I $D(DIRUT)!(Y=-1) K DIC,DA,DIRUT S LREND=1 Q

 S LRSPEC=+Y,LRSPECN=Y(0,0)

 ;Check to see if linked to file 64.061.  If not, then let enter link.

 I '$P($G(^LAB(61,LRSPEC,0)),U,9) D  Q

 .W !!,"There is not a LEDI HL7 code for "_LRSPECN,".",!

 S LRELEC=$P($G(^LAB(61,LRSPEC,0)),U,9)

 I 'LRELEC G SPEC

 S LRSPECL=$P(^LAB(64.061,LRELEC,0),U,2)

 Q

DISPL ;Show LOINC entry selected in file 95.3

 D DISPL^LRLNCC

 Q

LRLNC1    ;VA/DALOI/CA-LOOKUP LOINC CODE ;1-OCT-1998

 +1       ;;5.2;LAB SERVICE;**215,278,418**;NOV 01, 1997;Build 31

 +2       ;Reference to ^DD supported by IA 10154

 +3       ;=================================================================

 +4       ; Ask VistA test to Lookup LOINC code in Lab Test file #60

 +5        NEW LRLOINC

 +6        WRITE @IOF

START     ;entry point from option LR LOINC LOOKUP

 +1        DO TEST

 +2        IF $GET(LREND)

               GOTO EXIT

 +3        DO SPEC

 +4        IF $GET(LREND)

               DO EXIT

               GOTO START

 +5        KILL DIC

ENT        SET DIC="^LAB(95.3,"

           SET DIC(0)="AEQMZ"

 +1        SET LRLOINC=$GET(^LAB(60,LRIEN,1,LRSPEC,95.3))

 +2        IF +LRLOINC

               SET DIC("B")=LRLOINC

 +3        IF '+LRLOINC

               Begin DoDot:1

 +4                SET DIC("B")=LRTEST_".."_$GET(LRSPECL)

 +5                SET DIC("A")="LOINC Name..Specimen: "

               End DoDot:1

 +6        WRITE !,$$CJ^XLFSTR(" Your initial lookup entry is ",IOM)

 +7        WRITE !,$$CJ^XLFSTR(LRTEST_".."_$GET(LRSPECL),IOM)

 +8        WRITE !,$$CJ^XLFSTR("e.g. TEST NAME..SPECIMEN",IOM),!

 +9        DO ^DIC

 +10       IF $DATA(DIRUT)

               GOTO START

 +11       IF Y=-1

               WRITE !!,"NO MATCHES FOUND"

               GOTO START

 +12       SET LRCODE=+Y

 +13       DO DISPL

 +14       GOTO START

EXIT       KILL DA,DIC,DIE,DINUM,DIR,DIRUT,DR,DTOUT,I,LRCODE,LRDATA,LREND,LRLNC,LRLNC0,LRLOINC,LRELEC,LRIEN,LRNLT,LRSPEC,LRSPECL,LRSPECN,LRTIME,LRTEST,LRUNITS,S,Y

 +1        QUIT 

TEST       WRITE !!

           KILL DIR,DIRUT

 +1        SET DIR(0)="PO^60:QNEMZ,"

           SET DIR("A")="VistA Lab Test to Lookup LOINC "

 +2        SET DIR("?")="Select Lab test you wish to lookup LOINC Code"

 +3        DO ^DIR

           KILL DIR

 +4        IF $DATA(DIRUT)!'Y

               KILL DIRUT

               SET LREND=1

               QUIT 

 +5        SET LRIEN=+Y

           SET LRTEST=$PIECE(Y,U,2)

 +6        QUIT 

SPEC      ; Ask Specimen- Lookup in Specimen multiple in Lab Test file #60

 +1        KILL DA,DIC,DIE,DR

 +2        SET DA(1)=LRIEN

 +3        SET DIC="^LAB(60,"_LRIEN_",1,"

 +4        SET DIC(0)="AQEMZ"

 +5        SET DIC("A")="Specimen source: "

 +6        SET DIC("P")=$PIECE(^DD(60.01,0),"^",2)

 +7        DO ^DIC

 +8        IF $DATA(DIRUT)!(Y=-1)

               KILL DIC,DA,DIRUT

               SET LREND=1

               QUIT 

 +9        SET LRSPEC=+Y

           SET LRSPECN=Y(0,0)

 +10      ;Check to see if linked to file 64.061.  If not, then let enter link.

 +11       IF '$PIECE($GET(^LAB(61,LRSPEC,0)),U,9)

               Begin DoDot:1

 +12               WRITE !!,"There is not a LEDI HL7 code for "_LRSPECN,".",!

               End DoDot:1

               QUIT 

 +13       SET LRELEC=$PIECE($GET(^LAB(61,LRSPEC,0)),U,9)

 +14       IF 'LRELEC

               GOTO SPEC

 +15       SET LRSPECL=$PIECE(^LAB(64.061,LRELEC,0),U,2)

 +16       QUIT 

DISPL     ;Show LOINC entry selected in file 95.3

 +1        DO DISPL^LRLNCC

 +2        QUIT