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

LRSRVR3.m

Go to the documentation of this file. 
  1. LRSRVR3 ;DALOI/JMC -LAB DATA SERVER, CONT'D - LOINC SECTION ;Aug 17,2006
  1.  ;;5.2;LAB SERVICE;**303,346**;Sep 27, 1994;Build 10
  1.  ;
  1.  ;
  1. LOINCLD ; Build and send local delimited LOINC report
  1.  N I,LR6206,LR64,LINR,LRA,LRB,LRCNT,LRCRLF,LRMSUBJ,LRNODE,LRSTR,LRTXT,LRXREF,X,Y
  1.  ;
  1.  K ^TMP($J,"LRSERVER","LOINC"),^TMP($J,"LRDATA")
  1.  S ^TMP($J,"LRDATA",1)="Report Generated.......: "_$$FMTE^XLFDT($$NOW^XLFDT)_" at "_LRSTN
  1.  S ^TMP($J,"LRDATA",2)="Report requested.......: "_LRSUB
  1.  S ^TMP($J,"LRDATA",3)="LOINC version..........: "_$$GET1^DID(95.3,"","","PACKAGE REVISION DATA")
  1.  S ^TMP($J,"LRDATA",4)="File version...........: "_$G(^LAB(95.3,"VR"))
  1.  S LRFILENM=$TR(LRSTN," ","_")_"-"_LRSUB_"-"_$P($$FMTHL7^XLFDT($$NOW^XLFDT),"-")_".TXT"
  1.  S ^TMP($J,"LRDATA",5)="Attached file..........: "_LRFILENM
  1.  S ^TMP($J,"LRDATA",7)=" "
  1.  S ^TMP($J,"LRDATA",8)="Legend:"
  1.  S X="Station #-64 ien-61 ien-Time Aspect|NLT Code|NLT Name|Default LOINC Code|Default LOINC Name|Default Test|Time Aspect|Specimen|Data Location|Data Type|Input Transform|Units|Test Name|LOINC Code|LOINC Name"
  1.  S ^TMP($J,"LRDATA",9)=X
  1.  S Y="|Reference Low|Reference High|Therapeutic Low|Therapeutic High|Subscript|Lab Section|"
  1.  S ^TMP($J,"LRDATA",10)=Y
  1.  S ^TMP($J,"LRDATA",11)="                 1                 |    2   |   3    |          4       |        5         |      6     |     7     |   8    |     9       |   10    |       11      |  12 |    13   |    14    |    15    "
  1.  S ^TMP($J,"LRDATA",12)="|     16      |      17      |      18       |     19         |    20   |     21    |"
  1.  S ^TMP($J,"LRDATA",13)=$$REPEAT^XLFSTR("-",$L(X))
  1.  S ^TMP($J,"LRDATA",14)=$$REPEAT^XLFSTR("-",$L(Y))
  1.  S ^TMP($J,"LRDATA",15)=" "
  1.  S ^TMP($J,"LRDATA",16)=$$UUBEGFN^LRSRVR2A(LRFILENM)
  1.  S LINR=1,LRCNT=0,LRSTR="",LRTXT=0,LRCRLF=$C(13,10)
  1.  ;
  1.  F LRXREF="AI","AH" D
  1.  . S LRA=""
  1.  . F  S LRA=$O(^LAM(LRXREF,LRA)) Q:'LRA  D
  1.  . . S LRB=""
  1.  . . F  S LRB=$O(^LAM(LRXREF,LRA,LRB)) Q:LRB=""  S ^TMP($J,"LRSERVER","LOINC",LRB)=""
  1.  ;
  1.  S LR64=""
  1.  F  S LR64=$O(^TMP($J,"LRSERVER","LOINC",LR64)) Q:LR64=""  D LOINCLA
  1.  ;
  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 LRREC=$$MICRO(LR64)
  1.  . S LRINDX=LRST_"-"_LR64_"-"_"AB"_LR6206
  1.  . S LRSTR=LRSTR_LRINDX_"|"_LRREC_LRCRLF
  1.  . D SETDATA^LRSRVR2
  1.  . S LRCNT=LRCNT+1
  1.  ;
  1.  S ^TMP($J,"LRDATA",6)="Total number of records: "_LRCNT
  1.  I '$O(^TMP($J,"LRDATA",15)) S ^TMP($J,"LRDATA",12)="No LOINC codes mapped at "_LRSTN
  1.  ;
  1.  ; Set the final info into the ^TMP( message global
  1.  S LRNODE=$O(^TMP($J,"LRDATA",""),-1)+1
  1.  I LRSTR'="" S ^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 LRMSUBJ=LRST_" "_LRSTN_" LOCAL REPORT DELIMIT "_$$HTE^XLFDT($H,"1M")
  1.  D MAILSEND^LRSRVR6(LRMSUBJ)
  1.  D CLEAN^LRSRVR
  1.  Q
  1.  ;
  1.  ;
  1. LOINCLA ;
  1.  N LR60,LR61,LRAA,LRAA1,LRERR,LRINDX,LOINCDTA,LOINCDTB,LRPNTA,LRPNTB,LRREC,LRSS,LRX
  1.  D GETS^DIQ(64,LR64,".01;1;13;25;25.5","IE","LOINCDTB","LRERR")
  1.  D GETS^DIQ(64,LR64,"20*","IE","LOINCDTA","LRERR")
  1.  S LRPNTB=$O(LOINCDTB(64,"")) Q:LRPNTB=""
  1.  ;
  1.  ; NLT Code/Procedure
  1.  S LRSTUB=$G(LOINCDTB(64,LRPNTB,1,"E"))
  1.  S $P(LRSTUB,"|",2)=$G(LOINCDTB(64,LRPNTB,.01,"I"))
  1.  ;
  1.  ; Default LOINC code/name
  1.  S $P(LRSTUB,"|",3)=$G(LOINCDTB(64,LRPNTB,25,"E"))
  1.  S $P(LRSTUB,"|",4)=$G(^LAB(95.3,+$G(LOINCDTB(64,LRPNTB,25,"I")),81))
  1.  ;
  1.  ; Default LOINC code test (64,25.5)
  1.  S $P(LRSTUB,"|",5)=$G(LOINCDTB(64,LRPNTB,25.5,"I"))
  1.  ;
  1.  ; Look for 64.01 & 64.02 here
  1.  S LRAA1=""
  1.  F  S LRAA1=$O(LOINCDTA(64.01,LRAA1)) Q:LRAA1=""  D
  1.  . I '$D(LOINCDTA(64.01,LRAA1,.01,"I")) D  Q
  1.  . . S $P(LRSTUB,"|",6)="Specimen sub-field error in file 64 - "_LRAA1
  1.  . . S $P(LRSTUB,"|",7)=$G(LRERR("DIERR",1,"TEXT",1))
  1.  . . S LRSTR=LRSTR_LRCRLF
  1.  . . D SETDATA^LRSRVR2
  1.  . . S LRCNT=LRCNT+1
  1.  . S LRPNTA=LOINCDTA(64.01,LRAA1,.01,"I")
  1.  . S $P(LRSTUB,"|",6)=$$GET1^DIQ(61,LRPNTA_",",.0961) ; Time Aspect
  1.  . S $P(LRSTUB,"|",7)=LOINCDTA(64.01,LRAA1,.01,"E") ; Specimen
  1.  . S LRAA=""
  1.  . F  S LRAA=$O(LOINCDTA(64.02,LRAA)) Q:LRAA=""  I LRAA[LRAA1 D
  1.  . . S $P(LRSTUB,"|",8)=$G(LOINCDTA(64.02,LRAA,2,"E")) ; Data location
  1.  . . S LR60=+LOINCDTA(64.02,LRAA,3,"I")
  1.  . . S LR61=+LOINCDTA(64.01,$P(LRAA,",",2,4),.01,"I")
  1.  . . S $P(LRSTUB,"|",9,10)=$$TSTTYP(LOINCDTA(64.02,LRAA,2,"I"))
  1.  . . S LRSS=$$GET1^DIQ(60,LR60_",",4,"I") ; Subscript
  1.  . . S LRX=$$GET1^DIQ(60.01,LR61_","_LR60_",",6) ; Units
  1.  . . S $P(LRSTUB,"|",11)=$$TRIM^XLFSTR(LRX,"LR"," ")
  1.  . . S $P(LRSTUB,"|",12)=LOINCDTA(64.02,LRAA,3,"E") ; Test name
  1.  . . S $P(LRSTUB,"|",13)=$G(LOINCDTA(64.02,LRAA,4,"E")) ; Loinc code
  1.  . . S $P(LRSTUB,"|",14)=$G(^LAB(95.3,+$G(LOINCDTA(64.02,LRAA,4,"E")),81)) ; LOINC code (64.02,4)
  1.  . . S X=$G(^LAB(60,LR60,1,LR61,0))
  1.  . . S $P(LRSTUB,"|",15)=$P(X,"^",2) ; Test reference low
  1.  . . S $P(LRSTUB,"|",16)=$P(X,"^",3) ; Test reference high
  1.  . . S $P(LRSTUB,"|",17)=$P(X,"^",11) ; Test therapeutic low
  1.  . . S $P(LRSTUB,"|",18)=$P(X,"^",12) ; Test therapeutic high
  1.  . . S $P(LRSTUB,"|",19)=LRSS ; Lab subscript
  1.  . . S $P(LRSTUB,"|",20)=$G(LOINCDTB(64,LRPNTB,13,"E")) ; Lab section
  1.  . . S LRINDX=LRST_"-"_LR64_"-"_LR61_"-"_LOINCDTA(64.02,LRAA,.01,"I")
  1.  . . S LRSTR=LRSTR_LRINDX_"|"_LRSTUB_LRCRLF
  1.  . . D SETDATA^LRSRVR2
  1.  . . S LRCNT=LRCNT+1
  1.  Q
  1.  ;
  1.  ;
  1. MICRO(LR64) ;
  1.  N LOINCDTB,LR6421,LRPNTB,LRSTUB
  1.  S LRSTUB=""
  1.  D GETS^DIQ(64,LR64,".01;1;13;25;25.5","IE","LOINCDTB","LRERR")
  1.  D GETS^DIQ(64,LR64,"20*","IE","LOINCDTA","LRERR")
  1.  S LRPNTB=$O(LOINCDTB(64,"")) Q:LRPNTB="" LRSTUB
  1.  ;
  1.  ; NLT Code/Procedure
  1.  S LRSTUB=$G(LOINCDTB(64,LRPNTB,1,"E"))
  1.  S $P(LRSTUB,"|",2)=$G(LOINCDTB(64,LRPNTB,.01,"I"))
  1.  ;
  1.  ; Default LOINC code/name
  1.  S $P(LRSTUB,"|",3)=$G(LOINCDTB(64,LRPNTB,25,"E"))
  1.  S $P(LRSTUB,"|",4)=$G(^LAB(95.3,+$G(LOINCDTB(64,LRPNTB,25,"I")),81))
  1.  ;
  1.  ; Anti-microbial Suscept (62.06,.01)
  1.  S $P(LRSTUB,"|",5)=$$GET1^DIQ(62.06,LR6206_",",.01)
  1.  ;
  1.  ; Lab subscript/section
  1.  S $P(LRSTUB,"|",19)=LRSS
  1.  I $G(LOINCDTB(64,LRPNTB,13,"I")) D  ; Lab section
  1.  . S LR6421=LOINCDTB(64,LRPNTB,13,"I")
  1.  . S $P(LRSTUB,"|",20)=$$GET1^DIQ(64.21,LR6421_",",1)
  1.  ;
  1.  Q LRSTUB
  1.  ;
  1.  ;
  1. TSTTYP(LRX) ; Determine test data type
  1.  N LRSTUB,LRTYPE,LRY
  1.  I LRX="" Q "|"
  1.  S LRX=$P(LRX,"(",2)
  1.  ;
  1.  ; Data type
  1.  S LRTYPE=$$GET1^DID($P(LRX,","),$P(LRX,",",2,99),"","TYPE")
  1.  S $P(LRSTUB,"|",2)=LRTYPE
  1.  ;
  1.  ; Input transform
  1.  S LRY=$$GET1^DID($P(LRX,","),$P(LRX,",",2,99),"",$S(LRTYPE="SET":"POINTER",1:"INPUT TRANSFORM"))
  1.  I LRTYPE="NUMERIC",LRY["LRNUM" D
  1.  . S LRX=$P(LRY,"""",2)
  1.  . I LRX?.1"-".N1","1.N1","1N S LRY="Number from "_$P(LRX,",")_" to "_$P(LRX,",",2)_" with "_$P(LRX,",",3)_" decimal"
  1.  S $P(LRSTUB,"|",1)=LRY
  1.  ; Help prompt
  1.  I LRTYPE="FREE TEXT" D
  1.   . S LRY=$$GET1^DID($P(LRX,","),$P(LRX,",",2,99),"","HELP-PROMPT")
  1.   . S $P(LRSTUB,"|",1)=LRY
  1.  Q LRSTUB