| 1 | LRLNCMD ;DALOI/CA/FHS-MAP LAB TESTS TO DEFAULT LOINC CODES ;1-MAY-1999
|
|---|
| 2 | ;;5.2;LAB SERVICE;**232,278,280**;Sep 27,1994
|
|---|
| 3 | ;=================================================================
|
|---|
| 4 | ; Ask VistA test to map-Lookup in Lab Test file #60
|
|---|
| 5 | START ;entry point from option LR LOINC MAPPING
|
|---|
| 6 | Q:$D(LRDFONLY)
|
|---|
| 7 | S LREND=0 D TEST
|
|---|
| 8 | I $G(LREND) G EXIT
|
|---|
| 9 | I '$G(LRNLT) G START
|
|---|
| 10 | DEFAULT ;ENTRY POINT FROM LRLNC0
|
|---|
| 11 | W !
|
|---|
| 12 | S DIR(0)="Y",DIR("A")="Do you want to see possible LOINC code matches"
|
|---|
| 13 | S DIR("?")="Enter no if you already know the LOINC code."
|
|---|
| 14 | S DIR("B")="No"
|
|---|
| 15 | D ^DIR K DIR
|
|---|
| 16 | I $D(DIRUT),$G(LRLNC1) Q
|
|---|
| 17 | I $D(DIRUT) D EXIT G START
|
|---|
| 18 | I 'Y D ENTERLNC^LRLNCC
|
|---|
| 19 | I $G(LREND),$G(LRLNC1) K LREND Q
|
|---|
| 20 | I $G(LREND) D EXIT G START
|
|---|
| 21 | I '$G(LRCODE) D LOINC
|
|---|
| 22 | I $G(LRNO) D EXIT G START
|
|---|
| 23 | I $G(LREND),$G(LRLNC1) K LREND Q
|
|---|
| 24 | I $G(LREND) D EXIT G START
|
|---|
| 25 | I $G(LRNO) D ENTERLNC^LRLNCC
|
|---|
| 26 | I $G(LREND),$G(LRLNC1) K LREND Q
|
|---|
| 27 | I $G(LREND) D EXIT G START
|
|---|
| 28 | CORRECT W !!
|
|---|
| 29 | S DIR(0)="Y",DIR("A")="Is this the correct one"
|
|---|
| 30 | S DIR("B")="Yes"
|
|---|
| 31 | S DIR("?")="Enter no to select a different code."
|
|---|
| 32 | D ^DIR K DIR
|
|---|
| 33 | I $D(DIRUT)!($G(LREND)),$G(LRLNC1) K LREND Q
|
|---|
| 34 | I $D(DIRUT)!($G(LREND)) D EXIT G START
|
|---|
| 35 | I 'Y,$G(LRNO) D ENTERLNC^LRLNCC
|
|---|
| 36 | I 'Y,'$G(LRNO) D LOINC
|
|---|
| 37 | I $G(LRNO) D EXIT G START
|
|---|
| 38 | I $G(LREND),$G(LRLNC1) K LREND Q
|
|---|
| 39 | I $G(LREND) D EXIT G START
|
|---|
| 40 | D LINK
|
|---|
| 41 | I $G(LREND),$G(LRLNC1) K LREND Q
|
|---|
| 42 | I $G(LREND) D EXIT G START
|
|---|
| 43 | D CHECK
|
|---|
| 44 | I $G(LREND),$G(LRLNC1) K LREND Q
|
|---|
| 45 | I $G(LREND) D EXIT G START
|
|---|
| 46 | D MAP
|
|---|
| 47 | I $G(LRLNC1) K LRCODE Q
|
|---|
| 48 | D EXIT
|
|---|
| 49 | G START
|
|---|
| 50 | EXIT I $G(LRNLT) L -^LAM(LRNLT,9)
|
|---|
| 51 | 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
|
|---|
| 52 | K DD,DO,DLAYGO,LRLNCNAM,LRNO,X,LRNUM,LROLDCD
|
|---|
| 53 | QUIT
|
|---|
| 54 | TEST D TEST^LRLNC0
|
|---|
| 55 | Q
|
|---|
| 56 | LOINC ;Lookup possible LOINC matches in LAB LOINC file #95.3
|
|---|
| 57 | D FIND^DIC(95.3,"","80","M",LRTEST,"","","I '$G(^(4))","","LRLOINC","")
|
|---|
| 58 | CODE ;ask which code to map
|
|---|
| 59 | I +LRLOINC("DILIST",0)=0 D Q
|
|---|
| 60 | .W !!,"No matches found."
|
|---|
| 61 | .S LRNO=1
|
|---|
| 62 | W ! S I=0
|
|---|
| 63 | F S I=$O(LRLOINC("DILIST","ID",I)) Q:'I!$G(LREND) D
|
|---|
| 64 | .I $E(IOST,1,2)="C-",'(I#18) D Q:$G(LREND)
|
|---|
| 65 | ..S DIR(0)="E" D ^DIR
|
|---|
| 66 | ..S:$S($G(DIRUT):1,$G(DUOUT):1,1:0) LREND=1
|
|---|
| 67 | .W !,I,":",LRLOINC("DILIST","ID",I,80)
|
|---|
| 68 | K DIRUT,DUOUT
|
|---|
| 69 | W !!
|
|---|
| 70 | S DIR(0)="N^1:"_$S($G(LREND):I-2,1:$P(LRLOINC("DILIST",0),U),1:0)
|
|---|
| 71 | S DIR("A")="LOINC code to map this test"
|
|---|
| 72 | D ^DIR K DIR,LREND
|
|---|
| 73 | I $D(DIRUT) S LREND=1 Q
|
|---|
| 74 | S LRCODE=LRLOINC("DILIST",1,+Y)
|
|---|
| 75 | D DISPL^LRLNCC
|
|---|
| 76 | Q
|
|---|
| 77 | LINK ;Link the code with file 64
|
|---|
| 78 | S LRNLT=+$P(^LAM(LRNLT,0),U,2)
|
|---|
| 79 | LR64 ;
|
|---|
| 80 | K DIC,DA
|
|---|
| 81 | W !!
|
|---|
| 82 | S DIC=64,DIC(0)="ENMZ",X=LRNLT
|
|---|
| 83 | D ^DIC
|
|---|
| 84 | I Y=-1!($D(DTOUT))!($D(DUOUT)) K DTOUT,DUOUT S LREND=1 Q
|
|---|
| 85 | S LRNLT=+Y
|
|---|
| 86 | Q
|
|---|
| 87 | CHECK ;Check to see if already mapped to a LOINC code
|
|---|
| 88 | Q:'$P($G(^LAM(LRNLT,9)),U)
|
|---|
| 89 | D SHOWPRE
|
|---|
| 90 | I $D(DIRUT)!'Y S LREND=1 Q
|
|---|
| 91 | ;DELETE EXISTING DEFAULT MAPPING
|
|---|
| 92 | S DA=LRNLT
|
|---|
| 93 | S DIE="^LAM(",DR="25////@"
|
|---|
| 94 | D ^DIE
|
|---|
| 95 | K DA,DIE
|
|---|
| 96 | Q
|
|---|
| 97 | MAP ;DIE call to add DEFAULT LOINC CODE
|
|---|
| 98 | I '$D(LRDFONLY) S LRDATA=$P(^LAB(60,LRIEN,0),U,12) ;DATA NAME
|
|---|
| 99 | I '$L(LRDATA) S LRDATA=$P(^LAB(60,LRIEN,0),U,4)
|
|---|
| 100 | S LRTIME=$P(^LAB(95.3,LRCODE,0),U,7) ;TIME ASPECT
|
|---|
| 101 | S LRUNITS=$P(^LAB(95.3,LRCODE,0),U,14) ;UNITS
|
|---|
| 102 | L +^LAM(LRNLT):1 I '$T W !,"Another user is editing this record!!" H 5 Q
|
|---|
| 103 | S DIE="^LAM(",DA=LRNLT,DR="25////"_LRCODE_";25.2////"_LRTIME_";25.3////"_LRUNITS_";25.4////"_LRDATA_";25.5////"_$S($D(LRDFONLY):"@",1:LRIEN)
|
|---|
| 104 | D ^DIE
|
|---|
| 105 | L -^LAM(LRNLT)
|
|---|
| 106 | MAP2 ;HERE SHOW WHAT WAS MAPPED
|
|---|
| 107 | Q:'$D(^LAM(+$G(LRNLT),0))#2
|
|---|
| 108 | W !!
|
|---|
| 109 | W !,"NLT: ",$P($G(^LAM(LRNLT,0)),U)
|
|---|
| 110 | W !,"WKLD CODE: ",$P($G(^LAM(LRNLT,0)),U,2)
|
|---|
| 111 | K DIC,DR
|
|---|
| 112 | S DIC="^LAM(",DA=LRNLT
|
|---|
| 113 | S S=$Y
|
|---|
| 114 | D EN^DIQ
|
|---|
| 115 | Q
|
|---|
| 116 | SHOWPRE ;DISPLAY LOINC CODE ALREADY MAPPED TO NLT
|
|---|
| 117 | S LROLDCD=$P(^LAM(LRNLT,9),U)
|
|---|
| 118 | W !!,"This test is already mapped to:"
|
|---|
| 119 | W !,"Default LOINC code: ",LROLDCD_"-"_$P(^LAB(95.3,+$G(LROLDCD),0),U,15)," ",$G(^LAB(95.3,LROLDCD,80))
|
|---|
| 120 | W !!
|
|---|
| 121 | S DIR(0)="Y",DIR("A")="Do you want to "_$S($D(LRDEL):"delete",1:"change")_" this default mapping",DIR("B")="NO"
|
|---|
| 122 | S:'$D(LRDEL) DIR("?")="If you enter yes, the current default LOINC code will be overwritten with the default LOINC code that you have chosen."
|
|---|
| 123 | S:$D(LRDEL) DIR("?")="If you enter yes, the current default LOINC code will be deleted."
|
|---|
| 124 | D ^DIR K DIR
|
|---|
| 125 | Q
|
|---|
| 126 | DELETE ;DELETE/UNMAP DEFAULT LOINC CODE
|
|---|
| 127 | S LREND=0,LRDEL=1 D TEST
|
|---|
| 128 | I $G(LREND) G EXIT
|
|---|
| 129 | D CHECK
|
|---|
| 130 | K LRDEL
|
|---|
| 131 | G EXIT
|
|---|
| 132 | Q
|
|---|
| 133 | Q
|
|---|
