Routine: BGP3GTA

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

 ;;13.0;IHS CLINICAL REPORTING;;NOV 20, 2012;Build 81

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

 S X="MERR^BGP3GU",@^%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)

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

 S X="MERR^BGP3GU",@^%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(^BGPINDH("AOI",X)) Q:X'=+X  D

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

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

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

 .. S BGPI=BGPI+1

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

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

MUEP(RETVAL,BGPSTR) ;-- get measures based on user selection

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

 N BGPI,X,Y,Z,BGPLP,XREF,BGPMUYF,BGPVAL,BGPIEN

 K ^BGPTMP($J)

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

 S BGPI=0

 S BGPMUYF="90595.11"

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

 I BGPSTR="M" D

 . D INITM^BGPMUDSI

 I BGPSTR="S" D

 . D INIT^BGPMUDSI

 I BGPSTR="C" D  Q

 . D CI

 . N CDA

 . S CDA=0 F  S CDA=$O(BGPIND(CDA)) Q:'CDA  D

 .. S BGPI=BGPI+1

 .. S ^BGPTMP($J,BGPI)=CDA_$C(30)

 . S ^BGPTMP($J,BGPI+1)=$C(31)

 I BGPSTR="A" D  Q

 . D AI

 . N ADA

 . S ADA=0 F  S ADA=$O(BGPIND(ADA)) Q:'ADA  D

 .. S BGPI=BGPI+1

 .. S ^BGPTMP($J,BGPI)=ADA_$C(30)

 . S ^BGPTMP($J,BGPI+1)=$C(31)

 S X=0 F  S X=$O(BGPMUMEA(X)) Q:X'=+X  D

 . S BGPI=BGPI+1

 . S BGPIEN=$G(BGPMUMEA(X,X))

 . S BGPVAL=$G(BGPMUMEA(X,0))

 . I BGPSTR="M" S BGPVAL=$S($E(BGPVAL,2,4)=")  ":$E(BGPVAL,5,999),1:$E(BGPVAL,4,999))

 . I BGPSTR="S" S BGPVAL=$S($E(BGPVAL,2,4)=")  ":$E(BGPVAL,5,999),1:$E(BGPVAL,5,999))

 . S ^BGPTMP($J,BGPI)=BGPIEN_U_BGPVAL_$C(30)

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

 K BGPMUMEA

MUEPL(RETVAL,BGPSTR) ;-- get patient lists based on user selection

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

 N BGPI,X,Y,Z,BGPLP,XREF,BGPMUYF,BGPVAL,BGPIEN  ;,BGPNDI

 K ^BGPTMP($J)

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

 S BGPI=0

 S BGPMUYF="90595.11"

 F I=2:1 D  Q:$P(BGPSTR,"|",I)=""

 . S BGPNDI=$P(BGPSTR,"|",I)

 . Q:'$G(BGPNDI)

 . S BGPIND(BGPNDI)=""

 D INIT^BGPMUDSL

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

 S X=0 F  S X=$O(BGPMUGL(X)) Q:X'=+X  D

 . S BGPI=BGPI+1

 . S BGPIEN=$G(BGPMUGL("IDX",X,X))

 . S BGPVAL=$G(BGPMUGL(X,0))

 . S BGPVAL=$S($E(BGPVAL,2,4)=")  ":$E(BGPVAL,5,999),1:$E(BGPVAL,4,999))

 . S ^BGPTMP($J,BGPI)=BGPIEN_U_BGPVAL_$C(30)

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

 K BGPMUGL

MUHOS(RETVAL,BGPSTR) ;-- get measures based on user selection

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

 N BGPI,X,Y,Z,BGPLP,XREF,BGPMUYF,BGPVAL,BGPIEN

 K ^BGPTMP($J)

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

 S BGPI=0

 S BGPMUYF="90595.11"

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

 I BGPSTR="H" D  Q

 . D HI

 . N HDA

 . S HDA=0 F  S HDA=$O(BGPIND(HDA)) Q:'HDA  D

 .. S BGPI=BGPI+1

 .. S ^BGPTMP($J,BGPI)=HDA_$C(30)

 . S ^BGPTMP($J,BGPI+1)=$C(31)

 I BGPSTR="S" D

 . D INITH^BGPMUDSI

 S X=0 F  S X=$O(BGPMUMEA(X)) Q:X'=+X  D

 . S BGPI=BGPI+1

 . S BGPIEN=$G(BGPMUMEA(X,X))

 . S BGPVAL=$G(BGPMUMEA(X,0))

 . I BGPSTR="S" S BGPVAL=$S($E(BGPVAL,2,4)=")  ":$E(BGPVAL,5,999),1:$E(BGPVAL,5,999))

 . S ^BGPTMP($J,BGPI)=BGPIEN_U_BGPVAL_$C(30)

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

 K BGPMUMEA

