BGP6PDL1.m

BGP6PDL1 ; IHS/CMI/LAB - print ind 1 01 Jul 2010 8:03 PM ;

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

 ;

 ;

I1 ;EP

 D:'$G(BGPSUMON) H1

I1A1 ;001.A, 001.B, 001.C

 I BGPINDM'="E" F BGPPC1="1.1","1.2","1.3" D PI

 I BGPINDM="E" S BGPPC1="1.4" D PI

 D I1AGE^BGP6PDL9

 Q

IREG ;EP

 D:'$G(BGPSUMON) H1

 S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:$P(^BGPINDM(BGPIC,0),U,13) S BGPPC1=BGPORDP_"."_BGPORDP1 D PI

 Q

SBI ;EP

 G ^BGP6DP1O

 ;

WASS ;

 D:'$G(BGPSUMON) H1

 S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:6 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT  D PI

 D ^BGP6DP1S

 ;D:'$G(BGPSUMON) H1

 ;S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=6,8 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT  D PI

 Q

IASCRN ;EP

 D:'$G(BGPSUMON) H1

 S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 D PI

 D ^BGP6PDLL

 Q

IHIV ;EP

 D:'$G(BGPSUMON) H1

 S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:6 S BGPPC1=BGPORDP_"."_BGPORDP1 D PI

 ;D ^BGP6DP1H

 Q

I8 ;EP

 D:'$G(BGPSUMON) H1

 S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:1 S BGPPC1=BGPORDP_"."_BGPORDP1 D PI

 Q

I9 ;EP

 D:'$G(BGPSUMON) H1

 S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1,3,4 S BGPPC1=BGPORDP_"."_BGPORDP1 D PI

 S BGPNODEN=1

 F BGPPC1=$P(^BGPINDM(BGPIC,12),U,6)_".5" D PI^BGP6PDL2 Q:BGPQUIT

 D ^BGP6PD19

 Q

I12 ;EP

 D:'$G(BGPSUMON) H1

 S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:7 S BGPPC1=BGPORDP_"."_BGPORDP1 D PI

 Q

I13 ;EP

 D:'$G(BGPSUMON) H1

 S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:3 S BGPPC1=BGPORDP_"."_BGPORDP1 D PI

 D I1AGE^BGP6PD19

 Q

I14 ;EP

 D:'$G(BGPSUMON) H1

 S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:3 S BGPPC1=BGPORDP_"."_BGPORDP1 D PI

 Q

I007 ;EP

 D:'$G(BGPSUMON) H1

 S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:7 S BGPPC1=BGPORDP_"."_BGPORDP1 D PI

 Q

I008 ;

 D:'$G(BGPSUMON) H1

 S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:5 S BGPPC1=BGPORDP_"."_BGPORDP1 D PI

 Q

IB ;EP

 D:'$G(BGPSUMON) H1

 S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:6 S BGPPC1=BGPORDP_"."_BGPORDP1 D PI

 Q

IH ;EP

 D:'$G(BGPSUMON) H1

 S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:6 S BGPPC1=BGPORDP_"."_BGPORDP1 D PI

 D I1AGE^BGP6PDLA

 Q

I91 ;EP

 D:'$G(BGPSUMON) H1

 S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:4 S BGPPC1=BGPORDP_"."_BGPORDP1 D PI

 D I1AGE^BGP6PDLB

 ;S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=7 S BGPPC1=BGPORDP_"."_BGPORDP1 D PI

 Q

PHYACT ;EP

 D:'$G(BGPSUMON) H1

 S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:$P(^BGPINDM(BGPIC,0),U,13) S BGPPC1=BGPORDP_"."_BGPORDP1 D PI

 D I1AGE^BGP6PDPA

 Q

IG ;EP

 D:'$G(BGPSUMON) H1

 S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:3 S BGPPC1=BGPORDP_"."_BGPORDP1 D PI

 Q

IEDA ;EP

 D:'$G(BGPSUMON) H1

 S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:3,6:1:8 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT  D PI

 D I1AGE^BGP6PDPB

 Q

