BGP0GTA.m

BGP0GTA ; IHS/CMI/LAB - BGPG Gui CRS Tables 2/2/2005 10:24:22 AM ;

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

 ;

 ;

 ;

DIV(RETVAL) ;-- return all medical center divisions

 S X="MERR^BGP0GU",@^%ZOSF("TRAP") ; m error trap

 N BGPGI,BGPGDA

 S RETVAL="^BGPGTMP("_$J_")"

 S BGPGI=0

 S ^BGPGTMP($J,BGPGI)="T00050DIVISIONS"_$C(30)

 S BGPGDA=0 F  S BGPGDA=$O(^DG(40.8,"B",BGPGDA)) Q:BGPGDA=""  D

 . S BGPGI=BGPGI+1

 . S ^BGPGTMP($J,BGPGI)=BGPGDA_$C(30)

 S ^BGPGTMP($J,BGPGI+1)=$C(31)

 Q

 ;

GIALLC(RETVAL) ;-- get all GPRA measures for comm report

 S X="MERR^BGP0GU",@^%ZOSF("TRAP") ; m error trap

 N BGPI,X,Y,Z

 K ^BGPTMP($J)

 S RETVAL="^BGPTMP("_$J_")"

 S BGPI=0

 S ^BGPTMP($J,BGPI)="T00007BMXIEN^T00050Measure"_$C(30)

 S X=0 F  S X=$O(^BGPINDT("AOI",X)) Q:X'=+X  D

 . S Y=0 F  S Y=$O(^BGPINDT("AOI",X,Y)) Q:Y'=+Y  D

 .. Q:$P($G(^BGPINDT(Y,13)),U,1)=1

 .. ;Q:$P(^BGPINDT(Y,0),U,7)'=1

 .. S BGPI=BGPI+1

 .. S ^BGPTMP($J,BGPI)=Y_U_$P($G(^BGPINDT(Y,0)),U,3)_$C(30)

 S ^BGPTMP($J,BGPI+1)=$C(31)_$G(BGPERR)

 Q

 ;

BGP0GTA   ; IHS/CMI/LAB - BGPG Gui CRS Tables 2/2/2005 10:24:22 AM ;

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

 +2       ;

 +3       ;

 +4       ;

DIV(RETVAL) ;-- return all medical center divisions

 +1       ; m error trap

           SET X="MERR^BGP0GU"

           SET @^%ZOSF("TRAP")

 +2        NEW BGPGI,BGPGDA

 +3        SET RETVAL="^BGPGTMP("_$JOB_")"

 +4        SET BGPGI=0

 +5        SET ^BGPGTMP($JOB,BGPGI)="T00050DIVISIONS"_$CHAR(30)

 +6        SET BGPGDA=0

           FOR 

               SET BGPGDA=$ORDER(^DG(40.8,"B",BGPGDA))

               IF BGPGDA=""

                   QUIT 

               Begin DoDot:1

 +7                SET BGPGI=BGPGI+1

 +8                SET ^BGPGTMP($JOB,BGPGI)=BGPGDA_$CHAR(30)

               End DoDot:1

 +9        SET ^BGPGTMP($JOB,BGPGI+1)=$CHAR(31)

 +10       QUIT 

 +11      ;

GIALLC(RETVAL) ;-- get all GPRA measures for comm report

 +1       ; m error trap

           SET X="MERR^BGP0GU"

           SET @^%ZOSF("TRAP")

 +2        NEW BGPI,X,Y,Z

 +3        KILL ^BGPTMP($JOB)

 +4        SET RETVAL="^BGPTMP("_$JOB_")"

 +5        SET BGPI=0

 +6        SET ^BGPTMP($JOB,BGPI)="T00007BMXIEN^T00050Measure"_$CHAR(30)

 +7        SET X=0

           FOR 

               SET X=$ORDER(^BGPINDT("AOI",X))

               IF X'=+X

                   QUIT 

               Begin DoDot:1

 +8                SET Y=0

                   FOR 

                       SET Y=$ORDER(^BGPINDT("AOI",X,Y))

                       IF Y'=+Y

                           QUIT 

                       Begin DoDot:2

 +9                        IF $PIECE($GET(^BGPINDT(Y,13)),U,1)=1

                               QUIT 

 +10      ;Q:$P(^BGPINDT(Y,0),U,7)'=1

 +11                       SET BGPI=BGPI+1

 +12                       SET ^BGPTMP($JOB,BGPI)=Y_U_$PIECE($GET(^BGPINDT(Y,0)),U,3)_$CHAR(30)

                       End DoDot:2

               End DoDot:1

 +13       SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)_$GET(BGPERR)

 +14       QUIT 

 +15      ;