Routine: BLRQUALU

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

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

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

BLRQUALU.m