BGP1GT ; IHS/CMI/LAB - BGPG Gui CRS Tables 2/2/2005 10:24:22 AM ;
;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
;
;
;
GETTAX(RETVAL,BGPSTR) ;-- get taxonomies based on user selection
S X="MERR^BGP1GU",@^%ZOSF("TRAP") ; m error trap
N BGPDA,BGPI,P,BGPPKG,BGPPKGI,BGPI
S P="|"
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S BGPI=0
S BGPERR=""
S BGPPKG=$P(BGPSTR,P)
S BGPPKGI=$O(^DIC(9.4,"C",BGPPKG,0))
S ^BGPTMP($J,BGPI)="T00080TAXONOMIES"_$C(30)
S BGPDA=0 F S BGPDA=$O(^ATXAX("APKG",BGPPKGI,BGPDA)) Q:'BGPDA D
. N BGPTAX,BGPRO,BGPFL
. S BGPTAX=$P($G(^ATXAX(BGPDA,0)),U)
. S BGPRO=$S($P($G(^ATXAX(BGPDA,0)),U,22):"Read Only",1:"Editable")
. S BGPFL=$P($G(^ATXAX(BGPDA,0)),U,15)
. Q:'$G(BGPFL)
. S ^BGPTMP("TAX",$J,BGPFL,BGPTAX)=BGPRO_U_$S(BGPFL=50:"Med",1:"Tax")
S BGPDA=0 F S BGPDA=$O(^ATXLAB("APKG",BGPPKGI,BGPDA)) Q:'BGPDA D
. N BGPTAX,BGPRO,BGPFL
. S BGPTAX=$P($G(^ATXLAB(BGPDA,0)),U)
. S BGPRO=$S($P($G(^ATXLAB(BGPDA,0)),U,22):"Read Only",1:"Editable")
. S BGPFL=$P($G(^ATXLAB(BGPDA,0)),U,9)
. S ^BGPTMP("TAX",$J,BGPFL,BGPTAX)=BGPRO_U_"Lab"
S BGPDA=0 F S BGPDA=$O(^BGPTMP("TAX",$J,BGPDA)) Q:BGPDA="" D
. N BGPIEN
. S BGPIEN=0 F S BGPIEN=$O(^BGPTMP("TAX",$J,BGPDA,BGPIEN)) Q:BGPIEN="" D
.. S BGPI=BGPI+1
.. S BGPRO=$G(^BGPTMP("TAX",$J,BGPDA,BGPIEN))
.. S ^BGPTMP($J,BGPI)=BGPIEN_"("_$P(BGPRO,U)_"/"_$P(BGPRO,U,2)_"/"_BGPDA_")"_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)_$G(BGPERR)
K ^BGPTMP("TAX",$J)
Q
;
TAX(RETVAL,BGPSTR) ;-- generic taxonomy table
S X="MERR^BGP1GU",@^%ZOSF("TRAP") ; m error trap
N P,BGPRFL,BGPI,BGPERR,BGPIEN,BGPTAXB,BGPTAX,BGPDA,BGPNONC,BGPXRF
N BGPGL,BGPGRF,BGPP
S P="|"
I $P(BGPSTR,P)="Lab" D LABTAX(.RETVAL,.BGPSTR) Q
I $P(BGPSTR,P)="LAB" D LTAX(.RETVAL) Q
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S BGPI=0
S BGPERR=""
S ^BGPTMP($J,BGPI)="T00080TAXONOMY"_$C(30)
I $P(BGPSTR,P)="MED" D MEDBLD
F BGPP=3:1 S BGPTAXB=$P(BGPSTR,P,BGPP) Q:$G(BGPTAXB)="" D
. Q:$G(BGPTAXB)=""
. ;S BGPTAXB=$P(BGPSTR,P)
. S BGPTAX=$O(^ATXAX("B",BGPTAXB,0))
. Q:'$G(BGPTAX)
. S BGPNONC=$P($G(^ATXAX(BGPTAX,0)),U,13)
. S BGPXRF=$P($G(^ATXAX(BGPTAX,0)),U,14)
. S BGPFL=$P($G(^ATXAX(BGPTAX,0)),U,15)
. ;I $G(BGPXRF)="" S BGPXRF="B"
. I BGPFL=80 S BGPXRF="BA" ;icd diagnosis x ref
. S BGPGL=$G(^DIC(BGPFL,0,"GL"))
. S BGPDA=0 F S BGPDA=$O(^ATXAX(BGPTAX,21,BGPDA)) Q:'BGPDA D
.. N BGPL,BGPH
.. S BGPI=BGPI+1
.. S BGPL=$P($G(^ATXAX(BGPTAX,21,BGPDA,0)),U)
.. S BGPH=$P($G(^ATXAX(BGPTAX,21,BGPDA,0)),U,2)
.. I (BGPL=BGPH)!($G(BGPH)="") D Q
... I $G(BGPXRF)="" D Q
.... S BGPGRF=BGPGL_""""_BGPL_""""_")"
.... S ^BGPTMP($J,BGPI)=$P($G(@BGPGRF@(0)),U)_$C(30)
... S ^BGPTMP($J,BGPI)=BGPL_$C(30)
.. S BGPGRF=BGPGL_""""_BGPXRF_""")"
.. N BGPIEN
.. S BGPIEN=$O(@BGPGRF@(BGPL),-1)
.. F S BGPIEN=$O(@BGPGRF@(BGPIEN)) Q:BGPIEN>BGPH D
... S BGPI=BGPI+1
... S ^BGPTMP($J,BGPI)=BGPIEN_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)_$G(BGPERR)
Q
;
LABTAX(RETVAL,BGPSTR) ;-- return the lab taxonomy
S X="MERR^BGP1GU",@^%ZOSF("TRAP") ; m error trap
N P,BGPRFL,BGPI,BGPERR,BGPIEN,BGPTAXB,BGPTAX,BGPDA,BGPNONC,BGPXRF
N BGPGL,BGPGRF,BGPP
S P="|"
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S BGPI=0
S BGPERR=""
S ^BGPTMP($J,BGPI)="T00080LABTAXONOMY"_$C(30)
F BGPP=3:1 S BGPTAXB=$P(BGPSTR,P,BGPP) Q:$G(BGPTAXB)="" D
. Q:$G(BGPTAXB)=""
. ;S BGPTAXB=$P(BGPSTR,P)
. S BGPTAX=$O(^ATXLAB("B",BGPTAXB,0))
. Q:'$G(BGPTAX)
. S BGPNONC=$P($G(^ATXLAB(BGPTAX,0)),U,13)
. S BGPXRF=$P($G(^ATXLAB(BGPTAX,0)),U,14)
. S BGPFL=60
. S BGPGL=$G(^DIC(BGPFL,0,"GL"))
. S BGPDA=0 F S BGPDA=$O(^ATXLAB(BGPTAX,21,BGPDA)) Q:'BGPDA D
.. N BGPL,BGPH
.. S BGPI=BGPI+1
.. S BGPL=$P($G(^ATXLAB(BGPTAX,21,BGPDA,0)),U)
.. S BGPH=$P($G(^ATXLAB(BGPTAX,21,BGPDA,0)),U,2)
.. I (BGPL=BGPH)!($G(BGPH)="") D Q
... I $G(BGPXRF)="" D Q
.... S BGPGRF=BGPGL_""""_BGPL_""""_")"
.... S ^BGPTMP($J,BGPI)=$P($G(@BGPGRF@(0)),U)_$C(30)
... S ^BGPTMP($J,BGPI)=BGPL_$C(30)
.. S BGPGRF=BGPGL_""""_BGPXRF_""")"
.. N BGPIEN
.. S BGPIEN=$O(@BGPGRF@(BGPL),-1)
.. F S BGPIEN=$O(@BGPGRF@(BGPIEN)) Q:BGPIEN>BGPH D
... S BGPI=BGPI+1
... S ^BGPTMP($J,BGPI)=BGPIEN_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)_$G(BGPERR)
Q
;
LTAX(RETVAL) ;-- generic lab taxonomy table
S X="MERR^BGP1GU",@^%ZOSF("TRAP") ; m error trap
N P,BGPRFL,BGPI,BGPERR,BGPIEN,BGPTAXB,BGPTAX,BGPDA,BGPNONC,BGPXRF
N BGPGL,BGPGRF,BGPP,BGPPKG,BGPTDA,BGPPKGI
S P="|"
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S BGPI=0
S BGPERR=""
S BGPPKG=$P(BGPSTR,P,2)
S BGPPKGI=$O(^DIC(9.4,"C",BGPPKG,0))
S ^BGPTMP($J,BGPI)="T00080LABTAXONOMY"_$C(30)
S BGPTAX=0 F S BGPTAX=$O(^ATXLAB("APKG",BGPPKGI,BGPTAX)) Q:'BGPTAX D
. ;S BGPTAX=0 F S BGPTAX=$O(^ATXLAB(BGPTAX)) Q:'BGPTAX D
. ;S BGPTAX=$P($G(^ATXLAB(BGPP,0)),U)
. ;Q:$E($P($G(^ATXLAB(BGPTAX,0)),U),1,2)'="DM"
. ;S BGPTAXB=$P(BGPSTR,P)
. ;S BGPTAX=$O(^ATXLAB("B",BGPTAXB,0))
. ;Q:'$G(BGPTAX)
. S BGPXRF=$P($G(^ATXLAB(BGPTAX,0)),U,8)
. I $G(BGPXRF)="" S BGPXRF="B"
. S BGPFL=$P($G(^ATXLAB(BGPTAX,0)),U,9)
. S BGPGL=$G(^DIC(BGPFL,0,"GL"))
. S BGPDA=0 F S BGPDA=$O(^ATXLAB(BGPTAX,21,BGPDA)) Q:'BGPDA D
.. N BGPL,BGPH
.. S BGPI=BGPI+1
.. S BGPL=$P($G(^ATXLAB(BGPTAX,21,BGPDA,0)),U)
.. S BGPGRF=BGPGL_""""_BGPL_""""_")"
.. N BGPIEN
.. S BGPI=BGPI+1
.. S ^BGPTMP($J,BGPI)=$P($G(@BGPGRF@(0)),U)_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)_$G(BGPERR)
Q
;
MEDBLD ;-- setup BGPSTR for medication taxonomy
S X="MERR^BGP1GU",@^%ZOSF("TRAP") ; m error trap
N BGPTDA,BGPI,BGPPKG,BGPPKGI
S BGPI=1
S BGPPKG=$P(BGPSTR,P,2)
S BGPPKGI=$O(^DIC(9.4,"C",BGPPKG,0))
S BGPTDA=0 F S BGPTDA=$O(^ATXAX(BGPTDA)) Q:'BGPTDA D
. ;S BGPTDA=0 F S BGPTDA=$O(^ATXAX(BGPTDA)) Q:'BGPTDA D
. ;Q:$E($P($G(^ATXAX(BGPTDA,0)),U),1,2)'="DM"
. Q:$P($G(^ATXAX(BGPTDA,0)),U,15)'=50
. S BGPI=BGPI+1
. S $P(BGPSTR,P,BGPI)=$P($G(^ATXAX(BGPTDA,0)),U)
Q
;
GETTAXN(RETVAL,BGPSTR) ;-- get taxonomies based on user selection
S X="MERR^BGP1GU",@^%ZOSF("TRAP") ; m error trap
N BGPDA,BGPI,P,BGPPKG,BGPPKGI,BGPI
S P="|"
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S BGPI=0
S BGPERR=""
S BGPPKG=$P(BGPSTR,P)
S BGPPKGI=$O(^DIC(9.4,"C",BGPPKG,0))
S ^BGPTMP($J,BGPI)="T00080TAXONOMIES"_$C(30)
S BGPDA=0 F S BGPDA=$O(^ATXAX("APKG",BGPPKGI,BGPDA)) Q:'BGPDA D
. N BGPTAX,BGPRO,BGPFL
. S BGPTAX=$P($G(^ATXAX(BGPDA,0)),U)
. S BGPRO=$S($P($G(^ATXAX(BGPDA,0)),U,22):"Read Only",1:"Editable")
. S BGPFL=$P($G(^ATXAX(BGPDA,0)),U,15)
. S ^BGPTMP("TAX",$J,BGPFL,BGPTAX)=BGPRO_U_$S(BGPFL=50:"Med",1:"Tax")
S BGPDA=0 F S BGPDA=$O(^ATXLAB("APKG",BGPPKGI,BGPDA)) Q:'BGPDA D
. N BGPTAX,BGPRO,BGPFL
. S BGPTAX=$P($G(^ATXLAB(BGPDA,0)),U)
. S BGPRO=$S($P($G(^ATXLAB(BGPDA,0)),U,22):"Read Only",1:"Editable")
. S BGPFL=$P($G(^ATXLAB(BGPDA,0)),U,9)
. S ^BGPTMP("TAX",$J,BGPFL,BGPTAX)=BGPRO_U_"Lab"
S BGPDA=0 F S BGPDA=$O(^BGPTMP("TAX",$J,BGPDA)) Q:BGPDA="" D
. N BGPIEN
. S BGPIEN=0 F S BGPIEN=$O(^BGPTMP("TAX",$J,BGPDA,BGPIEN)) Q:BGPIEN="" D
.. S BGPI=BGPI+1
.. S BGPRO=$G(^BGPTMP("TAX",$J,BGPDA,BGPIEN))
.. S ^BGPTMP($J,BGPI)=BGPIEN_"("_$P(BGPRO,U)_"/"_$P(BGPRO,U,2)_"/"_BGPDA_")"_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)_$G(BGPERR)
K ^BGPTMP("TAX",$J)
Q
;
GI(RETVAL,BGPSTR) ;-- get GPRA measures
S X="MERR^BGP1GU",@^%ZOSF("TRAP") ; m error trap
N BGPI,X,Y,Z,P,BGPNPL
S P="|"
S BGPRTYP=$P(BGPSTR,P)
I BGPRTYP=1 S BGPNPL=1
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(^BGPINDB("AOI",X)) Q:X'=+X D
. S Y=0 F S Y=$O(^BGPINDB("AOI",X,Y)) Q:Y'=+Y D
.. I BGPRTYP=1 Q:$P(^BGPINDB(Y,0),U,7)'=1
.. I BGPRTYP=7 Q:$P($G(^BGPINDB(Y,12)),U,1)'=1
.. I $G(BGPNPL),'$D(^BGPNPLB("AR",Y,$S(BGPRTYP=1:"N",1:"O")))
.. S BGPI=BGPI+1
.. S ^BGPTMP($J,BGPI)=Y_U_$P($G(^BGPINDB(Y,0)),U,3)_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)_$G(BGPERR)
Q
;
GSI(RETVAL,BGPSTR) ;-- get sub measure based on passed in measure
S X="MERR^BGP1GU",@^%ZOSF("TRAP") ; m error trap
N P,BGPSIND,BGPIND,BGPI,X,Y
S P="|"
S BGPIND=$P(BGPSTR,P,2)
S BGPTYP=$P(BGPSTR,P)
N BGPXR,BGPXLF
S BGPXLF="^BGPNPLB("
S BGPXR=BGPXLF_"""AN"")"
I BGPTYP=7 S BGPXR=BGPXLF_"""AON"")"
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
N BGPGLB
S BGPI=0
S ^BGPTMP($J,BGPI)="T00007BMXIEN^T00050 "_$C(30)
S X=0 F S X=$O(@BGPXR@(BGPIND,X)) Q:'X D
. S Y=0 F S Y=$O(@BGPXR@(BGPIND,X,Y)) Q:'Y D
.. S BGPI=BGPI+1
.. S ^BGPTMP($J,BGPI)=Y_U_$P($G(^BGPNPLB(Y,0)),U,3)_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)_$G(BGPERR)
Q
;
GIALL(RETVAL) ;-- get all GPRA measures
S X="MERR^BGP1GU",@^%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(^BGPINDB("AO",X)) Q:X'=+X D
. S Y=0 F S Y=$O(^BGPINDB("AO",X,Y)) Q:Y'=+Y D
.. ;Q:$P(^BGPINDB(Y,0),U,7)'=1
.. Q:$P($G(^BGPINDB(Y,13)),U,1)=1
.. S BGPI=BGPI+1
.. S ^BGPTMP($J,BGPI)=Y_U_$P($G(^BGPINDB(Y,0)),U,3)_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)_$G(BGPERR)
Q
;
ECALL(RETVAL) ;-- get all elder care measures
S X="MERR^BGP1GU",@^%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(^BGPELIB("AO",X)) Q:X'=+X D
. S Y=0 F S Y=$O(^BGPELIB("AO",X,Y)) Q:Y'=+Y D
.. ;Q:$P(^BGPINDB(Y,0),U,7)'=1
.. S BGPI=BGPI+1
.. S ^BGPTMP($J,BGPI)=Y_U_$P($G(^BGPELIB(Y,0)),U,4)_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)_$G(BGPERR)
Q
;
EOALL(RETVAL) ;-- get all eo measures
S X="MERR^BGP1GU",@^%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(^BGPEOMB("AO",X)) Q:X'=+X D
. S Y=0 F S Y=$O(^BGPEOMB("AO",X,Y)) Q:Y'=+Y D
.. ;Q:$P(^BGPINDB(Y,0),U,7)'=1
.. S BGPI=BGPI+1
.. S ^BGPTMP($J,BGPI)=Y_U_$P($G(^BGPEOMB(Y,0)),U,2)_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)_$G(BGPERR)
Q
;
PCALL(RETVAL) ;-- get all patient education measures
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(^BGPPEIB("AO",X)) Q:X'=+X D
. S Y=0 F S Y=$O(^BGPPEIB("AO",X,Y)) Q:Y'=+Y D
..;Q:$P(^BGPINDS(Y,0),U,7)'=1
.. S BGPI=BGPI+1
.. S ^BGPTMP($J,BGPI)=Y_U_$P($G(^BGPPEIB(Y,0)),U,2)_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)_$G(BGPERR)
Q
PATLST(RETVAL,BGPSTR) ;-- get all GPRA measures
S X="MERR^BGP1GU",@^%ZOSF("TRAP") ; m error trap
N BGPI,X,Y,Z,P,BGPIND,O
S P="|"
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S BGPI=0
S ^BGPTMP($J,BGPI)="T00007BMXIEN^T00050Measure"_$C(30)
N I
F I=2:1 D Q:$P(BGPSTR,P,I)=""
. Q:$P(BGPSTR,P,I)=""
. S BGPINDI=$P(BGPSTR,P,I)
. S BGPIND($P(^BGPINDB(BGPINDI,0),U,2),BGPINDI)=""
S O=0 F S O=$O(BGPIND(O)) Q:O'=+O S X=$O(BGPIND(O,0)) D
. Q:$P(^BGPINDB(X,0),U,5)=""
. S BGPI=BGPI+1
. S ^BGPTMP($J,BGPI)=X_U_$P($G(^BGPINDB(X,0)),U,5)_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)_$G(BGPERR)
Q
;
EPATLST(RETVAL,BGPSTR) ;-- get all GPRA measures
S X="MERR^BGP1GU",@^%ZOSF("TRAP") ; m error trap
N BGPI,X,Y,Z,P,BGPIND
S P="|"
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S BGPI=0
S ^BGPTMP($J,BGPI)="T00007BMXIEN^T00050Measure"_$C(30)
N I
F I=2:1 D Q:$P(BGPSTR,P,I)=""
. Q:$P(BGPSTR,P,I)=""
. S BGPINDI=$P(BGPSTR,P,I)
. S BGPIND(BGPINDI)=""
S X=0 F S X=$O(BGPIND(X)) Q:X'=+X D
. Q:$P(^BGPELIB(X,0),U,5)=""
. S BGPI=BGPI+1
. S ^BGPTMP($J,BGPI)=X_U_$P($G(^BGPELIB(X,0)),U,5)_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)_$G(BGPERR)
Q
;
EOPATLST(RETVAL,BGPSTR) ;-- get all GPRA measures
S X="MERR^BGP1GU",@^%ZOSF("TRAP") ; m error trap
N BGPI,X,Y,Z,P,BGPIND
S P="|"
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S BGPI=0
S ^BGPTMP($J,BGPI)="T00007BMXIEN^T00050Measure"_$C(30)
N I
F I=2:1 D Q:$P(BGPSTR,P,I)=""
. Q:$P(BGPSTR,P,I)=""
. S BGPINDI=$P(BGPSTR,P,I)
. S BGPIND(BGPINDI)=""
S X=0 F S X=$O(BGPIND(X)) Q:X'=+X D
. Q:$P(^BGPEOMB(X,0),U,5)=""
. S BGPI=BGPI+1
. S ^BGPTMP($J,BGPI)=X_U_$P($G(^BGPEOMB(X,0)),U,5)_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)_$G(BGPERR)
Q
;
PPATLST(RETVAL,BGPSTR) ;-- get all GPRA measures
S X="MERR^BGP1GU",@^%ZOSF("TRAP") ; m error trap
N BGPI,X,Y,Z,P,BGPIND
S P="|"
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S BGPI=0
S ^BGPTMP($J,BGPI)="T00007BMXIEN^T00050Measure"_$C(30)
N I
F I=2:1 D Q:$P(BGPSTR,P,I)=""
. Q:$P(BGPSTR,P,I)=""
. S BGPINDI=$P(BGPSTR,P,I)
. S BGPIND(BGPINDI)=""
S X=0 F S X=$O(BGPIND(X)) Q:X'=+X D
. Q:$P(^BGPPEIB(X,0),U,4)=""
. S BGPI=BGPI+1
. S ^BGPTMP($J,BGPI)=X_U_$P($G(^BGPPEIB(X,0)),U,4)_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)_$G(BGPERR)
Q
COM(RETVAL,BGPSTR) ;-- get measures based on user selection
S X="MERR^BGP1GU",@^%ZOSF("TRAP") ; m error trap
N BGPI,X,Y,Z,BGPLP,XREF
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S BGPI=0
I BGPSTR="D" D
. S XREF="ADM"
I BGPSTR="C" D
. S XREF="ACARD"
I BGPSTR="W" D
. S XREF="AWH"
I BGPSTR="E" D
. S XREF="AEL"
I BGPSTR="I" D
. S XREF="AIPC"
I BGPSTR="P" D
. S XREF="APQA"
S BGPLP="^BGPINDBC("""_XREF_""",1)"
S ^BGPTMP($J,BGPI)="T00007BMXIEN^T00100Measure"_$C(30)
K ^TMP($J,"BGPG")
S X=0 F S X=$O(@BGPLP@(X)) Q:X'=+X D
. ;Q:$P(^BGPINDB(Y,0),U,7)'=1
. S ^TMP($J,"BGPG",$P($G(^BGPINDBC(X,0)),U))=""
S Y=0 F S Y=$O(^TMP($J,"BGPG",Y)) Q:'Y D
. S BGPI=BGPI+1
. S ^BGPTMP($J,BGPI)=Y_U_$P($G(^BGPINDB(Y,0)),U,5)_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)_$G(BGPERR)
Q
;
CMSIND(RETVAL) ;-- get CMS measures
S X="MERR^BGP1GU",@^%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(^BGPCMSIB("AO",X)) Q:X'=+X D
. S Y=0 F S Y=$O(^BGPCMSIB("AO",X,Y)) Q:Y'=+Y D
.. ;Q:$P(^BGPINDB(Y,0),U,7)'=1
.. S BGPI=BGPI+1
.. S ^BGPTMP($J,BGPI)=Y_U_$P($G(^BGPCMSIB(Y,0)),U,4)_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)_$G(BGPERR)
Q
;
CMSSI(RETVAL,BGPSTR) ;-- get sub measure based on passed in measure
S X="MERR^BGP1GU",@^%ZOSF("TRAP") ; m error trap
N P,BGPSIND,BGPIND,BGPI,X
S P="|"
S BGPIND=$P(BGPSTR,P)
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S BGPI=0
S ^BGPTMP($J,BGPI)="T00007BMXIEN^T00050Sub Measure"_$C(30)
N X,Y
S X=0 F S X=$O(^BGPCMSMB("AO",BGPIND,X)) Q:'X D
. S Y=0 F S Y=$O(^BGPCMSMB("AO",BGPIND,X,Y)) Q:'Y D
.. S BGPI=BGPI+1
.. S ^BGPTMP($J,BGPI)=Y_U_$P($G(^BGPCMSMB(Y,0)),U,3)_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)_$G(BGPERR)
Q
BGP1GT ; IHS/CMI/LAB - BGPG Gui CRS Tables 2/2/2005 10:24:22 AM ;
+1 ;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
+2 ;
+3 ;
+4 ;
GETTAX(RETVAL,BGPSTR) ;-- get taxonomies based on user selection
+1 ; m error trap
SET X="MERR^BGP1GU"
SET @^%ZOSF("TRAP")
+2 NEW BGPDA,BGPI,P,BGPPKG,BGPPKGI,BGPI
+3 SET P="|"
+4 KILL ^BGPTMP($JOB)
+5 SET RETVAL="^BGPTMP("_$JOB_")"
+6 SET BGPI=0
+7 SET BGPERR=""
+8 SET BGPPKG=$PIECE(BGPSTR,P)
+9 SET BGPPKGI=$ORDER(^DIC(9.4,"C",BGPPKG,0))
+10 SET ^BGPTMP($JOB,BGPI)="T00080TAXONOMIES"_$CHAR(30)
+11 SET BGPDA=0
FOR
SET BGPDA=$ORDER(^ATXAX("APKG",BGPPKGI,BGPDA))
IF 'BGPDA
QUIT
Begin DoDot:1
+12 NEW BGPTAX,BGPRO,BGPFL
+13 SET BGPTAX=$PIECE($GET(^ATXAX(BGPDA,0)),U)
+14 SET BGPRO=$SELECT($PIECE($GET(^ATXAX(BGPDA,0)),U,22):"Read Only",1:"Editable")
+15 SET BGPFL=$PIECE($GET(^ATXAX(BGPDA,0)),U,15)
+16 IF '$GET(BGPFL)
QUIT
+17 SET ^BGPTMP("TAX",$JOB,BGPFL,BGPTAX)=BGPRO_U_$SELECT(BGPFL=50:"Med",1:"Tax")
End DoDot:1
+18 SET BGPDA=0
FOR
SET BGPDA=$ORDER(^ATXLAB("APKG",BGPPKGI,BGPDA))
IF 'BGPDA
QUIT
Begin DoDot:1
+19 NEW BGPTAX,BGPRO,BGPFL
+20 SET BGPTAX=$PIECE($GET(^ATXLAB(BGPDA,0)),U)
+21 SET BGPRO=$SELECT($PIECE($GET(^ATXLAB(BGPDA,0)),U,22):"Read Only",1:"Editable")
+22 SET BGPFL=$PIECE($GET(^ATXLAB(BGPDA,0)),U,9)
+23 SET ^BGPTMP("TAX",$JOB,BGPFL,BGPTAX)=BGPRO_U_"Lab"
End DoDot:1
+24 SET BGPDA=0
FOR
SET BGPDA=$ORDER(^BGPTMP("TAX",$JOB,BGPDA))
IF BGPDA=""
QUIT
Begin DoDot:1
+25 NEW BGPIEN
+26 SET BGPIEN=0
FOR
SET BGPIEN=$ORDER(^BGPTMP("TAX",$JOB,BGPDA,BGPIEN))
IF BGPIEN=""
QUIT
Begin DoDot:2
+27 SET BGPI=BGPI+1
+28 SET BGPRO=$GET(^BGPTMP("TAX",$JOB,BGPDA,BGPIEN))
+29 SET ^BGPTMP($JOB,BGPI)=BGPIEN_"("_$PIECE(BGPRO,U)_"/"_$PIECE(BGPRO,U,2)_"/"_BGPDA_")"_$CHAR(30)
End DoDot:2
End DoDot:1
+30 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)_$GET(BGPERR)
+31 KILL ^BGPTMP("TAX",$JOB)
+32 QUIT
+33 ;
TAX(RETVAL,BGPSTR) ;-- generic taxonomy table
+1 ; m error trap
SET X="MERR^BGP1GU"
SET @^%ZOSF("TRAP")
+2 NEW P,BGPRFL,BGPI,BGPERR,BGPIEN,BGPTAXB,BGPTAX,BGPDA,BGPNONC,BGPXRF
+3 NEW BGPGL,BGPGRF,BGPP
+4 SET P="|"
+5 IF $PIECE(BGPSTR,P)="Lab"
DO LABTAX(.RETVAL,.BGPSTR)
QUIT
+6 IF $PIECE(BGPSTR,P)="LAB"
DO LTAX(.RETVAL)
QUIT
+7 KILL ^BGPTMP($JOB)
+8 SET RETVAL="^BGPTMP("_$JOB_")"
+9 SET BGPI=0
+10 SET BGPERR=""
+11 SET ^BGPTMP($JOB,BGPI)="T00080TAXONOMY"_$CHAR(30)
+12 IF $PIECE(BGPSTR,P)="MED"
DO MEDBLD
+13 FOR BGPP=3:1
SET BGPTAXB=$PIECE(BGPSTR,P,BGPP)
IF $GET(BGPTAXB)=""
QUIT
Begin DoDot:1
+14 IF $GET(BGPTAXB)=""
QUIT
+15 ;S BGPTAXB=$P(BGPSTR,P)
+16 SET BGPTAX=$ORDER(^ATXAX("B",BGPTAXB,0))
+17 IF '$GET(BGPTAX)
QUIT
+18 SET BGPNONC=$PIECE($GET(^ATXAX(BGPTAX,0)),U,13)
+19 SET BGPXRF=$PIECE($GET(^ATXAX(BGPTAX,0)),U,14)
+20 SET BGPFL=$PIECE($GET(^ATXAX(BGPTAX,0)),U,15)
+21 ;I $G(BGPXRF)="" S BGPXRF="B"
+22 ;icd diagnosis x ref
IF BGPFL=80
SET BGPXRF="BA"
+23 SET BGPGL=$GET(^DIC(BGPFL,0,"GL"))
+24 SET BGPDA=0
FOR
SET BGPDA=$ORDER(^ATXAX(BGPTAX,21,BGPDA))
IF 'BGPDA
QUIT
Begin DoDot:2
+25 NEW BGPL,BGPH
+26 SET BGPI=BGPI+1
+27 SET BGPL=$PIECE($GET(^ATXAX(BGPTAX,21,BGPDA,0)),U)
+28 SET BGPH=$PIECE($GET(^ATXAX(BGPTAX,21,BGPDA,0)),U,2)
+29 IF (BGPL=BGPH)!($GET(BGPH)="")
Begin DoDot:3
+30 IF $GET(BGPXRF)=""
Begin DoDot:4
+31 SET BGPGRF=BGPGL_""""_BGPL_""""_")"
+32 SET ^BGPTMP($JOB,BGPI)=$PIECE($GET(@BGPGRF@(0)),U)_$CHAR(30)
End DoDot:4
QUIT
+33 SET ^BGPTMP($JOB,BGPI)=BGPL_$CHAR(30)
End DoDot:3
QUIT
+34 SET BGPGRF=BGPGL_""""_BGPXRF_""")"
+35 NEW BGPIEN
+36 SET BGPIEN=$ORDER(@BGPGRF@(BGPL),-1)
+37 FOR
SET BGPIEN=$ORDER(@BGPGRF@(BGPIEN))
IF BGPIEN>BGPH
QUIT
Begin DoDot:3
+38 SET BGPI=BGPI+1
+39 SET ^BGPTMP($JOB,BGPI)=BGPIEN_$CHAR(30)
End DoDot:3
End DoDot:2
End DoDot:1
+40 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)_$GET(BGPERR)
+41 QUIT
+42 ;
LABTAX(RETVAL,BGPSTR) ;-- return the lab taxonomy
+1 ; m error trap
SET X="MERR^BGP1GU"
SET @^%ZOSF("TRAP")
+2 NEW P,BGPRFL,BGPI,BGPERR,BGPIEN,BGPTAXB,BGPTAX,BGPDA,BGPNONC,BGPXRF
+3 NEW BGPGL,BGPGRF,BGPP
+4 SET P="|"
+5 KILL ^BGPTMP($JOB)
+6 SET RETVAL="^BGPTMP("_$JOB_")"
+7 SET BGPI=0
+8 SET BGPERR=""
+9 SET ^BGPTMP($JOB,BGPI)="T00080LABTAXONOMY"_$CHAR(30)
+10 FOR BGPP=3:1
SET BGPTAXB=$PIECE(BGPSTR,P,BGPP)
IF $GET(BGPTAXB)=""
QUIT
Begin DoDot:1
+11 IF $GET(BGPTAXB)=""
QUIT
+12 ;S BGPTAXB=$P(BGPSTR,P)
+13 SET BGPTAX=$ORDER(^ATXLAB("B",BGPTAXB,0))
+14 IF '$GET(BGPTAX)
QUIT
+15 SET BGPNONC=$PIECE($GET(^ATXLAB(BGPTAX,0)),U,13)
+16 SET BGPXRF=$PIECE($GET(^ATXLAB(BGPTAX,0)),U,14)
+17 SET BGPFL=60
+18 SET BGPGL=$GET(^DIC(BGPFL,0,"GL"))
+19 SET BGPDA=0
FOR
SET BGPDA=$ORDER(^ATXLAB(BGPTAX,21,BGPDA))
IF 'BGPDA
QUIT
Begin DoDot:2
+20 NEW BGPL,BGPH
+21 SET BGPI=BGPI+1
+22 SET BGPL=$PIECE($GET(^ATXLAB(BGPTAX,21,BGPDA,0)),U)
+23 SET BGPH=$PIECE($GET(^ATXLAB(BGPTAX,21,BGPDA,0)),U,2)
+24 IF (BGPL=BGPH)!($GET(BGPH)="")
Begin DoDot:3
+25 IF $GET(BGPXRF)=""
Begin DoDot:4
+26 SET BGPGRF=BGPGL_""""_BGPL_""""_")"
+27 SET ^BGPTMP($JOB,BGPI)=$PIECE($GET(@BGPGRF@(0)),U)_$CHAR(30)
End DoDot:4
QUIT
+28 SET ^BGPTMP($JOB,BGPI)=BGPL_$CHAR(30)
End DoDot:3
QUIT
+29 SET BGPGRF=BGPGL_""""_BGPXRF_""")"
+30 NEW BGPIEN
+31 SET BGPIEN=$ORDER(@BGPGRF@(BGPL),-1)
+32 FOR
SET BGPIEN=$ORDER(@BGPGRF@(BGPIEN))
IF BGPIEN>BGPH
QUIT
Begin DoDot:3
+33 SET BGPI=BGPI+1
+34 SET ^BGPTMP($JOB,BGPI)=BGPIEN_$CHAR(30)
End DoDot:3
End DoDot:2
End DoDot:1
+35 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)_$GET(BGPERR)
+36 QUIT
+37 ;
LTAX(RETVAL) ;-- generic lab taxonomy table
+1 ; m error trap
SET X="MERR^BGP1GU"
SET @^%ZOSF("TRAP")
+2 NEW P,BGPRFL,BGPI,BGPERR,BGPIEN,BGPTAXB,BGPTAX,BGPDA,BGPNONC,BGPXRF
+3 NEW BGPGL,BGPGRF,BGPP,BGPPKG,BGPTDA,BGPPKGI
+4 SET P="|"
+5 KILL ^BGPTMP($JOB)
+6 SET RETVAL="^BGPTMP("_$JOB_")"
+7 SET BGPI=0
+8 SET BGPERR=""
+9 SET BGPPKG=$PIECE(BGPSTR,P,2)
+10 SET BGPPKGI=$ORDER(^DIC(9.4,"C",BGPPKG,0))
+11 SET ^BGPTMP($JOB,BGPI)="T00080LABTAXONOMY"_$CHAR(30)
+12 SET BGPTAX=0
FOR
SET BGPTAX=$ORDER(^ATXLAB("APKG",BGPPKGI,BGPTAX))
IF 'BGPTAX
QUIT
Begin DoDot:1
+13 ;S BGPTAX=0 F S BGPTAX=$O(^ATXLAB(BGPTAX)) Q:'BGPTAX D
+14 ;S BGPTAX=$P($G(^ATXLAB(BGPP,0)),U)
+15 ;Q:$E($P($G(^ATXLAB(BGPTAX,0)),U),1,2)'="DM"
+16 ;S BGPTAXB=$P(BGPSTR,P)
+17 ;S BGPTAX=$O(^ATXLAB("B",BGPTAXB,0))
+18 ;Q:'$G(BGPTAX)
+19 SET BGPXRF=$PIECE($GET(^ATXLAB(BGPTAX,0)),U,8)
+20 IF $GET(BGPXRF)=""
SET BGPXRF="B"
+21 SET BGPFL=$PIECE($GET(^ATXLAB(BGPTAX,0)),U,9)
+22 SET BGPGL=$GET(^DIC(BGPFL,0,"GL"))
+23 SET BGPDA=0
FOR
SET BGPDA=$ORDER(^ATXLAB(BGPTAX,21,BGPDA))
IF 'BGPDA
QUIT
Begin DoDot:2
+24 NEW BGPL,BGPH
+25 SET BGPI=BGPI+1
+26 SET BGPL=$PIECE($GET(^ATXLAB(BGPTAX,21,BGPDA,0)),U)
+27 SET BGPGRF=BGPGL_""""_BGPL_""""_")"
+28 NEW BGPIEN
+29 SET BGPI=BGPI+1
+30 SET ^BGPTMP($JOB,BGPI)=$PIECE($GET(@BGPGRF@(0)),U)_$CHAR(30)
End DoDot:2
End DoDot:1
+31 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)_$GET(BGPERR)
+32 QUIT
+33 ;
MEDBLD ;-- setup BGPSTR for medication taxonomy
+1 ; m error trap
SET X="MERR^BGP1GU"
SET @^%ZOSF("TRAP")
+2 NEW BGPTDA,BGPI,BGPPKG,BGPPKGI
+3 SET BGPI=1
+4 SET BGPPKG=$PIECE(BGPSTR,P,2)
+5 SET BGPPKGI=$ORDER(^DIC(9.4,"C",BGPPKG,0))
+6 SET BGPTDA=0
FOR
SET BGPTDA=$ORDER(^ATXAX(BGPTDA))
IF 'BGPTDA
QUIT
Begin DoDot:1
+7 ;S BGPTDA=0 F S BGPTDA=$O(^ATXAX(BGPTDA)) Q:'BGPTDA D
+8 ;Q:$E($P($G(^ATXAX(BGPTDA,0)),U),1,2)'="DM"
+9 IF $PIECE($GET(^ATXAX(BGPTDA,0)),U,15)'=50
QUIT
+10 SET BGPI=BGPI+1
+11 SET $PIECE(BGPSTR,P,BGPI)=$PIECE($GET(^ATXAX(BGPTDA,0)),U)
End DoDot:1
+12 QUIT
+13 ;
GETTAXN(RETVAL,BGPSTR) ;-- get taxonomies based on user selection
+1 ; m error trap
SET X="MERR^BGP1GU"
SET @^%ZOSF("TRAP")
+2 NEW BGPDA,BGPI,P,BGPPKG,BGPPKGI,BGPI
+3 SET P="|"
+4 KILL ^BGPTMP($JOB)
+5 SET RETVAL="^BGPTMP("_$JOB_")"
+6 SET BGPI=0
+7 SET BGPERR=""
+8 SET BGPPKG=$PIECE(BGPSTR,P)
+9 SET BGPPKGI=$ORDER(^DIC(9.4,"C",BGPPKG,0))
+10 SET ^BGPTMP($JOB,BGPI)="T00080TAXONOMIES"_$CHAR(30)
+11 SET BGPDA=0
FOR
SET BGPDA=$ORDER(^ATXAX("APKG",BGPPKGI,BGPDA))
IF 'BGPDA
QUIT
Begin DoDot:1
+12 NEW BGPTAX,BGPRO,BGPFL
+13 SET BGPTAX=$PIECE($GET(^ATXAX(BGPDA,0)),U)
+14 SET BGPRO=$SELECT($PIECE($GET(^ATXAX(BGPDA,0)),U,22):"Read Only",1:"Editable")
+15 SET BGPFL=$PIECE($GET(^ATXAX(BGPDA,0)),U,15)
+16 SET ^BGPTMP("TAX",$JOB,BGPFL,BGPTAX)=BGPRO_U_$SELECT(BGPFL=50:"Med",1:"Tax")
End DoDot:1
+17 SET BGPDA=0
FOR
SET BGPDA=$ORDER(^ATXLAB("APKG",BGPPKGI,BGPDA))
IF 'BGPDA
QUIT
Begin DoDot:1
+18 NEW BGPTAX,BGPRO,BGPFL
+19 SET BGPTAX=$PIECE($GET(^ATXLAB(BGPDA,0)),U)
+20 SET BGPRO=$SELECT($PIECE($GET(^ATXLAB(BGPDA,0)),U,22):"Read Only",1:"Editable")
+21 SET BGPFL=$PIECE($GET(^ATXLAB(BGPDA,0)),U,9)
+22 SET ^BGPTMP("TAX",$JOB,BGPFL,BGPTAX)=BGPRO_U_"Lab"
End DoDot:1
+23 SET BGPDA=0
FOR
SET BGPDA=$ORDER(^BGPTMP("TAX",$JOB,BGPDA))
IF BGPDA=""
QUIT
Begin DoDot:1
+24 NEW BGPIEN
+25 SET BGPIEN=0
FOR
SET BGPIEN=$ORDER(^BGPTMP("TAX",$JOB,BGPDA,BGPIEN))
IF BGPIEN=""
QUIT
Begin DoDot:2
+26 SET BGPI=BGPI+1
+27 SET BGPRO=$GET(^BGPTMP("TAX",$JOB,BGPDA,BGPIEN))
+28 SET ^BGPTMP($JOB,BGPI)=BGPIEN_"("_$PIECE(BGPRO,U)_"/"_$PIECE(BGPRO,U,2)_"/"_BGPDA_")"_$CHAR(30)
End DoDot:2
End DoDot:1
+29 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)_$GET(BGPERR)
+30 KILL ^BGPTMP("TAX",$JOB)
+31 QUIT
+32 ;
GI(RETVAL,BGPSTR) ;-- get GPRA measures
+1 ; m error trap
SET X="MERR^BGP1GU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,X,Y,Z,P,BGPNPL
+3 SET P="|"
+4 SET BGPRTYP=$PIECE(BGPSTR,P)
+5 IF BGPRTYP=1
SET BGPNPL=1
+6 KILL ^BGPTMP($JOB)
+7 SET RETVAL="^BGPTMP("_$JOB_")"
+8 SET BGPI=0
+9 SET ^BGPTMP($JOB,BGPI)="T00007BMXIEN^T00050Measure"_$CHAR(30)
+10 SET X=0
FOR
SET X=$ORDER(^BGPINDB("AOI",X))
IF X'=+X
QUIT
Begin DoDot:1
+11 SET Y=0
FOR
SET Y=$ORDER(^BGPINDB("AOI",X,Y))
IF Y'=+Y
QUIT
Begin DoDot:2
+12 IF BGPRTYP=1
IF $PIECE(^BGPINDB(Y,0),U,7)'=1
QUIT
+13 IF BGPRTYP=7
IF $PIECE($GET(^BGPINDB(Y,12)),U,1)'=1
QUIT
+14 IF $GET(BGPNPL)
IF '$DATA(^BGPNPLB("AR",Y,$SELECT(BGPRTYP=1:"N",1:"O")))
+15 SET BGPI=BGPI+1
+16 SET ^BGPTMP($JOB,BGPI)=Y_U_$PIECE($GET(^BGPINDB(Y,0)),U,3)_$CHAR(30)
End DoDot:2
End DoDot:1
+17 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)_$GET(BGPERR)
+18 QUIT
+19 ;
GSI(RETVAL,BGPSTR) ;-- get sub measure based on passed in measure
+1 ; m error trap
SET X="MERR^BGP1GU"
SET @^%ZOSF("TRAP")
+2 NEW P,BGPSIND,BGPIND,BGPI,X,Y
+3 SET P="|"
+4 SET BGPIND=$PIECE(BGPSTR,P,2)
+5 SET BGPTYP=$PIECE(BGPSTR,P)
+6 NEW BGPXR,BGPXLF
+7 SET BGPXLF="^BGPNPLB("
+8 SET BGPXR=BGPXLF_"""AN"")"
+9 IF BGPTYP=7
SET BGPXR=BGPXLF_"""AON"")"
+10 KILL ^BGPTMP($JOB)
+11 SET RETVAL="^BGPTMP("_$JOB_")"
+12 NEW BGPGLB
+13 SET BGPI=0
+14 SET ^BGPTMP($JOB,BGPI)="T00007BMXIEN^T00050 "_$CHAR(30)
+15 SET X=0
FOR
SET X=$ORDER(@BGPXR@(BGPIND,X))
IF 'X
QUIT
Begin DoDot:1
+16 SET Y=0
FOR
SET Y=$ORDER(@BGPXR@(BGPIND,X,Y))
IF 'Y
QUIT
Begin DoDot:2
+17 SET BGPI=BGPI+1
+18 SET ^BGPTMP($JOB,BGPI)=Y_U_$PIECE($GET(^BGPNPLB(Y,0)),U,3)_$CHAR(30)
End DoDot:2
End DoDot:1
+19 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)_$GET(BGPERR)
+20 QUIT
+21 ;
GIALL(RETVAL) ;-- get all GPRA measures
+1 ; m error trap
SET X="MERR^BGP1GU"
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(^BGPINDB("AO",X))
IF X'=+X
QUIT
Begin DoDot:1
+8 SET Y=0
FOR
SET Y=$ORDER(^BGPINDB("AO",X,Y))
IF Y'=+Y
QUIT
Begin DoDot:2
+9 ;Q:$P(^BGPINDB(Y,0),U,7)'=1
+10 IF $PIECE($GET(^BGPINDB(Y,13)),U,1)=1
QUIT
+11 SET BGPI=BGPI+1
+12 SET ^BGPTMP($JOB,BGPI)=Y_U_$PIECE($GET(^BGPINDB(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 ;
ECALL(RETVAL) ;-- get all elder care measures
+1 ; m error trap
SET X="MERR^BGP1GU"
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(^BGPELIB("AO",X))
IF X'=+X
QUIT
Begin DoDot:1
+8 SET Y=0
FOR
SET Y=$ORDER(^BGPELIB("AO",X,Y))
IF Y'=+Y
QUIT
Begin DoDot:2
+9 ;Q:$P(^BGPINDB(Y,0),U,7)'=1
+10 SET BGPI=BGPI+1
+11 SET ^BGPTMP($JOB,BGPI)=Y_U_$PIECE($GET(^BGPELIB(Y,0)),U,4)_$CHAR(30)
End DoDot:2
End DoDot:1
+12 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)_$GET(BGPERR)
+13 QUIT
+14 ;
EOALL(RETVAL) ;-- get all eo measures
+1 ; m error trap
SET X="MERR^BGP1GU"
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(^BGPEOMB("AO",X))
IF X'=+X
QUIT
Begin DoDot:1
+8 SET Y=0
FOR
SET Y=$ORDER(^BGPEOMB("AO",X,Y))
IF Y'=+Y
QUIT
Begin DoDot:2
+9 ;Q:$P(^BGPINDB(Y,0),U,7)'=1
+10 SET BGPI=BGPI+1
+11 SET ^BGPTMP($JOB,BGPI)=Y_U_$PIECE($GET(^BGPEOMB(Y,0)),U,2)_$CHAR(30)
End DoDot:2
End DoDot:1
+12 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)_$GET(BGPERR)
+13 QUIT
+14 ;
PCALL(RETVAL) ;-- get all patient education measures
+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(^BGPPEIB("AO",X))
IF X'=+X
QUIT
Begin DoDot:1
+8 SET Y=0
FOR
SET Y=$ORDER(^BGPPEIB("AO",X,Y))
IF Y'=+Y
QUIT
Begin DoDot:2
+9 ;Q:$P(^BGPINDS(Y,0),U,7)'=1
+10 SET BGPI=BGPI+1
+11 SET ^BGPTMP($JOB,BGPI)=Y_U_$PIECE($GET(^BGPPEIB(Y,0)),U,2)_$CHAR(30)
End DoDot:2
End DoDot:1
+12 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)_$GET(BGPERR)
+13 QUIT
PATLST(RETVAL,BGPSTR) ;-- get all GPRA measures
+1 ; m error trap
SET X="MERR^BGP1GU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,X,Y,Z,P,BGPIND,O
+3 SET P="|"
+4 KILL ^BGPTMP($JOB)
+5 SET RETVAL="^BGPTMP("_$JOB_")"
+6 SET BGPI=0
+7 SET ^BGPTMP($JOB,BGPI)="T00007BMXIEN^T00050Measure"_$CHAR(30)
+8 NEW I
+9 FOR I=2:1
Begin DoDot:1
+10 IF $PIECE(BGPSTR,P,I)=""
QUIT
+11 SET BGPINDI=$PIECE(BGPSTR,P,I)
+12 SET BGPIND($PIECE(^BGPINDB(BGPINDI,0),U,2),BGPINDI)=""
End DoDot:1
IF $PIECE(BGPSTR,P,I)=""
QUIT
+13 SET O=0
FOR
SET O=$ORDER(BGPIND(O))
IF O'=+O
QUIT
SET X=$ORDER(BGPIND(O,0))
Begin DoDot:1
+14 IF $PIECE(^BGPINDB(X,0),U,5)=""
QUIT
+15 SET BGPI=BGPI+1
+16 SET ^BGPTMP($JOB,BGPI)=X_U_$PIECE($GET(^BGPINDB(X,0)),U,5)_$CHAR(30)
End DoDot:1
+17 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)_$GET(BGPERR)
+18 QUIT
+19 ;
EPATLST(RETVAL,BGPSTR) ;-- get all GPRA measures
+1 ; m error trap
SET X="MERR^BGP1GU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,X,Y,Z,P,BGPIND
+3 SET P="|"
+4 KILL ^BGPTMP($JOB)
+5 SET RETVAL="^BGPTMP("_$JOB_")"
+6 SET BGPI=0
+7 SET ^BGPTMP($JOB,BGPI)="T00007BMXIEN^T00050Measure"_$CHAR(30)
+8 NEW I
+9 FOR I=2:1
Begin DoDot:1
+10 IF $PIECE(BGPSTR,P,I)=""
QUIT
+11 SET BGPINDI=$PIECE(BGPSTR,P,I)
+12 SET BGPIND(BGPINDI)=""
End DoDot:1
IF $PIECE(BGPSTR,P,I)=""
QUIT
+13 SET X=0
FOR
SET X=$ORDER(BGPIND(X))
IF X'=+X
QUIT
Begin DoDot:1
+14 IF $PIECE(^BGPELIB(X,0),U,5)=""
QUIT
+15 SET BGPI=BGPI+1
+16 SET ^BGPTMP($JOB,BGPI)=X_U_$PIECE($GET(^BGPELIB(X,0)),U,5)_$CHAR(30)
End DoDot:1
+17 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)_$GET(BGPERR)
+18 QUIT
+19 ;
EOPATLST(RETVAL,BGPSTR) ;-- get all GPRA measures
+1 ; m error trap
SET X="MERR^BGP1GU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,X,Y,Z,P,BGPIND
+3 SET P="|"
+4 KILL ^BGPTMP($JOB)
+5 SET RETVAL="^BGPTMP("_$JOB_")"
+6 SET BGPI=0
+7 SET ^BGPTMP($JOB,BGPI)="T00007BMXIEN^T00050Measure"_$CHAR(30)
+8 NEW I
+9 FOR I=2:1
Begin DoDot:1
+10 IF $PIECE(BGPSTR,P,I)=""
QUIT
+11 SET BGPINDI=$PIECE(BGPSTR,P,I)
+12 SET BGPIND(BGPINDI)=""
End DoDot:1
IF $PIECE(BGPSTR,P,I)=""
QUIT
+13 SET X=0
FOR
SET X=$ORDER(BGPIND(X))
IF X'=+X
QUIT
Begin DoDot:1
+14 IF $PIECE(^BGPEOMB(X,0),U,5)=""
QUIT
+15 SET BGPI=BGPI+1
+16 SET ^BGPTMP($JOB,BGPI)=X_U_$PIECE($GET(^BGPEOMB(X,0)),U,5)_$CHAR(30)
End DoDot:1
+17 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)_$GET(BGPERR)
+18 QUIT
+19 ;
PPATLST(RETVAL,BGPSTR) ;-- get all GPRA measures
+1 ; m error trap
SET X="MERR^BGP1GU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,X,Y,Z,P,BGPIND
+3 SET P="|"
+4 KILL ^BGPTMP($JOB)
+5 SET RETVAL="^BGPTMP("_$JOB_")"
+6 SET BGPI=0
+7 SET ^BGPTMP($JOB,BGPI)="T00007BMXIEN^T00050Measure"_$CHAR(30)
+8 NEW I
+9 FOR I=2:1
Begin DoDot:1
+10 IF $PIECE(BGPSTR,P,I)=""
QUIT
+11 SET BGPINDI=$PIECE(BGPSTR,P,I)
+12 SET BGPIND(BGPINDI)=""
End DoDot:1
IF $PIECE(BGPSTR,P,I)=""
QUIT
+13 SET X=0
FOR
SET X=$ORDER(BGPIND(X))
IF X'=+X
QUIT
Begin DoDot:1
+14 IF $PIECE(^BGPPEIB(X,0),U,4)=""
QUIT
+15 SET BGPI=BGPI+1
+16 SET ^BGPTMP($JOB,BGPI)=X_U_$PIECE($GET(^BGPPEIB(X,0)),U,4)_$CHAR(30)
End DoDot:1
+17 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)_$GET(BGPERR)
+18 QUIT
COM(RETVAL,BGPSTR) ;-- get measures based on user selection
+1 ; m error trap
SET X="MERR^BGP1GU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,X,Y,Z,BGPLP,XREF
+3 KILL ^BGPTMP($JOB)
+4 SET RETVAL="^BGPTMP("_$JOB_")"
+5 SET BGPI=0
+6 IF BGPSTR="D"
Begin DoDot:1
+7 SET XREF="ADM"
End DoDot:1
+8 IF BGPSTR="C"
Begin DoDot:1
+9 SET XREF="ACARD"
End DoDot:1
+10 IF BGPSTR="W"
Begin DoDot:1
+11 SET XREF="AWH"
End DoDot:1
+12 IF BGPSTR="E"
Begin DoDot:1
+13 SET XREF="AEL"
End DoDot:1
+14 IF BGPSTR="I"
Begin DoDot:1
+15 SET XREF="AIPC"
End DoDot:1
+16 IF BGPSTR="P"
Begin DoDot:1
+17 SET XREF="APQA"
End DoDot:1
+18 SET BGPLP="^BGPINDBC("""_XREF_""",1)"
+19 SET ^BGPTMP($JOB,BGPI)="T00007BMXIEN^T00100Measure"_$CHAR(30)
+20 KILL ^TMP($JOB,"BGPG")
+21 SET X=0
FOR
SET X=$ORDER(@BGPLP@(X))
IF X'=+X
QUIT
Begin DoDot:1
+22 ;Q:$P(^BGPINDB(Y,0),U,7)'=1
+23 SET ^TMP($JOB,"BGPG",$PIECE($GET(^BGPINDBC(X,0)),U))=""
End DoDot:1
+24 SET Y=0
FOR
SET Y=$ORDER(^TMP($JOB,"BGPG",Y))
IF 'Y
QUIT
Begin DoDot:1
+25 SET BGPI=BGPI+1
+26 SET ^BGPTMP($JOB,BGPI)=Y_U_$PIECE($GET(^BGPINDB(Y,0)),U,5)_$CHAR(30)
End DoDot:1
+27 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)_$GET(BGPERR)
+28 QUIT
+29 ;
CMSIND(RETVAL) ;-- get CMS measures
+1 ; m error trap
SET X="MERR^BGP1GU"
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(^BGPCMSIB("AO",X))
IF X'=+X
QUIT
Begin DoDot:1
+8 SET Y=0
FOR
SET Y=$ORDER(^BGPCMSIB("AO",X,Y))
IF Y'=+Y
QUIT
Begin DoDot:2
+9 ;Q:$P(^BGPINDB(Y,0),U,7)'=1
+10 SET BGPI=BGPI+1
+11 SET ^BGPTMP($JOB,BGPI)=Y_U_$PIECE($GET(^BGPCMSIB(Y,0)),U,4)_$CHAR(30)
End DoDot:2
End DoDot:1
+12 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)_$GET(BGPERR)
+13 QUIT
+14 ;
CMSSI(RETVAL,BGPSTR) ;-- get sub measure based on passed in measure
+1 ; m error trap
SET X="MERR^BGP1GU"
SET @^%ZOSF("TRAP")
+2 NEW P,BGPSIND,BGPIND,BGPI,X
+3 SET P="|"
+4 SET BGPIND=$PIECE(BGPSTR,P)
+5 KILL ^BGPTMP($JOB)
+6 SET RETVAL="^BGPTMP("_$JOB_")"
+7 SET BGPI=0
+8 SET ^BGPTMP($JOB,BGPI)="T00007BMXIEN^T00050Sub Measure"_$CHAR(30)
+9 NEW X,Y
+10 SET X=0
FOR
SET X=$ORDER(^BGPCMSMB("AO",BGPIND,X))
IF 'X
QUIT
Begin DoDot:1
+11 SET Y=0
FOR
SET Y=$ORDER(^BGPCMSMB("AO",BGPIND,X,Y))
IF 'Y
QUIT
Begin DoDot:2
+12 SET BGPI=BGPI+1
+13 SET ^BGPTMP($JOB,BGPI)=Y_U_$PIECE($GET(^BGPCMSMB(Y,0)),U,3)_$CHAR(30)
End DoDot:2
End DoDot:1
+14 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)_$GET(BGPERR)
+15 QUIT
