62 lines
2.4 KiB
Mathematica
62 lines
2.4 KiB
Mathematica
LRLNCV ;DALOI/CA-VALIDATE LOINC MAPPING ;18-JUL-2001
|
|
;;5.2;LAB SERVICE;**232,278**;Sep 27,1994
|
|
;
|
|
;=================================================================
|
|
; Ask VistA test in Lab Test file #60
|
|
START ;entry point from option LR LOINC VALIDATE
|
|
S LREND=0 D TEST
|
|
I $G(LREND) G EXIT
|
|
;
|
|
W !!,"NAME OF NLT CODE: ",$P(^LAM(LRNLT,0),U)
|
|
W !,"NLT CODE: ",$P(^LAM(LRNLT,0),U,2) S LRNLTN=$P($G(^LAM(LRNLT,0)),U,2)
|
|
S LRDEF=+$G(^LAM(LRNLT,9))
|
|
I LRDEF W !,"DEFAULT LOINC CODE: ",$S(LRDEF:LRDEF_" "_$P(^LAB(95.3,LRDEF,80),U),1:"NONE")
|
|
ASKSPEC ; Ask Specimen- Lookup in Specimen multiple in Lab Test file #60
|
|
W !!
|
|
LOOK61 K DIR,DA
|
|
S DIR(0)="PO^61:EZMN",DIR("S")="I $P(^(0),U,9)"
|
|
S DIR("A")="Select a Specimen source that has a LEDI HL7 code"
|
|
S DIC("A")="Specimen source: "
|
|
D ^DIR
|
|
I $D(DUOUT)!($D(DTOUT))!(Y<1) G START
|
|
S LRSPEC=+Y
|
|
SUFFIX ;Set LRCDEF Value
|
|
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
|
|
I $G(LREND) G START
|
|
S LRCDEF=$P(^LRO(68.2,+Y,"SUF"),U,3)
|
|
LOINC S LRMSG=1
|
|
S LRLOINC=$$LNC^LRVER1(LRNLTN,LRCDEF,LRSPEC)
|
|
I LRLOINC S LRLOINC=LRLOINC_"-"_$P($G(^LAB(95.3,LRLOINC,0)),U,15)
|
|
I 'LRLOINC W !!,"TEST NOT MAPPED",!! D EXIT G START
|
|
S LRDA=$P(LRMSGM,"-",2),LRDA=+$O(^LAM("C",LRDA,0))
|
|
S LRDAN="Unknown code number"
|
|
I $G(LRDA),$D(^LAM(LRDA,0)) S LRDAN=$P($G(^LAM(LRDA,0)),U)
|
|
W !!,"LOINC Code: ",LRLOINC,!,$G(^LAB(95.3,+LRLOINC,80)),!
|
|
W !,$$CJ^XLFSTR("LOINC code was located @ NLT CODE: "_LRDAN,IOM)
|
|
W !,$$CJ^XLFSTR($P(LRMSGM,"-",2,99),IOM)
|
|
D EXIT G START
|
|
Q
|
|
EXIT K DA,DIC,DIE,DINUM,DIR,DIRUT,DR,DTOUT,DUOUT,LREND,LRLOINC,LRIEN,LRMSG,LRNLT,LRSPEC,LRSPECN,LRSUF,LRTEST,S,Y
|
|
K DD,DO,DLAYGO,LRDEF,X
|
|
QUIT
|
|
TEST W !!
|
|
K DIR
|
|
S DIR(0)="PO^60:QENMZ,",DIR("A")="VistA Lab Test"
|
|
S DIR("?")="Select Lab test"
|
|
D ^DIR K DIR
|
|
I $D(DIRUT)!'Y K DIRUT S LREND=1 Q
|
|
S LRIEN=+Y,LRTEST=$P(Y,U,2)
|
|
;Check for RESULT NLT CODE and if not one let enter
|
|
I '$P($G(^LAB(60,+$G(LRIEN),64)),U,2) D
|
|
.W $$CJ^XLFSTR("There is not a RESULT NLT CODE for "_LRTEST,IOM)
|
|
.W $$CJ^XLFSTR("You MAY select one now to continue with the LOINC lookup",IOM),!
|
|
K DIE,DR,DA S DA=LRIEN,DIE="^LAB(60,",DR=64.1
|
|
D ^DIE
|
|
I $D(DUOUT)!($D(DTOUT)) G START
|
|
I '$P($G(^LAB(60,+$G(LRIEN),64)),U,2) D
|
|
.S DIC=DIE,DR=0 W !! W ?5,"IEN: [",DA,"] ",$P(^LAB(60,LRIEN,0),U) S S=$Y D EN^LRDIQ W !
|
|
W !
|
|
S LRNLT=$P($G(^LAB(60,+$G(LRIEN),64)),U,2)
|
|
I 'LRNLT G TEST
|
|
Q
|