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

BLRRLMUM.m

Go to the documentation of this file. 
  1. BLRRLMUM ; IHS/MSC/MKK - Reference Lab Meaningful Use Microbiology utilities  ; 22-Oct-2013 09:22 ; MKK
  1.  ;;5.2;IHS LABORATORY;**1033**;NOV 1, 1997
  1.  ;
  1. LABSTOR(LRDFN,LRSS,LRIDT) ; Store incoming HL7 data into the Lab Data file
  1.  NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,LRDFN,LRIDT,LRSS,U,XPARSYS,XQXFLG)
  1.  ;
  1.  D CHKITOUT
  1.  ;
  1.  S NOWDTIME=$$HTE^XLFDT($H,"2MZ")
  1.  ;
  1.  S LRUID=+$G(^LR(LRDFN,LRSS,LRIDT,"ORU"))          ; Get UID
  1.  Q:LRUID<1
  1.  ;
  1.  S PIEN=$$SHL7SEGS^BLRRLMUU(LRUID)                 ; Store HL7 data in ^TMP
  1.  Q:PIEN<1
  1.  ;
  1.  S ^LR(LRDFN,LRSS,LRIDT,"HL7")=PIEN_"^"            ; Store 62.49 IEN
  1.  ;
  1.  ; Store the various HL7 segments' data
  1.  S SEG=""
  1.  F  S SEG=$O(^TMP("BLRRLMUU",$J,LRUID,PIEN,SEG))  Q:SEG=""  D
  1.  . S SEGIEN=0
  1.  . F  S SEGIEN=$O(^TMP("BLRRLMUU",$J,LRUID,PIEN,SEG,SEGIEN))  Q:SEGIEN<1  D @SEG
  1.  ;
  1.  Q
  1.  ;
  1. MSH ; EP - Don't process anything in the MSH Segment
  1.  Q
  1.  ;
  1. PID ; EP - Don't process anything in the PID Segment
  1.  Q
  1.  ;
  1. OBR ; EP
  1.  Q
  1.  ;
  1. OBX ; EP
  1.  NEW ANSDTT,DATANAME,F60IEN,ORGANISM,ORGPTR,REFLAB,RLPTR,STATUS,STR,TESTNAME,TSTLOINC
  1.  ;
  1.  S STR=$G(^LAHM(62.49,PIEN,150,SEGIEN,0))
  1.  ;
  1.  S TSTLOINC=$P($P(STR,"|",4),"^")
  1.  S TESTNAME=$P($P(STR,"|",4),"^",2)
  1.  S ORIGTEXT=$P($P(STR,"|",4),"^",9)
  1.  ;
  1.  S F60IEN=+$$FIND1^DIC(60,,,ORIGTEXT_",")
  1.  I F60IEN D     ; Store File 60 Pointer
  1.  . K FDA
  1.  . S FDA(63.061,"+1,"_LRIDT_","_LRDFN_",",.01)=F60IEN_"^"_$$GET1^DIQ(60,F60IEN,"NAME")
  1.  . D UPDATE^DIE(,"FDA",,"ERRS")
  1.  ;
  1.  ; Reference Lab
  1.  S RLPTR=$P($P(STR,"|",24),"^",10)
  1.  I $L(RLPTR) D
  1.  . S REFLAB=+$$FIND1^DIC(4,,,RLPTR,"D")
  1.  . S:REFLAB ^LR(LRDFN,LRSS,LRIDT,"RF")=REFLAB
  1.  ;
  1.  ; Signing Physician
  1.  S SIGNSTR=$P(STR,"|",26)
  1.  S SIGNNPI=$P(SIGNSTR,"^")     ; NPI
  1.  S SIGNPHY=$P(SIGNSTR,"^",2)_", "_$TR($P(SIGNSTR,"^",3,6),"^"," ") ; Name
  1.  S SIGNPHY=$$TRIM^XLFSTR(SIGNPHY,"LR"," ")    ; Get rid of leading & trailing blanks
  1.  ;
  1.  ; IEN into 62.49
  1.  S ^LR(LRDFN,LRSS,LRIDT,"HL7")=PIEN
  1.  ;
  1.  ; Organism
  1.  S ORGANISM=$P(STR,"|",6)
  1.  S ORSNOMED=$P(ORGANISM,"^")
  1.  S ORGSEQ=+$P(STR,"|",5)
  1.  ;
  1.  Q:$L(ORGANISM)<1!(ORGSEQ<1)
  1.  ;
  1.  S ORGPTR=+$$FIND1^DIC(61.2,,"M",+ORGANISM)
  1.  I ORGPTR D
  1.  . D ^XBFMK
  1.  . K IENS,FDA
  1.  . S IENS(1)=ORGSEQ
  1.  . S FDA(63.3,"+1,"_LRIDT_","_LRDFN_",",.01)=ORGPTR
  1.  . ;
  1.  . D UPDATE^DIE(,"FDA","IENS","ERRS")
  1.  ;
  1.  S UNITS=$P($P(STR,"|",7),"^")
  1.  S:$L(UNITS) UNITS=$$GET1^DIQ(90475.3,UNITS,"I")
  1.  ;
  1.  S FLAG=$P(STR,"|",9)
  1.  S STATUS=$P(STR,"|",12)
  1.  S RELDATE=$$HL7TFM^XLFDT($P(STR,"|",15))
  1.  ;
  1.  K IENS,FDA
  1.  S IENS=LRIDT_","_LRDFN_","
  1.  S:$L(RELDATE) FDA(63.3,IENS,9999901)=RELDATE
  1.  S FDA(63.3,IENS,9999902)=STATUS
  1.  S FDA(63.3,IENS,9999903)=FLAG
  1.  S:$L(UNITS) FDA(63.3,IENS,9999905)=UNITS
  1.  ;
  1.  D UPDATE^DIE(,"FDA","IENS","ERRS")
  1.  ;
  1.  ; Performing Hospital
  1.  S HOSPITAL=$P(STR,"|",24)
  1.  S ADDRESS=$P(STR,"|",25)
  1.  S ADDRL1=$P(ADDRESS,"^"),ADDRL2=$P(ADDRESS,"^",2)
  1.  S CITY=$P(ADDRESS,"^",3),STATE=$P(ADDRESS,"^",4),ZIPCODE=$P(ADDRESS,"^",5)
  1.  S COUNTY=$P(ADDRESS,"^",5),COUNTRY=$P(ADDRESS,"^",6)
  1.  ;
  1.  ; Performing Provider?
  1.  S PERFHMDS=$P(STR,"|",26)
  1.  S MDID=$P(PERFHMDS,"^")
  1.  S MDNAME=$$TRIM^XLFSTR($P(PERFHMDS,"^",2)_","_$P(PERFHMDS,"^",3)_" "_$P(PERFHMDS,"^",4),"LR"," ")
  1.  ;
  1.  ; Get IEN into COUNTRY CODE (#779.004) file
  1.  S ICOUNTRY=0
  1.  I $L(COUNTRY) D
  1.  . D FIND^DIC(779.004,,,,COUNTRY,,,,,"TARGET","ERRS")
  1.  . S ICOUNTRY=+$O(TARGET("DILIST",2,0))
  1.  ;
  1.  Q:$L(COUNTY)<1&(ICOUNTRY<1)
  1.  ;
  1.  K FDA
  1.  S:$L(COUNTY) FDA(63.05,IENS,9999996)=COUNTY
  1.  S:ICOUNTRY FDA(63.05,IENS,9999997)=ICOUNTRY
  1.  D UPDATE^DIE(,"FDA","IENS","ERRS")
  1.  ;
  1.  Q
  1.  ;
  1. ORC ; EP
  1.  Q
  1.  ;
  1. SPM ; EP
  1.  Q
  1.  ;
  1. CHKITOUT ; EP - Determine if data exists in ^LAH
  1.  NEW AUTOINSP,LA7INST,LRAA,LRAD,LRAN,LRAS,LRIFN,LRLL,LRUID,NOWDTIME
  1.  ;
  1.  S NOWDTIME=$$HTE^XLFDT($H,"2MZ")
  1.  ;
  1.  S LA7INST=$$GET1^DIQ(9009029,DUZ(2),3001)
  1.  S ^XTMP("BLRRLMUM",NOWDTIME,$J,"01","LA7INST")=LA7INST
  1.  ;
  1.  Q:$L(LA7INST)<1                              ; Quit if no Reference Lab
  1.  ;
  1.  S AUTOINSP=+$O(^LAB(62.4,"B",LA7INST,""))    ; Auto Instrument IEN
  1.  S ^XTMP("BLRRLMUM",NOWDTIME,$J,"02,","AUTOINSP")=AUTOINSP
  1.  ;
  1.  Q:AUTOINSP<1                                 ; Quit if No Auto Instrument
  1.  ;
  1.  S LRLL=$$GET1^DIQ(62.4,AUTOINSP,3,"I")       ; LOAD/WORK LIST
  1.  S ^XTMP("BLRRLMUM",NOWDTIME,$J,"03,","LRLL")=LRLL
  1.  ;
  1.  S LRUID=+$G(^LR(LRDFN,LRSS,LRIDT,"ORU"))     ; Get UID
  1.  S ^XTMP("BLRRLMUM",NOWDTIME,$J,"04,","LRUID")=LRUID
  1.  ;
  1.  S LRIFN=$O(^LAH(LRLL,1,"U",LRUID,0))
  1.  S ^XTMP("BLRRLMUM",NOWDTIME,$J,"05,","LRIFN")=LRIFN
  1.  ;
  1.  Q:LRIFN<1                                    ; Quit if no data in ^LAH for the LRUID
  1.  ;
  1.  Q:'$D(^LAH(LRLL,1,LRIFN,0))#2                ; Quit if no data in ^LAH for the LRIFN
  1.  ;
  1.  S ^XTMP("BLRRLMUM",NOWDTIME,$J,"06","LRIFN")=LRIFN
  1.  S ^XTMP("BLRRLMUM",NOWDTIME,$J,"07","LRUID")=LRUID
  1.  Q
  1.  ;
  1. LABIHSMS(LRAA,LRAD,LRAN) ; EP - After LAMIAUT0 Verification, move IHS Subnodes to proper nodes in Lab Data file
  1.  NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,LRAA,LRAD,LRAN,U,XPARSYS,XQXFLG)
  1.  ;
  1.  S LRDFN=+$G(^LRO(68,LRAA,1,LRAD,1,LRAN,0)),LRIDT=$P($G(^(3)),"^",5),LRSS="MI"
  1.  ;
  1.  D LABSTOR(LRDFN,LRSS,LRIDT)
  1.  D MAKEANTI
  1.  D MAKEOIHS
  1.  ;
  1.  Q
  1.  ;
  1. MAKEANTI ; EP - Create new ANTIMICROBIAL SUSCEPTIBILITY nodes
  1.  S ORGIEN=.9999999
  1.  F  S ORGIEN=$O(^LR(LRDFN,LRSS,LRIDT,3,ORGIEN))  Q:ORGIEN<1  D
  1.  . Q:$D(^LR(LRDFN,LRSS,LRIDT,3,ORGIEN,"IHSOBX"))<1
  1.  . ;
  1.  . S ORGSTR=$G(^LR(LRDFN,LRSS,LRIDT,3,ORGIEN,"IHSOBX"))
  1.  . S ANTI1=0
  1.  . F  S ANTI1=$O(^LR(LRDFN,LRSS,LRIDT,3,ORGIEN,"ISO",ANTI1))  Q:ANTI1<1  D
  1.  .. S ANTI(ANTI1)=$G(^LR(LRDFN,LRSS,LRIDT,3,ORGIEN,"ISO",ANTI1))
  1.  .. S ANTI(ANTI1)=$G(ANTI(ANTI1))_$G(^LR(LRDFN,LRSS,LRIDT,3,ORGIEN,"ISO","IHSOBX",ANTI1))
  1.  . ;
  1.  . S ORGANISM=$G(^LR(LRDFN,LRSS,LRIDT,3,ORGIEN,0))
  1.  . S ANTI1=0
  1.  . F  S ANTI1=$O(ANTI(ANTI1))  Q:ANTI1<1  D
  1.  .. S ANTISTR=$G(ANTI(ANTI1))
  1.  .. S DRUGNODE=$P(ANTISTR,"^",2)
  1.  .. S DRUGRES=$P(ANTISTR,"^",3)
  1.  .. S DRUGUNIT=$P($P(ANTISTR,"^",4),"~")
  1.  .. S DRUGSUSP=$P(ANTISTR,"^",5)
  1.  .. S DRUGSUSP=$S($L(DRUGSUSP):DRUGSUSP,1:"S")
  1.  .. S DRUGSTAT=$P(ANTISTR,"^",6)
  1.  .. S DRUGDATE=$P(ANTISTR,"^",7)
  1.  .. S DRUGREFL=$P(ANTISTR,"^",8)
  1.  .. S DRUGNIEN=+$O(^LAB(62.06,"AD",DRUGNODE,0))
  1.  .. S DRUGNAME=$$GET1^DIQ(62.06,DRUGNIEN,"NAME")
  1.  .. ;
  1.  .. D MAKE14
  1.  .. S $P(^LR(LRDFN,LRSS,LRIDT,3,ORGIEN,DRUGNODE),"^")=DRUGSUSP
  1.  .. S $P(^LR(LRDFN,LRSS,LRIDT,3,ORGIEN,DRUGNODE,"IHS"),"^")=DRUGRES    ; Result
  1.  .. S $P(^LR(LRDFN,LRSS,LRIDT,3,ORGIEN,DRUGNODE,"IHS"),"^",2)=DRUGUNIT ; Units
  1.  .. S $P(^LR(LRDFN,LRSS,LRIDT,3,ORGIEN,DRUGNODE,"IHS"),"^",3)=DRUGSTAT ; Status
  1.  .. S $P(^LR(LRDFN,LRSS,LRIDT,3,ORGIEN,DRUGNODE,"IHS"),"^",4)=DRUGDATE ; Date/Time
  1.  .. S $P(^LR(LRDFN,LRSS,LRIDT,3,ORGIEN,DRUGNODE,"IHS"),"^",5)=DRUGREFL ; Referring Lab
  1.  ;
  1.  Q
  1.  ;
  1. MAKE14 ; EP - Make node 14, IFF drug not already there
  1.  NEW FDA,FOUNDIT,IEN,IENARRAY,ERRS,DRUGS
  1.  ;
  1.  S (DRUGS,FOUNDIT)=0
  1.  F  S DRUGS=$O(^LR(LRDFN,LRSS,LRIDT,14,DRUGS))  Q:DRUGS<1!(FOUNDIT)  D
  1.  . S:$G(^LR(LRDFN,LRSS,LRIDT,14,DRUGS,0))[DRUGNAME FOUNDIT=FOUNDIT+1
  1.  Q:FOUNDIT
  1.  ;
  1.  S FDA(63.42,"?+1,"_LRIDT_","_LRDFN_",",.01)=DRUGNAME
  1.  S FDA(63.42,"?+1,"_LRIDT_","_LRDFN_",",2)=DRUGRES
  1.  S FDA(63.42,"?+1,"_LRIDT_","_LRDFN_",",9999990)=DRUGDATE
  1.  S FDA(63.42,"?+1,"_LRIDT_","_LRDFN_",",9999991)=DRUGREFL
  1.  D UPDATE^DIE("S","FDA",,"ERRS")
  1.  ;
  1.  Q:$D(ERRS)<1
  1.  ;
  1.  ; Record Error
  1.  S HNOW=$H
  1.  S ^XTMP("BLRRLMUM")=$$HTFM^XLFDT(+$H+30)_"^"_$$DT^XLFDT_"^ERR UPDATING LAB MICRO RESULT"
  1.  M ^XTMP("BLRRLMUM",HNOW,"MAKE14","01 FDA")=FDA
  1.  M ^XTMP("BLRRLMUM",HNOW,"MAKE14","02 ERRS")=ERRS
  1.  Q
  1.  ;
  1. MAKEOIHS ; EP - Stuff "other" fields with IHS Data
  1.  S IENS=LRAN_","_LRAD_","_LRAA_","
  1.  S LRAS=$$GET1^DIQ(68.02,IENS,15)             ; Get Accession Number
  1.  S LRUID=+$$GET1^DIQ(68.02,IENS,16)           ; Get UID
  1.  Q:LRUID<1
  1.  ;
  1.  S PIEN=$$SHL7SEGS^BLRRLMUU(LRUID)            ; Get UID pointer to 62.49
  1.  ;
  1.  D UPDLTXNL
  1.  Q
  1.  ;
  1. UPDLTXNL ; EP - Update IHS Lab Transaction Log file
  1.  S BLRLOGDA=+$$FIND1^DIC(9009022,,"M",LRAS)   ; Get 9009022 IEN
  1.  Q:BLRLOGDA<1
  1.  ;
  1.  K FDA,ERRS
  1.  S FDA(9009022,BLRLOGDA_",",102)="R"          ; Set to "Resulted"
  1.  D UPDATE^DIE("S","FDA",,"ERRS")
  1.  ;
  1.  I $D(ERRS)<1 D TOP^BLRQUE(BLRLOGDA,0)  Q     ; If no errors, Requeue Txn to be re-filed into PCC
  1.  ;
  1.  ; Record Error
  1.  S HNOW=$H
  1.  S ^XTMP("BLRRLMUM")=$$HTFM^XLFDT(+$H+30)_"^"_$$DT^XLFDT_"^ERR UPDATING LAB MICRO RESULT"
  1.  M ^XTMP("BLRRLMUM",HNOW,"MAKEOIHS","01 FDA")=FDA
  1.  M ^XTMP("BLRRLMUM",HNOW,"MAKEOIHS","02 ERRS")=ERRS
  1.  Q
  1.  ;
  1. TESTANTI ; EP
  1.  NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,LRDFN,LRIDT,LRSS,U,XPARSYS,XQXFLG)
  1.  ;
  1.  D ^LRWU4
  1.  W !!
  1.  ;
  1.  S LRDFN=+$G(^LRO(68,LRAA,1,LRAD,1,LRAN,0)),LRIDT=$P($G(^(3)),"^",5)
  1.  S LRSS=$$GET1^DIQ(68,LRAA,.02,"I")
  1.  ;
  1.  D MAKEANTI
  1.  Q