- 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
