BGPMUF06.m

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