BGPDC.m

BGPDC ; IHS/CMI/LAB - indicator C ;

 ;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007

 ;

IC ;EP ;EP - indicator C

 ;Q:'$D(BGPIND(29))

 S BGPSEX=$P(^DPT(DFN,0),U,2),BGPSEX=$S(BGPSEX="M":1,1:2)

 D SAGE(BGPRPT,$S(BGPTIME=1:29,BGPTIME=0:59,BGPTIME=8:99,1:999),19,BGPSEX,1)

 S BGPAGEEP=$S(BGPAGEE<10:2,BGPAGEE>9&(BGPAGEE<20):3,BGPAGEE>19&(BGPAGEE<25):4,BGPAGEE>24&(BGPAGEE<35):5,BGPAGEE>34&(BGPAGEE<45):6,BGPAGEE>44&(BGPAGEE<55):7,BGPAGEE>54&(BGPAGEE<65):8,BGPAGEE>64:9,1:"")

 D SAGE(BGPRPT,$S(BGPTIME=1:29,BGPTIME=0:59,BGPTIME=8:99,1:999),BGPAGEEP,BGPSEX,1)

 S BGPEDPAT=$$ED(DFN,BGPEDATE)

 D SAGE(BGPRPT,$S(BGPTIME=1:29,BGPTIME=0:59,BGPTIME=8:99,1:"999"),10,BGPSEX,BGPEDPAT)

 I 'BGPEDPAT,$D(BGPLIST(26)),BGPTIME=1 S ^XTMP("BGPGAGD",BGPJ,BGPH,"LIST",26,$S($P($G(^AUPNPAT(DFN,11)),U,18)]"":$P(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$P(^DPT(DFN,0),U,2),BGPAGEE,DFN)=""

 S BGPAGEEP=$S(BGPAGEE<10:11,BGPAGEE>9&(BGPAGEE<20):12,BGPAGEE>19&(BGPAGEE<25):13,BGPAGEE>24&(BGPAGEE<35):14,BGPAGEE>34&(BGPAGEE<45):15,BGPAGEE>44&(BGPAGEE<55):16,BGPAGEE>54&(BGPAGEE<65):17,BGPAGEE>64:18,1:"")

 D SAGE(BGPRPT,$S(BGPTIME=1:29,BGPTIME=0:59,BGPTIME=8:99,1:999),BGPAGEEP,BGPSEX,BGPEDPAT)

 I 'BGPEDPAT,$D(BGPLIST(29)),BGPTIME=1 S ^XTMP("BGPD",BGPJ,BGPH,"LIST",29,$S($P($G(^AUPNPAT(DFN,11)),U,18)]"":$P(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$P(^DPT(DFN,0),U,2),BGPAGEE,DFN)="No Diet/Exc Educ provided"

 Q

SAGE(R,N,P,S,V) ;set age into file

 I 'V Q  ;no value

 NEW X,Y

 S X=$P($G(^BGPD(R,N)),U,P)

 S $P(X,"!",S)=$P(X,"!",S)+V

 S $P(^BGPD(R,N),U,P)=X

 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

ED(P,EDATE) ;education in past year

 NEW BDATE,%,X,E,R,BGPG

 K BGPG

 S BDATE=$$FMADD^XLFDT(EDATE,-365)

 S X=P_"^EDUC [BGP GPRA EX EDUC TOPICS;DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,"BGPG(")

 I $D(BGPG(1)) Q 1

 Q 0

BGPDC     ; IHS/CMI/LAB - indicator C ;

 +1       ;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007

 +2       ;

IC        ;EP ;EP - indicator C

 +1       ;Q:'$D(BGPIND(29))

 +2        SET BGPSEX=$PIECE(^DPT(DFN,0),U,2)

           SET BGPSEX=$SELECT(BGPSEX="M":1,1:2)

 +3        DO SAGE(BGPRPT,$SELECT(BGPTIME=1:29,BGPTIME=0:59,BGPTIME=8:99,1:999),19,BGPSEX,1)

 +4        SET BGPAGEEP=$SELECT(BGPAGEE<10:2,BGPAGEE>9&(BGPAGEE<20):3,BGPAGEE>19&(BGPAGEE<25):4,BGPAGEE>24&(BGPAGEE<35):5,BGPAGEE>34&(BGPAGEE<45):6,BGPAGEE>44&(BGPAGEE<55):7,BGPAGEE>54&(BGPAGEE<65):8,BGPAGEE>64:9,1:"")

 +5        DO SAGE(BGPRPT,$SELECT(BGPTIME=1:29,BGPTIME=0:59,BGPTIME=8:99,1:999),BGPAGEEP,BGPSEX,1)

 +6        SET BGPEDPAT=$$ED(DFN,BGPEDATE)

 +7        DO SAGE(BGPRPT,$SELECT(BGPTIME=1:29,BGPTIME=0:59,BGPTIME=8:99,1:"999"),10,BGPSEX,BGPEDPAT)

 +8        IF 'BGPEDPAT

               IF $DATA(BGPLIST(26))

                   IF BGPTIME=1

                       SET ^XTMP("BGPGAGD",BGPJ,BGPH,"LIST",26,$SELECT($PIECE($GET(^AUPNPAT(DFN,11)),U,18)]"":$PIECE(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$PIECE(^DPT(DFN,0),U,2),BGPAGEE,DFN)=""

 +9        SET BGPAGEEP=$SELECT(BGPAGEE<10:11,BGPAGEE>9&(BGPAGEE<20):12,BGPAGEE>19&(BGPAGEE<25):13,BGPAGEE>24&(BGPAGEE<35):14,BGPAGEE>34&(BGPAGEE<45):15,BGPAGEE>44&(BGPAGEE<55):16,BGPAGEE>54&(BGPAGEE<65):17,BGPAGEE>64:18,1:"")

 +10       DO SAGE(BGPRPT,$SELECT(BGPTIME=1:29,BGPTIME=0:59,BGPTIME=8:99,1:999),BGPAGEEP,BGPSEX,BGPEDPAT)

 +11       IF 'BGPEDPAT

               IF $DATA(BGPLIST(29))

                   IF BGPTIME=1

                       SET ^XTMP("BGPD",BGPJ,BGPH,"LIST",29,$SELECT($PIECE($GET(^AUPNPAT(DFN,11)),U,18)]"":$PIECE(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$PIECE(^DPT(DFN,0),U,2),BGPAGEE,DFN)="No Diet/Exc Educ provided"

 +12       QUIT 

SAGE(R,N,P,S,V) ;set age into file

 +1       ;no value

           IF 'V

               QUIT 

 +2        NEW X,Y

 +3        SET X=$PIECE($GET(^BGPD(R,N)),U,P)

 +4        SET $PIECE(X,"!",S)=$PIECE(X,"!",S)+V

 +5        SET $PIECE(^BGPD(R,N),U,P)=X

 +6        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 

ED(P,EDATE) ;education in past year

 +1        NEW BDATE,%,X,E,R,BGPG

 +2        KILL BGPG

 +3        SET BDATE=$$FMADD^XLFDT(EDATE,-365)

 +4        SET X=P_"^EDUC [BGP GPRA EX EDUC TOPICS;DURING "_BDATE_"-"_EDATE

           SET E=$$START1^APCLDF(X,"BGPG(")

 +5        IF $DATA(BGPG(1))

               QUIT 1

 +6        QUIT 0