BGP6GTA ; IHS/CMI/LAB - BGPG Gui CRS Tables 2/2/2005 10:24:22 AM ;
;;16.1;IHS CLINICAL REPORTING;;MAR 22, 2016;Build 170
;
;
;
DIV(RETVAL) ;-- return all medical center divisions
S X="MERR^BGP6GU",@^%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^BGP6GU",@^%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(^BGPINDM("AOI",X)) Q:X'=+X D
. S Y=0 F S Y=$O(^BGPINDM("AOI",X,Y)) Q:Y'=+Y D
.. Q:$P($G(^BGPINDM(Y,13)),U,1)=1
.. ;Q:$P(^BGPINDM(Y,0),U,7)'=1
.. S BGPI=BGPI+1
.. S ^BGPTMP($J,BGPI)=Y_U_$P($G(^BGPINDM(Y,0)),U,3)_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)_$G(BGPERR)
Q
;
MUEP(RETVAL,BGPSTR) ;-- get measures based on user selection
S X="MERR^BGP6GU",@^%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
Q
;
MUEPL(RETVAL,BGPSTR) ;-- get patient lists based on user selection
S X="MERR^BGP6GU",@^%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
Q
;
MUHOS(RETVAL,BGPSTR) ;-- get measures based on user selection
S X="MERR^BGP6GU",@^%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
Q
;
CI ;
S BGPMUYF="90595.11"
S X=0 F S X=$O(^BGPMUIND(BGPMUYF,"AMS","C",X)) Q:X'=+X S BGPIND(X)=""
Q
AI ;
S BGPMUYF="90595.11"
S X=0 F S X=$O(^BGPMUIND(BGPMUYF,"AMS","A",X)) Q:X'=+X S BGPIND(X)=""
Q
;
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)=""
Q
;
AUTOA ;--get the auto area parameters
Q
;
BGP6GTA ; IHS/CMI/LAB - BGPG Gui CRS Tables 2/2/2005 10:24:22 AM ;
+1 ;;16.1;IHS CLINICAL REPORTING;;MAR 22, 2016;Build 170
+2 ;
+3 ;
+4 ;
DIV(RETVAL) ;-- return all medical center divisions
+1 ; m error trap
SET X="MERR^BGP6GU"
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^BGP6GU"
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(^BGPINDM("AOI",X))
IF X'=+X
QUIT
Begin DoDot:1
+8 SET Y=0
FOR
SET Y=$ORDER(^BGPINDM("AOI",X,Y))
IF Y'=+Y
QUIT
Begin DoDot:2
+9 IF $PIECE($GET(^BGPINDM(Y,13)),U,1)=1
QUIT
+10 ;Q:$P(^BGPINDM(Y,0),U,7)'=1
+11 SET BGPI=BGPI+1
+12 SET ^BGPTMP($JOB,BGPI)=Y_U_$PIECE($GET(^BGPINDM(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^BGP6GU"
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^BGP6GU"
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^BGP6GU"
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 ;
