Routine: BGP6DH2

BGP6DH2 ; IHS/CMI/LAB - cover page for gpra 28 Apr 2010 11:30 AM 02 Jul 2010 8:28 AM ;

 ;;16.1;IHS CLINICAL REPORTING;;MAR 22, 2016;Build 170

DASH ;EP

 D W^BGP6DP("",0,1,BGPPTYPE)

 S BGPNODEP=91

 S BGPX=$O(^BGPCTRL("B",2016,0))

 S BGPY=0 F  S BGPY=$O(^BGPCTRL(BGPX,BGPNODEP,BGPY)) Q:BGPY'=+BGPY!(BGPQHDR)  D

 .I BGPPTYPE="P",$Y>(BGPIOSL-2) D HDR^BGP6DH I BGPPTYPE="P" Q:BGPQHDR

 .D W^BGP6DP(^BGPCTRL(BGPX,BGPNODEP,BGPY,0),0,1,BGPPTYPE)

.Q

 D W^BGP6DP("",0,1,BGPPTYPE)

ONMHDRA ;EP

 D W^BGP6DP("",0,1,BGPPTYPE)

 S BGPTEXT="ONH1" F BGPJ1=1:1 S BGPX=$T(@BGPTEXT+BGPJ1) Q:$P(BGPX,";;",2)="QUIT"  D

 .S BGPT=$P(BGPX,";;",2)

 .I BGPPTYPE="P",$Y>(BGPIOSL-2) D HDR^BGP6DH I BGPPTYPE="P" Q:BGPQHDR

 .D W^BGP6DP(BGPT,0,1,BGPPTYPE)

 I BGPPTYPE="P" Q:BGPQHDR

 I BGPRTC="U" D  I BGPPTYPE="P" Q:BGPQHDR

 .I BGPPTYPE="P",$Y>(BGPIOSL-2) D HDR^BGP6DH I BGPPTYPE="P" Q:BGPQHDR

 .D W^BGP6DP("3. User defines population: a) Indian/Alaska Natives Only - based on",0,1,BGPPTYPE)

 .D W^BGP6DP("Classification of 01; b) Non AI/AN (not 01); or c) Both.",0,1,BGPPTYPE)

 I BGPRTC="H" D  I BGPPTYPE="P" Q:BGPQHDR

 .I BGPPTYPE="P",$Y>(BGPIOSL-2) D  I BGPPTYPE="P" Q:BGPQHDR

 .D W^BGP6DP("3. Indian/Alaska Natives Only - based on Classification of 01.",0,1,BGPPTYPE)

 I BGPPTYPE="P" Q:BGPQHDR

 S BGPTEXT="ONH2" F BGPJ1=1:1 S BGPX=$T(@BGPTEXT+BGPJ1) Q:$P(BGPX,";;",2)="QUIT"  D

 .S BGPT=$P(BGPX,";;",2)

 .I BGPPTYPE="P",$Y>(BGPIOSL-2) D HDR^BGP6DH I BGPPTYPE="P" Q:BGPQHDR

 .D W^BGP6DP(BGPT,0,1,BGPPTYPE)

 I BGPPTYPE="P" Q:BGPQHDR

 S BGPTEXT="UP" F BGPJ1=1:1 S BGPX=$T(@BGPTEXT+BGPJ1) Q:$P(BGPX,";;",2)="QUIT"  D

 .S BGPT=$P(BGPX,";;",2)

 .I BGPPTYPE="P",$Y>(BGPIOSL-2) D HDR^BGP6DH I BGPPTYPE="P" Q:BGPQHDR

 .D W^BGP6DP(BGPT,0,1,BGPPTYPE)

 D W^BGP6DP("See last pages of this report for Performance Summary.",0,2,BGPPTYPE)

 D W^BGP6DP("",0,1,BGPPTYPE)

ONH1 ;;

 ;;Denominator Definitions used in this Report:

;;

 ;;ACTIVE CLINICAL POPULATION:

 ;;1. Must reside in a community specified in the community taxonomy used for

 ;;this report.

 ;;2. Must be alive on the last day of the Report period.

 ;;QUIT