IF ;EP

 D:'$G(BGPSUMON) H1

 S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:3 S BGPPC1=BGPORDP_"."_BGPORDP1 D PI

 Q

IA ;EP

 D:'$G(BGPSUMON) H1

 S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:18 S BGPPC1=BGPORDP_"."_BGPORDP1 D PI

 Q

ICRSAMM ;EP

 D:'$G(BGPSUMON) H1

 S BGPORDP=$P(^BGPINDM(BGPIC,0),U,2) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 D PI

 Q

I031A ;EP

 D:'$G(BGPSUMON) H1

 S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:14 S BGPPC1=BGPORDP_"."_BGPORDP1 D PI

 Q

ID ;EP

 D:'$G(BGPSUMON) H1

 S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:9 S BGPPC1=BGPORDP_"."_BGPORDP1 D PI

 Q

I0302 ;EP

 D:'$G(BGPSUMON) H1

 S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:9 S BGPPC1=BGPORDP_"."_BGPORDP1 D PI

 Q

I0303 ;EP

 D:'$G(BGPSUMON) H1

 S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:3 S BGPPC1=BGPORDP_"."_BGPORDP1 D PI

 Q

I0302A ;EP

 D:'$G(BGPSUMON) H1

 S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:4 S BGPPC1=BGPORDP_"."_BGPORDP1 D PI

 Q

IHEDBBH ;EP

 D:'$G(BGPSUMON) H1

 S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:6 S BGPPC1=BGPORDP_"."_BGPORDP1 D PI

 Q

IHEDPBH ;EP

 D:'$G(BGPSUMON) H1

 S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:6 S BGPPC1=BGPORDP_"."_BGPORDP1 D PI

 Q

IHEDCHM ;EP

 D:'$G(BGPSUMON) H1

 S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:6 S BGPPC1=BGPORDP_"."_BGPORDP1 D PI

 Q

IE2 ;

 D:'$G(BGPSUMON) H1

 S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:1 S BGPPC1=BGPORDP_"."_BGPORDP1 D PI

 Q

IE1 ;

 D:'$G(BGPSUMON) H1

 S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:1 S BGPPC1=BGPORDP_"."_BGPORDP1 D PI

 Q

IK ;EP

 D:'$G(BGPSUMON) H1

 S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:6 S BGPPC1=BGPORDP_"."_BGPORDP1 D PI

 Q

IOMW ;EP

 D:'$G(BGPSUMON) H1

 S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 D PI

 Q

IRAO ;EP

 D:'$G(BGPSUMON) H1

 S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 D PI

 Q

II ;EP

 D:'$G(BGPSUMON) H1

 S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 D PI

 Q

IL ;EP

 D:'$G(BGPSUMON) H1

 S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 D PI

 Q

IAS ;EP

 D:'$G(BGPSUMON) H1

 S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:$P(^BGPINDM(BGPIC,0),U,13) S BGPPC1=BGPORDP_"."_BGPORDP1 D PI

 Q

IAA ;

 D:'$G(BGPSUMON) H1

 S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:$P(^BGPINDM(BGPIC,0),U,13) S BGPPC1=BGPORDP_"."_BGPORDP1 D PI

 D ^BGP6DP1L

 Q

IMTA ;

 D:'$G(BGPSUMON) H1

 S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1,2,4 S BGPPC1=BGPORDP_"."_BGPORDP1 D PI

 D ^BGP6DP1M

 D ^BGP6DP1N

 Q

IMS ;EP

 D:'$G(BGPSUMON) H1

 S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 D PI

 Q

IC2 ;EP

 D:'$G(BGPSUMON) H1

 S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 D PI

 Q

IAST1 ;EP

 D:'$G(BGPSUMON) H1

 S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:12 S BGPPC1=BGPORDP_"."_BGPORDP1 D PI

 Q

IRAA ;EP

 D:'$G(BGPSUMON) H1

 S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 D PI

 Q

