| [613] | 1 | LRLNCX ;DALOI/FS- ROUTINE TO EXTRACT VISTA TEST NAMES FOR LOINC MAPPING;1-FEB-2001
|
|---|
| 2 | ;;5.2;LAB SERVICE;**232,278**;Sep 27,1994
|
|---|
| 3 | ;;
|
|---|
| 4 | ; Field Separator = "|"
|
|---|
| 5 | ;LR60 = IEN from ^LAB(60
|
|---|
| 6 | ;LRSP = SPECIMEN pointer to ^LAB(61
|
|---|
| 7 | ;LR60N = TEST NAME FOR ^LAB(60 - *? are translated to spaces for RELMA
|
|---|
| 8 | ;LRSPN = SPECIMEN NAME - attempt to get LOINC Abbrv if linked
|
|---|
| 9 | ;LRUNIT = REPORTING UNITS FROM ^LAB(60,IEN,1,LRSP,0)
|
|---|
| 10 | ;1-70|WBC BLD K/cmm
|
|---|
| 11 | ;Capture the output into a text file to import into Relma.
|
|---|
| 12 | ;Remove 1st and last lines before importing into Relma
|
|---|
| 13 | EN ;
|
|---|
| 14 | K ^TMP("LR LOINC",$J),LREND,LRAA
|
|---|
| 15 | D MSG W !
|
|---|
| 16 | G END:$G(LREND)
|
|---|
| 17 | S LRFS="|",LR60=0,LR60N=""
|
|---|
| 18 | G @LRANS
|
|---|
| 19 | 3 ;Selected all tests
|
|---|
| 20 | 2 ;Selected accession area - screen on LRAA(#)
|
|---|
| 21 | D ASK G END:$G(LREND)
|
|---|
| 22 | F S LR60N=$O(^LAB(60,"B",LR60N)) Q:LR60N="" D
|
|---|
| 23 | . S LR60=0 F S LR60=$O(^LAB(60,"B",LR60N,LR60)) Q:LR60<1 D
|
|---|
| 24 | . . Q:$G(^LAB(60,"B",LR60N,LR60))
|
|---|
| 25 | . . I '$D(^LAB(60,LR60,0))#2 K ^LAB(60,"B",LR60N,LR60) Q
|
|---|
| 26 | . . Q:$P(^LAB(60,LR60,0),U,3)="N"!($P(^(0),U,3)="") D OUT
|
|---|
| 27 | Q
|
|---|
| 28 | 1 ;create individual test list.
|
|---|
| 29 | K ^TMP("LR LOINC",$J)
|
|---|
| 30 | S ^TMP("LR LOINC",$J,0)=DT_U_DT_U_"LRLNCX TEST LIST"
|
|---|
| 31 | K DIR
|
|---|
| 32 | S DIR(0)="PO^60:NQEMZ"
|
|---|
| 33 | S DIR("S")="I $L($P(^(0),U,3)),$P(^(0),U,3)'=""N"",$P($P(^(0),U,5),"";"",2)"
|
|---|
| 34 | F D ^DIR Q:Y<1 S ^TMP("LR LOINC",$J,Y(0,0)_+Y,0)=+Y_U_Y(0,0)
|
|---|
| 35 | I $O(^TMP("LR LOINC",0))'="" D ASK G END:$G(LREND)
|
|---|
| 36 | S LRNX=0
|
|---|
| 37 | ;W !,$TR($$SITE^VASITE,U,"|")_"|"_$$FMTE^XLFDT($$NOW^XLFDT,1)
|
|---|
| 38 | F S LRNX=$O(^TMP("LR LOINC",$J,LRNX)) Q:LRNX="" D
|
|---|
| 39 | . S LR60=$G(^TMP("LR LOINC",$J,LRNX,0))
|
|---|
| 40 | . Q:'$G(LR60)
|
|---|
| 41 | . I $L($P(LR60,U,2)) S LR60N=$P(LR60,U,2),LR60=+LR60 D OUT
|
|---|
| 42 | G END
|
|---|
| 43 | Q
|
|---|
| 44 | OUT ;
|
|---|
| 45 | I $G(LRAA) S LRNOP=1 D Q:LRNOP
|
|---|
| 46 | . S LR8=0 F S LR8=$O(^LAB(60,LR60,8,LR8)) Q:LR8<1!('$G(LRNOP)) D
|
|---|
| 47 | . . I $D(LRAA(+$P($G(^LAB(60,LR60,8,LR8,0)),U,2)))#2 S LRNOP=0
|
|---|
| 48 | S LRSP=0 F S LRSP=$O(^LAB(60,LR60,1,LRSP)) Q:LRSP<1 D
|
|---|
| 49 | . S LRSP0=$G(^(LRSP,0)),LR61=$G(^LAB(61,LRSP,0)),LRUNIT=$P(LRSP0,U,7)
|
|---|
| 50 | . S LRSPN=$P(LR61,U),LR64061=$P(LR61,U,9),LRLSPN=$P(LR61,U,8)
|
|---|
| 51 | . K LR64N I LR64061 S LR64N=$P($G(^LAB(64.061,LR64061,0)),U,2)
|
|---|
| 52 | . S LRSPN=$S($D(LR64N):LR64N,$L(LRLSPN):LRLSPN,1:LRSPN)
|
|---|
| 53 | . D WRT
|
|---|
| 54 | Q
|
|---|
| 55 | WRT ;LR60N [test name] - translate "*" or "?" to spaces
|
|---|
| 56 | W !,$E(LR60_"-"_LRSP_LRFS_$TR(LR60N,"*?"," ")_" "_LRSPN_LRFS_LRUNIT,1,80)
|
|---|
| 57 | Q
|
|---|
| 58 | ASK ;
|
|---|
| 59 | K DIR S DIR(0)="Y",DIR("A")="Ready to Capture"
|
|---|
| 60 | D ^DIR S:$D(DIRUT) LREND=1
|
|---|
| 61 | Q
|
|---|
| 62 | MSG ;
|
|---|
| 63 | W @IOF
|
|---|
| 64 | W !,"(NOTE) You should use the Add/Edit Topography Specimen HL7 Code"
|
|---|
| 65 | W !,"[LR LOINC LEDI HL7 CODE] option before you proceed."
|
|---|
| 66 | W !," ----- ----- ----- ----"
|
|---|
| 67 | W !,"This option will create a Local Master Observation File (LMOF)"
|
|---|
| 68 | W !,"from your local LABORATORY TEST (#60) file."
|
|---|
| 69 | W !!,"Only 'CH' subscripted test having a dataname and having a type"
|
|---|
| 70 | W !,"of 'BOTH', 'INPUT' or 'OUTPUT' will be extracted."
|
|---|
| 71 | W !,"The LMOF file will use the vertical bar '|' as the field separator."
|
|---|
| 72 | W !,"The 1st. field is the test internal number and internal number"
|
|---|
| 73 | W !,"of the spec. (i.e. 1-72 will represent test 1 and specimen 72)."
|
|---|
| 74 | W !,"The 2nd field contains |test name<SP>specimen."
|
|---|
| 75 | W !,"The 3rd field is the reporting unit only (if any)."
|
|---|
| 76 | W !!,"You will need to capture this printout into a text file."
|
|---|
| 77 | W !,"Using a text editor, remove extraneous lines from the beginning"
|
|---|
| 78 | W !,"and the end of the file so that only extracted test names remain."
|
|---|
| 79 | W !,"Save the edited file. Use this file in the import function of the"
|
|---|
| 80 | W !,"Regenstrief LOINC Mapping Assistant (RELMA)."
|
|---|
| 81 | W !,"Consult the Regenstrief RELMA documentation for specifics."
|
|---|
| 82 | K DIR S DIR(0)="E" D ^DIR S:$D(DIRUT) LREND=1 Q:$G(LREND)
|
|---|
| 83 | SEL ;Select method of extraction
|
|---|
| 84 | K DIR,LRAA
|
|---|
| 85 | S (LRANS,LREND)=0
|
|---|
| 86 | S DIR(0)="SO^1:Individual single test;2:By Accession Area;3:All Test"
|
|---|
| 87 | S DIR("A")="Select extraction criteria"
|
|---|
| 88 | D ^DIR S:$D(DIRUT) LREND=1
|
|---|
| 89 | I Y>0 S LRANS=Y
|
|---|
| 90 | I LRANS=2 D
|
|---|
| 91 | . K DIR
|
|---|
| 92 | . S DIR(0)="PO^68:ENZM",DIR("A")="Select accession area "
|
|---|
| 93 | . S DIR("S")="I $P(^(0),U,17)'=""S"""
|
|---|
| 94 | . F D ^DIR Q:Y<1 D
|
|---|
| 95 | . . S LRAA=Y
|
|---|
| 96 | . . S LRAA(+LRAA)=LRAA,DIR("A")="Select another accession area "
|
|---|
| 97 | Q
|
|---|
| 98 | END ;
|
|---|
| 99 | K DIR,DIRUT,LR60,LR60N,LR61,LR64061,LR64N,LR8,LRAA,LRANS,LREND,LRFS,LRLSPN,LRNOP,LRNX,LRSITE,LRSP,LRSP0,LRSPN,LRUNIT,Y
|
|---|
| 100 | Q
|
|---|
