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

LRSRVR2.m

Go to the documentation of this file. 
  1. LRSRVR2 ;DALIO/FHS - LAB DATA SERVER CONT'D RELMA EXTRACT ; Jan 9, 2006
  1.  ;;5.2;LAB SERVICE;**303,346**;Sep 27, 1994;Build 10
  1.  ; Produces LOINC RELMA extract - via LRLABSERVER or option
  1.  ;
  1. EN ; Called by option [LR LOINC EXTRACT RELMA FORMAT]
  1.  ; Entry point for the option - user must capture output
  1.  N DIR,DIRUT,LREND,LRCNT,LRSUB,LRVAL,LRST,LRSTN,LRTXT,X,Y
  1.  S DIR(0)="Y",DIR("A")="Ready to Capture",DIR("B")="Yes"
  1.  D ^DIR
  1.  I $D(DIRUT) Q
  1.  D WAIT^DICD
  1.  S LRSUB="RELMA",LRTXT=1
  1.  D BUILD
  1.  W !
  1.  S LRL=0
  1.  F  S LRL=$O(^TMP($J,"LRDATA",LRL)) Q:LRL<1  W !,^(LRL)
  1.  D CLEAN^LRSRVR2A
  1.  Q
  1.  ;
  1.  ;
  1. SERVER ; Server entry Point
  1.  N I,LRCNT,LREND,LRL,LRMSUBJ,LRTXT,LRX,LRY
  1.  S LRTXT=0
  1.  D BUILD
  1.  S LRMSUBJ=LRST_" "_LRSTN_" RELMA EXTRACT "_$$HTE^XLFDT($H,"1M")
  1.  D MAILSEND^LRSRVR6(LRMSUBJ)
  1.  D CLEAN^LRSRVR2A
  1.  Q
  1.  ;
  1.  ;
  1. BUILD ; Build extract
  1.  N I,LR6206,LR64,LRCNT,LRCRLF,LRLEN,LRQUIT,LRROOT,LRSTNOTE,LRSS,LRSTR,LRSTUB,LRVAL
  1.  S LRVAL=$$SITE^VASITE,LRST=$P(LRVAL,"^",3),LRSTN=$P(LRVAL,"^",2)
  1.  I LRST="" S LRST="???"
  1.  K ^TMP($J,"LRDATA"),^TMP($J,"LR60")
  1.  S LRCNT=0,LRCRLF=$C(13,10),LRSTR=""
  1.  F I=0,1,2,3 S LRCNT(I)=0
  1.  D HDR^LRSRVR2A
  1.  ;
  1.  ; Step down the B X-ref - exclude synomyms
  1.  S LRROOT="^LAB(60,""B"")"
  1.  F  S LRROOT=$Q(@LRROOT) Q:LRROOT=""  Q:$QS(LRROOT,2)'="B"  D
  1.  . Q:$G(@LRROOT)
  1.  . D TEST
  1.  ;
  1.  ; Process microbiology antibiotics
  1.  S LR6206=0,LRSS="MI"
  1.  F  S LR6206=$O(^LAB(62.06,LR6206)) Q:'LR6206  D
  1.  . S LR64=$$GET1^DIQ(62.06,LR6206_",",64,"I")
  1.  . S LRX=$$MICRO^LRSRVR3(LR64)
  1.  . S LRSTUB=$P(LRX,"|",5)_"||||"_$P(LRX,"|",3)_"|"_$P(LRX,"|",1)_"|||"_$P(LRX,"|",20)_"|"_$P(LRX,"|",19)_"|||||||||||"
  1.  . I LR64 S LRSTUB=LRSTUB_$$GET1^DIQ(64,LR64_",",25)
  1.  . S LRSTUB=LRSTUB_"|1.1|" ; Set extract version number
  1.  . S LRSTR=LRSTR_LRST_"-"_LR64_"-"_"AB"_LR6206_"|"_LRSTUB
  1.  . I 'LRTXT S LRSTR=LRSTR_LRCRLF
  1.  . D SETDATA S LRCNT=LRCNT+1,LRCNT(3)=LRCNT(3)+1
  1.  ;
  1.  ; Set the final info into the ^TMP message global
  1.  I 'LRTXT D
  1.  . S LRNODE=$O(^TMP($J,"LRDATA",""),-1)
  1.  . I LRSTR'="" S LRNODE=LRNODE+1,^TMP($J,"LRDATA",LRNODE)=$$UUEN^LRSRVR4(LRSTR)
  1.  . S ^TMP($J,"LRDATA",LRNODE+1)=" "
  1.  . S ^TMP($J,"LRDATA",LRNODE+2)="end"
  1.  ;
  1.  S ^TMP($J,"LRDATA",6)="Total number of records: "_$J(LRCNT,5)
  1.  S ^TMP($J,"LRDATA",7)="Total number of tests..: "_$J(LRCNT(0),5)
  1.  S ^TMP($J,"LRDATA",8)="Tests with LOINC code..: "_$J(LRCNT(1),5)
  1.  S ^TMP($J,"LRDATA",9)="Tests with NLT code....: "_$J(LRCNT(2),5)
  1.  S ^TMP($J,"LRDATA",10)="Antimicrobials.........: "_$J(LRCNT(3),5)
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. TEST ; Pull out test info
  1.  N LA7TREE,LR60,LRBATTY,LRBATTYN,LRTSTTYP
  1.  K LROUT,LRSPEC,ERR
  1.  S LR60NM=$QS(LRROOT,3),LR60IEN=$QS(LRROOT,4)
  1.  S LR60NM=$$TRIM^XLFSTR(LR60NM,"RL"," ")
  1.  S LRTSTTYP=$P(^LAB(60,LR60IEN,0),"^",3)
  1.  ;
  1.  ; Bypass "neither" type tests.
  1.  I LRTSTTYP="N" Q
  1.  ; Bypass "workload" type tests.
  1.  I $P(^LAB(60,LR60IEN,0),"^",4)="WK" Q
  1.  ;
  1.  S LRBATTY=LRST_"-"_LR60IEN,LRBATTYN=LR60NM
  1.  S LRBATTY=$$TRIM^XLFSTR(LRBATTY,"RL"," ")
  1.  ; Panel test
  1.  ; Bypass "output panel" type tests - usually used for display only.
  1.  I $O(^LAB(60,LR60IEN,2,0)) D  Q
  1.  . I $P(^LAB(60,LR60IEN,0),"^",3)="O" Q
  1.  . D UNWIND^LA7ADL1(LR60IEN,9,0)
  1.  . S LR60=0
  1.  . F  S LR60=$O(LA7TREE(LR60)) Q:'LR60  D
  1.  . . I $D(^TMP($J,"LR60",LR60)) Q
  1.  . . S LR60IEN=LR60,LR60NM=$P(^LAB(60,LR60IEN,0),"^")
  1.  . . S LRTSTTYP=$P(^LAB(60,LR60IEN,0),"^",3)
  1.  . . ; Bypass "neither" type tests.
  1.  . . I LRTSTTYP="N" Q
  1.  . . ; Bypass "workload" type tests.
  1.  . . I $P(^LAB(60,LR60IEN,0),"^",4)="WK" Q
  1.  . . S LRR64=+$P($G(^LAB(60,+LR60IEN,64)),U,2)
  1.  . . D SPEC
  1.  ;
  1.  I $D(^TMP($J,"LR60",LR60IEN)) Q
  1.  ; Not a panel test
  1.  ; Get result NLT code
  1.  S LRR64=+$P($G(^LAB(60,+LR60IEN,64)),U,2)
  1.  D SPEC
  1.  Q
  1.  ;
  1.  ;
  1. SPEC ; Check each specimen for this test
  1.  K LRSPEC,LROUT
  1.  S (LRCDEF,LRSPEC,LRSPECN,LRLNC,LRLNCN,LRLNCX,LRLNC80,LRUNIT,Y)=""
  1.  D SITENOTE^LRSRVR2A
  1.  D SYNNOTE^LRSRVR2A
  1.  S LRSPEC60=0
  1.  F  S LRSPEC60=$O(^LAB(60,+LR60IEN,1,LRSPEC60)) Q:'LRSPEC60  D
  1.  . Q:'($D(^LAB(60,+LR60IEN,1,LRSPEC60,0))#2)
  1.  . S LRUNIT=$P(^LAB(60,+LR60IEN,1,LRSPEC60,0),U,7)
  1.  . S X=$G(^LAB(61,LRSPEC60,0))
  1.  . S LRSPECN=$P(X,"^"),LRSPECTA=$P(X,"^",10)
  1.  . S LRSPEC(LRSPEC60_"-0")=LRSPEC60_U_LRSPECN_U_LRSPECTA_U_LRUNIT_U_LRR64
  1.  . I LRR64,$P($$GET1^DIQ(64,LRR64_",",1,"E"),".",2)="0000" D SUFFIX^LRSRVR2A
  1.  D SPECLOOP
  1.  Q
  1.  ;
  1.  ;
  1. SPECLOOP ; Check to see if specimen has been linked to LOINC
  1.  ;
  1.  N LR64,LR6421,LRINDX,LRLNTA,LRRNLT,LRTA,LRX,X
  1.  S LRINDX=0
  1.  F  S LRINDX=$O(LRSPEC(LRINDX)) Q:'LRINDX  D
  1.  . S X=LRSPEC(LRINDX)
  1.  . S LRSPEC=$P(X,U),LRSPECN=$P(X,U,2),LRLNTA=$P(X,U,3),LR64=$P(X,U,5),LRUNIT=$$TRIM^XLFSTR($P(X,U,4),"RL"," ")
  1.  . S (LR6421,LRLNC,LRRNLT,LRTA)=""
  1.  . I LR64 D
  1.  . . S LRRNLT=$$GET1^DIQ(64,LR64_",",1,"E")
  1.  . . S LR6421=$$GET1^DIQ(64,LR64_",",13,"I")
  1.  . . S LRX=""
  1.  . . I LRSPEC,LRLNTA S LRX=$P($G(^LAM(LR64,5,LRSPEC,1,LRLNTA,1)),"^")
  1.  . . I LRX="",LRSPEC D
  1.  . . . S X=$O(^LAM(LR64,5,LRSPEC,1,0))
  1.  . . . I X S LRLNTA=X,LRX=$P($G(^LAM(LR64,5,LRSPEC,1,X,1)),"^")
  1.  . . I LRX'="" S LRLNC=$$GET1^DIQ(95.3,LRX_",",.01,"E")
  1.  . . I LRLNTA S LRTA=$$GET1^DIQ(64.061,LRLNTA_",",.01,"E")
  1.  . D WRT
  1.  Q
  1.  ;
  1.  ;
  1. WRT ; Set ^TMP( with extracted data
  1.  N LRJ,LREN,LRQUIT,LRSS,X,Y
  1.  ;
  1.  ; Set flag that this file #60 test has been processed - avoid duplicate
  1.  ; processing as component of panel and individual test
  1.  S ^TMP($J,"LR60",LR60IEN)=""
  1.  ;
  1.  S LRSTR=LRSTR_LRST_"-"_LR60IEN_"-"_LRINDX
  1.  S LRSTR=LRSTR_"|"_LR60NM_"|"_LRSPECN_"|"_LRTA_"|"_LRUNIT_"|"_LRLNC_"|"_LRRNLT_"|"_LRBATTY_"|"_LRBATTYN_"|"
  1.  ;
  1.  ; Lab section specified for this NLT code.
  1.  S LRSTR=LRSTR_$S($G(LR6421)>0:$$GET1^DIQ(64.21,LR6421_",",1),1:"")_"|"
  1.  ;
  1.  ; Subscript
  1.  S LRSS=$$GET1^DIQ(60,LR60IEN_",",4,"I")
  1.  S LRSTR=LRSTR_LRSS_"|"
  1.  ; Test info - data type, help prompt
  1.  I LRSS'="CH" S LRSTR=LRSTR_"||"
  1.  I LRSS="CH" S X=$$TSTTYP^LRSRVR3($$GET1^DIQ(60,LR60IEN_",",13)) S LRSTR=LRSTR_$P(X,"|")_"|"_$P(X,"|",2)_"|"
  1.  ;
  1.  ; Test reference low|reference high|therapeutic low|therapeutic high|
  1.  S X=$G(^LAB(60,LR60IEN,1,LRSPEC,0))
  1.  S Y=$P(X,"^",2)_"|"_$P(X,"^",3)_"|"_$P(X,"^",11)_"|"_$P(X,"^",12)
  1.  S LRSTR=LRSTR_$TR(Y,$C(34),"")
  1.  ; Use for reference lab testing
  1.  S X=$G(^LAB(60,LR60IEN,1,LRSPEC,.1))
  1.  S LRSTR=LRSTR_"|"_$S($P(X,"^")=1:"YES",1:"NO")_"|"
  1.  ; 
  1.  ; Send site's test notes on first record for this test.
  1.  I LRSTNOTE D
  1.  . D SETDATA
  1.  . S LRJ="LRSTNOTE"
  1.  . F  S LRJ=$Q(@LRJ) Q:LRJ=""  D
  1.  . . S X=@LRJ I X["|" S X=$TR(X,"|","~")
  1.  . . S LRSTR=LRSTR_X D SETDATA
  1.  . S LRSTNOTE=0
  1.  S LRSTR=LRSTR_"|"
  1.  ;
  1.  ; Send site's test synonym's on first record for this test.
  1.  I LRSTSYN D
  1.  . D SETDATA
  1.  . S LRJ="LRSTSYN"
  1.  . F  S LRJ=$Q(@LRJ) Q:LRJ=""  S LRSTR=LRSTR_@LRJ_"^" D SETDATA
  1.  . S LRSTSYN=0
  1.  ;
  1.  ; Send file #60 test type
  1.  S LRSTR=LRSTR_"|"_LRTSTTYP_"|"
  1.  ;
  1.  ; Send default LOINC code
  1.  I LR64 S LRSTR=LRSTR_$$GET1^DIQ(64,LR64_",",25)
  1.  ;
  1.  ; Set extract version number
  1.  S LRSTR=LRSTR_"|1.1|"
  1.  ;
  1.  I 'LRTXT S LRSTR=LRSTR_LRCRLF
  1.  D SETDATA
  1.  ;
  1.  S LRCNT=LRCNT+1,LRCNT(0)=LRCNT(0)+1
  1.  I LRLNC'="" S LRCNT(1)=LRCNT(1)+1
  1.  I LR64 S LRCNT(2)=LRCNT(2)+1
  1.  Q
  1.  ;
  1.  ;
  1. SETDATA ; Set data into report structure
  1.  S LRNODE=$O(^TMP($J,"LRDATA",""),-1)
  1.  I LRTXT S LRNODE=LRNODE+1,^TMP($J,"LRDATA",LRNODE)=LRSTR,LRSTR="" Q
  1.  I 'LRTXT D ENCODE^LRSRVR4(.LRSTR)
  1.  Q