CI ;

 S BGPMUYF="90595.11"

 S X=0 F  S X=$O(^BGPMUIND(BGPMUYF,"AMS","C",X)) Q:X'=+X  S BGPIND(X)=""

AI ;

 S BGPMUYF="90595.11"

 S X=0 F  S X=$O(^BGPMUIND(BGPMUYF,"AMS","A",X)) Q:X'=+X  S BGPIND(X)=""

HI ;-- get all mu hospital indicators

 S BGPMUYF="90595.11"

 S X=0 F  S X=$O(^BGPMUIND(BGPMUYF,"AMS","H",X)) Q:X'=+X  S BGPIND(X)=""

AUTOA ;--get the auto area parameters

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

 +1       ;;13.0;IHS CLINICAL REPORTING;;NOV 20, 2012;Build 81

 +2       ;

 +3       ;

 +4       ;

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

 +1       ; m error trap

           SET X="MERR^BGP3GU"

           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^BGP3GU"

           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(^BGPINDH("AOI",X))

               IF X'=+X

                   QUIT

               Begin DoDot:1

 +8                SET Y=0

FOR

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

                       IF Y'=+Y

                           QUIT

                       Begin DoDot:2

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

                               QUIT

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

 +11                       SET BGPI=BGPI+1

 +12                       SET ^BGPTMP($JOB,BGPI)=Y_U_$PIECE($GET(^BGPINDH(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      ;

MUEP(RETVAL,BGPSTR) ;-- get measures based on user selection

 +1       ; m error trap

           SET X="MERR^BGP3GU"

           SET @^%ZOSF("TRAP")

 +2        NEW BGPI,X,Y,Z,BGPLP,XREF,BGPMUYF,BGPVAL,BGPIEN

 +3        KILL ^BGPTMP($JOB)

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

 +5        SET BGPI=0

 +6        SET BGPMUYF="90595.11"

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

 +8        IF BGPSTR="M"

               Begin DoDot:1

 +9                DO INITM^BGPMUDSI

               End DoDot:1

 +10       IF BGPSTR="S"

               Begin DoDot:1

 +11               DO INIT^BGPMUDSI

               End DoDot:1

 +12       IF BGPSTR="C"

               Begin DoDot:1

 +13               DO CI

 +14               NEW CDA

 +15               SET CDA=0

FOR

                       SET CDA=$ORDER(BGPIND(CDA))

                       IF 'CDA

                           QUIT

                       Begin DoDot:2

 +16                       SET BGPI=BGPI+1

 +17                       SET ^BGPTMP($JOB,BGPI)=CDA_$CHAR(30)

                       End DoDot:2

 +18               SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)

               End DoDot:1

               QUIT

 +19       IF BGPSTR="A"

               Begin DoDot:1

 +20               DO AI

 +21               NEW ADA

 +22               SET ADA=0

FOR

                       SET ADA=$ORDER(BGPIND(ADA))

                       IF 'ADA

                           QUIT

                       Begin DoDot:2

 +23                       SET BGPI=BGPI+1

 +24                       SET ^BGPTMP($JOB,BGPI)=ADA_$CHAR(30)

                       End DoDot:2

 +25               SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)

               End DoDot:1

               QUIT

 +26       SET X=0

FOR

               SET X=$ORDER(BGPMUMEA(X))

               IF X'=+X

                   QUIT

               Begin DoDot:1

 +27               SET BGPI=BGPI+1

 +28               SET BGPIEN=$GET(BGPMUMEA(X,X))

 +29               SET BGPVAL=$GET(BGPMUMEA(X,0))

 +30               IF BGPSTR="M"

                       SET BGPVAL=$SELECT($EXTRACT(BGPVAL,2,4)=")  ":$EXTRACT(BGPVAL,5,999),1:$EXTRACT(BGPVAL,4,999))

 +31               IF BGPSTR="S"

                       SET BGPVAL=$SELECT($EXTRACT(BGPVAL,2,4)=")  ":$EXTRACT(BGPVAL,5,999),1:$EXTRACT(BGPVAL,5,999))

 +32               SET ^BGPTMP($JOB,BGPI)=BGPIEN_U_BGPVAL_$CHAR(30)

               End DoDot:1

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

 +34       KILL BGPMUMEA

 +35       QUIT

 +36      ;

MUEPL(RETVAL,BGPSTR) ;-- get patient lists based on user selection

 +1       ; m error trap

           SET X="MERR^BGP3GU"

           SET @^%ZOSF("TRAP")

 +2       ;,BGPNDI

           NEW BGPI,X,Y,Z,BGPLP,XREF,BGPMUYF,BGPVAL,BGPIEN

 +3        KILL ^BGPTMP($JOB)

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

 +5        SET BGPI=0

 +6        SET BGPMUYF="90595.11"

 +7        FOR I=2:1

               Begin DoDot:1

 +8                SET BGPNDI=$PIECE(BGPSTR,"|",I)

 +9                IF '$GET(BGPNDI)

                       QUIT

 +10               SET BGPIND(BGPNDI)=""

               End DoDot:1

               IF $PIECE(BGPSTR,"|",I)=""

                   QUIT

 +11       DO INIT^BGPMUDSL

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

 +13       SET X=0

FOR

               SET X=$ORDER(BGPMUGL(X))

               IF X'=+X

                   QUIT

               Begin DoDot:1

 +14               SET BGPI=BGPI+1

 +15               SET BGPIEN=$GET(BGPMUGL("IDX",X,X))

 +16               SET BGPVAL=$GET(BGPMUGL(X,0))

 +17               SET BGPVAL=$SELECT($EXTRACT(BGPVAL,2,4)=")  ":$EXTRACT(BGPVAL,5,999),1:$EXTRACT(BGPVAL,4,999))

 +18               SET ^BGPTMP($JOB,BGPI)=BGPIEN_U_BGPVAL_$CHAR(30)

               End DoDot:1

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

 +20       KILL BGPMUGL

 +21       QUIT

 +22      ;

MUHOS(RETVAL,BGPSTR) ;-- get measures based on user selection

 +1       ; m error trap

           SET X="MERR^BGP3GU"

           SET @^%ZOSF("TRAP")

 +2        NEW BGPI,X,Y,Z,BGPLP,XREF,BGPMUYF,BGPVAL,BGPIEN

 +3        KILL ^BGPTMP($JOB)

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

 +5        SET BGPI=0

 +6        SET BGPMUYF="90595.11"

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

 +8        IF BGPSTR="H"

               Begin DoDot:1

 +9                DO HI

 +10               NEW HDA

 +11               SET HDA=0

FOR

                       SET HDA=$ORDER(BGPIND(HDA))

                       IF 'HDA

                           QUIT

                       Begin DoDot:2

 +12                       SET BGPI=BGPI+1

 +13                       SET ^BGPTMP($JOB,BGPI)=HDA_$CHAR(30)

                       End DoDot:2

 +14               SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)

               End DoDot:1

               QUIT

 +15       IF BGPSTR="S"

               Begin DoDot:1

 +16               DO INITH^BGPMUDSI

               End DoDot:1

 +17       SET X=0