IRAR ;EP

 D:'$G(BGPSUMON) H1

 S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 D PI

 Q

IHEDCWP ;EP

 D:'$G(BGPSUMON) H1

 S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 D PI

 Q

IHEDURI ;EP

 D:'$G(BGPSUMON) H1

 S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 D PI

 Q

I28 ;EP

 D:'$G(BGPSUMON) H1

 S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=1:1:2 S BGPPC1=BGPORDP_"."_BGPORDP1 D PI

 Q

PI ;EP

 S BGPDENP=0

 S BGPPC2=0 F  S BGPPC2=$O(^BGPINDMC("ABC",BGPPC1,BGPPC2)) Q:BGPPC2=""  S BGPPC=$O(^BGPINDMC("ABC",BGPPC1,BGPPC2,0)) D PI1

 Q

PI1 ;EP

 K BGPEXCT,BGPSDP,BGPSDPN,BGPSDPO,BGPYSDPD

 Q:'$$CHECK^BGP6DP1E(BGPPC)

 I $P(^BGPINDMC(BGPPC,0),U,4)="E-2.B.3" S X=" " D S(X,1,1) D PI1^BGP6PDL2 Q  ;count only

 S BGPDF=$P(^BGPINDMC(BGPPC,0),U,8)

 ;get denominator value of measure

 S BGPNP=$P(^DD(90556.03,BGPDF,0),U,4),N=$P(BGPNP,";"),P=$P(BGPNP,";",2)

 S BGPCYD=$$V^BGP6DP1C(1,BGPRPT,N,P,1) I $G(BGPAREAA) D SETEXA^BGP6DP1C(1,N,P)

 S BGPPRD=$$V^BGP6DP1C(2,BGPRPT,N,P,1) I $G(BGPAREAA) D SETEXA^BGP6DP1C(2,N,P)

 S BGPBLD=$$V^BGP6DP1C(3,BGPRPT,N,P,1) I $G(BGPAREAA) D SETEXA^BGP6DP1C(3,N,P)

 ;write out denominator

 ;write out denom

 I BGPRTYPE=1,$P(^BGPINDMC(BGPPC,0),U,4)="MS.A.9" S BGPDENP=0

 I BGPRTYPE=1,$P(^BGPINDMC(BGPPC,0),U,4)="E-2.B.8" S BGPDENP=0

 I BGPRTYPE=1,$P(^BGPINDMC(BGPPC,0),U,4)="DM.2.1" S BGPDENP=0

 I BGPRTYPE=1,$P(^BGPINDMC(BGPPC,0),U,4)="E-2.A.1" S BGPDENP=0

 I BGPRTYPE=9,$P(^BGPINDMC(BGPPC,0),U,4)="027.C.36" S BGPDENP=0

 I BGPRTYPE=7,$P(^BGPINDMC(BGPPC,0),U,4)="028.C.4" S BGPDENP=0

 I 'BGPDENP D

 .S Y=" " D:$E($P($G(^BGPINDMC(BGPPC,12)),U,4),1,4)'=48.2!($P($G(^BGPINDMC(BGPPC,12)),U,4)="48.2.1")!($P($G(^BGPINDMC(BGPPC,12)),U,4)="43.22.1") S(Y,1,1) D

 .I $P($G(^BGPINDMC(BGPPC,12)),U,14) Q

 .I $G(BGPSEAT) D S($P(^DIBT(BGPSEAT,0),U)_" Population",1,1)

 .S Y=$$LABEL^BGP6UTL1(BGPPC,BGPRTYPE,BGPPTYPE,$G(BGPINDM),"D") D S(Y,1,1)

 .S Y=BGPCYD_"^^"_BGPPRD_"^^^"_BGPBLD D S(Y,,2)

 .S BGPDENP=1

 ;get numerator value of measure and calc %

 I $E($P(^BGPINDMC(BGPPC,0),U,4),1,2)="I." D

 .S BGPDF=$P(^BGPINDMC(BGPPC,0),U,8)

 .;get denominator value of measure

 .S BGPNP=$P(^DD(90556.03,BGPDF,0),U,4),N=$P(BGPNP,";"),P=$P(BGPNP,";",2)

 .S BGPCYD=$$V^BGP6DP1C(1,BGPRPT,N,P,1) I $G(BGPAREAA) D SETEXA^BGP6DP1C(1,N,P)

 .S BGPPRD=$$V^BGP6DP1C(2,BGPRPT,N,P,1) I $G(BGPAREAA) D SETEXA^BGP6DP1C(2,N,P)

 .S BGPBLD=$$V^BGP6DP1C(3,BGPRPT,N,P,1) I $G(BGPAREAA) D SETEXA^BGP6DP1C(3,N,P)

 S BGPNF=$P(^BGPINDMC(BGPPC,0),U,9)

 S BGPNP=$P(^DD(90556.03,BGPNF,0),U,4),N=$P(BGPNP,";"),P=$P(BGPNP,";",2)

 D SETN

 I $P(^BGPINDMC(BGPPC,0),U,22) D S(" ",1,1)

 S X=$$LABEL^BGP6UTL1(BGPPC,BGPRTYPE,BGPPTYPE,$G(BGPINDM),"N") D S(X,1,1)

 D H2

 Q

