- 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
