BLRQUALU ; IHS/MSC/MKK - RPMS LAB QUALitative Utilities ; 13-Oct-2017 14:04 ; MKK
;;5.2;LAB SERVICE;**1041**;NOV 01, 1997;Build 23
;
EEP ; Ersatz EP
D EEP^BLRGMENU
Q
;
QUALCHEK() ; EP -- CR06260 - Qualitative critical alert
NEW ARRAY,OLDX,OLDY,QIEN,QVAL,SUBJECT,TAB
;
; LRDL = Result
; LRSB = DataName
; LRSPEC = Site/Specimen
; LRTS = File 60 IEN
;
Q:$D(^LAB(60,LRTS,1,LRSPEC,999999))<1 0 ; Skip if no Qualitative value
;
M OLDX=X,OLDY=Y
;
S QIEN=0
F S QIEN=$O(^LAB(60,LRTS,1,LRSPEC,999999,QIEN)) Q:QIEN<1!($G(LRFLG)="A*") D
. S:LRDL=$$GET1^DIQ(60.1999999,QIEN_","_LRSPEC_","_LRTS,.01) LRFLG="A*"
;
I $$GET^XPAR("PKG","BLR QUALITATIVE ALERT",1,"Q")'=1!($G(LRFLG)'="A*") D Q $S($G(LRFLG)="A*":1,1:0)
. M:$D(OLDX) X=OLDX
. M:$D(OLDY) Y=OLDY
;
Q:$G(LRACC)="" $S($G(LRFLG)="A*":1,1:0) ; During Point-Of-Care Tests, there is no accession initially.
;
S TAB=$J("",5)
S SUBJECT="Accession "_LRACC_" Qualitative Alert"
S ARRAY(1)="Accession "_LRACC_" has a result that has triggered a Qualitative Alert."
S ARRAY(2)=" "
S ARRAY(3)=TAB_"Patient: "_$$GET1^DIQ(2,DFN,.01)
S ARRAY(4)=" "
S ARRAY(5)=TAB_"Test: "_$$GET1^DIQ(60,LRTS,.01)_" ["_LRTS_"]"
S ARRAY(6)=" "
S ARRAY(7)=TAB_TAB_"Result:"_LRDL
S ARRAY(8)=" "
S ARRAY(9)=TAB_"DATE/TIME:"_$$UP^XLFSTR($$HTE^XLFDT($H,"5MPZ"))
;
D MAILALMI^BLRUTIL8(SUBJECT,.ARRAY,"LRVER4",,"LAB QUALITATIVE ALERT")
;
M:$D(OLDX) X=OLDX
M:$D(OLDY) Y=OLDY
;
Q $S($G(LRFLG)="A*":1,1:0)
;
TESTQA ; EP - Test the Qualitative Alert
NEW ARRAY,OLDX,OLDY,SUBJECT,TAB
NEW DFN,LRACC,LRTS,LRDL
;
S LRFLG="A*"
;
Q:$$GET^XPAR("PKG","BLR QUALITATIVE ALERT",1,"Q")'=1
;
S DFN=132602
S LRACC="REF 16 24"
S LRTS=123478
S LRDL="POSITIVE"
;
S OLDX=$G(X),OLDY=$G(Y)
;
S TAB=$J("",5)
S SUBJECT="Accession "_LRACC_" Qualitative Alert"
S ARRAY(1)="Accession "_LRACC_" has a result that has triggered a Qualitative Alert."
S ARRAY(2)=" "
S ARRAY(3)=TAB_"Patient: "_$$GET1^DIQ(2,DFN,.01)
S ARRAY(4)=" "
S ARRAY(5)=TAB_"Test: "_$$GET1^DIQ(60,LRTS,.01)_" ["_LRTS_"]"
S ARRAY(6)=" "
S ARRAY(7)=TAB_TAB_"Result:"_LRDL
S ARRAY(8)=" "
S ARRAY(9)=TAB_"DATE/TIME:"_$$UP^XLFSTR($$HTE^XLFDT($H,"5MPZ"))
;
D MAILALMI^BLRUTIL8(SUBJECT,.ARRAY,"LRVER4 - TESTQA",0,"LAB QUALITATIVE ALERT")
;
S:$L(OLDX) X=OLDX
S:$L(OLDY) Y=OLDY
Q
BLRQUALU ; IHS/MSC/MKK - RPMS LAB QUALitative Utilities ; 13-Oct-2017 14:04 ; MKK
+1 ;;5.2;LAB SERVICE;**1041**;NOV 01, 1997;Build 23
+2 ;
EEP ; Ersatz EP
+1 DO EEP^BLRGMENU
+2 QUIT
+3 ;
QUALCHEK() ; EP -- CR06260 - Qualitative critical alert
+1 NEW ARRAY,OLDX,OLDY,QIEN,QVAL,SUBJECT,TAB
+2 ;
+3 ; LRDL = Result
+4 ; LRSB = DataName
+5 ; LRSPEC = Site/Specimen
+6 ; LRTS = File 60 IEN
+7 ;
+8 ; Skip if no Qualitative value
IF $DATA(^LAB(60,LRTS,1,LRSPEC,999999))<1
QUIT 0
+9 ;
+10 MERGE OLDX=X,OLDY=Y
+11 ;
+12 SET QIEN=0
+13 FOR
SET QIEN=$ORDER(^LAB(60,LRTS,1,LRSPEC,999999,QIEN))
IF QIEN<1!($GET(LRFLG)="A*")
QUIT
Begin DoDot:1
+14 IF LRDL=$$GET1^DIQ(60.1999999,QIEN_","_LRSPEC_","_LRTS,.01)
SET LRFLG="A*"
End DoDot:1
+15 ;
+16 IF $$GET^XPAR("PKG","BLR QUALITATIVE ALERT",1,"Q")'=1!($GET(LRFLG)'="A*")
Begin DoDot:1
+17 IF $DATA(OLDX)
MERGE X=OLDX
+18 IF $DATA(OLDY)
MERGE Y=OLDY
End DoDot:1
QUIT $SELECT($GET(LRFLG)="A*":1,1:0)
+19 ;
+20 ; During Point-Of-Care Tests, there is no accession initially.
IF $GET(LRACC)=""
QUIT $SELECT($GET(LRFLG)="A*":1,1:0)
+21 ;
+22 SET TAB=$JUSTIFY("",5)
+23 SET SUBJECT="Accession "_LRACC_" Qualitative Alert"
+24 SET ARRAY(1)="Accession "_LRACC_" has a result that has triggered a Qualitative Alert."
+25 SET ARRAY(2)=" "
+26 SET ARRAY(3)=TAB_"Patient: "_$$GET1^DIQ(2,DFN,.01)
+27 SET ARRAY(4)=" "
+28 SET ARRAY(5)=TAB_"Test: "_$$GET1^DIQ(60,LRTS,.01)_" ["_LRTS_"]"
+29 SET ARRAY(6)=" "
+30 SET ARRAY(7)=TAB_TAB_"Result:"_LRDL
+31 SET ARRAY(8)=" "
+32 SET ARRAY(9)=TAB_"DATE/TIME:"_$$UP^XLFSTR($$HTE^XLFDT($HOROLOG,"5MPZ"))
+33 ;
+34 DO MAILALMI^BLRUTIL8(SUBJECT,.ARRAY,"LRVER4",,"LAB QUALITATIVE ALERT")
+35 ;
+36 IF $DATA(OLDX)
MERGE X=OLDX
+37 IF $DATA(OLDY)
MERGE Y=OLDY
+38 ;
+39 QUIT $SELECT($GET(LRFLG)="A*":1,1:0)
+40 ;
TESTQA ; EP - Test the Qualitative Alert
+1 NEW ARRAY,OLDX,OLDY,SUBJECT,TAB
+2 NEW DFN,LRACC,LRTS,LRDL
+3 ;
+4 SET LRFLG="A*"
+5 ;
+6 IF $$GET^XPAR("PKG","BLR QUALITATIVE ALERT",1,"Q")'=1
QUIT
+7 ;
+8 SET DFN=132602
+9 SET LRACC="REF 16 24"
+10 SET LRTS=123478
+11 SET LRDL="POSITIVE"
+12 ;
+13 SET OLDX=$GET(X)
SET OLDY=$GET(Y)
+14 ;
+15 SET TAB=$JUSTIFY("",5)
+16 SET SUBJECT="Accession "_LRACC_" Qualitative Alert"
+17 SET ARRAY(1)="Accession "_LRACC_" has a result that has triggered a Qualitative Alert."
+18 SET ARRAY(2)=" "
+19 SET ARRAY(3)=TAB_"Patient: "_$$GET1^DIQ(2,DFN,.01)
+20 SET ARRAY(4)=" "
+21 SET ARRAY(5)=TAB_"Test: "_$$GET1^DIQ(60,LRTS,.01)_" ["_LRTS_"]"
+22 SET ARRAY(6)=" "
+23 SET ARRAY(7)=TAB_TAB_"Result:"_LRDL
+24 SET ARRAY(8)=" "
+25 SET ARRAY(9)=TAB_"DATE/TIME:"_$$UP^XLFSTR($$HTE^XLFDT($HOROLOG,"5MPZ"))
+26 ;
+27 DO MAILALMI^BLRUTIL8(SUBJECT,.ARRAY,"LRVER4 - TESTQA",0,"LAB QUALITATIVE ALERT")
+28 ;
+29 IF $LENGTH(OLDX)
SET X=OLDX
+30 IF $LENGTH(OLDY)
SET Y=OLDY
+31 QUIT