SETN ;EP - set numerator fields

 S BGPIIDEL=1

 D SETN^BGP6DP1C

 Q

C(X,X2,X3) ;

 D COMMA^%DTC

 Q X

S(Y,F,P) ;set up array

 I '$G(F) S F=0

 S %=$P(^TMP($J,"BGPDEL",0),U)+F,$P(^TMP($J,"BGPDEL",0),U)=%

 I '$D(^TMP($J,"BGPDEL",%)) S ^TMP($J,"BGPDEL",%)=""

 S $P(^TMP($J,"BGPDEL",%),U,P)=Y

 Q

CALC(N,O) ;

 NEW Z

 S Z=N-O,Z=$FN(Z,"+,",1)

 Q Z

H3 ;EP

 S X="Age Distribution" D S(X,1,1) S X=" " D S(X,1,1)

 S Y="<15" D S(Y,1,2)

 S Y="15-19" D S(Y,,3)

 S Y="20-24" D S(Y,,4)

 S Y="25-34" D S(Y,,5)

 S Y="35-44" D S(Y,,6)

 S Y="45-54" D S(Y,,7)

 S Y="55-64" D S(Y,,8)

 S Y="65+ yrs" D S(Y,,9)

 Q

SB(X) ;EP - Strip leading and trailing blanks from X.

 NEW %

 X ^DD("FUNC",$O(^DD("FUNC","B","STRIPBLANKS",0)),1)

 Q X

H2 ;EP

 S BGPX="",BGPX=BGPCYN,$P(BGPX,U,2)=$$SB($J(BGPCYP,5,1)),$P(BGPX,U,3)=BGPPRN,$P(BGPX,U,4)=$$SB($J(BGPPRP,5,1)),$P(BGPX,U,5)=$$SB($J($$CALC(BGPCYP,BGPPRP),6)),$P(BGPX,U,6)=BGPBLN,$P(BGPX,U,7)=$$SB($J(BGPBLP,5,1))

 S $P(BGPX,U,8)=$$SB($J($$CALC(BGPCYP,BGPBLP),6))

 D S(BGPX,,2)

 Q

H1 ;EP

 ;I BGPFONE=1 D S(" ",1,1) S Y=$P(^BGPINDM(BGPIC,0),U,3) D S(Y,1,1) S BGPFONE=0

 S Y="" D S(Y,1,1)

 S Y="REPORT" D S(Y,1,2)

 S Y="%" D S(Y,,3)

 S Y="PREV YR" D S(Y,,4)

 S Y="%" D S(Y,,5)

 S Y="CHG from" D S(Y,,6)

 S Y="BASE" D S(Y,,7)

 S Y="%" D S(Y,,8)

 S Y="CHG from" D S(Y,,9)

 S Y="PERIOD" D S(Y,1,2)

 S Y="PERIOD" D S(Y,,4)

 S Y="PREV YR %" D S(Y,,6)

 S Y="PERIOD" D S(Y,,7)

 S Y="BASE %" D S(Y,,9)

 Q

