BPXRMRAD ; IHS/MSC/MGH - Use V RAD in reminder resolution. ;25-Nov-2013 14:52;DU
;;2.0;CLINICAL REMINDERS;**1001**;Feb 04, 2005;Build 21
;===================================================================
VRAD(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("PXRMRAD",$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'="RAMIS(71,"
.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("PXRMRAD",$J,BPXRESLT))
I BPXRESLT="" S TEST=0,VALUE=TEST
I +BPXRESLT D
.S TEST=1,VALUE=$P($G(^TMP("PXRMRAD",$J,BPXRESLT)),U,2)
.S DATE=$P($G(^TMP("PXRMRAD",$J,BPXRESLT)),U,1)
.S TEXT=$P($G(^TMP("PXRMRAD",$J,BPXRESLT)),U,3)
Q
RESULT(DFN,RADIEN) ;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 VRIEN,INVDATE,TEMP,RADPROC,COUNT
S VRIEN="",COUNT=0
Q:'$D(^AUPNVRAD("AC",DFN))
F S VRIEN=$O(^AUPNVRAD("AC",DFN,VRIEN)) Q:VRIEN=""!(COUNT>10) D
.S RADPROC=$P($G(^AUPNVRAD(VRIEN,0)),U,1)
.I RADPROC=RADIEN D STORE
Q
STORE ;Store the needed data into TMP for use in reminders
N FLAG,UNITS,ORDER,TEMP,TEMP1,TEMP2,VIS,VDATE,Y,INVDATE,PROC,STATUS
S COUNT=COUNT+1
S TEMP=$G(^AUPNVRAD(VRIEN,0)),TEMP1=$G(^AUPNVRAD(VRIEN,11))
S TEMP2=$G(^AUPNVRAD(VRIEN,12))
I TEMP1'="" S ORDER="COMPLETE",STATUS="COMPLETE"
I TEMP1="" S ORDER="IN PROGRESS",STATUS="IN PROGRESS"
S PROC=$$GET1^DIQ(9000010.22,VRIEN,.01)
I $P(TEMP2,U,1)="" D
.S VIS=$P($G(^AUPNVRAD(VRIEN,0)),U,3)
.Q:VIS=""
.S VDATE=$P($G(^AUPNVSIT(VIS,0)),U,1)
.S Y=VDATE
E S Y=$P(TEMP2,U,1)
S INVDATE=9999999-Y
S ^TMP("PXRMRAD",$J,INVDATE)=Y_U_PROC_U_STATUS
Q
BPXRMRAD ; IHS/MSC/MGH - Use V RAD in reminder resolution. ;25-Nov-2013 14:52;DU
+1 ;;2.0;CLINICAL REMINDERS;**1001**;Feb 04, 2005;Build 21
+2 ;===================================================================
VRAD(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("PXRMRAD",$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'="RAMIS(71,"
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("PXRMRAD",$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("PXRMRAD",$JOB,BPXRESLT)),U,2)
+19 SET DATE=$PIECE($GET(^TMP("PXRMRAD",$JOB,BPXRESLT)),U,1)
+20 SET TEXT=$PIECE($GET(^TMP("PXRMRAD",$JOB,BPXRESLT)),U,3)
End DoDot:1
+21 QUIT
RESULT(DFN,RADIEN) ;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 VRIEN,INVDATE,TEMP,RADPROC,COUNT
+7 SET VRIEN=""
SET COUNT=0
+8 IF '$DATA(^AUPNVRAD("AC",DFN))
QUIT
+9 FOR
SET VRIEN=$ORDER(^AUPNVRAD("AC",DFN,VRIEN))
IF VRIEN=""!(COUNT>10)
QUIT
Begin DoDot:1
+10 SET RADPROC=$PIECE($GET(^AUPNVRAD(VRIEN,0)),U,1)
+11 IF RADPROC=RADIEN
DO STORE
End DoDot:1
+12 QUIT
STORE ;Store the needed data into TMP for use in reminders
+1 NEW FLAG,UNITS,ORDER,TEMP,TEMP1,TEMP2,VIS,VDATE,Y,INVDATE,PROC,STATUS
+2 SET COUNT=COUNT+1
+3 SET TEMP=$GET(^AUPNVRAD(VRIEN,0))
SET TEMP1=$GET(^AUPNVRAD(VRIEN,11))
+4 SET TEMP2=$GET(^AUPNVRAD(VRIEN,12))
+5 IF TEMP1'=""
SET ORDER="COMPLETE"
SET STATUS="COMPLETE"
+6 IF TEMP1=""
SET ORDER="IN PROGRESS"
SET STATUS="IN PROGRESS"
+7 SET PROC=$$GET1^DIQ(9000010.22,VRIEN,.01)
+8 IF $PIECE(TEMP2,U,1)=""
Begin DoDot:1
+9 SET VIS=$PIECE($GET(^AUPNVRAD(VRIEN,0)),U,3)
+10 IF VIS=""
QUIT
+11 SET VDATE=$PIECE($GET(^AUPNVSIT(VIS,0)),U,1)
+12 SET Y=VDATE
End DoDot:1
+13 IF '$TEST
SET Y=$PIECE(TEMP2,U,1)
+14 SET INVDATE=9999999-Y
+15 SET ^TMP("PXRMRAD",$JOB,INVDATE)=Y_U_PROC_U_STATUS
+16 QUIT