ONH2 ;;

 ;;4. Must have 2 visits to medical clinics in the 3 years prior to the end

 ;;of the Report period. At least one visit must include: 01 General,

 ;;06 Diabetic, 10 GYN, 12 Immunization, 13 Internal Med, 20 Pediatrics, 24

 ;;Well Child, 28 Family Practice, 57 EPSDT, 70 Women's Health, 80 Urgent, 89

 ;;Evening.  See User Manual for complete description of medical clinics.

 ;;QUIT

;;

UP ;;

;;

 ;;USER POPULATION:

 ;;1. Definitions 1-3 above.

 ;;2. Must have been seen at least once in the 3 years prior to the end of

 ;;the Report period, regardless of the clinic type.

;;

 ;;QUIT

;;

UP1 ;;

;;

 ;;USER POPULATION:

 ;;1. Definitions 1-3 above.

 ;;2. Must have been seen at least once in the 3 years prior to the end of

 ;;the Report period, regardless of the clinic type.

;;

 ;;QUIT

;;

;;

GPRAHDRA ;EP

 D W^BGP6DP("",0,1,BGPPTYPE)

 S BGPX=$O(^BGPCTRL("B",2016,0))

 S BGPNODEP=15 D 2

 ;S BGPTEXT="UP" F BGPJ1=1:1 S BGPX=$T(@BGPTEXT+BGPJ1) Q:$P(BGPX,";;",2)="QUIT"  D

 ;.S BGPT=$P(BGPX,";;",2)

 ;.I BGPPTYPE="P",$Y>(BGPIOSL-2) D HDR^BGP6DH I BGPPTYPE="P" Q:BGPQHDR

 ;.D W^BGP6DP(BGPT,0,1,BGPPTYPE)

2 S BGPY=0 F  S BGPY=$O(^BGPCTRL(BGPX,BGPNODEP,BGPY)) Q:BGPY'=+BGPY!(BGPQHDR)  D

 .I BGPPTYPE="P",$Y>(BGPIOSL-2) D AHDR^BGP6DH1 Q:BGPQHDR

 .D W^BGP6DP(^BGPCTRL(BGPX,BGPNODEP,BGPY,0),0,1,BGPPTYPE)

.Q

DASHHDRA ;EP

 D W^BGP6DP("",0,1,BGPPTYPE)

 S BGPX=$O(^BGPCTRL("B",2016,0))

 S BGPNODEP=94 D 2

 ;D W^BGP6DP("",0,1,BGPPTYPE)

 S BGPTEXT="UP1" F BGPJ1=1:1 S BGPX=$T(@BGPTEXT+BGPJ1) Q:$P(BGPX,";;",2)="QUIT"  D

 .S BGPT=$P(BGPX,";;",2)

 .I BGPPTYPE="P",$Y>(BGPIOSL-2) D HDR^BGP6DH I BGPPTYPE="P" Q:BGPQHDR

 .D W^BGP6DP(BGPT,0,1,BGPPTYPE)

BGP6DH2   ; IHS/CMI/LAB - cover page for gpra 28 Apr 2010 11:30 AM 02 Jul 2010 8:28 AM ;

 +1       ;;16.1;IHS CLINICAL REPORTING;;MAR 22, 2016;Build 170

 +2       ;

 +3       ;

DASH      ;EP

 +1        DO W^BGP6DP("",0,1,BGPPTYPE)

 +2        SET BGPNODEP=91

 +3        SET BGPX=$ORDER(^BGPCTRL("B",2016,0))

 +4        SET BGPY=0

FOR

               SET BGPY=$ORDER(^BGPCTRL(BGPX,BGPNODEP,BGPY))

               IF BGPY'=+BGPY!(BGPQHDR)

                   QUIT

               Begin DoDot:1

 +5                IF BGPPTYPE="P"

                       IF $Y>(BGPIOSL-2)

                           DO HDR^BGP6DH

                           IF BGPPTYPE="P"

                               IF BGPQHDR

                                   QUIT

 +6                DO W^BGP6DP(^BGPCTRL(BGPX,BGPNODEP,BGPY,0),0,1,BGPPTYPE)

 +7                QUIT

               End DoDot:1

 +8        DO W^BGP6DP("",0,1,BGPPTYPE)

 +9        QUIT

