source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRLNCV.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.4 KB
Line 
1LRLNCV ;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
6START ;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")
14ASKSPEC ; Ask Specimen- Lookup in Specimen multiple in Lab Test file #60
15 W !!
16LOOK61 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
23SUFFIX ;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)
27LOINC 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
39EXIT 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
42TEST 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
Note: See TracBrowser for help on using the repository browser.