BQITRCBP.m

BQITRCBP ;GDHD/HSD/ALA-CVD Blood Pressure ; 13 Jun 2016  9:01 AM

 ;;2.5;ICARE MANAGEMENT SYSTEM;**1**;May 24, 2016;Build 17

 ;

 ;

BP(BQDFN,TMFRAME) ;EP

 ; If 2 of last 3 non-ER blood pressures in past 2 years are Systolic >140

 ; or Diastolic >90

 NEW X,DESC,TEXT,BQI,QFL,AGE,BCT

 S DESC="",TEXT=""

 S X=$$BP^BQITRUTL(TMFRAME,BQDFN)

 I 'X Q "0^No BPs in past 2 years"

 S AGE=$$AGE^BQIAGE(BQDFN)

 I AGE<60 S X=$$BP^BQITRUTL(TMFRAME,BQDFN,140,90,">")

 I AGE'<60 S X=$$BP^BQITRUTL(TMFRAME,BQDFN,150,90,">")

 I $P(X,U,2)'="" D

 . NEW NDATE

 . S QFL=0,BCT=0

 . F BQI=1:1:3 D  Q:QFL

 .. I $P($P(X,U,2),";",BQI)="No BPs in last 2 years" S TEXT=$P($P(X,U,2),";",BQI),QFL=1 Q

 .. ;S NDATE=$$FMTE^BQIUL1($P($P(X,U,2),";",BQI))_" ("_$P($P(X,U,5),";",BQI)_")",TEXT=TEXT_NDATE_";"

 .. S NDATE=$$FMTMDY^BQIUL1($P($P(X,U,2),";",BQI))_" ("_$P($P(X,U,5),";",BQI)_")",TEXT=TEXT_NDATE_";"

 .. I $P($P(X,U,2),";",BQI)="" S BCT=BCT+1

 I $P(X,U,1)=0,(3-BCT)<2 S DESC="Patient has less than 2 BPs in last 2 years" Q $P(X,U,1)_U_DESC

 I $P(X,U,1)=0,(3-BCT)>1 S DESC="2 of last 3 non-ER BP do not meet criteria ["_TEXT_"]" Q $P(X,U,1)_U_DESC

 I $P(X,U,1)=1 S DESC=DESC_$$PBP(DESC,X)

 Q $P(X,U,1)_U_DESC

 ;

PBP(NDESC,NX) ;EP - Parse Blood Pressure values

 NEW DATES,MIENS,DDSC,MDT,MVAL,MIEN

 S DATES=$P(NX,U,2),MIENS=$P(NX,U,3),DDSC=""

 F BQJ=1:1:$L(DATES,";") S MDT=$P(DATES,";",BQJ) Q:MDT=""  D

 . S MIEN=$P(MIENS,";",BQJ),MVAL=""

 . I MIEN'="" S MVAL=$$GET1^DIQ(9000010.01,MIEN_",",.04,"E")

 . ;S DDSC=DDSC_$$FMTE^BQIUL1(MDT)_" ("_MVAL_"); "

 . S DDSC=DDSC_$$FMTMDY^BQIUL1(MDT)_" ("_MVAL_"); "

 S DDSC=$$TKO^BQIUL1(DDSC,"; ")

 Q NDESC_" "_DDSC

 ;

NBP(BQDFN) ;EP

 ; If no blood pressures taken in past 2 years

 NEW X,DESC,TEXT,BQI,QFL,AGE,BCT

 S DESC="",TEXT=""

 S X=$$BP^BQITRUTL("T-12M",BQDFN)

 I 'X Q "1^No BPs in past year"

 Q 0

BQITRCBP  ;GDHD/HSD/ALA-CVD Blood Pressure ; 13 Jun 2016  9:01 AM

 +1       ;;2.5;ICARE MANAGEMENT SYSTEM;**1**;May 24, 2016;Build 17

 +2       ;

 +3       ;

