BGP5EL31 ; IHS/CMI/LAB - measure 1,2,3,4 05 Apr 2010 1:44 PM ;
;;15.1;IHS CLINICAL REPORTING;;MAY 06, 2015;Build 143
;
IELDFSA ;EP
S (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5)=0
S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7)=0
I BGPAGEB<55 S BGPSTOP=1 Q
I 'BGPACTCL S BGPSTOP=1 Q
S BGPD1=1
I BGPAGEB>54,BGPAGEB<65 S BGPD2=1
I BGPAGEB>64,BGPAGEB<75 S BGPD3=1
I BGPAGEB>74,BGPAGEB<85 S BGPD4=1
I BGPAGEB>84 S BGPD5=1
S BGPVALUE=$$FUNCTION^BGP5EL4(DFN,BGPBDATE,BGPEDATE)
I $P(BGPVALUE,U) S BGPN1=1
S BGPVALUE=$S($P(BGPVALUE,U,2)="":"",BGPN1:"YES: ",1:"NO: ")_$P(BGPVALUE,U,2)
S BGPVALUE="AC|||"_BGPVALUE
K X,Y,Z,%,A,B,C,D,E,H,BDATE,EDATE,P,V,S,F,T,BGPG
Q
IELDASA ;EP
S (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5)=0
S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7)=0
I BGPAGEB<55 S BGPSTOP=1 Q
I 'BGPACTCL S BGPSTOP=1 Q
S BGPD1=1
I BGPAGEB>54,BGPAGEB<65 S BGPD2=1
I BGPAGEB>64,BGPAGEB<75 S BGPD3=1
I BGPAGEB>74,BGPAGEB<85 S BGPD4=1
I BGPAGEB>84 S BGPD5=1
S BGPHOSPL=""
S BGPN1=$$V2ASTH^BGP5D31(DFN,BGP365,BGPEDATE)
I BGPN1 S BGPHOSPL=$$HOSP^BGP5D31(DFN,BGP365,BGPEDATE) I BGPHOSPL S BGPN2=1
S BGPVALUE="AC"_"|||"_$S(BGPN1:$P(BGPN1,U,2),1:"")_" "_$S(BGPHOSPL:"H "_$$DATE^BGP5UTL($P(BGPHOSPL,U,2)),1:"")
K X,Y,Z,%,A,B,C,D,E,H,BDATE,EDATE,P,V,S,F,T,BGPG
Q
IELDPHA ;EP - PHN
S (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5)=0
S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7)=0
I BGPAGEB<55 S BGPSTOP=1 Q
S BGPD1=1
I BGPAGEB>54,BGPAGEB<65 S BGPD2=1
I BGPAGEB>64,BGPAGEB<75 S BGPD3=1
I BGPAGEB>74,BGPAGEB<85 S BGPD4=1
I BGPAGEB>84 S BGPD5=1
S BGPVALUE=$$PHNV^BGP5EL4(DFN,BGPBDATE,BGPEDATE,BGPHOME)
S BGPN1=BGPVALUE
S BGPVALUE="UP|||"_$P(BGPVALUE,U)_" all PHN; "_$P(BGPVALUE,U,7)_" home; "_$P(BGPVALUE,U,6)_" driver all; "_$P(BGPVALUE,U,12)_" driver home"
Q
BGP5EL31 ; IHS/CMI/LAB - measure 1,2,3,4 05 Apr 2010 1:44 PM ;
+1 ;;15.1;IHS CLINICAL REPORTING;;MAY 06, 2015;Build 143
+2 ;
IELDFSA ;EP
+1 SET (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5)=0
+2 SET (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7)=0
+3 IF BGPAGEB<55
SET BGPSTOP=1
QUIT
+4 IF 'BGPACTCL
SET BGPSTOP=1
QUIT
+5 SET BGPD1=1
+6 IF BGPAGEB>54
IF BGPAGEB<65
SET BGPD2=1
+7 IF BGPAGEB>64
IF BGPAGEB<75
SET BGPD3=1
+8 IF BGPAGEB>74
IF BGPAGEB<85
SET BGPD4=1
+9 IF BGPAGEB>84
SET BGPD5=1
+10 SET BGPVALUE=$$FUNCTION^BGP5EL4(DFN,BGPBDATE,BGPEDATE)
+11 IF $PIECE(BGPVALUE,U)
SET BGPN1=1
+12 SET BGPVALUE=$SELECT($PIECE(BGPVALUE,U,2)="":"",BGPN1:"YES: ",1:"NO: ")_$PIECE(BGPVALUE,U,2)
+13 SET BGPVALUE="AC|||"_BGPVALUE
+14 KILL X,Y,Z,%,A,B,C,D,E,H,BDATE,EDATE,P,V,S,F,T,BGPG
+15 QUIT
IELDASA ;EP
+1 SET (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5)=0
+2 SET (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7)=0
+3 IF BGPAGEB<55
SET BGPSTOP=1
QUIT
+4 IF 'BGPACTCL
SET BGPSTOP=1
QUIT
+5 SET BGPD1=1
+6 IF BGPAGEB>54
IF BGPAGEB<65
SET BGPD2=1
+7 IF BGPAGEB>64
IF BGPAGEB<75
SET BGPD3=1
+8 IF BGPAGEB>74
IF BGPAGEB<85
SET BGPD4=1
+9 IF BGPAGEB>84
SET BGPD5=1
+10 SET BGPHOSPL=""
+11 SET BGPN1=$$V2ASTH^BGP5D31(DFN,BGP365,BGPEDATE)
+12 IF BGPN1
SET BGPHOSPL=$$HOSP^BGP5D31(DFN,BGP365,BGPEDATE)
IF BGPHOSPL
SET BGPN2=1
+13 SET BGPVALUE="AC"_"|||"_$SELECT(BGPN1:$PIECE(BGPN1,U,2),1:"")_" "_$SELECT(BGPHOSPL:"H "_$$DATE^BGP5UTL($PIECE(BGPHOSPL,U,2)),1:"")
+14 KILL X,Y,Z,%,A,B,C,D,E,H,BDATE,EDATE,P,V,S,F,T,BGPG
+15 QUIT
IELDPHA ;EP - PHN
+1 SET (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5)=0
+2 SET (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7)=0
+3 IF BGPAGEB<55
SET BGPSTOP=1
QUIT
+4 SET BGPD1=1
+5 IF BGPAGEB>54
IF BGPAGEB<65
SET BGPD2=1
+6 IF BGPAGEB>64
IF BGPAGEB<75
SET BGPD3=1
+7 IF BGPAGEB>74
IF BGPAGEB<85
SET BGPD4=1
+8 IF BGPAGEB>84
SET BGPD5=1
+9 SET BGPVALUE=$$PHNV^BGP5EL4(DFN,BGPBDATE,BGPEDATE,BGPHOME)
+10 SET BGPN1=BGPVALUE
+11 SET BGPVALUE="UP|||"_$PIECE(BGPVALUE,U)_" all PHN; "_$PIECE(BGPVALUE,U,7)_" home; "_$PIECE(BGPVALUE,U,6)_" driver all; "_$PIECE(BGPVALUE,U,12)_" driver home"
+12 QUIT