ONMHDRA   ;EP

 +1        DO W^BGP6DP("",0,1,BGPPTYPE)

 +2        SET BGPTEXT="ONH1"

           FOR BGPJ1=1:1

               SET BGPX=$TEXT(@BGPTEXT+BGPJ1)

               IF $PIECE(BGPX,";;",2)="QUIT"

                   QUIT

               Begin DoDot:1

 +3                SET BGPT=$PIECE(BGPX,";;",2)

 +4                IF BGPPTYPE="P"

                       IF $Y>(BGPIOSL-2)

                           DO HDR^BGP6DH

                           IF BGPPTYPE="P"

                               IF BGPQHDR

                                   QUIT

 +5                DO W^BGP6DP(BGPT,0,1,BGPPTYPE)

               End DoDot:1

 +6        IF BGPPTYPE="P"

               IF BGPQHDR

                   QUIT

 +7        IF BGPRTC="U"

               Begin DoDot:1

 +8                IF BGPPTYPE="P"

                       IF $Y>(BGPIOSL-2)

                           DO HDR^BGP6DH

                           IF BGPPTYPE="P"

                               IF BGPQHDR

                                   QUIT

 +9                DO W^BGP6DP("3. User defines population: a) Indian/Alaska Natives Only - based on",0,1,BGPPTYPE)

 +10               DO W^BGP6DP("Classification of 01; b) Non AI/AN (not 01); or c) Both.",0,1,BGPPTYPE)

               End DoDot:1

               IF BGPPTYPE="P"

                   IF BGPQHDR

                       QUIT

 +11       IF BGPRTC="H"

               Begin DoDot:1

 +12               IF BGPPTYPE="P"

                       IF $Y>(BGPIOSL-2)

                           Begin DoDot:2

                           End DoDot:2

                           IF BGPPTYPE="P"

                               IF BGPQHDR

                                   QUIT

 +13               DO W^BGP6DP("3. Indian/Alaska Natives Only - based on Classification of 01.",0,1,BGPPTYPE)

               End DoDot:1

               IF BGPPTYPE="P"

                   IF BGPQHDR

                       QUIT

 +14       IF BGPPTYPE="P"

               IF BGPQHDR

                   QUIT

 +15       SET BGPTEXT="ONH2"

           FOR BGPJ1=1:1

               SET BGPX=$TEXT(@BGPTEXT+BGPJ1)

               IF $PIECE(BGPX,";;",2)="QUIT"

                   QUIT

               Begin DoDot:1

 +16               SET BGPT=$PIECE(BGPX,";;",2)

 +17               IF BGPPTYPE="P"

                       IF $Y>(BGPIOSL-2)

                           DO HDR^BGP6DH

                           IF BGPPTYPE="P"

                               IF BGPQHDR

                                   QUIT

 +18               DO W^BGP6DP(BGPT,0,1,BGPPTYPE)

               End DoDot:1

 +19       IF BGPPTYPE="P"

               IF BGPQHDR

                   QUIT

 +20       SET BGPTEXT="UP"

           FOR BGPJ1=1:1

               SET BGPX=$TEXT(@BGPTEXT+BGPJ1)

               IF $PIECE(BGPX,";;",2)="QUIT"

                   QUIT

               Begin DoDot:1

 +21               SET BGPT=$PIECE(BGPX,";;",2)

 +22               IF BGPPTYPE="P"

                       IF $Y>(BGPIOSL-2)

                           DO HDR^BGP6DH

                           IF BGPPTYPE="P"

                               IF BGPQHDR

                                   QUIT

 +23               DO W^BGP6DP(BGPT,0,1,BGPPTYPE)

               End DoDot:1

 +24       DO W^BGP6DP("See last pages of this report for Performance Summary.",0,2,BGPPTYPE)

 +25       DO W^BGP6DP("",0,1,BGPPTYPE)

 +26       QUIT

