BPXRMLAB ; IHS/MSC/MGH - Use V Labs in reminder resolution. ;25-Nov-2013 14:52;DU
;;2.0;CLINICAL REMINDERS;**1001**;Feb 04, 2005;Build 21
;===================================================================
VLAB(DFN,TEST,DATE,VALUE,TEXT) ;EP
N BPXTRM
Q:TEST=""
S BPXTRM="" S BPXTRM=$O(^PXRMD(811.5,"B",TEST,BPXTRM))
I BPXTRM="" S TEST=0,DATE=DT,TEXT="Reminder term does not exist" Q
D GETVAR(BPXTRM)
Q
GETVAR(BPXTRM) ;EP
;Get the needed data from the reminder term. This includes
;the test name(s) and the value to search for
N X,Y,BPXFIND,BPXTYPE,BPXOFF,BPXFILE,BPXRESLT,BPXCNT,BPXTEST
K ^TMP("PXRMLAB",$J)
S BPXCNT=0,BPXRESLT=0
S BPXFIND=0 F S BPXFIND=$O(^PXRMD(811.5,BPXTRM,20,BPXFIND)) Q:BPXFIND=""!(BPXFIND?1A.A)!(BPXRESLT=1) D
.S BPXTYPE=$P($G(^PXRMD(811.5,BPXTRM,20,BPXFIND,0)),U,1)
.S BPXTEST=$P(BPXTYPE,";",1),BPXFILE=$P(BPXTYPE,";",2)
.;This needs to be a term of laboratory tests
.Q:BPXFILE'="LAB(60,"
.S BPXOFF=$P($G(^PXRMD(811.5,BPXTRM,20,BPXFIND,0)),U,8)
.;Call next routine with patient,start and stop dates,test name
.D RESULT(DFN,BPXTEST)
;Loop through results and return most recent
S BPXRESLT="" S BPXRESLT=$O(^TMP("PXRMLAB",$J,BPXRESLT))
I BPXRESLT="" S TEST=0,VALUE=TEST
I +BPXRESLT D
.S TEST=1,VALUE=$P($G(^TMP("PXRMLAB",$J,BPXRESLT)),U,6)
.S DATE=$P($G(^TMP("PXRMLAB",$J,BPXRESLT)),U,5)
.S TEXT=$P($G(^TMP("PXRMLAB",$J,BPXRESLT)),U,2)
Q
RESULT(DFN,LABIEN) ;EP
;EP Find a patients labs in the V LAB file
;Get up to ten results of the specified lab test
;If the result has an associated LR ACCESSION NUMBER quit
;If not, add it to the array to be used in the reminder
;===================================================================
N VLIEN,INVDATE,TEMP,COUNT
S INVDATE="",COUNT=0
F S INVDATE=$O(^AUPNVLAB("AA",DFN,LABIEN,INVDATE)) Q:INVDATE=""!(COUNT>10) D
.S VLIEN="" F S VLIEN=$O(^AUPNVLAB("AA",DFN,LABIEN,INVDATE,VLIEN)) Q:VLIEN="" D
..S TEMP=$G(^AUPNVLAB(VLIEN,0))
..I TEMP'="" D STORE
Q
STORE ;Store the needed data into TMP for use in reminders
N FLAG,UNITS,TEMP1,TEMP2,VAL,EVDT,VIEN
S COUNT=COUNT+1
S TEMP1=$G(^AUPNVLAB(VLIEN,11))
S VAL=$P(TEMP,U,4) I VAL="" S VAL="pending"
S FLAG=$P(TEMP,U,5)
S UNITS=$P(TEMP1,U,1)
S VIEN=$P(TEMP,U,3)
S EVDT=$$GET1^DIQ(9000010.09,VLIEN,1201,"I")
I EVDT="" S EVDT=$$GET1^DIQ(9000010,VIEN,.01,"I")
S TEMP2=LABIEN_U_VAL_U_FLAG_U_UNITS_U_EVDT
S $P(TEMP2,U,6)=$P($G(^LAB(60,LABIEN,.1)),"^")
S ^TMP("PXRMLAB",$J,INVDATE)=TEMP2
Q
BPXRMLAB ; IHS/MSC/MGH - Use V Labs in reminder resolution. ;25-Nov-2013 14:52;DU
+1 ;;2.0;CLINICAL REMINDERS;**1001**;Feb 04, 2005;Build 21
+2 ;===================================================================
VLAB(DFN,TEST,DATE,VALUE,TEXT) ;EP
+1 NEW BPXTRM
+2 IF TEST=""
QUIT
+3 SET BPXTRM=""
SET BPXTRM=$ORDER(^PXRMD(811.5,"B",TEST,BPXTRM))
+4 IF BPXTRM=""
SET TEST=0
SET DATE=DT
SET TEXT="Reminder term does not exist"
QUIT
+5 DO GETVAR(BPXTRM)
+6 QUIT
GETVAR(BPXTRM) ;EP
+1 ;Get the needed data from the reminder term. This includes
+2 ;the test name(s) and the value to search for
+3 NEW X,Y,BPXFIND,BPXTYPE,BPXOFF,BPXFILE,BPXRESLT,BPXCNT,BPXTEST
+4 KILL ^TMP("PXRMLAB",$JOB)
+5 SET BPXCNT=0
SET BPXRESLT=0
+6 SET BPXFIND=0
FOR
SET BPXFIND=$ORDER(^PXRMD(811.5,BPXTRM,20,BPXFIND))
IF BPXFIND=""!(BPXFIND?1A.A)!(BPXRESLT=1)
QUIT
Begin DoDot:1
+7 SET BPXTYPE=$PIECE($GET(^PXRMD(811.5,BPXTRM,20,BPXFIND,0)),U,1)
+8 SET BPXTEST=$PIECE(BPXTYPE,";",1)
SET BPXFILE=$PIECE(BPXTYPE,";",2)
+9 ;This needs to be a term of laboratory tests
+10 IF BPXFILE'="LAB(60,"
QUIT
+11 SET BPXOFF=$PIECE($GET(^PXRMD(811.5,BPXTRM,20,BPXFIND,0)),U,8)
+12 ;Call next routine with patient,start and stop dates,test name
+13 DO RESULT(DFN,BPXTEST)
End DoDot:1
+14 ;Loop through results and return most recent
+15 SET BPXRESLT=""
SET BPXRESLT=$ORDER(^TMP("PXRMLAB",$JOB,BPXRESLT))
+16 IF BPXRESLT=""
SET TEST=0
SET VALUE=TEST
+17 IF +BPXRESLT
Begin DoDot:1
+18 SET TEST=1
SET VALUE=$PIECE($GET(^TMP("PXRMLAB",$JOB,BPXRESLT)),U,6)
+19 SET DATE=$PIECE($GET(^TMP("PXRMLAB",$JOB,BPXRESLT)),U,5)
+20 SET TEXT=$PIECE($GET(^TMP("PXRMLAB",$JOB,BPXRESLT)),U,2)
End DoDot:1
+21 QUIT
RESULT(DFN,LABIEN) ;EP
+1 ;EP Find a patients labs in the V LAB file
+2 ;Get up to ten results of the specified lab test
+3 ;If the result has an associated LR ACCESSION NUMBER quit
+4 ;If not, add it to the array to be used in the reminder
+5 ;===================================================================
+6 NEW VLIEN,INVDATE,TEMP,COUNT
+7 SET INVDATE=""
SET COUNT=0
+8 FOR
SET INVDATE=$ORDER(^AUPNVLAB("AA",DFN,LABIEN,INVDATE))
IF INVDATE=""!(COUNT>10)
QUIT
Begin DoDot:1
+9 SET VLIEN=""
FOR
SET VLIEN=$ORDER(^AUPNVLAB("AA",DFN,LABIEN,INVDATE,VLIEN))
IF VLIEN=""
QUIT
Begin DoDot:2
+10 SET TEMP=$GET(^AUPNVLAB(VLIEN,0))
+11 IF TEMP'=""
DO STORE
End DoDot:2
End DoDot:1
+12 QUIT
STORE ;Store the needed data into TMP for use in reminders
+1 NEW FLAG,UNITS,TEMP1,TEMP2,VAL,EVDT,VIEN
+2 SET COUNT=COUNT+1
+3 SET TEMP1=$GET(^AUPNVLAB(VLIEN,11))
+4 SET VAL=$PIECE(TEMP,U,4)
IF VAL=""
SET VAL="pending"
+5 SET FLAG=$PIECE(TEMP,U,5)
+6 SET UNITS=$PIECE(TEMP1,U,1)
+7 SET VIEN=$PIECE(TEMP,U,3)
+8 SET EVDT=$$GET1^DIQ(9000010.09,VLIEN,1201,"I")
+9 IF EVDT=""
SET EVDT=$$GET1^DIQ(9000010,VIEN,.01,"I")
+10 SET TEMP2=LABIEN_U_VAL_U_FLAG_U_UNITS_U_EVDT
+11 SET $PIECE(TEMP2,U,6)=$PIECE($GET(^LAB(60,LABIEN,.1)),"^")
+12 SET ^TMP("PXRMLAB",$JOB,INVDATE)=TEMP2
+13 QUIT
