Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRLNCX

LRLNCX.m

Go to the documentation of this file. 
  1. LRLNCX  ;DAL/OI/FS - ROUTINE TO EXTRACT VISTA TEST NAMES FOR LOINC MAPPING ; 1-FEB-2001; [Aug 06, 2010 ]
  1.  ;;5.2;LR;**1018,1028**;NOV 01, 1997;Build 46
  1.  ;;5.2;LAB SERVICE;**232,278**;Sep 27,1994
  1.  ;;
  1.  ; Field Separator = "|"
  1.  ;LR60 = IEN from ^LAB(60
  1.  ;LRSP = SPECIMEN pointer to ^LAB(61
  1.  ;LR60N = TEST NAME FOR ^LAB(60 - *? are translated to spaces for RELMA
  1.  ;LRSPN = SPECIMEN NAME - attempt to get LOINC Abbrv if linked
  1.  ;LRUNIT = REPORTING UNITS FROM ^LAB(60,IEN,1,LRSP,0)
  1.  ;1-70|WBC BLD K/cmm
  1.  ;Capture the output into a text file to import into Relma.
  1.  ;Remove 1st and last lines before importing into Relma
  1. EN ;
  1.  K ^TMP("LR LOINC",$J),LREND,LRAA
  1.  D MSG W !
  1.  G END:$G(LREND)
  1.  S LRFS="|",LR60=0,LR60N=""
  1.  G @LRANS
  1. 3 ;Selected all tests
  1. 2 ;Selected accession area - screen on LRAA(#)
  1.  D ASK G END:$G(LREND)
  1.  ;[LR*5.2*1028,MPW,08/09/10]Rewrite loop to go directly through File 60 rather than "B" cross-reference.
  1.  ;F  S LR60N=$O(^LAB(60,"B",LR60N)) Q:LR60N=""  D
  1.  ;S LR60=0 F  S LR60=$O(^LAB(60,"B",LR60N,LR60)) Q:LR60<1  D
  1.  ;Q:$G(^LAB(60,"B",LR60N,LR60))
  1.  ;I '$D(^LAB(60,LR60,0))#2 K ^LAB(60,"B",LR60N,LR60) Q
  1.  ;Q:$P(^LAB(60,LR60,0),U,3)="N"!($P(^(0),U,3)="")  D OUT
  1.  ;[LR*5.2*1028,MPW,08/09/10]Added next 6 lines.
  1.  S LR60=0
  1.  F  S LR60=$O(^LAB(60,LR60)) Q:LR60'=+LR60  D
  1.  .S LR60N=$P(^LAB(60,LR60,0),U,1)
  1.  .;skip inactive tests
  1.  .Q:$E(LR60N,1,2)="ZZ"!($E(LR60N,1,2)="zz")
  1.  .F I=1:1 Q:$E(LR60N,1)'="_"  S LR60N=$E(LR60N,2,$L(LR60N)) ;strip leading underscores from test name
  1.  .I $E(LR60N,1)="x" S LR60N=$E(LR60N,2,$L(LR60N)) ;strip leading 'x' on interface test name
  1.  .Q:$P(^LAB(60,LR60,0),U,3)="N"!($P(^(0),U,3)="")  D OUT
  1.  Q
  1. 1 ;create individual test list.
  1.  K ^TMP("LR LOINC",$J)
  1.  S ^TMP("LR LOINC",$J,0)=DT_U_DT_U_"LRLNCX TEST LIST"
  1.  K DIR
  1.  S DIR(0)="PO^60:NQEMZ"
  1.  S DIR("S")="I $L($P(^(0),U,3)),$P(^(0),U,3)'=""N"",$P($P(^(0),U,5),"";"",2)"
  1.  F  D ^DIR Q:Y<1  S ^TMP("LR LOINC",$J,Y(0,0)_+Y,0)=+Y_U_Y(0,0)
  1.  I $O(^TMP("LR LOINC",0))'="" D ASK G END:$G(LREND)
  1.  S LRNX=0
  1.  ;W !,$TR($$SITE^VASITE,U,"|")_"|"_$$FMTE^XLFDT($$NOW^XLFDT,1)
  1.  F  S LRNX=$O(^TMP("LR LOINC",$J,LRNX)) Q:LRNX=""  D
  1.  . S LR60=$G(^TMP("LR LOINC",$J,LRNX,0))
  1.  . Q:'$G(LR60)
  1.  . I $L($P(LR60,U,2)) S LR60N=$P(LR60,U,2),LR60=+LR60 D OUT
  1.  G END
  1.  Q
  1. OUT ;
  1.  I $G(LRAA) S LRNOP=1 D  Q:LRNOP
  1.  . S LR8=0 F  S LR8=$O(^LAB(60,LR60,8,LR8)) Q:LR8<1!('$G(LRNOP))  D
  1.  . . I $D(LRAA(+$P($G(^LAB(60,LR60,8,LR8,0)),U,2)))#2 S LRNOP=0
  1.  ;[LR*5.2*1028,MPW,08/09/10]Added next 1 line.
  1.  I '$D(^LAB(60,LR60,1)) S (LRSP,LRSPN,LRUNIT)="" D WRT Q
  1.  S LRSP=0 F  S LRSP=$O(^LAB(60,LR60,1,LRSP)) Q:LRSP<1  D
  1.  .;[LR*5.2*1028,MPW,08/06/10]S LRSP0=$G(^(LRSP,0)),LR61=$G(^LAB(61,LRSP,0)),LRUNIT=$P(LRSP0,U,7)
  1.  . S LRSP0=$G(^(LRSP,0)),LR61=$G(^LAB(61,LRSP,0)),LRUNIT=$P(LRSP0,U,7) I LRUNIT=+LRUNIT S LRUNIT=$P(^BLRUCUM(LRUNIT,0),U,1)
  1.  . ;[LR*5.2*1028;08/23/10;IHS/OIT/MPW]Added next 1 line to skip specimens already mapped
  1.  . Q:$G(^LAB(60,LR60,1,LRSP,95.3))'=""
  1.  . S LRSPN=$P(LR61,U),LR64061=$P(LR61,U,9),LRLSPN=$P(LR61,U,8)
  1.  . K LR64N I LR64061 S LR64N=$P($G(^LAB(64.061,LR64061,0)),U,2)
  1.  . S LRSPN=$S($D(LR64N):LR64N,$L(LRLSPN):LRLSPN,1:LRSPN)
  1.  . D WRT
  1.  Q
  1. WRT ;LR60N [test name] - translate "*" or "?" to spaces
  1.  ;[LR*5.2*1028,MPW,08/09/10]W !,$E(LR60_"-"_LRSP_LRFS_$TR(LR60N,"*?"," ")_" "_LRSPN_LRFS_LRUNIT,1,80)
  1.  W !,$E(LR60_$S(LRSP'="":"-",1:"")_LRSP_LRFS_$TR(LR60N,"*?"," ")_$S(LRSPN'="":" ",1:"")_LRSPN_LRFS_LRUNIT,1,80)
  1.  Q
  1. ASK ;
  1.  K DIR S DIR(0)="Y",DIR("A")="Ready to Capture"
  1.  D ^DIR S:$D(DIRUT) LREND=1
  1.  Q
  1. MSG ;
  1.  W @IOF
  1.  W !,"(NOTE) You should use the Add/Edit Topography Specimen HL7 Code"
  1.  W !,"[LR LOINC LEDI HL7 CODE] option before you proceed."
  1.  W !," -----    -----     -----     ----"
  1.  W !,"This option will create a Local Master Observation File (LMOF)"
  1.  W !,"from your local LABORATORY TEST (#60) file."
  1.  ;W !!,"Only 'CH' subscripted test having a dataname and having a type"
  1.  ;W !,"of 'BOTH', 'INPUT' or 'OUTPUT' will be extracted."
  1.  W !,"The LMOF file will use the vertical bar '|' as the field separator."
  1.  W !,"The 1st. field is the test internal number and internal number"
  1.  W !,"of the spec. (i.e. 1-72 will represent test 1 and specimen 72)."
  1.  W !,"The 2nd field contains |test name<SP>specimen."
  1.  W !,"The 3rd field is the reporting unit only (if any)."
  1.  W !!,"You will need to capture this printout into a text file."
  1.  W !,"Using a text editor, remove extraneous lines from the beginning"
  1.  W !,"and the end of the file so that only extracted test names remain."
  1.  W !,"Save the edited file. Use this file in the import function of the"
  1.  W !,"Regenstrief LOINC Mapping Assistant (RELMA)."
  1.  W !,"Consult the Regenstrief RELMA documentation for specifics."
  1.  K DIR S DIR(0)="E" D ^DIR S:$D(DIRUT) LREND=1 Q:$G(LREND)
  1. SEL ;Select method of extraction
  1.  K DIR,LRAA
  1.  S (LRANS,LREND)=0
  1.  S DIR(0)="SO^1:Individual single test;2:By Accession Area;3:All Test"
  1.  S DIR("A")="Select extraction criteria"
  1.  D ^DIR S:$D(DIRUT) LREND=1
  1.  I Y>0 S LRANS=Y
  1.  I LRANS=2 D
  1.  . K DIR
  1.  . S DIR(0)="PO^68:ENZM",DIR("A")="Select accession area "
  1.  . S DIR("S")="I $P(^(0),U,17)'=""S"""
  1.  . F  D ^DIR Q:Y<1  D
  1.  . . S LRAA=Y
  1.  . . S LRAA(+LRAA)=LRAA,DIR("A")="Select another accession area "
  1.  Q
  1. END ;
  1.  K DIR,DIRUT,LR60,LR60N,LR61,LR64061,LR64N,LR8,LRAA,LRANS,LREND,LRFS,LRLSPN,LRNOP,LRNX,LRSITE,LRSP,LRSP0,LRSPN,LRUNIT,Y
  1.  Q