BPXRMDRG ; IHS/MSC/MGH - Use V Meds in reminder resolution. ;25-Nov-2013 14:57;DU
;;2.0;CLINICAL REMINDERS;**1001**;Feb 04, 2005;Build 21
;===================================================================
VMED(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,ARRAY
K ^TMP("PXRMMED",$J)
D GETMEDS(DFN)
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 medications
.Q:(BPXFILE'="PSNDF(50.6,")&(BPXFILE'="PSDRUG(,")
.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,BPXFILE)
;Loop through results and return most recent
S BPXRESLT="" S BPXRESLT=$O(ARRAY(BPXRESLT))
I BPXRESLT="" S TEST=0,VALUE=TEST
I +BPXRESLT D
.S TEST=1,VALUE=$P(ARRAY(BPXRESLT),U,1)
.S VALUE=$$GET1^DIQ(50,VALUE,.01)
.S DATE=$P(ARRAY(BPXRESLT),U,2)
Q
GETMEDS(DFN) ;EP
;EP Find a patients labs in the V MED file
;Get up to the last 3 years.
;If not, add it to the array to be used in the reminder
;===================================================================
N ORDER,DRUG,SDATE,INVDATE,VMIEN,MED,TEMP,EVDT,DATE,STARTDT,X1,X2
N DISC,DSUP,INVDTE
K ^TMP("PXRMMED",$J)
S X1=DT,X2=-1095 D C^%DTC S STARTDT=X
S STARTDT=9999999-STARTDT
Q:'$D(^AUPNVMED("AA",DFN))
S (VMIEN,INVDATE)=0
F S INVDATE=$O(^AUPNVMED("AA",DFN,INVDATE)) Q:INVDATE=""!(INVDATE>STARTDT) D
.S VMIEN="" F S VMIEN=$O(^AUPNVMED("AA",DFN,INVDATE,VMIEN)) Q:VMIEN="" D
..S EVDT=$P($G(^AUPNVMED(VMIEN,12)),U,1)
..I $P($G(^AUPNVMED(VMIEN,11)),U,8)'="" S EVDT=DT
..S TEMP=$G(^AUPNVMED(VMIEN,0))
.S MED=$P(TEMP,U,1)
.S DSUP=$P(TEMP,U,7)
.S DISC=$P(TEMP,U,8)
.Q:DISC'=""
.S INVDTE=9999999-EVDT
.S ^TMP("PXRMMED",$J,INVDTE,MED)=EVDT
Q
RESULT(DFN,BPXTEST,BPXFILE) ;FIND MATCHES
;Loop through med list looking for matches
N DTE,MED,POI
S DTE="" F S DTE=$O(^TMP("PXRMMED",$J,DTE)) Q:DTE="" D
.S MED="" F S MED=$O(^TMP("PXRMMED",$J,DTE,MED)) Q:MED="" D
..I BPXFILE="PSDRUG(," D
...I BPXTEST=MED S ARRAY(DTE)=MED
..I BPXFILE="PSNDF(50.6," D
...I $D(^PSDRUG("AND",BPXTEST,MED))>0 S ARRAY(DTE)=MED_U_$G(^TMP("PXRMMED",$J,DTE,MED))
Q
BPXRMDRG ; IHS/MSC/MGH - Use V Meds in reminder resolution. ;25-Nov-2013 14:57;DU
+1 ;;2.0;CLINICAL REMINDERS;**1001**;Feb 04, 2005;Build 21
+2 ;===================================================================
VMED(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,ARRAY
+4 KILL ^TMP("PXRMMED",$JOB)
+5 DO GETMEDS(DFN)
+6 SET BPXCNT=0
SET BPXRESLT=0
+7 SET BPXFIND=0
FOR
SET BPXFIND=$ORDER(^PXRMD(811.5,BPXTRM,20,BPXFIND))
IF BPXFIND=""!(BPXFIND?1A.A)!(BPXRESLT=1)
QUIT
Begin DoDot:1
+8 SET BPXTYPE=$PIECE($GET(^PXRMD(811.5,BPXTRM,20,BPXFIND,0)),U,1)
+9 SET BPXTEST=$PIECE(BPXTYPE,";",1)
SET BPXFILE=$PIECE(BPXTYPE,";",2)
+10 ;This needs to be a term of medications
+11 IF (BPXFILE'="PSNDF(50.6,")&(BPXFILE'="PSDRUG(,")
QUIT
+12 SET BPXOFF=$PIECE($GET(^PXRMD(811.5,BPXTRM,20,BPXFIND,0)),U,8)
+13 ;Call next routine with patient,start and stop dates,test name
+14 DO RESULT(DFN,BPXTEST,BPXFILE)
End DoDot:1
+15 ;Loop through results and return most recent
+16 SET BPXRESLT=""
SET BPXRESLT=$ORDER(ARRAY(BPXRESLT))
+17 IF BPXRESLT=""
SET TEST=0
SET VALUE=TEST
+18 IF +BPXRESLT
Begin DoDot:1
+19 SET TEST=1
SET VALUE=$PIECE(ARRAY(BPXRESLT),U,1)
+20 SET VALUE=$$GET1^DIQ(50,VALUE,.01)
+21 SET DATE=$PIECE(ARRAY(BPXRESLT),U,2)
End DoDot:1
+22 QUIT
GETMEDS(DFN) ;EP
+1 ;EP Find a patients labs in the V MED file
+2 ;Get up to the last 3 years.
+3 ;If not, add it to the array to be used in the reminder
+4 ;===================================================================
+5 NEW ORDER,DRUG,SDATE,INVDATE,VMIEN,MED,TEMP,EVDT,DATE,STARTDT,X1,X2
+6 NEW DISC,DSUP,INVDTE
+7 KILL ^TMP("PXRMMED",$JOB)
+8 SET X1=DT
SET X2=-1095
DO C^%DTC
SET STARTDT=X
+9 SET STARTDT=9999999-STARTDT
+10 IF '$DATA(^AUPNVMED("AA",DFN))
QUIT
+11 SET (VMIEN,INVDATE)=0
+12 FOR
SET INVDATE=$ORDER(^AUPNVMED("AA",DFN,INVDATE))
IF INVDATE=""!(INVDATE>STARTDT)
QUIT
Begin DoDot:1
+13 SET VMIEN=""
FOR
SET VMIEN=$ORDER(^AUPNVMED("AA",DFN,INVDATE,VMIEN))
IF VMIEN=""
QUIT
Begin DoDot:2
+14 SET EVDT=$PIECE($GET(^AUPNVMED(VMIEN,12)),U,1)
+15 IF $PIECE($GET(^AUPNVMED(VMIEN,11)),U,8)'=""
SET EVDT=DT
+16 SET TEMP=$GET(^AUPNVMED(VMIEN,0))
End DoDot:2
+17 SET MED=$PIECE(TEMP,U,1)
+18 SET DSUP=$PIECE(TEMP,U,7)
+19 SET DISC=$PIECE(TEMP,U,8)
+20 IF DISC'=""
QUIT
+21 SET INVDTE=9999999-EVDT
+22 SET ^TMP("PXRMMED",$JOB,INVDTE,MED)=EVDT
End DoDot:1
+23 QUIT
RESULT(DFN,BPXTEST,BPXFILE) ;FIND MATCHES
+1 ;Loop through med list looking for matches
+2 NEW DTE,MED,POI
+3 SET DTE=""
FOR
SET DTE=$ORDER(^TMP("PXRMMED",$JOB,DTE))
IF DTE=""
QUIT
Begin DoDot:1
+4 SET MED=""
FOR
SET MED=$ORDER(^TMP("PXRMMED",$JOB,DTE,MED))
IF MED=""
QUIT
Begin DoDot:2
+5 IF BPXFILE="PSDRUG(,"
Begin DoDot:3
+6 IF BPXTEST=MED
SET ARRAY(DTE)=MED
End DoDot:3
+7 IF BPXFILE="PSNDF(50.6,"
Begin DoDot:3
+8 IF $DATA(^PSDRUG("AND",BPXTEST,MED))>0
SET ARRAY(DTE)=MED_U_$GET(^TMP("PXRMMED",$JOB,DTE,MED))
End DoDot:3
End DoDot:2
End DoDot:1
+9 QUIT