BGP6PDL1  ; IHS/CMI/LAB - print ind 1 01 Jul 2010 8:03 PM ;

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

 +2       ;

 +3       ;

I1        ;EP

 +1        IF '$GET(BGPSUMON)

               DO H1

I1A1      ;001.A, 001.B, 001.C

 +1        IF BGPINDM'="E"

               FOR BGPPC1="1.1","1.2","1.3"

                   DO PI

 +2        IF BGPINDM="E"

               SET BGPPC1="1.4"

               DO PI

 +3        DO I1AGE^BGP6PDL9

 +4        QUIT 

IREG      ;EP

 +1        IF '$GET(BGPSUMON)

               DO H1

 +2        SET BGPORDP=$PIECE(^BGPINDM(BGPIC,12),U,6)

           FOR BGPORDP1=1:1:$PIECE(^BGPINDM(BGPIC,0),U,13)

               SET BGPPC1=BGPORDP_"."_BGPORDP1

               DO PI

 +3        QUIT 

SBI       ;EP

 +1        GOTO ^BGP6DP1O

 +2       ;

WASS      ;

 +1        IF '$GET(BGPSUMON)

               DO H1

 +2        SET BGPORDP=$PIECE(^BGPINDM(BGPIC,12),U,6)

           FOR BGPORDP1=1:1:6

               SET BGPPC1=BGPORDP_"."_BGPORDP1

               IF BGPQUIT

                   QUIT 

               DO PI

 +3        DO ^BGP6DP1S

 +4       ;D:'$G(BGPSUMON) H1

 +5       ;S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=6,8 S BGPPC1=BGPORDP_"."_BGPORDP1 Q:BGPQUIT  D PI

 +6        QUIT 

IASCRN    ;EP

 +1        IF '$GET(BGPSUMON)

               DO H1

 +2        SET BGPORDP=$PIECE(^BGPINDM(BGPIC,12),U,6)

           FOR BGPORDP1=1:1:2

               SET BGPPC1=BGPORDP_"."_BGPORDP1

               DO PI

 +3        DO ^BGP6PDLL

 +4        QUIT 

IHIV      ;EP

 +1        IF '$GET(BGPSUMON)

               DO H1

 +2        SET BGPORDP=$PIECE(^BGPINDM(BGPIC,12),U,6)

           FOR BGPORDP1=1:1:6

               SET BGPPC1=BGPORDP_"."_BGPORDP1

               DO PI

 +3       ;D ^BGP6DP1H

 +4        QUIT 

I8        ;EP

 +1        IF '$GET(BGPSUMON)

               DO H1

 +2        SET BGPORDP=$PIECE(^BGPINDM(BGPIC,12),U,6)

           FOR BGPORDP1=1:1:1

               SET BGPPC1=BGPORDP_"."_BGPORDP1

               DO PI

 +3        QUIT 

I9        ;EP

 +1        IF '$GET(BGPSUMON)

               DO H1

 +2        SET BGPORDP=$PIECE(^BGPINDM(BGPIC,12),U,6)

           FOR BGPORDP1=1,3,4

               SET BGPPC1=BGPORDP_"."_BGPORDP1

               DO PI

 +3        SET BGPNODEN=1

 +4        FOR BGPPC1=$PIECE(^BGPINDM(BGPIC,12),U,6)_".5"

               DO PI^BGP6PDL2

               IF BGPQUIT

                   QUIT 

 +5        DO ^BGP6PD19

 +6        QUIT 

I12       ;EP

 +1        IF '$GET(BGPSUMON)

               DO H1

 +2        SET BGPORDP=$PIECE(^BGPINDM(BGPIC,12),U,6)

           FOR BGPORDP1=1:1:7

               SET BGPPC1=BGPORDP_"."_BGPORDP1

               DO PI

 +3        QUIT 

