- 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