FOR

               SET X=$ORDER(BGPMUMEA(X))

               IF X'=+X

                   QUIT

               Begin DoDot:1

 +18               SET BGPI=BGPI+1

 +19               SET BGPIEN=$GET(BGPMUMEA(X,X))

 +20               SET BGPVAL=$GET(BGPMUMEA(X,0))

 +21               IF BGPSTR="S"

                       SET BGPVAL=$SELECT($EXTRACT(BGPVAL,2,4)=")  ":$EXTRACT(BGPVAL,5,999),1:$EXTRACT(BGPVAL,5,999))

 +22               SET ^BGPTMP($JOB,BGPI)=BGPIEN_U_BGPVAL_$CHAR(30)

               End DoDot:1

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

 +24       KILL BGPMUMEA

 +25       QUIT

 +26      ;

CI        ;

 +1        SET BGPMUYF="90595.11"

 +2        SET X=0

FOR

               SET X=$ORDER(^BGPMUIND(BGPMUYF,"AMS","C",X))

               IF X'=+X

                   QUIT

               SET BGPIND(X)=""

 +3        QUIT

AI        ;

 +1        SET BGPMUYF="90595.11"

 +2        SET X=0

FOR

               SET X=$ORDER(^BGPMUIND(BGPMUYF,"AMS","A",X))

               IF X'=+X

                   QUIT

               SET BGPIND(X)=""

 +3        QUIT

 +4       ;

HI        ;-- get all mu hospital indicators

 +1        SET BGPMUYF="90595.11"

 +2        SET X=0

FOR

               SET X=$ORDER(^BGPMUIND(BGPMUYF,"AMS","H",X))

               IF X'=+X

                   QUIT

               SET BGPIND(X)=""

 +3        QUIT

 +4       ;

AUTOA     ;--get the auto area parameters

 +1        QUIT

 +2       ;

BGP3GTA.m