I13       ;EP

 +1        IF '$GET(BGPSUMON)

               DO H1

 +2        SET BGPORDP=$PIECE(^BGPINDM(BGPIC,12),U,6)

           FOR BGPORDP1=1:1:3

               SET BGPPC1=BGPORDP_"."_BGPORDP1

               DO PI

 +3        DO I1AGE^BGP6PD19

 +4        QUIT 

I14       ;EP

 +1        IF '$GET(BGPSUMON)

               DO H1

 +2        SET BGPORDP=$PIECE(^BGPINDM(BGPIC,12),U,6)

           FOR BGPORDP1=1:1:3

               SET BGPPC1=BGPORDP_"."_BGPORDP1

               DO PI

 +3        QUIT 

I007      ;EP

 +1        IF '$GET(BGPSUMON)

               DO H1

 +2        SET BGPORDP=$PIECE(^BGPINDM(BGPIC,12),U,6)

           FOR BGPORDP1=1:1:7

               SET BGPPC1=BGPORDP_"."_BGPORDP1

               DO PI

 +3        QUIT 

I008      ;

 +1        IF '$GET(BGPSUMON)

               DO H1

 +2        SET BGPORDP=$PIECE(^BGPINDM(BGPIC,12),U,6)

           FOR BGPORDP1=1:1:5

               SET BGPPC1=BGPORDP_"."_BGPORDP1

               DO PI

 +3        QUIT 

IB        ;EP

 +1        IF '$GET(BGPSUMON)

               DO H1

 +2        SET BGPORDP=$PIECE(^BGPINDM(BGPIC,12),U,6)

           FOR BGPORDP1=1:1:6

               SET BGPPC1=BGPORDP_"."_BGPORDP1

               DO PI

 +3        QUIT 

IH        ;EP

 +1        IF '$GET(BGPSUMON)

               DO H1

 +2        SET BGPORDP=$PIECE(^BGPINDM(BGPIC,12),U,6)

           FOR BGPORDP1=1:1:6

               SET BGPPC1=BGPORDP_"."_BGPORDP1

               DO PI

 +3        DO I1AGE^BGP6PDLA

 +4        QUIT 

I91       ;EP

 +1        IF '$GET(BGPSUMON)

               DO H1

 +2        SET BGPORDP=$PIECE(^BGPINDM(BGPIC,12),U,6)

           FOR BGPORDP1=1:1:4

               SET BGPPC1=BGPORDP_"."_BGPORDP1

               DO PI

 +3        DO I1AGE^BGP6PDLB

 +4       ;S BGPORDP=$P(^BGPINDM(BGPIC,12),U,6) F BGPORDP1=7 S BGPPC1=BGPORDP_"."_BGPORDP1 D PI

 +5        QUIT 

PHYACT    ;EP

 +1        IF '$GET(BGPSUMON)

               DO H1

 +2        SET BGPORDP=$PIECE(^BGPINDM(BGPIC,12),U,6)

           FOR BGPORDP1=1:1:$PIECE(^BGPINDM(BGPIC,0),U,13)

               SET BGPPC1=BGPORDP_"."_BGPORDP1

               DO PI

 +3        DO I1AGE^BGP6PDPA

 +4        QUIT 

IG        ;EP

 +1        IF '$GET(BGPSUMON)

               DO H1

 +2        SET BGPORDP=$PIECE(^BGPINDM(BGPIC,12),U,6)

           FOR BGPORDP1=1:1:3

               SET BGPPC1=BGPORDP_"."_BGPORDP1

               DO PI

 +3        QUIT 

IEDA      ;EP

 +1        IF '$GET(BGPSUMON)

               DO H1

 +2        SET BGPORDP=$PIECE(^BGPINDM(BGPIC,12),U,6)

           FOR BGPORDP1=1:1:3,6:1:8

               SET BGPPC1=BGPORDP_"."_BGPORDP1

               IF BGPQUIT

                   QUIT 

               DO PI

 +3        DO I1AGE^BGP6PDPB

 +4        QUIT 