BP(BQDFN,TMFRAME) ;EP

 +1       ; If 2 of last 3 non-ER blood pressures in past 2 years are Systolic >140

 +2       ; or Diastolic >90

 +3        NEW X,DESC,TEXT,BQI,QFL,AGE,BCT

 +4        SET DESC=""

           SET TEXT=""

 +5        SET X=$$BP^BQITRUTL(TMFRAME,BQDFN)

 +6        IF 'X

               QUIT "0^No BPs in past 2 years"

 +7        SET AGE=$$AGE^BQIAGE(BQDFN)

 +8        IF AGE<60

               SET X=$$BP^BQITRUTL(TMFRAME,BQDFN,140,90,">")

 +9        IF AGE'<60

               SET X=$$BP^BQITRUTL(TMFRAME,BQDFN,150,90,">")

 +10       IF $PIECE(X,U,2)'=""

               Begin DoDot:1

 +11               NEW NDATE

 +12               SET QFL=0

                   SET BCT=0

 +13               FOR BQI=1:1:3

                       Begin DoDot:2

 +14                       IF $PIECE($PIECE(X,U,2),";",BQI)="No BPs in last 2 years"

                               SET TEXT=$PIECE($PIECE(X,U,2),";",BQI)

                               SET QFL=1

                               QUIT 

 +15      ;S NDATE=$$FMTE^BQIUL1($P($P(X,U,2),";",BQI))_" ("_$P($P(X,U,5),";",BQI)_")",TEXT=TEXT_NDATE_";"

 +16                       SET NDATE=$$FMTMDY^BQIUL1($PIECE($PIECE(X,U,2),";",BQI))_" ("_$PIECE($PIECE(X,U,5),";",BQI)_")"

                           SET TEXT=TEXT_NDATE_";"

 +17                       IF $PIECE($PIECE(X,U,2),";",BQI)=""

                               SET BCT=BCT+1

                       End DoDot:2

                       IF QFL

                           QUIT 

               End DoDot:1

 +18       IF $PIECE(X,U,1)=0

               IF (3-BCT)<2

                   SET DESC="Patient has less than 2 BPs in last 2 years"

                   QUIT $PIECE(X,U,1)_U_DESC

 +19       IF $PIECE(X,U,1)=0

               IF (3-BCT)>1

                   SET DESC="2 of last 3 non-ER BP do not meet criteria ["_TEXT_"]"

                   QUIT $PIECE(X,U,1)_U_DESC

 +20       IF $PIECE(X,U,1)=1

               SET DESC=DESC_$$PBP(DESC,X)

 +21       QUIT $PIECE(X,U,1)_U_DESC

 +22      ;

PBP(NDESC,NX) ;EP - Parse Blood Pressure values

 +1        NEW DATES,MIENS,DDSC,MDT,MVAL,MIEN

 +2        SET DATES=$PIECE(NX,U,2)

           SET MIENS=$PIECE(NX,U,3)

           SET DDSC=""

 +3        FOR BQJ=1:1:$LENGTH(DATES,";")

               SET MDT=$PIECE(DATES,";",BQJ)

               IF MDT=""

                   QUIT 

               Begin DoDot:1

 +4                SET MIEN=$PIECE(MIENS,";",BQJ)

                   SET MVAL=""

 +5                IF MIEN'=""

                       SET MVAL=$$GET1^DIQ(9000010.01,MIEN_",",.04,"E")

 +6       ;S DDSC=DDSC_$$FMTE^BQIUL1(MDT)_" ("_MVAL_"); "

 +7                SET DDSC=DDSC_$$FMTMDY^BQIUL1(MDT)_" ("_MVAL_"); "

               End DoDot:1

 +8        SET DDSC=$$TKO^BQIUL1(DDSC,"; ")

 +9        QUIT NDESC_" "_DDSC

 +10      ;

NBP(BQDFN) ;EP

 +1       ; If no blood pressures taken in past 2 years

 +2        NEW X,DESC,TEXT,BQI,QFL,AGE,BCT

 +3        SET DESC=""

           SET TEXT=""

 +4        SET X=$$BP^BQITRUTL("T-12M",BQDFN)

 +5        IF 'X

               QUIT "1^No BPs in past year"

 +6        QUIT 0