ONH1      ;;

 +1       ;;Denominator Definitions used in this Report:

 +2       ;;

 +3       ;;ACTIVE CLINICAL POPULATION:

 +4       ;;1. Must reside in a community specified in the community taxonomy used for

 +5       ;;this report.

 +6       ;;2. Must be alive on the last day of the Report period.

 +7       ;;QUIT

 +8       ;

ONH2      ;;

 +1       ;;4. Must have 2 visits to medical clinics in the 3 years prior to the end

 +2       ;;of the Report period. At least one visit must include: 01 General,

 +3       ;;06 Diabetic, 10 GYN, 12 Immunization, 13 Internal Med, 20 Pediatrics, 24

 +4       ;;Well Child, 28 Family Practice, 57 EPSDT, 70 Women's Health, 80 Urgent, 89

 +5       ;;Evening.  See User Manual for complete description of medical clinics.

 +6       ;;QUIT

 +7       ;;

UP        ;;

 +1       ;;

 +2       ;;USER POPULATION:

 +3       ;;1. Definitions 1-3 above.

 +4       ;;2. Must have been seen at least once in the 3 years prior to the end of

 +5       ;;the Report period, regardless of the clinic type.

 +6       ;;

 +7       ;;QUIT

 +8       ;;

UP1       ;;

 +1       ;;

 +2       ;;USER POPULATION:

 +3       ;;1. Definitions 1-3 above.

 +4       ;;2. Must have been seen at least once in the 3 years prior to the end of

 +5       ;;the Report period, regardless of the clinic type.

 +6       ;;

 +7       ;;QUIT

 +8       ;;

 +9       ;;

GPRAHDRA  ;EP

 +1        DO W^BGP6DP("",0,1,BGPPTYPE)

 +2        SET BGPX=$ORDER(^BGPCTRL("B",2016,0))

 +3        SET BGPNODEP=15

           DO 2

 +4       ;S BGPTEXT="UP" F BGPJ1=1:1 S BGPX=$T(@BGPTEXT+BGPJ1) Q:$P(BGPX,";;",2)="QUIT"  D

 +5       ;.S BGPT=$P(BGPX,";;",2)

 +6       ;.I BGPPTYPE="P",$Y>(BGPIOSL-2) D HDR^BGP6DH I BGPPTYPE="P" Q:BGPQHDR

 +7       ;.D W^BGP6DP(BGPT,0,1,BGPPTYPE)

 +8        QUIT

2          SET BGPY=0

FOR

               SET BGPY=$ORDER(^BGPCTRL(BGPX,BGPNODEP,BGPY))

               IF BGPY'=+BGPY!(BGPQHDR)

                   QUIT

               Begin DoDot:1

 +1                IF BGPPTYPE="P"

                       IF $Y>(BGPIOSL-2)

                           DO AHDR^BGP6DH1

                           IF BGPQHDR

                               QUIT

 +2                DO W^BGP6DP(^BGPCTRL(BGPX,BGPNODEP,BGPY,0),0,1,BGPPTYPE)

 +3                QUIT

               End DoDot:1

 +4        QUIT

DASHHDRA  ;EP

 +1        DO W^BGP6DP("",0,1,BGPPTYPE)

 +2        SET BGPX=$ORDER(^BGPCTRL("B",2016,0))

 +3        SET BGPNODEP=94

           DO 2

 +4       ;D W^BGP6DP("",0,1,BGPPTYPE)

 +5        SET BGPTEXT="UP1"

           FOR BGPJ1=1:1

               SET BGPX=$TEXT(@BGPTEXT+BGPJ1)

               IF $PIECE(BGPX,";;",2)="QUIT"

                   QUIT

               Begin DoDot:1

 +6                SET BGPT=$PIECE(BGPX,";;",2)

 +7                IF BGPPTYPE="P"

                       IF $Y>(BGPIOSL-2)

                           DO HDR^BGP6DH

                           IF BGPPTYPE="P"

                               IF BGPQHDR

                                   QUIT

 +8                DO W^BGP6DP(BGPT,0,1,BGPPTYPE)

               End DoDot:1

 +9        QUIT

BGP6DH2.m