BLRRLMUM ; IHS/MSC/MKK - Reference Lab Meaningful Use Microbiology utilities ; 22-Oct-2013 09:22 ; MKK
;;5.2;IHS LABORATORY;**1033**;NOV 1, 1997
;
LABSTOR(LRDFN,LRSS,LRIDT) ; Store incoming HL7 data into the Lab Data file
NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,LRDFN,LRIDT,LRSS,U,XPARSYS,XQXFLG)
;
D CHKITOUT
;
S NOWDTIME=$$HTE^XLFDT($H,"2MZ")
;
S LRUID=+$G(^LR(LRDFN,LRSS,LRIDT,"ORU")) ; Get UID
Q:LRUID<1
;
S PIEN=$$SHL7SEGS^BLRRLMUU(LRUID) ; Store HL7 data in ^TMP
Q:PIEN<1
;
S ^LR(LRDFN,LRSS,LRIDT,"HL7")=PIEN_"^" ; Store 62.49 IEN
;
; Store the various HL7 segments' data
S SEG=""
F S SEG=$O(^TMP("BLRRLMUU",$J,LRUID,PIEN,SEG)) Q:SEG="" D
. S SEGIEN=0
. F S SEGIEN=$O(^TMP("BLRRLMUU",$J,LRUID,PIEN,SEG,SEGIEN)) Q:SEGIEN<1 D @SEG
;
Q
;
MSH ; EP - Don't process anything in the MSH Segment
Q
;
PID ; EP - Don't process anything in the PID Segment
Q
;
OBR ; EP
Q
;
OBX ; EP
NEW ANSDTT,DATANAME,F60IEN,ORGANISM,ORGPTR,REFLAB,RLPTR,STATUS,STR,TESTNAME,TSTLOINC
;
S STR=$G(^LAHM(62.49,PIEN,150,SEGIEN,0))
;
S TSTLOINC=$P($P(STR,"|",4),"^")
S TESTNAME=$P($P(STR,"|",4),"^",2)
S ORIGTEXT=$P($P(STR,"|",4),"^",9)
;
S F60IEN=+$$FIND1^DIC(60,,,ORIGTEXT_",")
I F60IEN D ; Store File 60 Pointer
. K FDA
. S FDA(63.061,"+1,"_LRIDT_","_LRDFN_",",.01)=F60IEN_"^"_$$GET1^DIQ(60,F60IEN,"NAME")
. D UPDATE^DIE(,"FDA",,"ERRS")
;
; Reference Lab
S RLPTR=$P($P(STR,"|",24),"^",10)
I $L(RLPTR) D
. S REFLAB=+$$FIND1^DIC(4,,,RLPTR,"D")
. S:REFLAB ^LR(LRDFN,LRSS,LRIDT,"RF")=REFLAB
;
; Signing Physician
S SIGNSTR=$P(STR,"|",26)
S SIGNNPI=$P(SIGNSTR,"^") ; NPI
S SIGNPHY=$P(SIGNSTR,"^",2)_", "_$TR($P(SIGNSTR,"^",3,6),"^"," ") ; Name
S SIGNPHY=$$TRIM^XLFSTR(SIGNPHY,"LR"," ") ; Get rid of leading & trailing blanks
;
; IEN into 62.49
S ^LR(LRDFN,LRSS,LRIDT,"HL7")=PIEN
;
; Organism
S ORGANISM=$P(STR,"|",6)
S ORSNOMED=$P(ORGANISM,"^")
S ORGSEQ=+$P(STR,"|",5)
;
Q:$L(ORGANISM)<1!(ORGSEQ<1)
;
S ORGPTR=+$$FIND1^DIC(61.2,,"M",+ORGANISM)
I ORGPTR D
. D ^XBFMK
. K IENS,FDA
. S IENS(1)=ORGSEQ
. S FDA(63.3,"+1,"_LRIDT_","_LRDFN_",",.01)=ORGPTR
. ;
. D UPDATE^DIE(,"FDA","IENS","ERRS")
;
S UNITS=$P($P(STR,"|",7),"^")
S:$L(UNITS) UNITS=$$GET1^DIQ(90475.3,UNITS,"I")
;
S FLAG=$P(STR,"|",9)
S STATUS=$P(STR,"|",12)
S RELDATE=$$HL7TFM^XLFDT($P(STR,"|",15))
;
K IENS,FDA
S IENS=LRIDT_","_LRDFN_","
S:$L(RELDATE) FDA(63.3,IENS,9999901)=RELDATE
S FDA(63.3,IENS,9999902)=STATUS
S FDA(63.3,IENS,9999903)=FLAG
S:$L(UNITS) FDA(63.3,IENS,9999905)=UNITS
;
D UPDATE^DIE(,"FDA","IENS","ERRS")
;
; Performing Hospital
S HOSPITAL=$P(STR,"|",24)
S ADDRESS=$P(STR,"|",25)
S ADDRL1=$P(ADDRESS,"^"),ADDRL2=$P(ADDRESS,"^",2)
S CITY=$P(ADDRESS,"^",3),STATE=$P(ADDRESS,"^",4),ZIPCODE=$P(ADDRESS,"^",5)
S COUNTY=$P(ADDRESS,"^",5),COUNTRY=$P(ADDRESS,"^",6)
;
; Performing Provider?
S PERFHMDS=$P(STR,"|",26)
S MDID=$P(PERFHMDS,"^")
S MDNAME=$$TRIM^XLFSTR($P(PERFHMDS,"^",2)_","_$P(PERFHMDS,"^",3)_" "_$P(PERFHMDS,"^",4),"LR"," ")
;
; Get IEN into COUNTRY CODE (#779.004) file
S ICOUNTRY=0
I $L(COUNTRY) D
. D FIND^DIC(779.004,,,,COUNTRY,,,,,"TARGET","ERRS")
. S ICOUNTRY=+$O(TARGET("DILIST",2,0))
;
Q:$L(COUNTY)<1&(ICOUNTRY<1)
;
K FDA
S:$L(COUNTY) FDA(63.05,IENS,9999996)=COUNTY
S:ICOUNTRY FDA(63.05,IENS,9999997)=ICOUNTRY
D UPDATE^DIE(,"FDA","IENS","ERRS")
;
Q
;
ORC ; EP
Q
;
SPM ; EP
Q
;
CHKITOUT ; EP - Determine if data exists in ^LAH
NEW AUTOINSP,LA7INST,LRAA,LRAD,LRAN,LRAS,LRIFN,LRLL,LRUID,NOWDTIME
;
S NOWDTIME=$$HTE^XLFDT($H,"2MZ")
;
S LA7INST=$$GET1^DIQ(9009029,DUZ(2),3001)
S ^XTMP("BLRRLMUM",NOWDTIME,$J,"01","LA7INST")=LA7INST
;
Q:$L(LA7INST)<1 ; Quit if no Reference Lab
;
S AUTOINSP=+$O(^LAB(62.4,"B",LA7INST,"")) ; Auto Instrument IEN
S ^XTMP("BLRRLMUM",NOWDTIME,$J,"02,","AUTOINSP")=AUTOINSP
;
Q:AUTOINSP<1 ; Quit if No Auto Instrument
;
S LRLL=$$GET1^DIQ(62.4,AUTOINSP,3,"I") ; LOAD/WORK LIST
S ^XTMP("BLRRLMUM",NOWDTIME,$J,"03,","LRLL")=LRLL
;
S LRUID=+$G(^LR(LRDFN,LRSS,LRIDT,"ORU")) ; Get UID
S ^XTMP("BLRRLMUM",NOWDTIME,$J,"04,","LRUID")=LRUID
;
S LRIFN=$O(^LAH(LRLL,1,"U",LRUID,0))
S ^XTMP("BLRRLMUM",NOWDTIME,$J,"05,","LRIFN")=LRIFN
;
Q:LRIFN<1 ; Quit if no data in ^LAH for the LRUID
;
Q:'$D(^LAH(LRLL,1,LRIFN,0))#2 ; Quit if no data in ^LAH for the LRIFN
;
S ^XTMP("BLRRLMUM",NOWDTIME,$J,"06","LRIFN")=LRIFN
S ^XTMP("BLRRLMUM",NOWDTIME,$J,"07","LRUID")=LRUID
Q
;
LABIHSMS(LRAA,LRAD,LRAN) ; EP - After LAMIAUT0 Verification, move IHS Subnodes to proper nodes in Lab Data file
NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,LRAA,LRAD,LRAN,U,XPARSYS,XQXFLG)
;
S LRDFN=+$G(^LRO(68,LRAA,1,LRAD,1,LRAN,0)),LRIDT=$P($G(^(3)),"^",5),LRSS="MI"
;
D LABSTOR(LRDFN,LRSS,LRIDT)
D MAKEANTI
D MAKEOIHS
;
Q
;
MAKEANTI ; EP - Create new ANTIMICROBIAL SUSCEPTIBILITY nodes
S ORGIEN=.9999999
F S ORGIEN=$O(^LR(LRDFN,LRSS,LRIDT,3,ORGIEN)) Q:ORGIEN<1 D
. Q:$D(^LR(LRDFN,LRSS,LRIDT,3,ORGIEN,"IHSOBX"))<1
. ;
. S ORGSTR=$G(^LR(LRDFN,LRSS,LRIDT,3,ORGIEN,"IHSOBX"))
. S ANTI1=0
. F S ANTI1=$O(^LR(LRDFN,LRSS,LRIDT,3,ORGIEN,"ISO",ANTI1)) Q:ANTI1<1 D
.. S ANTI(ANTI1)=$G(^LR(LRDFN,LRSS,LRIDT,3,ORGIEN,"ISO",ANTI1))
.. S ANTI(ANTI1)=$G(ANTI(ANTI1))_$G(^LR(LRDFN,LRSS,LRIDT,3,ORGIEN,"ISO","IHSOBX",ANTI1))
. ;
. S ORGANISM=$G(^LR(LRDFN,LRSS,LRIDT,3,ORGIEN,0))
. S ANTI1=0
. F S ANTI1=$O(ANTI(ANTI1)) Q:ANTI1<1 D
.. S ANTISTR=$G(ANTI(ANTI1))
.. S DRUGNODE=$P(ANTISTR,"^",2)
.. S DRUGRES=$P(ANTISTR,"^",3)
.. S DRUGUNIT=$P($P(ANTISTR,"^",4),"~")
.. S DRUGSUSP=$P(ANTISTR,"^",5)
.. S DRUGSUSP=$S($L(DRUGSUSP):DRUGSUSP,1:"S")
.. S DRUGSTAT=$P(ANTISTR,"^",6)
.. S DRUGDATE=$P(ANTISTR,"^",7)
.. S DRUGREFL=$P(ANTISTR,"^",8)
.. S DRUGNIEN=+$O(^LAB(62.06,"AD",DRUGNODE,0))
.. S DRUGNAME=$$GET1^DIQ(62.06,DRUGNIEN,"NAME")
.. ;
.. D MAKE14
.. S $P(^LR(LRDFN,LRSS,LRIDT,3,ORGIEN,DRUGNODE),"^")=DRUGSUSP
.. S $P(^LR(LRDFN,LRSS,LRIDT,3,ORGIEN,DRUGNODE,"IHS"),"^")=DRUGRES ; Result
.. S $P(^LR(LRDFN,LRSS,LRIDT,3,ORGIEN,DRUGNODE,"IHS"),"^",2)=DRUGUNIT ; Units
.. S $P(^LR(LRDFN,LRSS,LRIDT,3,ORGIEN,DRUGNODE,"IHS"),"^",3)=DRUGSTAT ; Status
.. S $P(^LR(LRDFN,LRSS,LRIDT,3,ORGIEN,DRUGNODE,"IHS"),"^",4)=DRUGDATE ; Date/Time
.. S $P(^LR(LRDFN,LRSS,LRIDT,3,ORGIEN,DRUGNODE,"IHS"),"^",5)=DRUGREFL ; Referring Lab
;
Q
;
MAKE14 ; EP - Make node 14, IFF drug not already there
NEW FDA,FOUNDIT,IEN,IENARRAY,ERRS,DRUGS
;
S (DRUGS,FOUNDIT)=0
F S DRUGS=$O(^LR(LRDFN,LRSS,LRIDT,14,DRUGS)) Q:DRUGS<1!(FOUNDIT) D
. S:$G(^LR(LRDFN,LRSS,LRIDT,14,DRUGS,0))[DRUGNAME FOUNDIT=FOUNDIT+1
Q:FOUNDIT
;
S FDA(63.42,"?+1,"_LRIDT_","_LRDFN_",",.01)=DRUGNAME
S FDA(63.42,"?+1,"_LRIDT_","_LRDFN_",",2)=DRUGRES
S FDA(63.42,"?+1,"_LRIDT_","_LRDFN_",",9999990)=DRUGDATE
S FDA(63.42,"?+1,"_LRIDT_","_LRDFN_",",9999991)=DRUGREFL
D UPDATE^DIE("S","FDA",,"ERRS")
;
Q:$D(ERRS)<1
;
; Record Error
S HNOW=$H
S ^XTMP("BLRRLMUM")=$$HTFM^XLFDT(+$H+30)_"^"_$$DT^XLFDT_"^ERR UPDATING LAB MICRO RESULT"
M ^XTMP("BLRRLMUM",HNOW,"MAKE14","01 FDA")=FDA
M ^XTMP("BLRRLMUM",HNOW,"MAKE14","02 ERRS")=ERRS
Q
;
MAKEOIHS ; EP - Stuff "other" fields with IHS Data
S IENS=LRAN_","_LRAD_","_LRAA_","
S LRAS=$$GET1^DIQ(68.02,IENS,15) ; Get Accession Number
S LRUID=+$$GET1^DIQ(68.02,IENS,16) ; Get UID
Q:LRUID<1
;
S PIEN=$$SHL7SEGS^BLRRLMUU(LRUID) ; Get UID pointer to 62.49
;
D UPDLTXNL
Q
;
UPDLTXNL ; EP - Update IHS Lab Transaction Log file
S BLRLOGDA=+$$FIND1^DIC(9009022,,"M",LRAS) ; Get 9009022 IEN
Q:BLRLOGDA<1
;
K FDA,ERRS
S FDA(9009022,BLRLOGDA_",",102)="R" ; Set to "Resulted"
D UPDATE^DIE("S","FDA",,"ERRS")
;
I $D(ERRS)<1 D TOP^BLRQUE(BLRLOGDA,0) Q ; If no errors, Requeue Txn to be re-filed into PCC
;
; Record Error
S HNOW=$H
S ^XTMP("BLRRLMUM")=$$HTFM^XLFDT(+$H+30)_"^"_$$DT^XLFDT_"^ERR UPDATING LAB MICRO RESULT"
M ^XTMP("BLRRLMUM",HNOW,"MAKEOIHS","01 FDA")=FDA
M ^XTMP("BLRRLMUM",HNOW,"MAKEOIHS","02 ERRS")=ERRS
Q
;
TESTANTI ; EP
NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,LRDFN,LRIDT,LRSS,U,XPARSYS,XQXFLG)
;
D ^LRWU4
W !!
;
S LRDFN=+$G(^LRO(68,LRAA,1,LRAD,1,LRAN,0)),LRIDT=$P($G(^(3)),"^",5)
S LRSS=$$GET1^DIQ(68,LRAA,.02,"I")
;
D MAKEANTI
Q
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
+2 ;
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)
+2 ;
+3 DO CHKITOUT
+4 ;
+5 SET NOWDTIME=$$HTE^XLFDT($HOROLOG,"2MZ")
+6 ;
+7 ; Get UID
SET LRUID=+$GET(^LR(LRDFN,LRSS,LRIDT,"ORU"))
+8 IF LRUID<1
QUIT
+9 ;
+10 ; Store HL7 data in ^TMP
SET PIEN=$$SHL7SEGS^BLRRLMUU(LRUID)
+11 IF PIEN<1
QUIT
+12 ;
+13 ; Store 62.49 IEN
SET ^LR(LRDFN,LRSS,LRIDT,"HL7")=PIEN_"^"
+14 ;
+15 ; Store the various HL7 segments' data
+16 SET SEG=""
+17 FOR
SET SEG=$ORDER(^TMP("BLRRLMUU",$JOB,LRUID,PIEN,SEG))
IF SEG=""
QUIT
Begin DoDot:1
+18 SET SEGIEN=0
+19 FOR
SET SEGIEN=$ORDER(^TMP("BLRRLMUU",$JOB,LRUID,PIEN,SEG,SEGIEN))
IF SEGIEN<1
QUIT
DO @SEG
End DoDot:1
+20 ;
+21 QUIT
+22 ;
MSH ; EP - Don't process anything in the MSH Segment
+1 QUIT
+2 ;
PID ; EP - Don't process anything in the PID Segment
+1 QUIT
+2 ;
OBR ; EP
+1 QUIT
+2 ;
OBX ; EP
+1 NEW ANSDTT,DATANAME,F60IEN,ORGANISM,ORGPTR,REFLAB,RLPTR,STATUS,STR,TESTNAME,TSTLOINC
+2 ;
+3 SET STR=$GET(^LAHM(62.49,PIEN,150,SEGIEN,0))
+4 ;
+5 SET TSTLOINC=$PIECE($PIECE(STR,"|",4),"^")
+6 SET TESTNAME=$PIECE($PIECE(STR,"|",4),"^",2)
+7 SET ORIGTEXT=$PIECE($PIECE(STR,"|",4),"^",9)
+8 ;
+9 SET F60IEN=+$$FIND1^DIC(60,,,ORIGTEXT_",")
+10 ; Store File 60 Pointer
IF F60IEN
Begin DoDot:1
+11 KILL FDA
+12 SET FDA(63.061,"+1,"_LRIDT_","_LRDFN_",",.01)=F60IEN_"^"_$$GET1^DIQ(60,F60IEN,"NAME")
+13 DO UPDATE^DIE(,"FDA",,"ERRS")
End DoDot:1
+14 ;
+15 ; Reference Lab
+16 SET RLPTR=$PIECE($PIECE(STR,"|",24),"^",10)
+17 IF $LENGTH(RLPTR)
Begin DoDot:1
+18 SET REFLAB=+$$FIND1^DIC(4,,,RLPTR,"D")
+19 IF REFLAB
SET ^LR(LRDFN,LRSS,LRIDT,"RF")=REFLAB
End DoDot:1
+20 ;
+21 ; Signing Physician
+22 SET SIGNSTR=$PIECE(STR,"|",26)
+23 ; NPI
SET SIGNNPI=$PIECE(SIGNSTR,"^")
+24 ; Name
SET SIGNPHY=$PIECE(SIGNSTR,"^",2)_", "_$TRANSLATE($PIECE(SIGNSTR,"^",3,6),"^"," ")
+25 ; Get rid of leading & trailing blanks
SET SIGNPHY=$$TRIM^XLFSTR(SIGNPHY,"LR"," ")
+26 ;
+27 ; IEN into 62.49
+28 SET ^LR(LRDFN,LRSS,LRIDT,"HL7")=PIEN
+29 ;
+30 ; Organism
+31 SET ORGANISM=$PIECE(STR,"|",6)
+32 SET ORSNOMED=$PIECE(ORGANISM,"^")
+33 SET ORGSEQ=+$PIECE(STR,"|",5)
+34 ;
+35 IF $LENGTH(ORGANISM)<1!(ORGSEQ<1)
QUIT
+36 ;
+37 SET ORGPTR=+$$FIND1^DIC(61.2,,"M",+ORGANISM)
+38 IF ORGPTR
Begin DoDot:1
+39 DO ^XBFMK
+40 KILL IENS,FDA
+41 SET IENS(1)=ORGSEQ
+42 SET FDA(63.3,"+1,"_LRIDT_","_LRDFN_",",.01)=ORGPTR
+43 ;
+44 DO UPDATE^DIE(,"FDA","IENS","ERRS")
End DoDot:1
+45 ;
+46 SET UNITS=$PIECE($PIECE(STR,"|",7),"^")
+47 IF $LENGTH(UNITS)
SET UNITS=$$GET1^DIQ(90475.3,UNITS,"I")
+48 ;
+49 SET FLAG=$PIECE(STR,"|",9)
+50 SET STATUS=$PIECE(STR,"|",12)
+51 SET RELDATE=$$HL7TFM^XLFDT($PIECE(STR,"|",15))
+52 ;
+53 KILL IENS,FDA
+54 SET IENS=LRIDT_","_LRDFN_","
+55 IF $LENGTH(RELDATE)
SET FDA(63.3,IENS,9999901)=RELDATE
+56 SET FDA(63.3,IENS,9999902)=STATUS
+57 SET FDA(63.3,IENS,9999903)=FLAG
+58 IF $LENGTH(UNITS)
SET FDA(63.3,IENS,9999905)=UNITS
+59 ;
+60 DO UPDATE^DIE(,"FDA","IENS","ERRS")
+61 ;
+62 ; Performing Hospital
+63 SET HOSPITAL=$PIECE(STR,"|",24)
+64 SET ADDRESS=$PIECE(STR,"|",25)
+65 SET ADDRL1=$PIECE(ADDRESS,"^")
SET ADDRL2=$PIECE(ADDRESS,"^",2)
+66 SET CITY=$PIECE(ADDRESS,"^",3)
SET STATE=$PIECE(ADDRESS,"^",4)
SET ZIPCODE=$PIECE(ADDRESS,"^",5)
+67 SET COUNTY=$PIECE(ADDRESS,"^",5)
SET COUNTRY=$PIECE(ADDRESS,"^",6)
+68 ;
+69 ; Performing Provider?
+70 SET PERFHMDS=$PIECE(STR,"|",26)
+71 SET MDID=$PIECE(PERFHMDS,"^")
+72 SET MDNAME=$$TRIM^XLFSTR($PIECE(PERFHMDS,"^",2)_","_$PIECE(PERFHMDS,"^",3)_" "_$PIECE(PERFHMDS,"^",4),"LR"," ")
+73 ;
+74 ; Get IEN into COUNTRY CODE (#779.004) file
+75 SET ICOUNTRY=0
+76 IF $LENGTH(COUNTRY)
Begin DoDot:1
+77 DO FIND^DIC(779.004,,,,COUNTRY,,,,,"TARGET","ERRS")
+78 SET ICOUNTRY=+$ORDER(TARGET("DILIST",2,0))
End DoDot:1
+79 ;
+80 IF $LENGTH(COUNTY)<1&(ICOUNTRY<1)
QUIT
+81 ;
+82 KILL FDA
+83 IF $LENGTH(COUNTY)
SET FDA(63.05,IENS,9999996)=COUNTY
+84 IF ICOUNTRY
SET FDA(63.05,IENS,9999997)=ICOUNTRY
+85 DO UPDATE^DIE(,"FDA","IENS","ERRS")
+86 ;
+87 QUIT
+88 ;
ORC ; EP
+1 QUIT
+2 ;
SPM ; EP
+1 QUIT
+2 ;
CHKITOUT ; EP - Determine if data exists in ^LAH
+1 NEW AUTOINSP,LA7INST,LRAA,LRAD,LRAN,LRAS,LRIFN,LRLL,LRUID,NOWDTIME
+2 ;
+3 SET NOWDTIME=$$HTE^XLFDT($HOROLOG,"2MZ")
+4 ;
+5 SET LA7INST=$$GET1^DIQ(9009029,DUZ(2),3001)
+6 SET ^XTMP("BLRRLMUM",NOWDTIME,$JOB,"01","LA7INST")=LA7INST
+7 ;
+8 ; Quit if no Reference Lab
IF $LENGTH(LA7INST)<1
QUIT
+9 ;
+10 ; Auto Instrument IEN
SET AUTOINSP=+$ORDER(^LAB(62.4,"B",LA7INST,""))
+11 SET ^XTMP("BLRRLMUM",NOWDTIME,$JOB,"02,","AUTOINSP")=AUTOINSP
+12 ;
+13 ; Quit if No Auto Instrument
IF AUTOINSP<1
QUIT
+14 ;
+15 ; LOAD/WORK LIST
SET LRLL=$$GET1^DIQ(62.4,AUTOINSP,3,"I")
+16 SET ^XTMP("BLRRLMUM",NOWDTIME,$JOB,"03,","LRLL")=LRLL
+17 ;
+18 ; Get UID
SET LRUID=+$GET(^LR(LRDFN,LRSS,LRIDT,"ORU"))
+19 SET ^XTMP("BLRRLMUM",NOWDTIME,$JOB,"04,","LRUID")=LRUID
+20 ;
+21 SET LRIFN=$ORDER(^LAH(LRLL,1,"U",LRUID,0))
+22 SET ^XTMP("BLRRLMUM",NOWDTIME,$JOB,"05,","LRIFN")=LRIFN
+23 ;
+24 ; Quit if no data in ^LAH for the LRUID
IF LRIFN<1
QUIT
+25 ;
+26 ; Quit if no data in ^LAH for the LRIFN
IF '$DATA(^LAH(LRLL,1,LRIFN,0))#2
QUIT
+27 ;
+28 SET ^XTMP("BLRRLMUM",NOWDTIME,$JOB,"06","LRIFN")=LRIFN
+29 SET ^XTMP("BLRRLMUM",NOWDTIME,$JOB,"07","LRUID")=LRUID
+30 QUIT
+31 ;
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)
+2 ;
+3 SET LRDFN=+$GET(^LRO(68,LRAA,1,LRAD,1,LRAN,0))
SET LRIDT=$PIECE($GET(^(3)),"^",5)
SET LRSS="MI"
+4 ;
+5 DO LABSTOR(LRDFN,LRSS,LRIDT)
+6 DO MAKEANTI
+7 DO MAKEOIHS
+8 ;
+9 QUIT
+10 ;
MAKEANTI ; EP - Create new ANTIMICROBIAL SUSCEPTIBILITY nodes
+1 SET ORGIEN=.9999999
+2 FOR
SET ORGIEN=$ORDER(^LR(LRDFN,LRSS,LRIDT,3,ORGIEN))
IF ORGIEN<1
QUIT
Begin DoDot:1
+3 IF $DATA(^LR(LRDFN,LRSS,LRIDT,3,ORGIEN,"IHSOBX"))<1
QUIT
+4 ;
+5 SET ORGSTR=$GET(^LR(LRDFN,LRSS,LRIDT,3,ORGIEN,"IHSOBX"))
+6 SET ANTI1=0
+7 FOR
SET ANTI1=$ORDER(^LR(LRDFN,LRSS,LRIDT,3,ORGIEN,"ISO",ANTI1))
IF ANTI1<1
QUIT
Begin DoDot:2
+8 SET ANTI(ANTI1)=$GET(^LR(LRDFN,LRSS,LRIDT,3,ORGIEN,"ISO",ANTI1))
+9 SET ANTI(ANTI1)=$GET(ANTI(ANTI1))_$GET(^LR(LRDFN,LRSS,LRIDT,3,ORGIEN,"ISO","IHSOBX",ANTI1))
End DoDot:2
+10 ;
+11 SET ORGANISM=$GET(^LR(LRDFN,LRSS,LRIDT,3,ORGIEN,0))
+12 SET ANTI1=0
+13 FOR
SET ANTI1=$ORDER(ANTI(ANTI1))
IF ANTI1<1
QUIT
Begin DoDot:2
+14 SET ANTISTR=$GET(ANTI(ANTI1))
+15 SET DRUGNODE=$PIECE(ANTISTR,"^",2)
+16 SET DRUGRES=$PIECE(ANTISTR,"^",3)
+17 SET DRUGUNIT=$PIECE($PIECE(ANTISTR,"^",4),"~")
+18 SET DRUGSUSP=$PIECE(ANTISTR,"^",5)
+19 SET DRUGSUSP=$SELECT($LENGTH(DRUGSUSP):DRUGSUSP,1:"S")
+20 SET DRUGSTAT=$PIECE(ANTISTR,"^",6)
+21 SET DRUGDATE=$PIECE(ANTISTR,"^",7)
+22 SET DRUGREFL=$PIECE(ANTISTR,"^",8)
+23 SET DRUGNIEN=+$ORDER(^LAB(62.06,"AD",DRUGNODE,0))
+24 SET DRUGNAME=$$GET1^DIQ(62.06,DRUGNIEN,"NAME")
+25 ;
+26 DO MAKE14
+27 SET $PIECE(^LR(LRDFN,LRSS,LRIDT,3,ORGIEN,DRUGNODE),"^")=DRUGSUSP
+28 ; Result
SET $PIECE(^LR(LRDFN,LRSS,LRIDT,3,ORGIEN,DRUGNODE,"IHS"),"^")=DRUGRES
+29 ; Units
SET $PIECE(^LR(LRDFN,LRSS,LRIDT,3,ORGIEN,DRUGNODE,"IHS"),"^",2)=DRUGUNIT
+30 ; Status
SET $PIECE(^LR(LRDFN,LRSS,LRIDT,3,ORGIEN,DRUGNODE,"IHS"),"^",3)=DRUGSTAT
+31 ; Date/Time
SET $PIECE(^LR(LRDFN,LRSS,LRIDT,3,ORGIEN,DRUGNODE,"IHS"),"^",4)=DRUGDATE
+32 ; Referring Lab
SET $PIECE(^LR(LRDFN,LRSS,LRIDT,3,ORGIEN,DRUGNODE,"IHS"),"^",5)=DRUGREFL
End DoDot:2
End DoDot:1
+33 ;
+34 QUIT
+35 ;
MAKE14 ; EP - Make node 14, IFF drug not already there
+1 NEW FDA,FOUNDIT,IEN,IENARRAY,ERRS,DRUGS
+2 ;
+3 SET (DRUGS,FOUNDIT)=0
+4 FOR
SET DRUGS=$ORDER(^LR(LRDFN,LRSS,LRIDT,14,DRUGS))
IF DRUGS<1!(FOUNDIT)
QUIT
Begin DoDot:1
+5 IF $GET(^LR(LRDFN,LRSS,LRIDT,14,DRUGS,0))[DRUGNAME
SET FOUNDIT=FOUNDIT+1
End DoDot:1
+6 IF FOUNDIT
QUIT
+7 ;
+8 SET FDA(63.42,"?+1,"_LRIDT_","_LRDFN_",",.01)=DRUGNAME
+9 SET FDA(63.42,"?+1,"_LRIDT_","_LRDFN_",",2)=DRUGRES
+10 SET FDA(63.42,"?+1,"_LRIDT_","_LRDFN_",",9999990)=DRUGDATE
+11 SET FDA(63.42,"?+1,"_LRIDT_","_LRDFN_",",9999991)=DRUGREFL
+12 DO UPDATE^DIE("S","FDA",,"ERRS")
+13 ;
+14 IF $DATA(ERRS)<1
QUIT
+15 ;
+16 ; Record Error
+17 SET HNOW=$HOROLOG
+18 SET ^XTMP("BLRRLMUM")=$$HTFM^XLFDT(+$HOROLOG+30)_"^"_$$DT^XLFDT_"^ERR UPDATING LAB MICRO RESULT"
+19 MERGE ^XTMP("BLRRLMUM",HNOW,"MAKE14","01 FDA")=FDA
+20 MERGE ^XTMP("BLRRLMUM",HNOW,"MAKE14","02 ERRS")=ERRS
+21 QUIT
+22 ;
MAKEOIHS ; EP - Stuff "other" fields with IHS Data
+1 SET IENS=LRAN_","_LRAD_","_LRAA_","
+2 ; Get Accession Number
SET LRAS=$$GET1^DIQ(68.02,IENS,15)
+3 ; Get UID
SET LRUID=+$$GET1^DIQ(68.02,IENS,16)
+4 IF LRUID<1
QUIT
+5 ;
+6 ; Get UID pointer to 62.49
SET PIEN=$$SHL7SEGS^BLRRLMUU(LRUID)
+7 ;
+8 DO UPDLTXNL
+9 QUIT
+10 ;
UPDLTXNL ; EP - Update IHS Lab Transaction Log file
+1 ; Get 9009022 IEN
SET BLRLOGDA=+$$FIND1^DIC(9009022,,"M",LRAS)
+2 IF BLRLOGDA<1
QUIT
+3 ;
+4 KILL FDA,ERRS
+5 ; Set to "Resulted"
SET FDA(9009022,BLRLOGDA_",",102)="R"
+6 DO UPDATE^DIE("S","FDA",,"ERRS")
+7 ;
+8 ; If no errors, Requeue Txn to be re-filed into PCC
IF $DATA(ERRS)<1
DO TOP^BLRQUE(BLRLOGDA,0)
QUIT
+9 ;
+10 ; Record Error
+11 SET HNOW=$HOROLOG
+12 SET ^XTMP("BLRRLMUM")=$$HTFM^XLFDT(+$HOROLOG+30)_"^"_$$DT^XLFDT_"^ERR UPDATING LAB MICRO RESULT"
+13 MERGE ^XTMP("BLRRLMUM",HNOW,"MAKEOIHS","01 FDA")=FDA
+14 MERGE ^XTMP("BLRRLMUM",HNOW,"MAKEOIHS","02 ERRS")=ERRS
+15 QUIT
+16 ;
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)
+2 ;
+3 DO ^LRWU4
+4 WRITE !!
+5 ;
+6 SET LRDFN=+$GET(^LRO(68,LRAA,1,LRAD,1,LRAN,0))
SET LRIDT=$PIECE($GET(^(3)),"^",5)
+7 SET LRSS=$$GET1^DIQ(68,LRAA,.02,"I")
+8 ;
+9 DO MAKEANTI
+10 QUIT
