BGPMUF06 ; IHS/MSC/MGH - MI measure NQF0073 ;02-Aug-2011 14:56;DU
;;11.1;IHS CLINICAL REPORTING SYSTEM;**1**;JUN 27, 2011;Build 106
;Code to collect meaningful use report for IVD BP Mgmt
ENTRY ;EP
N START,END,BGPNUM,BGPDEN,BGPNUM,STRING,OUTCT,NFCT,INCT
N IEN,INV,VISIT,DATA,VDATE,VALUE,FIRST,VIEN,RESULT,IVDSTRT,IVDEND
N CNT,IVD,NUM,OUTENC,NFENC,VENC,IVDDX
S (BGPDEN,BGPNUM,RESULT)=0
S IVDSTRT=$$FMADD^XLFDT(BGPEDATE,-730),IVDEND=$$FMADD^XLFDT(BGPEDATE,-426)
S STRING="",IVDDX=0
S (IVD,NUM)=0
;Pts must be >18
;No need to check further if no age match
Q:BGPAGEE<18
S CNT=0
;First check for IVD DX as an outpatient since this is more common
S START=9999999-IVDSTRT,END=9999999-BGPEDATE,VALUE=0
S FIRST=END-0.1 F S FIRST=$O(^AUPNVSIT("AA",DFN,FIRST)) Q:FIRST=""!($P(FIRST,".",1)>START)!(+IVD) D
.S IEN=0 F S IEN=$O(^AUPNVSIT("AA",DFN,FIRST,IEN)) Q:'+IEN!(+IVD) D
..;Check provider, Only visits for chosen provider
..Q:'$$PRV^BGPMUUT1(IEN,BGPPROV)
..S OUTENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU ENCOUNTER OUTPT")
..I +OUTENC D VSTSTORE Q
..S NFENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU ACUTE INPT ENC")
..I +NFENC D VSTSTORE Q
..S VENC=$$VSTPOV^BGPMUUT3(DFN,IEN,"BGPMU ENC OUTPATIENT ICD")
..I +VENC D VSTSTORE Q
;skip to numerator checking if IVD Dx found
I +IVD G NUMCHKS
;check for other procedures or diagnoses
S CNT=0
S START=9999999-IVDSTRT,END=9999999-IVDEND,VALUE=0
S FIRST=END-0.1 F S FIRST=$O(^AUPNVSIT("AA",DFN,FIRST)) Q:FIRST=""!($P(FIRST,".",1)>START)!(+IVD) D
.S IEN=0 F S IEN=$O(^AUPNVSIT("AA",DFN,FIRST,IEN)) Q:'+IEN!(+IVD) D
..;Check provider, Only visits for chosen provider
..Q:'$$PRV^BGPMUUT1(IEN,BGPPROV)
..S NFENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU ACUTE INPT ENC")
..I +NFENC D
...S VDATE=$P($G(^AUPNVSIT(IEN,0)),U,1)
...S CNT=CNT+1
...S VIEN(CNT)=IEN_U_VDATE_U_$$DATE^BGPMUUTL(VDATE)
...S STRING(CNT)=$$DATE^BGPMUUTL(VDATE)
...S IVD=$$INPTDEN(DFN,IEN,IVDSTRT,IVDEND)
NUMCHKS ;If the patient had IVD, check to see if they are in the numerator
Q:'IVD
S NUM=$$NUM(DFN,BGPBDATE,BGPEDATE)
D TOTAL1(DFN,IVD,NUM)
Q
VSTSTORE ;Store compliant visit into array
S VDATE=$P($G(^AUPNVSIT(IEN,0)),U,1)
S CNT=CNT+1
S VIEN(CNT)=IEN_U_VDATE_U_$$DATE^BGPMUUTL(VDATE)
S STRING(CNT)=$$DATE^BGPMUUTL(VDATE)
S IVD=$$OUTPTDEN(DFN,IEN)
Q
TOTAL1(DFN,IVD,NUM) ;See where this patient ends up
N PTCNT,DENCT,NUM1CT,NOTNUM1,TOTALS,DXTIME,DEN
S TOTALS=$G(^TMP("BGPMU0073",$J,BGPMUTF,"TOT"))
S DENCT=+$G(^TMP("BGPMU0073",$J,BGPMUTF,"DEN"))
S NUM1CT=+$G(^TMP("BGPMU0073",$J,BGPMUTF,"NUM"))
S NOTNUM1=+$G(^TMP("BGPMU0073",$J,BGPMUTF,"NOT"))
S PTCNT=TOTALS
S PTCNT=PTCNT+1
S (DEN,DXTIME)=""
S DENCT=DENCT+1 S ^TMP("BGPMU0073",$J,BGPMUTF,"DEN")=DENCT
I $P(IVD,U,3)'="" S DXTIME=$$DATE^BGPMUUTL($P(IVD,U,3))
S DEN=$P(IVD,U,2)_DXTIME_";EN:"_STRING(1)
I +NUM=2 D
.S NUM1CT=NUM1CT+1 S ^TMP("BGPMU0073",$J,BGPMUTF,"NUM")=NUM1CT
.I BGPMUTF="C" S ^TMP("BGPMU0073",$J,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_DEN_U_$P(NUM,U,2,5)
I +NUM<2 D
.S NOTNUM1=NOTNUM1+1 S ^TMP("BGPMU0073",$J,BGPMUTF,"NOT")=NOTNUM1
.I BGPMUTF="C" S ^TMP("BGPMU0073",$J,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_DEN_U_$P(NUM,U,2,5)
S ^TMP("BGPMU0073",$J,BGPMUTF,"TOT")=PTCNT
;Setup iCare array for patient
S BGPICARE("MU.EP.0073.1",BGPMUTF)=1_U_(+NUM=2)_U_""_U_DEN_";"_$P(NUM,U,2)_";"_$P(NUM,U,3)
Q
OUTPTDEN(DFN,VIEN) ; Get the denominator
N RESULT,IVDA,IVDB,IVDDX,DOB
S RESULT=0
;Check for IVD Dx
S DOB=$$GET1^DIQ(2,DFN,.03,"I")
S IVDA=$$VSTPOV^BGPMUUT3(DFN,VIEN,"BGPMU IVD DX")
; PROBLEM check not in ORT - S IVDB=$$PLTAX^BGPMUUT1(DFN,"BGPMU IVD DX","A",END)
I +IVDA S IVDDX=IVDA
;I +IVDB S IVDDX=IVDB
;I +IVDA!(+IVDB) S RESULT=1_U_"IVD:"_$P(IVDDX,U,2)_U_$P(IVDDX,U,3) Q RESULT
I +IVDA S RESULT=1_U_"IVD:"_U_$P(IVDDX,U,3) Q RESULT
Q RESULT
INPTDEN(DFN,VIEN,START,END) ;Evaluate Inpatient visit denominator criteria
N RESULT,PTCA,PTCAP,AMI,CABG,CABGP
S RESULT=0
;Check for PTCA Codes (14 to 24 months hence)
S PTCA=$$CPT^BGPMUUT1(DFN,IVDSTRT,IVDEND,"BGPMU PTCA CPT")
;I +PTCA S RESULT=1_U_"PTCA:"_$P(PTCA,U,2)_U_$P(PTCA,U,3) Q RESULT
I +PTCA S RESULT=1_U_"PTCA:"_U_$P(PTCA,U,3) Q RESULT
S PTCAP=$$LASTPRC^BGPMUUT2(DFN,IVDSTRT,IVDEND,"BGPMU PTCA PROCEDURE")
I +PTCAP S RESULT=1_U_"PTCA:"_U_$P(PTCAP,U,3) Q RESULT
;Check for AMI Dx (during visit)
S AMI=$$VSTPOV^BGPMUUT3(DFN,VIEN,"BGPMU ACUTE MI DX")
I +AMI S RESULT=1_U_"AMI:"_U_$P(AMI,U,3) Q RESULT
;Check for CABG procedure (during visit)
S CABG=$$VSTCPT^BGPMUUT1(DFN,VIEN,"BGPMU CABG CPT")
I +CABG S RESULT=1_U_"CABG:"_U_$P(CABG,U,3) Q RESULT
S CABGP=$$VSTICD0^BGPMUUT3(DFN,VIEN,"BGPMU CABG PROCEDURE")
I +CABGP S RESULT=1_U_"CABG:"_U_$P(CABGP,U,3) Q RESULT
Q RESULT
NUM(DFN,BGPBDATE,BGPEDATE) ;check for BP's
;check blood pressure reading of most recent outpatient encounter
N LDIA,LSYS,BGPBP,BP,SYS,DIA,BGPI,BGPNUM,BGPCNT,RESULT,VSIEN
S (LDIA,LSYS)=""
;Find is pt has a BP on the chosen visits
N IEN,MSR,MTYP,BP,BPCNT,SAVE,ARRAY,VST,VCNT,INV,DTE,EIE
S BP=0,BPCNT=0,VCNT=0
S MTYP="" S MTYP=$O(^AUTTMSR("B","BP",MTYP))
Q:MTYP="" 0
Q:'$D(VIEN) 0
S VSIEN=$P($G(VIEN(1)),U,1)
S SAVE=0
S MSR="" F S MSR=$O(^AUPNVMSR("AD",VSIEN,MSR)) Q:MSR="" D
.S EIE=$$GET1^DIQ(9000010.01,MSR,2,"I")
.Q:EIE=1
.I $P($G(^AUPNVMSR(MSR,0)),U,1)=MTYP D
..S BPCNT=BPCNT+1
..S INV=9999999-$P($G(^AUPNVMSR(MSR,12)),U,1)
..S ARRAY(INV)=VSIEN_U_$P($G(^AUPNVMSR(MSR,0)),U,4)_U_$$DATE^BGPMUUTL($P($G(^AUPNVMSR(MSR,12)),U,1))
I BPCNT=1 D
.S DTE="" S DTE=$O(ARRAY(DTE))
.S RESULT=$P($G(ARRAY(DTE)),U,2)
.S SYS=$P(RESULT,"/",1),DIAS=$P(RESULT,"/",2)
.I SYS>139!(DIAS>89) S BP=1_U_RESULT_U_$P($G(ARRAY(DTE)),U,3)
.E S BP=2_U_RESULT_U_$P($G(ARRAY(DTE)),U,3)
;More than one BP on the visit
I BPCNT>1 D
.N DONE,SYSARRAY,DIAARRAY
.S DONE=0
.S DTE="" F S DTE=$O(ARRAY(DTE)) Q:DTE=""!(+DONE) D
..S RESULT=$P($G(ARRAY(DTE)),U,2)
..S SYS=$P(RESULT,"/",1),DIAS=$P(RESULT,"/",2)
..I SYS<140&(DIAS<90) D Q
...;If any BP is <140/90 we are done
...S DONE=1
...S BP=2_U_RESULT_U_$P($G(ARRAY(DTE)),U,3)
..;If Sys <140 save it
..I SYS<140 D Q
...S SYSARRAY(SYS)=RESULT_U_$P($G(ARRAY(DTE)),U,3)
..;If Dias <90 save it
..I DIAS<90 D Q
...S DIAARRAY(DIAS)=RESULT_U_$P($G(ARRAY(DTE)),U,3)
.;when done looping, see if there are any saved items
.I $D(SYSARRAY)&$D(DIAARRAY) D
..S RES1=$O(SYSARRAY(""))
..S RES2=$O(DIAARRAY(""))
..S BP=2_U_$G(SYSARRAY(RES1))_U_$G(DIAARRAY(RES2))
Q BP
BGPMUF06 ; IHS/MSC/MGH - MI measure NQF0073 ;02-Aug-2011 14:56;DU
+1 ;;11.1;IHS CLINICAL REPORTING SYSTEM;**1**;JUN 27, 2011;Build 106
+2 ;Code to collect meaningful use report for IVD BP Mgmt
ENTRY ;EP
+1 NEW START,END,BGPNUM,BGPDEN,BGPNUM,STRING,OUTCT,NFCT,INCT
+2 NEW IEN,INV,VISIT,DATA,VDATE,VALUE,FIRST,VIEN,RESULT,IVDSTRT,IVDEND
+3 NEW CNT,IVD,NUM,OUTENC,NFENC,VENC,IVDDX
+4 SET (BGPDEN,BGPNUM,RESULT)=0
+5 SET IVDSTRT=$$FMADD^XLFDT(BGPEDATE,-730)
SET IVDEND=$$FMADD^XLFDT(BGPEDATE,-426)
+6 SET STRING=""
SET IVDDX=0
+7 SET (IVD,NUM)=0
+8 ;Pts must be >18
+9 ;No need to check further if no age match
+10 IF BGPAGEE<18
QUIT
+11 SET CNT=0
+12 ;First check for IVD DX as an outpatient since this is more common
+13 SET START=9999999-IVDSTRT
SET END=9999999-BGPEDATE
SET VALUE=0
+14 SET FIRST=END-0.1
FOR
SET FIRST=$ORDER(^AUPNVSIT("AA",DFN,FIRST))
IF FIRST=""!($PIECE(FIRST,".",1)>START)!(+IVD)
QUIT
Begin DoDot:1
+15 SET IEN=0
FOR
SET IEN=$ORDER(^AUPNVSIT("AA",DFN,FIRST,IEN))
IF '+IEN!(+IVD)
QUIT
Begin DoDot:2
+16 ;Check provider, Only visits for chosen provider
+17 IF '$$PRV^BGPMUUT1(IEN,BGPPROV)
QUIT
+18 SET OUTENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU ENCOUNTER OUTPT")
+19 IF +OUTENC
DO VSTSTORE
QUIT
+20 SET NFENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU ACUTE INPT ENC")
+21 IF +NFENC
DO VSTSTORE
QUIT
+22 SET VENC=$$VSTPOV^BGPMUUT3(DFN,IEN,"BGPMU ENC OUTPATIENT ICD")
+23 IF +VENC
DO VSTSTORE
QUIT
End DoDot:2
End DoDot:1
+24 ;skip to numerator checking if IVD Dx found
+25 IF +IVD
GOTO NUMCHKS
+26 ;check for other procedures or diagnoses
+27 SET CNT=0
+28 SET START=9999999-IVDSTRT
SET END=9999999-IVDEND
SET VALUE=0
+29 SET FIRST=END-0.1
FOR
SET FIRST=$ORDER(^AUPNVSIT("AA",DFN,FIRST))
IF FIRST=""!($PIECE(FIRST,".",1)>START)!(+IVD)
QUIT
Begin DoDot:1
+30 SET IEN=0
FOR
SET IEN=$ORDER(^AUPNVSIT("AA",DFN,FIRST,IEN))
IF '+IEN!(+IVD)
QUIT
Begin DoDot:2
+31 ;Check provider, Only visits for chosen provider
+32 IF '$$PRV^BGPMUUT1(IEN,BGPPROV)
QUIT
+33 SET NFENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU ACUTE INPT ENC")
+34 IF +NFENC
Begin DoDot:3
+35 SET VDATE=$PIECE($GET(^AUPNVSIT(IEN,0)),U,1)
+36 SET CNT=CNT+1
+37 SET VIEN(CNT)=IEN_U_VDATE_U_$$DATE^BGPMUUTL(VDATE)
+38 SET STRING(CNT)=$$DATE^BGPMUUTL(VDATE)
+39 SET IVD=$$INPTDEN(DFN,IEN,IVDSTRT,IVDEND)
End DoDot:3
End DoDot:2
End DoDot:1
NUMCHKS ;If the patient had IVD, check to see if they are in the numerator
+1 IF 'IVD
QUIT
+2 SET NUM=$$NUM(DFN,BGPBDATE,BGPEDATE)
+3 DO TOTAL1(DFN,IVD,NUM)
+4 QUIT
VSTSTORE ;Store compliant visit into array
+1 SET VDATE=$PIECE($GET(^AUPNVSIT(IEN,0)),U,1)
+2 SET CNT=CNT+1
+3 SET VIEN(CNT)=IEN_U_VDATE_U_$$DATE^BGPMUUTL(VDATE)
+4 SET STRING(CNT)=$$DATE^BGPMUUTL(VDATE)
+5 SET IVD=$$OUTPTDEN(DFN,IEN)
+6 QUIT
TOTAL1(DFN,IVD,NUM) ;See where this patient ends up
+1 NEW PTCNT,DENCT,NUM1CT,NOTNUM1,TOTALS,DXTIME,DEN
+2 SET TOTALS=$GET(^TMP("BGPMU0073",$JOB,BGPMUTF,"TOT"))
+3 SET DENCT=+$GET(^TMP("BGPMU0073",$JOB,BGPMUTF,"DEN"))
+4 SET NUM1CT=+$GET(^TMP("BGPMU0073",$JOB,BGPMUTF,"NUM"))
+5 SET NOTNUM1=+$GET(^TMP("BGPMU0073",$JOB,BGPMUTF,"NOT"))
+6 SET PTCNT=TOTALS
+7 SET PTCNT=PTCNT+1
+8 SET (DEN,DXTIME)=""
+9 SET DENCT=DENCT+1
SET ^TMP("BGPMU0073",$JOB,BGPMUTF,"DEN")=DENCT
+10 IF $PIECE(IVD,U,3)'=""
SET DXTIME=$$DATE^BGPMUUTL($PIECE(IVD,U,3))
+11 SET DEN=$PIECE(IVD,U,2)_DXTIME_";EN:"_STRING(1)
+12 IF +NUM=2
Begin DoDot:1
+13 SET NUM1CT=NUM1CT+1
SET ^TMP("BGPMU0073",$JOB,BGPMUTF,"NUM")=NUM1CT
+14 IF BGPMUTF="C"
SET ^TMP("BGPMU0073",$JOB,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_DEN_U_$PIECE(NUM,U,2,5)
End DoDot:1
+15 IF +NUM<2
Begin DoDot:1
+16 SET NOTNUM1=NOTNUM1+1
SET ^TMP("BGPMU0073",$JOB,BGPMUTF,"NOT")=NOTNUM1
+17 IF BGPMUTF="C"
SET ^TMP("BGPMU0073",$JOB,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_DEN_U_$PIECE(NUM,U,2,5)
End DoDot:1
+18 SET ^TMP("BGPMU0073",$JOB,BGPMUTF,"TOT")=PTCNT
+19 ;Setup iCare array for patient
+20 SET BGPICARE("MU.EP.0073.1",BGPMUTF)=1_U_(+NUM=2)_U_""_U_DEN_";"_$PIECE(NUM,U,2)_";"_$PIECE(NUM,U,3)
+21 QUIT
OUTPTDEN(DFN,VIEN) ; Get the denominator
+1 NEW RESULT,IVDA,IVDB,IVDDX,DOB
+2 SET RESULT=0
+3 ;Check for IVD Dx
+4 SET DOB=$$GET1^DIQ(2,DFN,.03,"I")
+5 SET IVDA=$$VSTPOV^BGPMUUT3(DFN,VIEN,"BGPMU IVD DX")
+6 ; PROBLEM check not in ORT - S IVDB=$$PLTAX^BGPMUUT1(DFN,"BGPMU IVD DX","A",END)
+7 IF +IVDA
SET IVDDX=IVDA
+8 ;I +IVDB S IVDDX=IVDB
+9 ;I +IVDA!(+IVDB) S RESULT=1_U_"IVD:"_$P(IVDDX,U,2)_U_$P(IVDDX,U,3) Q RESULT
+10 IF +IVDA
SET RESULT=1_U_"IVD:"_U_$PIECE(IVDDX,U,3)
QUIT RESULT
+11 QUIT RESULT
INPTDEN(DFN,VIEN,START,END) ;Evaluate Inpatient visit denominator criteria
+1 NEW RESULT,PTCA,PTCAP,AMI,CABG,CABGP
+2 SET RESULT=0
+3 ;Check for PTCA Codes (14 to 24 months hence)
+4 SET PTCA=$$CPT^BGPMUUT1(DFN,IVDSTRT,IVDEND,"BGPMU PTCA CPT")
+5 ;I +PTCA S RESULT=1_U_"PTCA:"_$P(PTCA,U,2)_U_$P(PTCA,U,3) Q RESULT
+6 IF +PTCA
SET RESULT=1_U_"PTCA:"_U_$PIECE(PTCA,U,3)
QUIT RESULT
+7 SET PTCAP=$$LASTPRC^BGPMUUT2(DFN,IVDSTRT,IVDEND,"BGPMU PTCA PROCEDURE")
+8 IF +PTCAP
SET RESULT=1_U_"PTCA:"_U_$PIECE(PTCAP,U,3)
QUIT RESULT
+9 ;Check for AMI Dx (during visit)
+10 SET AMI=$$VSTPOV^BGPMUUT3(DFN,VIEN,"BGPMU ACUTE MI DX")
+11 IF +AMI
SET RESULT=1_U_"AMI:"_U_$PIECE(AMI,U,3)
QUIT RESULT
+12 ;Check for CABG procedure (during visit)
+13 SET CABG=$$VSTCPT^BGPMUUT1(DFN,VIEN,"BGPMU CABG CPT")
+14 IF +CABG
SET RESULT=1_U_"CABG:"_U_$PIECE(CABG,U,3)
QUIT RESULT
+15 SET CABGP=$$VSTICD0^BGPMUUT3(DFN,VIEN,"BGPMU CABG PROCEDURE")
+16 IF +CABGP
SET RESULT=1_U_"CABG:"_U_$PIECE(CABGP,U,3)
QUIT RESULT
+17 QUIT RESULT
NUM(DFN,BGPBDATE,BGPEDATE) ;check for BP's
+1 ;check blood pressure reading of most recent outpatient encounter
+2 NEW LDIA,LSYS,BGPBP,BP,SYS,DIA,BGPI,BGPNUM,BGPCNT,RESULT,VSIEN
+3 SET (LDIA,LSYS)=""
+4 ;Find is pt has a BP on the chosen visits
+5 NEW IEN,MSR,MTYP,BP,BPCNT,SAVE,ARRAY,VST,VCNT,INV,DTE,EIE
+6 SET BP=0
SET BPCNT=0
SET VCNT=0
+7 SET MTYP=""
SET MTYP=$ORDER(^AUTTMSR("B","BP",MTYP))
+8 IF MTYP=""
QUIT 0
+9 IF '$DATA(VIEN)
QUIT 0
+10 SET VSIEN=$PIECE($GET(VIEN(1)),U,1)
+11 SET SAVE=0
+12 SET MSR=""
FOR
SET MSR=$ORDER(^AUPNVMSR("AD",VSIEN,MSR))
IF MSR=""
QUIT
Begin DoDot:1
+13 SET EIE=$$GET1^DIQ(9000010.01,MSR,2,"I")
+14 IF EIE=1
QUIT
+15 IF $PIECE($GET(^AUPNVMSR(MSR,0)),U,1)=MTYP
Begin DoDot:2
+16 SET BPCNT=BPCNT+1
+17 SET INV=9999999-$PIECE($GET(^AUPNVMSR(MSR,12)),U,1)
+18 SET ARRAY(INV)=VSIEN_U_$PIECE($GET(^AUPNVMSR(MSR,0)),U,4)_U_$$DATE^BGPMUUTL($PIECE($GET(^AUPNVMSR(MSR,12)),U,1))
End DoDot:2
End DoDot:1
+19 IF BPCNT=1
Begin DoDot:1
+20 SET DTE=""
SET DTE=$ORDER(ARRAY(DTE))
+21 SET RESULT=$PIECE($GET(ARRAY(DTE)),U,2)
+22 SET SYS=$PIECE(RESULT,"/",1)
SET DIAS=$PIECE(RESULT,"/",2)
+23 IF SYS>139!(DIAS>89)
SET BP=1_U_RESULT_U_$PIECE($GET(ARRAY(DTE)),U,3)
+24 IF '$TEST
SET BP=2_U_RESULT_U_$PIECE($GET(ARRAY(DTE)),U,3)
End DoDot:1
+25 ;More than one BP on the visit
+26 IF BPCNT>1
Begin DoDot:1
+27 NEW DONE,SYSARRAY,DIAARRAY
+28 SET DONE=0
+29 SET DTE=""
FOR
SET DTE=$ORDER(ARRAY(DTE))
IF DTE=""!(+DONE)
QUIT
Begin DoDot:2
+30 SET RESULT=$PIECE($GET(ARRAY(DTE)),U,2)
+31 SET SYS=$PIECE(RESULT,"/",1)
SET DIAS=$PIECE(RESULT,"/",2)
+32 IF SYS<140&(DIAS<90)
Begin DoDot:3
+33 ;If any BP is <140/90 we are done
+34 SET DONE=1
+35 SET BP=2_U_RESULT_U_$PIECE($GET(ARRAY(DTE)),U,3)
End DoDot:3
QUIT
+36 ;If Sys <140 save it
+37 IF SYS<140
Begin DoDot:3
+38 SET SYSARRAY(SYS)=RESULT_U_$PIECE($GET(ARRAY(DTE)),U,3)
End DoDot:3
QUIT
+39 ;If Dias <90 save it
+40 IF DIAS<90
Begin DoDot:3
+41 SET DIAARRAY(DIAS)=RESULT_U_$PIECE($GET(ARRAY(DTE)),U,3)
End DoDot:3
QUIT
End DoDot:2
+42 ;when done looping, see if there are any saved items
+43 IF $DATA(SYSARRAY)&$DATA(DIAARRAY)
Begin DoDot:2
+44 SET RES1=$ORDER(SYSARRAY(""))
+45 SET RES2=$ORDER(DIAARRAY(""))
+46 SET BP=2_U_$GET(SYSARRAY(RES1))_U_$GET(DIAARRAY(RES2))
End DoDot:2
End DoDot:1
+47 QUIT BP
