| 1 | LRLNCV ;DALOI/CA-VALIDATE LOINC MAPPING ;18-JUL-2001
|
|---|
| 2 | ;;5.2;LAB SERVICE;**232,278**;Sep 27,1994
|
|---|
| 3 | ;
|
|---|
| 4 | ;=================================================================
|
|---|
| 5 | ; Ask VistA test in Lab Test file #60
|
|---|
| 6 | START ;entry point from option LR LOINC VALIDATE
|
|---|
| 7 | S LREND=0 D TEST
|
|---|
| 8 | I $G(LREND) G EXIT
|
|---|
| 9 | ;
|
|---|
| 10 | W !!,"NAME OF NLT CODE: ",$P(^LAM(LRNLT,0),U)
|
|---|
| 11 | W !,"NLT CODE: ",$P(^LAM(LRNLT,0),U,2) S LRNLTN=$P($G(^LAM(LRNLT,0)),U,2)
|
|---|
| 12 | S LRDEF=+$G(^LAM(LRNLT,9))
|
|---|
| 13 | I LRDEF W !,"DEFAULT LOINC CODE: ",$S(LRDEF:LRDEF_" "_$P(^LAB(95.3,LRDEF,80),U),1:"NONE")
|
|---|
| 14 | ASKSPEC ; Ask Specimen- Lookup in Specimen multiple in Lab Test file #60
|
|---|
| 15 | W !!
|
|---|
| 16 | LOOK61 K DIR,DA
|
|---|
| 17 | S DIR(0)="PO^61:EZMN",DIR("S")="I $P(^(0),U,9)"
|
|---|
| 18 | S DIR("A")="Select a Specimen source that has a LEDI HL7 code"
|
|---|
| 19 | S DIC("A")="Specimen source: "
|
|---|
| 20 | D ^DIR
|
|---|
| 21 | I $D(DUOUT)!($D(DTOUT))!(Y<1) G START
|
|---|
| 22 | S LRSPEC=+Y
|
|---|
| 23 | SUFFIX ;Set LRCDEF Value
|
|---|
| 24 | S LREND=0,DIC="^LRO(68.2,",DIC(0)="AQEM",DIC("A")="Work Load Area: ",DIC("S")="I $D(^(""SUF"")),+^(""SUF"")" D ^DIC S:Y<1 LREND=1 K DIC
|
|---|
| 25 | I $G(LREND) G START
|
|---|
| 26 | S LRCDEF=$P(^LRO(68.2,+Y,"SUF"),U,3)
|
|---|
| 27 | LOINC S LRMSG=1
|
|---|
| 28 | S LRLOINC=$$LNC^LRVER1(LRNLTN,LRCDEF,LRSPEC)
|
|---|
| 29 | I LRLOINC S LRLOINC=LRLOINC_"-"_$P($G(^LAB(95.3,LRLOINC,0)),U,15)
|
|---|
| 30 | I 'LRLOINC W !!,"TEST NOT MAPPED",!! D EXIT G START
|
|---|
| 31 | S LRDA=$P(LRMSGM,"-",2),LRDA=+$O(^LAM("C",LRDA,0))
|
|---|
| 32 | S LRDAN="Unknown code number"
|
|---|
| 33 | I $G(LRDA),$D(^LAM(LRDA,0)) S LRDAN=$P($G(^LAM(LRDA,0)),U)
|
|---|
| 34 | W !!,"LOINC Code: ",LRLOINC,!,$G(^LAB(95.3,+LRLOINC,80)),!
|
|---|
| 35 | W !,$$CJ^XLFSTR("LOINC code was located @ NLT CODE: "_LRDAN,IOM)
|
|---|
| 36 | W !,$$CJ^XLFSTR($P(LRMSGM,"-",2,99),IOM)
|
|---|
| 37 | D EXIT G START
|
|---|
| 38 | Q
|
|---|
| 39 | EXIT K DA,DIC,DIE,DINUM,DIR,DIRUT,DR,DTOUT,DUOUT,LREND,LRLOINC,LRIEN,LRMSG,LRNLT,LRSPEC,LRSPECN,LRSUF,LRTEST,S,Y
|
|---|
| 40 | K DD,DO,DLAYGO,LRDEF,X
|
|---|
| 41 | QUIT
|
|---|
| 42 | TEST W !!
|
|---|
| 43 | K DIR
|
|---|
| 44 | S DIR(0)="PO^60:QENMZ,",DIR("A")="VistA Lab Test"
|
|---|
| 45 | S DIR("?")="Select Lab test"
|
|---|
| 46 | D ^DIR K DIR
|
|---|
| 47 | I $D(DIRUT)!'Y K DIRUT S LREND=1 Q
|
|---|
| 48 | S LRIEN=+Y,LRTEST=$P(Y,U,2)
|
|---|
| 49 | ;Check for RESULT NLT CODE and if not one let enter
|
|---|
| 50 | I '$P($G(^LAB(60,+$G(LRIEN),64)),U,2) D
|
|---|
| 51 | .W $$CJ^XLFSTR("There is not a RESULT NLT CODE for "_LRTEST,IOM)
|
|---|
| 52 | .W $$CJ^XLFSTR("You MAY select one now to continue with the LOINC lookup",IOM),!
|
|---|
| 53 | K DIE,DR,DA S DA=LRIEN,DIE="^LAB(60,",DR=64.1
|
|---|
| 54 | D ^DIE
|
|---|
| 55 | I $D(DUOUT)!($D(DTOUT)) G START
|
|---|
| 56 | I '$P($G(^LAB(60,+$G(LRIEN),64)),U,2) D
|
|---|
| 57 | .S DIC=DIE,DR=0 W !! W ?5,"IEN: [",DA,"] ",$P(^LAB(60,LRIEN,0),U) S S=$Y D EN^LRDIQ W !
|
|---|
| 58 | W !
|
|---|
| 59 | S LRNLT=$P($G(^LAB(60,+$G(LRIEN),64)),U,2)
|
|---|
| 60 | I 'LRNLT G TEST
|
|---|
| 61 | Q
|
|---|