IF        ;EP

 +1        IF '$GET(BGPSUMON)

               DO H1

 +2        SET BGPORDP=$PIECE(^BGPINDM(BGPIC,12),U,6)

           FOR BGPORDP1=1:1:3

               SET BGPPC1=BGPORDP_"."_BGPORDP1

               DO PI

 +3        QUIT 

IA        ;EP

 +1        IF '$GET(BGPSUMON)

               DO H1

 +2        SET BGPORDP=$PIECE(^BGPINDM(BGPIC,12),U,6)

           FOR BGPORDP1=1:1:18

               SET BGPPC1=BGPORDP_"."_BGPORDP1

               DO PI

 +3        QUIT 

ICRSAMM   ;EP

 +1        IF '$GET(BGPSUMON)

               DO H1

 +2        SET BGPORDP=$PIECE(^BGPINDM(BGPIC,0),U,2)

           FOR BGPORDP1=1:1:2

               SET BGPPC1=BGPORDP_"."_BGPORDP1

               DO PI

 +3        QUIT 

I031A     ;EP

 +1        IF '$GET(BGPSUMON)

               DO H1

 +2        SET BGPORDP=$PIECE(^BGPINDM(BGPIC,12),U,6)

           FOR BGPORDP1=1:1:14

               SET BGPPC1=BGPORDP_"."_BGPORDP1

               DO PI

 +3        QUIT 

ID        ;EP

 +1        IF '$GET(BGPSUMON)

               DO H1

 +2        SET BGPORDP=$PIECE(^BGPINDM(BGPIC,12),U,6)

           FOR BGPORDP1=1:1:9

               SET BGPPC1=BGPORDP_"."_BGPORDP1

               DO PI

 +3        QUIT 

I0302     ;EP

 +1        IF '$GET(BGPSUMON)

               DO H1

 +2        SET BGPORDP=$PIECE(^BGPINDM(BGPIC,12),U,6)

           FOR BGPORDP1=1:1:9

               SET BGPPC1=BGPORDP_"."_BGPORDP1

               DO PI

 +3        QUIT 

I0303     ;EP

 +1        IF '$GET(BGPSUMON)

               DO H1

 +2        SET BGPORDP=$PIECE(^BGPINDM(BGPIC,12),U,6)

           FOR BGPORDP1=1:1:3

               SET BGPPC1=BGPORDP_"."_BGPORDP1

               DO PI

 +3        QUIT 

I0302A    ;EP

 +1        IF '$GET(BGPSUMON)

               DO H1

 +2        SET BGPORDP=$PIECE(^BGPINDM(BGPIC,12),U,6)

           FOR BGPORDP1=1:1:4

               SET BGPPC1=BGPORDP_"."_BGPORDP1

               DO PI

 +3        QUIT 

IHEDBBH   ;EP

 +1        IF '$GET(BGPSUMON)

               DO H1

 +2        SET BGPORDP=$PIECE(^BGPINDM(BGPIC,12),U,6)

           FOR BGPORDP1=1:1:6

               SET BGPPC1=BGPORDP_"."_BGPORDP1

               DO PI

 +3        QUIT 

IHEDPBH   ;EP

 +1        IF '$GET(BGPSUMON)

               DO H1

 +2        SET BGPORDP=$PIECE(^BGPINDM(BGPIC,12),U,6)

           FOR BGPORDP1=1:1:6

               SET BGPPC1=BGPORDP_"."_BGPORDP1

               DO PI

 +3        QUIT 

IHEDCHM   ;EP

 +1        IF '$GET(BGPSUMON)

               DO H1

 +2        SET BGPORDP=$PIECE(^BGPINDM(BGPIC,12),U,6)

           FOR BGPORDP1=1:1:6

               SET BGPPC1=BGPORDP_"."_BGPORDP1

               DO PI

 +3        QUIT 

IE2       ;

 +1        IF '$GET(BGPSUMON)

               DO H1