BGPD3 ; IHS/CMI/LAB - indicator 3 ;
;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007
;
I3A ;EP ;EP - indicator 2a
Q:'BGPDMPAT ;not in the simple population for denominator
S BGPMBP=$$MEANBP(DFN,BGPEDATE)
;set value 2,3,4 piece and set list
I $P(BGPMBP,U,2) D S(BGPRPT,$S(BGPTIME=1:13,BGPTIME=0:43,BGPTIME=8:83,1:999),$P(BGPMBP,U,2),1) ;set piece 2,3,4
I $D(BGPLIST(6)),BGPTIME=1 S ^XTMP("BGPD",BGPJ,BGPH,"LIST",6,$S($P($G(^AUPNPAT(DFN,11)),U,18)]"":$P(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$P(^DPT(DFN,0),U,2),BGPAGEE,DFN)=$P(BGPMBP,U)
Q
I3B ;EP
;;Q:'$D(BGPIND(7))
Q:'BGPDMPAT ;not in the simple population for denominator
Q:'BGP2BD
;set value 2,3,4 piece and set list
I $P(BGPMBP,U,2) D S(BGPRPT,$S(BGPTIME=1:13,BGPTIME=0:43,BGPTIME=8:83,1:999),$P(BGPMBP,U,2)+5,1) ;set piece 2,3,4
I $D(BGPLIST(7)),BGPTIME=1 S ^XTMP("BGPD",BGPJ,BGPH,"LIST",7,$S($P($G(^AUPNPAT(DFN,11)),U,18)]"":$P(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$P(^DPT(DFN,0),U,2),BGPAGEE,DFN)=$P(BGPMBP,U)
Q
I3C ;EP
;Q:'$D(BGPIND(8))
Q:'BGPDMPAT ;not in the simple population for denominator
Q:'BGP2CD
;set value 2,3,4 piece and set list
I $P(BGPMBP,U,2) D S(BGPRPT,$S(BGPTIME=1:13,BGPTIME=0:43,BGPTIME=8:83,1:999),$P(BGPMBP,U,2)+10,1) ;set piece 2,3,4
I $D(BGPLIST(8)),BGPTIME=1 S ^XTMP("BGPD",BGPJ,BGPH,"LIST",8,$S($P($G(^AUPNPAT(DFN,11)),U,18)]"":$P(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$P(^DPT(DFN,0),U,2),BGPAGEE,DFN)=$P(BGPMBP,U)
Q
S(R,N,P,V) ;
I 'V Q ;no value to add
S $P(^BGPD(R,N),U,P)=$P($G(^BGPD(R,N)),U,P)+V
Q
MEANBP(P,EDATE) ;
NEW S,D,DS,X
S D=$$FMADD^XLFDT(EDATE,-365)
S X=$$BPS(P,D,EDATE,"I")
S S=$$SYSMEAN(X) I S="" Q "^4"
S DS=$$DIAMEAN(X) I DS="" Q "^4"
I S<130&(DS<80) Q S_"/"_DS_" CON"_U_2
Q S_"/"_DS_" UNC"_U_3
SYSMEAN(X) ;EP
I X="" Q ""
NEW Y,C S C=0 F Y=1:1:3 I $P(X,";",Y)]"" S C=C+1
I C'=3 Q ""
S C=0 F Y=1:1:3 S C=$P($P(X,";",Y),"/")+C
Q C\3
DIAMEAN(X) ;EP
I X="" Q ""
NEW Y,C S C=0 F Y=1:1:3 I $P(X,";",Y)]"" S C=C+1
I C'=3 Q ""
S C=0 F Y=1:1:3 S C=$P($P(X,";",Y),"/",2)+C
Q C\3
BPS(P,BDATE,EDATE,F) ;EP ;
I $G(F)="" S F="E"
NEW X,BGPG,E,BGPGL,BGPGLL,BGPGV
S BGPGLL=0,BGPGV=""
K BGPG
S X=P_"^LAST 50 MEAS BP;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,"BGPG(")
S BGPGL=0 F S BGPGL=$O(BGPG(BGPGL)) Q:BGPGL'=+BGPGL!(BGPGLL=3) S BGPGBP=$P($G(BGPG(BGPGL)),U,2) D
.Q:$$CLINIC^APCLV($P(BGPG(BGPGL),U,5),"C")=30
.S BGPGLL=BGPGLL+1
.I F="E" S $P(BGPGV,";",BGPGLL)=BGPGBP_" "_$$FMTE^XLFDT($P(BGPG(BGPGL),U))
.I F="I" S $P(BGPGV,";",BGPGLL)=$P(BGPGBP," ")
Q BGPGV
BGPD3 ; IHS/CMI/LAB - indicator 3 ;
+1 ;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007
+2 ;
I3A ;EP ;EP - indicator 2a
+1 ;not in the simple population for denominator
IF 'BGPDMPAT
QUIT
+2 SET BGPMBP=$$MEANBP(DFN,BGPEDATE)
+3 ;set value 2,3,4 piece and set list
+4 ;set piece 2,3,4
IF $PIECE(BGPMBP,U,2)
DO S(BGPRPT,$SELECT(BGPTIME=1:13,BGPTIME=0:43,BGPTIME=8:83,1:999),$PIECE(BGPMBP,U,2),1)
+5 IF $DATA(BGPLIST(6))
IF BGPTIME=1
SET ^XTMP("BGPD",BGPJ,BGPH,"LIST",6,$SELECT($PIECE($GET(^AUPNPAT(DFN,11)),U,18)]"":$PIECE(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$PIECE(^DPT(DFN,0),U,2),BGPAGEE,DFN)=$PIECE(BGPMBP,U)
+6 QUIT
I3B ;EP
+1 ;;Q:'$D(BGPIND(7))
+2 ;not in the simple population for denominator
IF 'BGPDMPAT
QUIT
+3 IF 'BGP2BD
QUIT
+4 ;set value 2,3,4 piece and set list
+5 ;set piece 2,3,4
IF $PIECE(BGPMBP,U,2)
DO S(BGPRPT,$SELECT(BGPTIME=1:13,BGPTIME=0:43,BGPTIME=8:83,1:999),$PIECE(BGPMBP,U,2)+5,1)
+6 IF $DATA(BGPLIST(7))
IF BGPTIME=1
SET ^XTMP("BGPD",BGPJ,BGPH,"LIST",7,$SELECT($PIECE($GET(^AUPNPAT(DFN,11)),U,18)]"":$PIECE(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$PIECE(^DPT(DFN,0),U,2),BGPAGEE,DFN)=$PIECE(BGPMBP,U)
+7 QUIT
I3C ;EP
+1 ;Q:'$D(BGPIND(8))
+2 ;not in the simple population for denominator
IF 'BGPDMPAT
QUIT
+3 IF 'BGP2CD
QUIT
+4 ;set value 2,3,4 piece and set list
+5 ;set piece 2,3,4
IF $PIECE(BGPMBP,U,2)
DO S(BGPRPT,$SELECT(BGPTIME=1:13,BGPTIME=0:43,BGPTIME=8:83,1:999),$PIECE(BGPMBP,U,2)+10,1)
+6 IF $DATA(BGPLIST(8))
IF BGPTIME=1
SET ^XTMP("BGPD",BGPJ,BGPH,"LIST",8,$SELECT($PIECE($GET(^AUPNPAT(DFN,11)),U,18)]"":$PIECE(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$PIECE(^DPT(DFN,0),U,2),BGPAGEE,DFN)=$PIECE(BGPMBP,U)
+7 QUIT
S(R,N,P,V) ;
+1 ;no value to add
IF 'V
QUIT
+2 SET $PIECE(^BGPD(R,N),U,P)=$PIECE($GET(^BGPD(R,N)),U,P)+V
+3 QUIT
MEANBP(P,EDATE) ;
+1 NEW S,D,DS,X
+2 SET D=$$FMADD^XLFDT(EDATE,-365)
+3 SET X=$$BPS(P,D,EDATE,"I")
+4 SET S=$$SYSMEAN(X)
IF S=""
QUIT "^4"
+5 SET DS=$$DIAMEAN(X)
IF DS=""
QUIT "^4"
+6 IF S<130&(DS<80)
QUIT S_"/"_DS_" CON"_U_2
+7 QUIT S_"/"_DS_" UNC"_U_3
SYSMEAN(X) ;EP
+1 IF X=""
QUIT ""
+2 NEW Y,C
SET C=0
FOR Y=1:1:3
IF $PIECE(X,";",Y)]""
SET C=C+1
+3 IF C'=3
QUIT ""
+4 SET C=0
FOR Y=1:1:3
SET C=$PIECE($PIECE(X,";",Y),"/")+C
+5 QUIT C\3
DIAMEAN(X) ;EP
+1 IF X=""
QUIT ""
+2 NEW Y,C
SET C=0
FOR Y=1:1:3
IF $PIECE(X,";",Y)]""
SET C=C+1
+3 IF C'=3
QUIT ""
+4 SET C=0
FOR Y=1:1:3
SET C=$PIECE($PIECE(X,";",Y),"/",2)+C
+5 QUIT C\3
BPS(P,BDATE,EDATE,F) ;EP ;
+1 IF $GET(F)=""
SET F="E"
+2 NEW X,BGPG,E,BGPGL,BGPGLL,BGPGV
+3 SET BGPGLL=0
SET BGPGV=""
+4 KILL BGPG
+5 SET X=P_"^LAST 50 MEAS BP;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(X,"BGPG(")
+6 SET BGPGL=0
FOR
SET BGPGL=$ORDER(BGPG(BGPGL))
IF BGPGL'=+BGPGL!(BGPGLL=3)
QUIT
SET BGPGBP=$PIECE($GET(BGPG(BGPGL)),U,2)
Begin DoDot:1
+7 IF $$CLINIC^APCLV($PIECE(BGPG(BGPGL),U,5),"C")=30
QUIT
+8 SET BGPGLL=BGPGLL+1
+9 IF F="E"
SET $PIECE(BGPGV,";",BGPGLL)=BGPGBP_" "_$$FMTE^XLFDT($PIECE(BGPG(BGPGL),U))
+10 IF F="I"
SET $PIECE(BGPGV,";",BGPGLL)=$PIECE(BGPGBP," ")
End DoDot:1
+11 QUIT BGPGV
