BGP0EL31.m

BGP0EL31 ; IHS/CMI/LAB - measure 1,2,3,4 05 Apr 2009 1:44 PM ;

 ;;10.0;IHS CLINICAL REPORTING;;JUN 18, 2010

 ;

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^BGP0EL4(DFN,BGPBDATE,BGPEDATE)

 I $P(BGPVALUE,U) S BGPN1=1

 S BGPVALUE="AC|||"_$S(BGPN1:"YES: ",1:"NO: ")_$P(BGPVALUE,U,2)

 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^BGP0D31(DFN,BGP365,BGPEDATE)

 I BGPN1 S BGPHOSPL=$$HOSP^BGP0D31(DFN,BGP365,BGPEDATE) I BGPHOSPL S BGPN2=1

 S BGPVALUE="AC"_"|||"_$S(BGPN1:$$LAST^BGP0D31(DFN,BGP365,BGPEDATE),1:"")_" "_$S(BGPHOSPL:"H "_$$DATE^BGP0UTL($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^BGP0EL4(DFN,BGP365,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

BGP0EL31  ; IHS/CMI/LAB - measure 1,2,3,4 05 Apr 2009 1:44 PM ;

 +1       ;;10.0;IHS CLINICAL REPORTING;;JUN 18, 2010

 +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^BGP0EL4(DFN,BGPBDATE,BGPEDATE)

 +11       IF $PIECE(BGPVALUE,U)

               SET BGPN1=1

 +12       SET BGPVALUE="AC|||"_$SELECT(BGPN1:"YES: ",1:"NO: ")_$PIECE(BGPVALUE,U,2)

 +13       KILL X,Y,Z,%,A,B,C,D,E,H,BDATE,EDATE,P,V,S,F,T,BGPG

 +14       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^BGP0D31(DFN,BGP365,BGPEDATE)

 +12       IF BGPN1

               SET BGPHOSPL=$$HOSP^BGP0D31(DFN,BGP365,BGPEDATE)

               IF BGPHOSPL

                   SET BGPN2=1

 +13       SET BGPVALUE="AC"_"|||"_$SELECT(BGPN1:$$LAST^BGP0D31(DFN,BGP365,BGPEDATE),1:"")_" "_$SELECT(BGPHOSPL:"H "_$$DATE^BGP0UTL($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^BGP0EL4(DFN,BGP365,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