BGP9GR ; IHS/CMI/LAB - BGPG Visual CRS Reports ;
;;9.0;IHS CLINICAL REPORTING;**1**;JUL 01, 2009
;
NTL(RETVAL,BGPSTR) ;-- queue ngr
S X="MERR^BGP9GU",@^%ZOSF("TRAP")
N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT,R,BGPOM,BGPFN
S P="|",R="~"
S BGPI=0
S BGPERR=""
S BGPCT=$P($P(BGPSTR,P),R)
I $P(BGPCT,R)'?.N S BGPCT=$O(^ATXAX("B",BGPCT,0))
S BGPYN=$P(BGPSTR,P,2)
S BGPOT=$P(BGPSTR,P,3)
S BGPOPT=$P(BGPSTR,P,4)
S BGPOPT="CRS 09 NATIONAL GPRA REPORT"
S BGPRT=$P(BGPSTR,P,5)
S BGPMFITI=$P(BGPSTR,P,6)
S BGPYWCHW=$P(BGPSTR,P,7)
S BGPOM=$P(BGPSTR,P,8)
S BGPFN=$P(BGPSTR,P,9)
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
D EP^BGP9GNTL(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPYN,BGPOT,BGPRT,BGPMFITI,BGPYWCHW,BGPOM,BGPFN)
S BGPI=BGPI+1
S ^BGPTMP($J,BGPI)=$G(BGPERR)_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)
D EN^XBVK("BGP")
Q
;
NPL(RETVAL,BGPSTR) ;--queue nat lists
S X="MERR^BGP9GU",@^%ZOSF("TRAP")
N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPDT,BGPOT,BGPOPT,BGPRT,BGPPIEN,BGPPRV,BGPQTR,BGPLST,R,BGPIND,BGPINDL,BGPFN
N BGPBLDT,BGPBEN
S P="|",R="~"
S BGPI=0
S BGPERR=""
I $G(BGPSTR)="" D CATSTR(.BGPSTR,.BGPSTR)
S BGPCT=$P($P(BGPSTR,P),R)
I $P(BGPCT,R)'?.N S BGPCT=$O(^ATXAX("B",BGPCT,0))
S BGPDT=$P(BGPSTR,P,2)
S BGPPIEN=$P($P(BGPSTR,P,3),R)
S BGPPRV=$P($P(BGPSTR,P,3),R,2)
S BGPOPT="CRS 09 NATIONAL PATIENT LISTS"
S BGPOT=$P(BGPSTR,P,4)
S BGPRT=$P(BGPSTR,P,5)
S BGPQTR=$P(BGPSTR,P,6)
S BGPLST=$P(BGPSTR,P,7)
S BGPMFITI=$P(BGPSTR,P,8)
S BGPBLDT=$P(BGPSTR,P,9)
S BGPBEN=$P(BGPSTR,P,10)
S BGPFN=$P(BGPSTR,P,11)
N I
F I=13:1 D Q:$P(BGPSTR,P,I)=""
. Q:$P(BGPSTR,P,I)=""
. N BGPNSTR
. S BGPNSTR=$P(BGPSTR,P,I)
. S BGPINDI=$P(BGPNSTR,R)
. S BGPIND(BGPINDI)=""
. N J
. F J=2:1 D Q:$P(BGPNSTR,R,J)=""
.. Q:$P(BGPNSTR,R,J)=""
.. N BGPSIND
.. S BGPSIND=$P(BGPNSTR,R,J)
.. S BGPINDL(BGPINDI,BGPSIND)=""
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
D EP^BGP9GNPL(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,.BGPIND,.BGPINDL,BGPQTR,BGPDT,BGPLST,BGPPIEN,BGPPRV,BGPOT,BGPRT,BGPMFITI,BGPBLDT,BGPBEN,BGPFN)
S BGPI=BGPI+1
S ^BGPTMP($J,BGPI)=+$G(BGPERR)_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)
D EN^XBVK("BGP")
Q
NPLS(RETVAL,BGPSTR) ;-- queue npl search template
S X="MERR^BGP9GU",@^%ZOSF("TRAP")
N BGPI,BGPJ,BGPDATA,BGPDA,P,B,BGPERR,BGPCT,BGPDT,BGPOT,BGPOPT,BGPRT,BGPPIEN,BGPPRV,BGPQTR,BGPLST,R,BGPIND,BGPINDL,BGPSTMP,BGPFN
N BGPBEN,BGPBASE
S P="|",R="~",B="\"
S BGPI=0
S BGPERR=""
I $G(BGPSTR)="" D CATSTR(.BGPSTR,.BGPSTR)
S BGPCT=$P($P(BGPSTR,P),R)
I $P(BGPCT,R)'?.N S BGPCT=$O(^ATXAX("B",BGPCT,0))
S BGPDT=$P(BGPSTR,P,2)
S BGPPIEN=$P($P(BGPSTR,P,3),R)
S BGPPRV=$P($P(BGPSTR,P,3),R,2)
S BGPOPT="CRS 09 NATIONAL PATIENT LIST SEARCH TEMPLATE"
S BGPOT=$P(BGPSTR,P,4)
S BGPRT=$P(BGPSTR,P,5)
S BGPQTR=$P(BGPSTR,P,6)
S BGPLST=$P(BGPSTR,P,7)
S BGPMFITI=$P(BGPSTR,P,8)
S BGPBASE=$P(BGPSTR,P,9)
S BGPBEN=$P(BGPSTR,P,10)
S BGPFN=$P(BGPSTR,P,11)
S BGPSTMP=$P(BGPSTR,B,2)
N I
F I=13:1 D Q:$P(BGPSTR,P,I)=""
. Q:$P(BGPSTR,P,I)=""
. N BGPNSTR
. S BGPNSTR=$P(BGPSTR,P,I)
. S BGPINDI=$P(BGPNSTR,R)
. S BGPIND(BGPINDI)=""
. N J
. F J=2:1 D Q:$P(BGPNSTR,R,J)=""
.. Q:$P(BGPNSTR,R,J)=""
.. Q:$P(BGPNSTR,R,J)["\"
.. N BGPSIND
.. S BGPSIND=$P(BGPNSTR,R,J)
.. S BGPINDL(BGPINDI,BGPSIND)=""
.. S BGPINDL(BGPINDI,BGPSIND,"TEMP")=$G(BGPSTMP)
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
D EP^BGP9GNST(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,.BGPIND,.BGPINDL,BGPQTR,BGPDT,BGPLST,BGPPIEN,BGPPRV,BGPOT,BGPRT,BGPMFITI,BGPBASE,BGPBEN,BGPFN)
S BGPI=BGPI+1
S ^BGPTMP($J,BGPI)=+$G(BGPERR)_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)
D EN^XBVK("BGP")
Q
COM(RETVAL,BGPSTR) ;selected measures by comm
S X="MERR^BGP9GU",@^%ZOSF("TRAP")
N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPOT,BGPOPT,BGPRT,P,R,A
N BGPTP,BGPQTR,BGPRDT,BGPRE,BGPBAS,BGPPATT,BGPLIST,BGPPRV,BGPPROV,BGPIND,BGPINDI,BGPLSTI
S P="|",R="~",A="*"
I $G(BGPSTR)="" D CATSTR(.BGPSTR,.BGPSTR)
S BGPI=0
S BGPERR=""
S BGPCT=$P($P(BGPSTR,P),R)
I $P(BGPCT,R)'?.N S BGPCT=$O(^ATXAX("B",BGPCT,0))
S BGPTP=$P(BGPSTR,P,2)
S BGPQTR=$P(BGPSTR,P,3)
S BGPRDT=$P(BGPSTR,P,4)
S BGPRE=$P(BGPSTR,P,5)
S BGPOPT="CRS 09 COM - SELECTED MEASURES REPORT"
S BGPBAS=$P(BGPSTR,P,6)
S BGPPATT=$P(BGPSTR,P,7)
S BGPLIST=$P(BGPSTR,P,8)
S BGPPRV=$P($P(BGPSTR,P,9),R)
S BGPPROV=$P($P(BGPSTR,P,9),R,2)
S BGPOT=$P(BGPSTR,P,10)
S BGPFN=$P(BGPSTR,P,14)
S BGPINDI=$P(BGPSTR,P,12)
S BGPMFITI=$P(BGPSTR,P,13)
S BGPLSTI=$P(BGPSTR,P,11)
N I
F I=2:1 D Q:$P(BGPLSTI,A,I)=""
. Q:$P(BGPLSTI,A,I)=""
. N BGPL
. S BGPL=$P($P(BGPLSTI,A,I),R)
. S BGPLIST(BGPL)=""
N J
F J=2:1 D Q:$P(BGPINDI,A,J)=""
. Q:$P(BGPINDI,A,J)=""
. N BGPL
. S BGPL=$P($P(BGPINDI,A,J),R)
. S BGPIND(BGPL)=""
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
D EP^BGP9GCOM(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPTP,.BGPIND,BGPQTR,BGPRE,BGPBAS,BGPPATT,BGPLIST,.BGPLIST,BGPPRV,BGPPROV,BGPOT,BGPRDT,BGPMFITI,BGPFN)
S BGPI=BGPI+1
S ^BGPTMP($J,BGPI)=+$G(BGPERR)_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)
D EN^XBVK("BGP")
Q
;
PP(RETVAL,BGPSTR) ;-- queue NGR
S X="MERR^BGP9GU",@^%ZOSF("TRAP")
N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPSEAT,BGPOT,BGPOPT,BGPRT,P,R,A,BGPFN
N BGPTP,BGPQTR,BGPRDT,BGPRE,BGPBAS,BGPPATT,BGPLIST,BGPPRV,BGPPROV,BGPSEAT,BGPIND,BGPINDT,BGPINDI,BGPLSTI
S P="|",R="~",A="*"
I $G(BGPSTR)="" D CATSTR(.BGPSTR,.BGPSTR)
S BGPI=0
S BGPERR=""
S BGPTP=$P(BGPSTR,P,2)
S BGPQTR=$P(BGPSTR,P,3)
S BGPRDT=$P(BGPSTR,P,4)
S BGPRE=$P(BGPSTR,P,5)
S BGPOPT="CRS 09 PATIENT PANEL SELECTED MEASURES REPORT"
S BGPBAS=$P(BGPSTR,P,6)
S BGPSEAT=$P($P(BGPSTR,P,7),R)
S BGPLIST=$P(BGPSTR,P,8)
S BGPPRV=$P($P(BGPSTR,P,9),R)
S BGPPROV=$P($P(BGPSTR,P,9),R,2)
S BGPOT=$P(BGPSTR,P,10)
S BGPINDI=$P(BGPSTR,P,12)
S BGPLSTI=$P(BGPSTR,P,11)
S BGPFN=$P(BGPSTR,P,13)
N I
F I=2:1 D Q:$P(BGPLSTI,A,I)=""
. Q:$P(BGPLSTI,A,I)=""
. N BGPL
. S BGPL=$P($P(BGPLSTI,A,I),R)
. S BGPLIST(BGPL)=""
N J
F J=2:1 D Q:$P(BGPINDI,A,J)=""
. Q:$P(BGPINDI,A,J)=""
. N BGPL
. S BGPL=$P($P(BGPINDI,A,J),R)
. S BGPIND(BGPL)=""
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
D EP^BGP9GPP(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPTP,.BGPIND,BGPQTR,BGPRE,BGPBAS,BGPSEAT,BGPLIST,.BGPLIST,BGPPRV,BGPPROV,BGPOT,BGPRDT,BGPFN)
S BGPI=BGPI+1
S ^BGPTMP($J,BGPI)=+$G(BGPERR)_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)
D EN^XBVK("BGP")
Q
;
ALL(RETVAL,BGPSTR) ;--selected measures with all comms
S X="MERR^BGP9GU",@^%ZOSF("TRAP")
N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPOT,BGPOPT,BGPRT,P,R,A
N BGPTP,BGPQTR,BGPRDT,BGPRE,BGPBAS,BGPPATT,BGPLIST,BGPPRV,BGPPROV,BGPIND,BGPINDT,BGPLSTI,BGPINDI,BGPFN
S P="|",R="~",A="*"
I $G(BGPSTR)="" D CATSTR(.BGPSTR,.BGPSTR)
S BGPI=0
S BGPERR=""
S BGPTP=$P(BGPSTR,P,2)
S BGPQTR=$P(BGPSTR,P,3)
S BGPRDT=$P(BGPSTR,P,4)
S BGPRE=$P(BGPSTR,P,5)
S BGPOPT="CRS 09 ALL PATIENT SELECTED MEASURES REPORT"
S BGPBAS=$P(BGPSTR,P,6)
S BGPPATT=$P(BGPSTR,P,7)
S BGPLIST=$P(BGPSTR,P,8)
S BGPPRV=$P($P(BGPSTR,P,9),R)
S BGPPROV=$P($P(BGPSTR,P,9),R,2)
S BGPOT=$P(BGPSTR,P,10)
S BGPINDI=$P(BGPSTR,P,12)
S BGPLSTI=$P(BGPSTR,P,11)
S BGPMFITI=$P(BGPSTR,P,13)
S BGPFN=$P(BGPSTR,P,14)
N I
F I=2:1 D Q:$P(BGPLSTI,A,I)=""
. Q:$P(BGPLSTI,A,I)=""
. N BGPL
. S BGPL=$P($P(BGPLSTI,A,I),R)
. S BGPLIST(BGPL)=""
N J
F J=2:1 D Q:$P(BGPINDI,A,J)=""
. Q:$P(BGPINDI,A,J)=""
. N BGPL
. S BGPL=$P($P(BGPINDI,A,J),R)
. S BGPIND(BGPL)=""
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
D EP^BGP9GALL(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPTP,.BGPIND,BGPQTR,BGPRE,BGPBAS,BGPPATT,BGPLIST,.BGPLIST,BGPPRV,BGPPROV,BGPOT,BGPRDT,BGPMFITI,BGPFN)
S BGPI=BGPI+1
S ^BGPTMP($J,BGPI)=+$G(BGPERR)_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)
D EN^XBVK("BGP")
Q
;
CMS(RETVAL,BGPSTR) ;
S X="MERR^BGP9GU",@^%ZOSF("TRAP")
N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPDT,BGPOT,BGPOPT,BGPRT,BGPPIEN,BGPPRV,BGPQTR,BGPLST,R,BGPIND,BGPBEN,BGPEXPL
N BGPEDT,BGPBDT,BGPFN
S P="|",R="~"
S BGPI=0
S BGPERR=""
I $G(BGPSTR)="" D CATSTR(.BGPSTR,.BGPSTR)
S BGPCT=$P(BGPSTR,P)
I $P(BGPCT,R)'?.N S BGPCT=$O(^DIC(4,"B",BGPCT,0))
I $P(BGPCT,R)?.N S BGPCT=$P(BGPCT,R)
S BGPDT=$P(BGPSTR,P,2)
S BGPBDT=$P(BGPSTR,P,3)
S BGPEDT=$P(BGPSTR,P,4)
S BGPOPT="CRS 09 CMS PERFORMANCE REPORT"
S BGPRT=$P(BGPSTR,P,7)
S BGPQTR=$P(BGPSTR,P,5)
S BGPBEN=$P(BGPSTR,P,6)
S BGPEXPL=$P(BGPSTR,P,8)
S BGPFN=$P(BGPSTR,P,9)
N I
F I=11:1 D Q:$P(BGPSTR,P,I)=""
. Q:$P(BGPSTR,P,I)=""
. N BGPNSTR
. S BGPNSTR=$P(BGPSTR,P,I)
. S BGPINDI=$P(BGPNSTR,R)
. S BGPIND(BGPINDI)=""
. N J
. F J=2:1 D Q:$P(BGPNSTR,R,J)=""
.. Q:$P(BGPNSTR,R,J)=""
.. N BGPSIND
.. S BGPSIND=$P(BGPNSTR,R,J)
.. S BGPINDL(BGPINDI,BGPSIND)=""
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
D EP^BGP9GCMS(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,.BGPIND,.BGPINDL,BGPQTR,BGPDT,BGPRT,BGPBDT,BGPEDT,BGPBEN,BGPEXPL,BGPFN)
S BGPI=BGPI+1
S ^BGPTMP($J,BGPI)=$G(BGPERR)_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)
D EN^XBVK("BGP")
Q
GPU(RETVAL,BGPSTR) ;-- queue National GPRA Report
S X="MERR^BGP9GU",@^%ZOSF("TRAP") ;m error trap
N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT,BGPIND,BGPLIST
N BGPQTR,BGPRE,BGPBAS,BGPBEN,BGPINDI,R,BGPFN
S P="|",R="~"
S BGPI=0
S BGPERR=""
S BGPCT=$P($P(BGPSTR,P),R)
I $P(BGPCT,R)'?.N S BGPCT=$O(^ATXAX("B",BGPCT,0))
S BGPYN=$P(BGPSTR,P,2)
S BGPQTR=$P(BGPSTR,P,3)
S BGPRT=$P(BGPSTR,P,4)
S BGPRE=$P(BGPSTR,P,5)
S BGPBAS=$P(BGPSTR,P,6)
S BGPBEN=$P(BGPSTR,P,7)
S BGPOT=$P(BGPSTR,P,8)
S BGPMFITI=$P(BGPSTR,P,9)
S BGPFN=$P(BGPSTR,P,10)
S BGPOPT="CRS 09 GPU GPRA PERFORMANCE REPORT"
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
D EP^BGP9GGPU(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPQTR,BGPRE,BGPBAS,BGPBEN,BGPYN,BGPOT,BGPRT,BGPMFITI,BGPFN)
S BGPI=BGPI+1
S ^BGPTMP($J,BGPI)=$G(BGPERR)_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)
D EN^XBVK("BGP")
Q
;
HED(RETVAL,BGPSTR) ;-- HEDIS Report
S X="MERR^BGP9GU",@^%ZOSF("TRAP")
N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPOT,BGPOPT,BGPRT,P,R,A
N BGPTP,BGPQTR,BGPRDT,BGPRE,BGPBAS,BGPPATT,BGPLIST,BGPPRV,BGPPROV,BGPYN,BGPIND,BGPLIST,BGPFN
S P="|",R="~",A="*"
I $G(BGPSTR)="" D CATSTR(.BGPSTR,.BGPSTR)
S BGPI=0
S BGPERR=""
S BGPCT=$P($P(BGPSTR,P),R)
I $P(BGPCT,R)'?.N S BGPCT=$O(^ATXAX("B",BGPCT,0))
S BGPYN=$P(BGPSTR,P,2)
S BGPQTR=$P(BGPSTR,P,3)
S BGPRDT=$P(BGPSTR,P,4)
S BGPRE=$P(BGPSTR,P,5)
S BGPOPT="CRS 09 HEDIS REPORT"
S BGPBAS=$P(BGPSTR,P,6)
S BGPPATT=$P(BGPSTR,P,7)
S BGPLIST=$P(BGPSTR,P,8)
S BGPPRV=$P($P(BGPSTR,P,9),R)
S BGPPROV=$P($P(BGPSTR,P,9),R,2)
S BGPOT=$P(BGPSTR,P,10)
S BGPLSTI=$P(BGPSTR,P,11)
S BGPMFITI=$P(BGPSTR,P,12)
S BGPFN=$P(BGPSTR,P,13)
N I
F I=2:1 D Q:$P(BGPLSTI,A,I)=""
. Q:$P(BGPLSTI,A,I)=""
. N BGPL
. S BGPL=$P($P(BGPLSTI,A,I),R)
. S BGPLIST(BGPL)=""
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
D EP^BGP9GHED(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPQTR,BGPRE,BGPBAS,BGPPATT,BGPYN,BGPLIST,.BGPLIST,BGPPRV,BGPPROV,BGPOT,BGPRDT,BGPMFITI,BGPFN)
S BGPI=BGPI+1
S ^BGPTMP($J,BGPI)=$G(BGPERR)_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)
D EN^XBVK("BGP")
Q
;
LST(RETVAL,BGPSTR) ;-- list files
S X="MERR^BGP9GU",@^%ZOSF("TRAP")
N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT,R,BGPFN
S P="|",R="~"
S BGPI=0
S BGPERR=""
S BGPCT=$P($P(BGPSTR,P),R)
I $P(BGPCT,R)'?.N S BGPCT=$O(^ATXAX("B",BGPCT,0))
S BGPYN=$P(BGPSTR,P,2)
S BGPOT=$P(BGPSTR,P,3)
S BGPOPT=$P(BGPSTR,P,4)
S BGPRT=$P(BGPSTR,P,5)
S BGPFN=$P(BGPSTR,P,6)
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
D EP^BGP9GNPL(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPYN,BGPOT,BGPRT,BGPFN)
S BGPI=BGPI+1
S ^BGPTMP($J,BGPI)=+$G(BGPERR)_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)
D EN^XBVK("BGP")
Q
;
NPLST(RETVAL,BGPSTR) ;-- list files
S X="MERR^BGP9GU",@^%ZOSF("TRAP")
N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT,R,BGPFN
S P="|",R="~"
S BGPI=0
S BGPERR=""
S BGPCT=$P($P(BGPSTR,P),R)
I $P(BGPCT,R)'?.N S BGPCT=$O(^ATXAX("B",BGPCT,0))
S BGPYN=$P(BGPSTR,P,2)
S BGPOT=$P(BGPSTR,P,3)
S BGPOPT=$P(BGPSTR,P,4)
S BGPRT=$P(BGPSTR,P,5)
S BGPMFITI=$P(BGPSTR,P,6)
S BGPFN=$P(BGPSTR,P,7)
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
D EP^BGP9GNST(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPYN,BGPOT,BGPRT,BGPMFITI,BGPFN)
S BGPI=BGPI+1
S ^BGPTMP($J,BGPI)=+$G(BGPERR)_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)
D EN^XBVK("BGP")
Q
ELD(RETVAL,BGPSTR) ;
G ELD^BGP9GR1
ONTL(RETVAL,BGPSTR) ;
S X="MERR^BGP9GU",@^%ZOSF("TRAP")
N P,BGPI,BGPDA,BGPRIEN
S P="|"
S BGPRIEN=$P(BGPSTR,P)
S RETVAL="^BGPTMP("_$J_")"
S BGPI=0
S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
S BGPDA=0 F S BGPDA=$O(^BGPGUIN(BGPRIEN,11,BGPDA)) Q:'BGPDA D
. S BGPI=BGPI+1
. S ^BGPTMP($J,BGPI)=$G(^BGPGUIN(BGPRIEN,11,BGPDA,0))_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)_$G(X)
D EN^XBVK("BGP")
Q
;
DNTL(RETVAL,BGPSTR) ;
S X="MERR^BGP9GU",@^%ZOSF("TRAP") ;m error trap
N P,BGPI,BGPDA,BGPRIEN
S P="|"
S BGPRIEN=$P(BGPSTR,P)
S RETVAL="^BGPTMP("_$J_")"
S BGPI=0
S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
S BGPDA=0 F S BGPDA=$O(^BGPGUIN(BGPRIEN,12,BGPDA)) Q:'BGPDA D
. S BGPI=BGPI+1
. S ^BGPTMP($J,BGPI)=$TR($G(^BGPGUIN(BGPRIEN,12,BGPDA,0)),"^","~")_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)_$G(BGPERR)
D EN^XBVK("BGP")
Q
;
CATSTR(BGPSRET,STR) ;EP
N BGPDA
S BGPSRET=""
S BGPDA=0 F S BGPDA=$O(STR(BGPDA)) Q:'BGPDA D
. S BGPSRET=BGPSRET_$G(STR(BGPDA))
Q
;
CMP(RETVAL,BGPSTR) ;EP
S X="MERR^BGP9GU",@^%ZOSF("TRAP")
N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPQTR,BGPRDT,BGPRE,BGPLIST,BGPPRV,BGPPROV,BGPOT,BGPOPT,BGPRT,R
N BGPBEN,BGPBLDT,BGPFN
S P="|",R="~"
S BGPI=0
S BGPERR=""
S BGPCT=$P($P(BGPSTR,P),R)
I $P(BGPCT,R)'?.N S BGPCT=$O(^ATXAX("B",BGPCT,0))
S BGPQTR=$P(BGPSTR,P,2)
S BGPRDT=$P(BGPSTR,P,3)
S BGPRE=$P(BGPSTR,P,4)
S BGPOPT="CRS 09 NATIONAL GPRA COMPREHENSIVE PATIENT LIST"
S BGPLIST=$P(BGPSTR,P,5)
S BGPPRV=$P($P(BGPSTR,P,6),R)
S BGPPROV=$P($P(BGPSTR,P,6),R,2)
S BGPOT=$P(BGPSTR,P,7)
S BGPMFITI=$P(BGPSTR,P,8)
S BGPBLDT=$P(BGPSTR,P,9)
S BGPBEN=$P(BGPSTR,P,10)
S BGPFN=$P(BGPSTR,P,11)
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
D EP^BGP9GCMP(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPLIST,BGPPRV,BGPPROV,BGPQTR,BGPRE,BGPCT,BGPOT,BGPRDT,BGPMFITI,BGPBLDT,BGPBEN,BGPFN)
S BGPI=BGPI+1
S ^BGPTMP($J,BGPI)=+$G(BGPERR)_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)
D EN^XBVK("BGP")
Q
BGP9GR ; IHS/CMI/LAB - BGPG Visual CRS Reports ;
+1 ;;9.0;IHS CLINICAL REPORTING;**1**;JUL 01, 2009
+2 ;
NTL(RETVAL,BGPSTR) ;-- queue ngr
+1 SET X="MERR^BGP9GU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT,R,BGPOM,BGPFN
+3 SET P="|"
SET R="~"
+4 SET BGPI=0
+5 SET BGPERR=""
+6 SET BGPCT=$PIECE($PIECE(BGPSTR,P),R)
+7 IF $PIECE(BGPCT,R)'?.N
SET BGPCT=$ORDER(^ATXAX("B",BGPCT,0))
+8 SET BGPYN=$PIECE(BGPSTR,P,2)
+9 SET BGPOT=$PIECE(BGPSTR,P,3)
+10 SET BGPOPT=$PIECE(BGPSTR,P,4)
+11 SET BGPOPT="CRS 09 NATIONAL GPRA REPORT"
+12 SET BGPRT=$PIECE(BGPSTR,P,5)
+13 SET BGPMFITI=$PIECE(BGPSTR,P,6)
+14 SET BGPYWCHW=$PIECE(BGPSTR,P,7)
+15 SET BGPOM=$PIECE(BGPSTR,P,8)
+16 SET BGPFN=$PIECE(BGPSTR,P,9)
+17 KILL ^BGPTMP($JOB)
+18 SET RETVAL="^BGPTMP("_$JOB_")"
+19 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
+20 DO EP^BGP9GNTL(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPYN,BGPOT,BGPRT,BGPMFITI,BGPYWCHW,BGPOM,BGPFN)
+21 SET BGPI=BGPI+1
+22 SET ^BGPTMP($JOB,BGPI)=$GET(BGPERR)_$CHAR(30)
+23 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
+24 DO EN^XBVK("BGP")
+25 QUIT
+26 ;
NPL(RETVAL,BGPSTR) ;--queue nat lists
+1 SET X="MERR^BGP9GU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPDT,BGPOT,BGPOPT,BGPRT,BGPPIEN,BGPPRV,BGPQTR,BGPLST,R,BGPIND,BGPINDL,BGPFN
+3 NEW BGPBLDT,BGPBEN
+4 SET P="|"
SET R="~"
+5 SET BGPI=0
+6 SET BGPERR=""
+7 IF $GET(BGPSTR)=""
DO CATSTR(.BGPSTR,.BGPSTR)
+8 SET BGPCT=$PIECE($PIECE(BGPSTR,P),R)
+9 IF $PIECE(BGPCT,R)'?.N
SET BGPCT=$ORDER(^ATXAX("B",BGPCT,0))
+10 SET BGPDT=$PIECE(BGPSTR,P,2)
+11 SET BGPPIEN=$PIECE($PIECE(BGPSTR,P,3),R)
+12 SET BGPPRV=$PIECE($PIECE(BGPSTR,P,3),R,2)
+13 SET BGPOPT="CRS 09 NATIONAL PATIENT LISTS"
+14 SET BGPOT=$PIECE(BGPSTR,P,4)
+15 SET BGPRT=$PIECE(BGPSTR,P,5)
+16 SET BGPQTR=$PIECE(BGPSTR,P,6)
+17 SET BGPLST=$PIECE(BGPSTR,P,7)
+18 SET BGPMFITI=$PIECE(BGPSTR,P,8)
+19 SET BGPBLDT=$PIECE(BGPSTR,P,9)
+20 SET BGPBEN=$PIECE(BGPSTR,P,10)
+21 SET BGPFN=$PIECE(BGPSTR,P,11)
+22 NEW I
+23 FOR I=13:1
Begin DoDot:1
+24 IF $PIECE(BGPSTR,P,I)=""
QUIT
+25 NEW BGPNSTR
+26 SET BGPNSTR=$PIECE(BGPSTR,P,I)
+27 SET BGPINDI=$PIECE(BGPNSTR,R)
+28 SET BGPIND(BGPINDI)=""
+29 NEW J
+30 FOR J=2:1
Begin DoDot:2
+31 IF $PIECE(BGPNSTR,R,J)=""
QUIT
+32 NEW BGPSIND
+33 SET BGPSIND=$PIECE(BGPNSTR,R,J)
+34 SET BGPINDL(BGPINDI,BGPSIND)=""
End DoDot:2
IF $PIECE(BGPNSTR,R,J)=""
QUIT
End DoDot:1
IF $PIECE(BGPSTR,P,I)=""
QUIT
+35 KILL ^BGPTMP($JOB)
+36 SET RETVAL="^BGPTMP("_$JOB_")"
+37 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
+38 DO EP^BGP9GNPL(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,.BGPIND,.BGPINDL,BGPQTR,BGPDT,BGPLST,BGPPIEN,BGPPRV,BGPOT,BGPRT,BGPMFITI,BGPBLDT,BGPBEN,BGPFN)
+39 SET BGPI=BGPI+1
+40 SET ^BGPTMP($JOB,BGPI)=+$GET(BGPERR)_$CHAR(30)
+41 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
+42 DO EN^XBVK("BGP")
+43 QUIT
NPLS(RETVAL,BGPSTR) ;-- queue npl search template
+1 SET X="MERR^BGP9GU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,B,BGPERR,BGPCT,BGPDT,BGPOT,BGPOPT,BGPRT,BGPPIEN,BGPPRV,BGPQTR,BGPLST,R,BGPIND,BGPINDL,BGPSTMP,BGPFN
+3 NEW BGPBEN,BGPBASE
+4 SET P="|"
SET R="~"
SET B="\"
+5 SET BGPI=0
+6 SET BGPERR=""
+7 IF $GET(BGPSTR)=""
DO CATSTR(.BGPSTR,.BGPSTR)
+8 SET BGPCT=$PIECE($PIECE(BGPSTR,P),R)
+9 IF $PIECE(BGPCT,R)'?.N
SET BGPCT=$ORDER(^ATXAX("B",BGPCT,0))
+10 SET BGPDT=$PIECE(BGPSTR,P,2)
+11 SET BGPPIEN=$PIECE($PIECE(BGPSTR,P,3),R)
+12 SET BGPPRV=$PIECE($PIECE(BGPSTR,P,3),R,2)
+13 SET BGPOPT="CRS 09 NATIONAL PATIENT LIST SEARCH TEMPLATE"
+14 SET BGPOT=$PIECE(BGPSTR,P,4)
+15 SET BGPRT=$PIECE(BGPSTR,P,5)
+16 SET BGPQTR=$PIECE(BGPSTR,P,6)
+17 SET BGPLST=$PIECE(BGPSTR,P,7)
+18 SET BGPMFITI=$PIECE(BGPSTR,P,8)
+19 SET BGPBASE=$PIECE(BGPSTR,P,9)
+20 SET BGPBEN=$PIECE(BGPSTR,P,10)
+21 SET BGPFN=$PIECE(BGPSTR,P,11)
+22 SET BGPSTMP=$PIECE(BGPSTR,B,2)
+23 NEW I
+24 FOR I=13:1
Begin DoDot:1
+25 IF $PIECE(BGPSTR,P,I)=""
QUIT
+26 NEW BGPNSTR
+27 SET BGPNSTR=$PIECE(BGPSTR,P,I)
+28 SET BGPINDI=$PIECE(BGPNSTR,R)
+29 SET BGPIND(BGPINDI)=""
+30 NEW J
+31 FOR J=2:1
Begin DoDot:2
+32 IF $PIECE(BGPNSTR,R,J)=""
QUIT
+33 IF $PIECE(BGPNSTR,R,J)["\"
QUIT
+34 NEW BGPSIND
+35 SET BGPSIND=$PIECE(BGPNSTR,R,J)
+36 SET BGPINDL(BGPINDI,BGPSIND)=""
+37 SET BGPINDL(BGPINDI,BGPSIND,"TEMP")=$GET(BGPSTMP)
End DoDot:2
IF $PIECE(BGPNSTR,R,J)=""
QUIT
End DoDot:1
IF $PIECE(BGPSTR,P,I)=""
QUIT
+38 KILL ^BGPTMP($JOB)
+39 SET RETVAL="^BGPTMP("_$JOB_")"
+40 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
+41 DO EP^BGP9GNST(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,.BGPIND,.BGPINDL,BGPQTR,BGPDT,BGPLST,BGPPIEN,BGPPRV,BGPOT,BGPRT,BGPMFITI,BGPBASE,BGPBEN,BGPFN)
+42 SET BGPI=BGPI+1
+43 SET ^BGPTMP($JOB,BGPI)=+$GET(BGPERR)_$CHAR(30)
+44 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
+45 DO EN^XBVK("BGP")
+46 QUIT
COM(RETVAL,BGPSTR) ;selected measures by comm
+1 SET X="MERR^BGP9GU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPOT,BGPOPT,BGPRT,P,R,A
+3 NEW BGPTP,BGPQTR,BGPRDT,BGPRE,BGPBAS,BGPPATT,BGPLIST,BGPPRV,BGPPROV,BGPIND,BGPINDI,BGPLSTI
+4 SET P="|"
SET R="~"
SET A="*"
+5 IF $GET(BGPSTR)=""
DO CATSTR(.BGPSTR,.BGPSTR)
+6 SET BGPI=0
+7 SET BGPERR=""
+8 SET BGPCT=$PIECE($PIECE(BGPSTR,P),R)
+9 IF $PIECE(BGPCT,R)'?.N
SET BGPCT=$ORDER(^ATXAX("B",BGPCT,0))
+10 SET BGPTP=$PIECE(BGPSTR,P,2)
+11 SET BGPQTR=$PIECE(BGPSTR,P,3)
+12 SET BGPRDT=$PIECE(BGPSTR,P,4)
+13 SET BGPRE=$PIECE(BGPSTR,P,5)
+14 SET BGPOPT="CRS 09 COM - SELECTED MEASURES REPORT"
+15 SET BGPBAS=$PIECE(BGPSTR,P,6)
+16 SET BGPPATT=$PIECE(BGPSTR,P,7)
+17 SET BGPLIST=$PIECE(BGPSTR,P,8)
+18 SET BGPPRV=$PIECE($PIECE(BGPSTR,P,9),R)
+19 SET BGPPROV=$PIECE($PIECE(BGPSTR,P,9),R,2)
+20 SET BGPOT=$PIECE(BGPSTR,P,10)
+21 SET BGPFN=$PIECE(BGPSTR,P,14)
+22 SET BGPINDI=$PIECE(BGPSTR,P,12)
+23 SET BGPMFITI=$PIECE(BGPSTR,P,13)
+24 SET BGPLSTI=$PIECE(BGPSTR,P,11)
+25 NEW I
+26 FOR I=2:1
Begin DoDot:1
+27 IF $PIECE(BGPLSTI,A,I)=""
QUIT
+28 NEW BGPL
+29 SET BGPL=$PIECE($PIECE(BGPLSTI,A,I),R)
+30 SET BGPLIST(BGPL)=""
End DoDot:1
IF $PIECE(BGPLSTI,A,I)=""
QUIT
+31 NEW J
+32 FOR J=2:1
Begin DoDot:1
+33 IF $PIECE(BGPINDI,A,J)=""
QUIT
+34 NEW BGPL
+35 SET BGPL=$PIECE($PIECE(BGPINDI,A,J),R)
+36 SET BGPIND(BGPL)=""
End DoDot:1
IF $PIECE(BGPINDI,A,J)=""
QUIT
+37 KILL ^BGPTMP($JOB)
+38 SET RETVAL="^BGPTMP("_$JOB_")"
+39 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
+40 DO EP^BGP9GCOM(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPTP,.BGPIND,BGPQTR,BGPRE,BGPBAS,BGPPATT,BGPLIST,.BGPLIST,BGPPRV,BGPPROV,BGPOT,BGPRDT,BGPMFITI,BGPFN)
+41 SET BGPI=BGPI+1
+42 SET ^BGPTMP($JOB,BGPI)=+$GET(BGPERR)_$CHAR(30)
+43 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
+44 DO EN^XBVK("BGP")
+45 QUIT
+46 ;
PP(RETVAL,BGPSTR) ;-- queue NGR
+1 SET X="MERR^BGP9GU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPSEAT,BGPOT,BGPOPT,BGPRT,P,R,A,BGPFN
+3 NEW BGPTP,BGPQTR,BGPRDT,BGPRE,BGPBAS,BGPPATT,BGPLIST,BGPPRV,BGPPROV,BGPSEAT,BGPIND,BGPINDT,BGPINDI,BGPLSTI
+4 SET P="|"
SET R="~"
SET A="*"
+5 IF $GET(BGPSTR)=""
DO CATSTR(.BGPSTR,.BGPSTR)
+6 SET BGPI=0
+7 SET BGPERR=""
+8 SET BGPTP=$PIECE(BGPSTR,P,2)
+9 SET BGPQTR=$PIECE(BGPSTR,P,3)
+10 SET BGPRDT=$PIECE(BGPSTR,P,4)
+11 SET BGPRE=$PIECE(BGPSTR,P,5)
+12 SET BGPOPT="CRS 09 PATIENT PANEL SELECTED MEASURES REPORT"
+13 SET BGPBAS=$PIECE(BGPSTR,P,6)
+14 SET BGPSEAT=$PIECE($PIECE(BGPSTR,P,7),R)
+15 SET BGPLIST=$PIECE(BGPSTR,P,8)
+16 SET BGPPRV=$PIECE($PIECE(BGPSTR,P,9),R)
+17 SET BGPPROV=$PIECE($PIECE(BGPSTR,P,9),R,2)
+18 SET BGPOT=$PIECE(BGPSTR,P,10)
+19 SET BGPINDI=$PIECE(BGPSTR,P,12)
+20 SET BGPLSTI=$PIECE(BGPSTR,P,11)
+21 SET BGPFN=$PIECE(BGPSTR,P,13)
+22 NEW I
+23 FOR I=2:1
Begin DoDot:1
+24 IF $PIECE(BGPLSTI,A,I)=""
QUIT
+25 NEW BGPL
+26 SET BGPL=$PIECE($PIECE(BGPLSTI,A,I),R)
+27 SET BGPLIST(BGPL)=""
End DoDot:1
IF $PIECE(BGPLSTI,A,I)=""
QUIT
+28 NEW J
+29 FOR J=2:1
Begin DoDot:1
+30 IF $PIECE(BGPINDI,A,J)=""
QUIT
+31 NEW BGPL
+32 SET BGPL=$PIECE($PIECE(BGPINDI,A,J),R)
+33 SET BGPIND(BGPL)=""
End DoDot:1
IF $PIECE(BGPINDI,A,J)=""
QUIT
+34 KILL ^BGPTMP($JOB)
+35 SET RETVAL="^BGPTMP("_$JOB_")"
+36 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
+37 DO EP^BGP9GPP(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPTP,.BGPIND,BGPQTR,BGPRE,BGPBAS,BGPSEAT,BGPLIST,.BGPLIST,BGPPRV,BGPPROV,BGPOT,BGPRDT,BGPFN)
+38 SET BGPI=BGPI+1
+39 SET ^BGPTMP($JOB,BGPI)=+$GET(BGPERR)_$CHAR(30)
+40 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
+41 DO EN^XBVK("BGP")
+42 QUIT
+43 ;
ALL(RETVAL,BGPSTR) ;--selected measures with all comms
+1 SET X="MERR^BGP9GU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPOT,BGPOPT,BGPRT,P,R,A
+3 NEW BGPTP,BGPQTR,BGPRDT,BGPRE,BGPBAS,BGPPATT,BGPLIST,BGPPRV,BGPPROV,BGPIND,BGPINDT,BGPLSTI,BGPINDI,BGPFN
+4 SET P="|"
SET R="~"
SET A="*"
+5 IF $GET(BGPSTR)=""
DO CATSTR(.BGPSTR,.BGPSTR)
+6 SET BGPI=0
+7 SET BGPERR=""
+8 SET BGPTP=$PIECE(BGPSTR,P,2)
+9 SET BGPQTR=$PIECE(BGPSTR,P,3)
+10 SET BGPRDT=$PIECE(BGPSTR,P,4)
+11 SET BGPRE=$PIECE(BGPSTR,P,5)
+12 SET BGPOPT="CRS 09 ALL PATIENT SELECTED MEASURES REPORT"
+13 SET BGPBAS=$PIECE(BGPSTR,P,6)
+14 SET BGPPATT=$PIECE(BGPSTR,P,7)
+15 SET BGPLIST=$PIECE(BGPSTR,P,8)
+16 SET BGPPRV=$PIECE($PIECE(BGPSTR,P,9),R)
+17 SET BGPPROV=$PIECE($PIECE(BGPSTR,P,9),R,2)
+18 SET BGPOT=$PIECE(BGPSTR,P,10)
+19 SET BGPINDI=$PIECE(BGPSTR,P,12)
+20 SET BGPLSTI=$PIECE(BGPSTR,P,11)
+21 SET BGPMFITI=$PIECE(BGPSTR,P,13)
+22 SET BGPFN=$PIECE(BGPSTR,P,14)
+23 NEW I
+24 FOR I=2:1
Begin DoDot:1
+25 IF $PIECE(BGPLSTI,A,I)=""
QUIT
+26 NEW BGPL
+27 SET BGPL=$PIECE($PIECE(BGPLSTI,A,I),R)
+28 SET BGPLIST(BGPL)=""
End DoDot:1
IF $PIECE(BGPLSTI,A,I)=""
QUIT
+29 NEW J
+30 FOR J=2:1
Begin DoDot:1
+31 IF $PIECE(BGPINDI,A,J)=""
QUIT
+32 NEW BGPL
+33 SET BGPL=$PIECE($PIECE(BGPINDI,A,J),R)
+34 SET BGPIND(BGPL)=""
End DoDot:1
IF $PIECE(BGPINDI,A,J)=""
QUIT
+35 KILL ^BGPTMP($JOB)
+36 SET RETVAL="^BGPTMP("_$JOB_")"
+37 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
+38 DO EP^BGP9GALL(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPTP,.BGPIND,BGPQTR,BGPRE,BGPBAS,BGPPATT,BGPLIST,.BGPLIST,BGPPRV,BGPPROV,BGPOT,BGPRDT,BGPMFITI,BGPFN)
+39 SET BGPI=BGPI+1
+40 SET ^BGPTMP($JOB,BGPI)=+$GET(BGPERR)_$CHAR(30)
+41 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
+42 DO EN^XBVK("BGP")
+43 QUIT
+44 ;
CMS(RETVAL,BGPSTR) ;
+1 SET X="MERR^BGP9GU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPDT,BGPOT,BGPOPT,BGPRT,BGPPIEN,BGPPRV,BGPQTR,BGPLST,R,BGPIND,BGPBEN,BGPEXPL
+3 NEW BGPEDT,BGPBDT,BGPFN
+4 SET P="|"
SET R="~"
+5 SET BGPI=0
+6 SET BGPERR=""
+7 IF $GET(BGPSTR)=""
DO CATSTR(.BGPSTR,.BGPSTR)
+8 SET BGPCT=$PIECE(BGPSTR,P)
+9 IF $PIECE(BGPCT,R)'?.N
SET BGPCT=$ORDER(^DIC(4,"B",BGPCT,0))
+10 IF $PIECE(BGPCT,R)?.N
SET BGPCT=$PIECE(BGPCT,R)
+11 SET BGPDT=$PIECE(BGPSTR,P,2)
+12 SET BGPBDT=$PIECE(BGPSTR,P,3)
+13 SET BGPEDT=$PIECE(BGPSTR,P,4)
+14 SET BGPOPT="CRS 09 CMS PERFORMANCE REPORT"
+15 SET BGPRT=$PIECE(BGPSTR,P,7)
+16 SET BGPQTR=$PIECE(BGPSTR,P,5)
+17 SET BGPBEN=$PIECE(BGPSTR,P,6)
+18 SET BGPEXPL=$PIECE(BGPSTR,P,8)
+19 SET BGPFN=$PIECE(BGPSTR,P,9)
+20 NEW I
+21 FOR I=11:1
Begin DoDot:1
+22 IF $PIECE(BGPSTR,P,I)=""
QUIT
+23 NEW BGPNSTR
+24 SET BGPNSTR=$PIECE(BGPSTR,P,I)
+25 SET BGPINDI=$PIECE(BGPNSTR,R)
+26 SET BGPIND(BGPINDI)=""
+27 NEW J
+28 FOR J=2:1
Begin DoDot:2
+29 IF $PIECE(BGPNSTR,R,J)=""
QUIT
+30 NEW BGPSIND
+31 SET BGPSIND=$PIECE(BGPNSTR,R,J)
+32 SET BGPINDL(BGPINDI,BGPSIND)=""
End DoDot:2
IF $PIECE(BGPNSTR,R,J)=""
QUIT
End DoDot:1
IF $PIECE(BGPSTR,P,I)=""
QUIT
+33 KILL ^BGPTMP($JOB)
+34 SET RETVAL="^BGPTMP("_$JOB_")"
+35 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
+36 DO EP^BGP9GCMS(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,.BGPIND,.BGPINDL,BGPQTR,BGPDT,BGPRT,BGPBDT,BGPEDT,BGPBEN,BGPEXPL,BGPFN)
+37 SET BGPI=BGPI+1
+38 SET ^BGPTMP($JOB,BGPI)=$GET(BGPERR)_$CHAR(30)
+39 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
+40 DO EN^XBVK("BGP")
+41 QUIT
GPU(RETVAL,BGPSTR) ;-- queue National GPRA Report
+1 ;m error trap
SET X="MERR^BGP9GU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT,BGPIND,BGPLIST
+3 NEW BGPQTR,BGPRE,BGPBAS,BGPBEN,BGPINDI,R,BGPFN
+4 SET P="|"
SET R="~"
+5 SET BGPI=0
+6 SET BGPERR=""
+7 SET BGPCT=$PIECE($PIECE(BGPSTR,P),R)
+8 IF $PIECE(BGPCT,R)'?.N
SET BGPCT=$ORDER(^ATXAX("B",BGPCT,0))
+9 SET BGPYN=$PIECE(BGPSTR,P,2)
+10 SET BGPQTR=$PIECE(BGPSTR,P,3)
+11 SET BGPRT=$PIECE(BGPSTR,P,4)
+12 SET BGPRE=$PIECE(BGPSTR,P,5)
+13 SET BGPBAS=$PIECE(BGPSTR,P,6)
+14 SET BGPBEN=$PIECE(BGPSTR,P,7)
+15 SET BGPOT=$PIECE(BGPSTR,P,8)
+16 SET BGPMFITI=$PIECE(BGPSTR,P,9)
+17 SET BGPFN=$PIECE(BGPSTR,P,10)
+18 SET BGPOPT="CRS 09 GPU GPRA PERFORMANCE REPORT"
+19 KILL ^BGPTMP($JOB)
+20 SET RETVAL="^BGPTMP("_$JOB_")"
+21 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
+22 DO EP^BGP9GGPU(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPQTR,BGPRE,BGPBAS,BGPBEN,BGPYN,BGPOT,BGPRT,BGPMFITI,BGPFN)
+23 SET BGPI=BGPI+1
+24 SET ^BGPTMP($JOB,BGPI)=$GET(BGPERR)_$CHAR(30)
+25 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
+26 DO EN^XBVK("BGP")
+27 QUIT
+28 ;
HED(RETVAL,BGPSTR) ;-- HEDIS Report
+1 SET X="MERR^BGP9GU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPOT,BGPOPT,BGPRT,P,R,A
+3 NEW BGPTP,BGPQTR,BGPRDT,BGPRE,BGPBAS,BGPPATT,BGPLIST,BGPPRV,BGPPROV,BGPYN,BGPIND,BGPLIST,BGPFN
+4 SET P="|"
SET R="~"
SET A="*"
+5 IF $GET(BGPSTR)=""
DO CATSTR(.BGPSTR,.BGPSTR)
+6 SET BGPI=0
+7 SET BGPERR=""
+8 SET BGPCT=$PIECE($PIECE(BGPSTR,P),R)
+9 IF $PIECE(BGPCT,R)'?.N
SET BGPCT=$ORDER(^ATXAX("B",BGPCT,0))
+10 SET BGPYN=$PIECE(BGPSTR,P,2)
+11 SET BGPQTR=$PIECE(BGPSTR,P,3)
+12 SET BGPRDT=$PIECE(BGPSTR,P,4)
+13 SET BGPRE=$PIECE(BGPSTR,P,5)
+14 SET BGPOPT="CRS 09 HEDIS REPORT"
+15 SET BGPBAS=$PIECE(BGPSTR,P,6)
+16 SET BGPPATT=$PIECE(BGPSTR,P,7)
+17 SET BGPLIST=$PIECE(BGPSTR,P,8)
+18 SET BGPPRV=$PIECE($PIECE(BGPSTR,P,9),R)
+19 SET BGPPROV=$PIECE($PIECE(BGPSTR,P,9),R,2)
+20 SET BGPOT=$PIECE(BGPSTR,P,10)
+21 SET BGPLSTI=$PIECE(BGPSTR,P,11)
+22 SET BGPMFITI=$PIECE(BGPSTR,P,12)
+23 SET BGPFN=$PIECE(BGPSTR,P,13)
+24 NEW I
+25 FOR I=2:1
Begin DoDot:1
+26 IF $PIECE(BGPLSTI,A,I)=""
QUIT
+27 NEW BGPL
+28 SET BGPL=$PIECE($PIECE(BGPLSTI,A,I),R)
+29 SET BGPLIST(BGPL)=""
End DoDot:1
IF $PIECE(BGPLSTI,A,I)=""
QUIT
+30 KILL ^BGPTMP($JOB)
+31 SET RETVAL="^BGPTMP("_$JOB_")"
+32 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
+33 DO EP^BGP9GHED(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPQTR,BGPRE,BGPBAS,BGPPATT,BGPYN,BGPLIST,.BGPLIST,BGPPRV,BGPPROV,BGPOT,BGPRDT,BGPMFITI,BGPFN)
+34 SET BGPI=BGPI+1
+35 SET ^BGPTMP($JOB,BGPI)=$GET(BGPERR)_$CHAR(30)
+36 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
+37 DO EN^XBVK("BGP")
+38 QUIT
+39 ;
LST(RETVAL,BGPSTR) ;-- list files
+1 SET X="MERR^BGP9GU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT,R,BGPFN
+3 SET P="|"
SET R="~"
+4 SET BGPI=0
+5 SET BGPERR=""
+6 SET BGPCT=$PIECE($PIECE(BGPSTR,P),R)
+7 IF $PIECE(BGPCT,R)'?.N
SET BGPCT=$ORDER(^ATXAX("B",BGPCT,0))
+8 SET BGPYN=$PIECE(BGPSTR,P,2)
+9 SET BGPOT=$PIECE(BGPSTR,P,3)
+10 SET BGPOPT=$PIECE(BGPSTR,P,4)
+11 SET BGPRT=$PIECE(BGPSTR,P,5)
+12 SET BGPFN=$PIECE(BGPSTR,P,6)
+13 KILL ^BGPTMP($JOB)
+14 SET RETVAL="^BGPTMP("_$JOB_")"
+15 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
+16 DO EP^BGP9GNPL(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPYN,BGPOT,BGPRT,BGPFN)
+17 SET BGPI=BGPI+1
+18 SET ^BGPTMP($JOB,BGPI)=+$GET(BGPERR)_$CHAR(30)
+19 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
+20 DO EN^XBVK("BGP")
+21 QUIT
+22 ;
NPLST(RETVAL,BGPSTR) ;-- list files
+1 SET X="MERR^BGP9GU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT,R,BGPFN
+3 SET P="|"
SET R="~"
+4 SET BGPI=0
+5 SET BGPERR=""
+6 SET BGPCT=$PIECE($PIECE(BGPSTR,P),R)
+7 IF $PIECE(BGPCT,R)'?.N
SET BGPCT=$ORDER(^ATXAX("B",BGPCT,0))
+8 SET BGPYN=$PIECE(BGPSTR,P,2)
+9 SET BGPOT=$PIECE(BGPSTR,P,3)
+10 SET BGPOPT=$PIECE(BGPSTR,P,4)
+11 SET BGPRT=$PIECE(BGPSTR,P,5)
+12 SET BGPMFITI=$PIECE(BGPSTR,P,6)
+13 SET BGPFN=$PIECE(BGPSTR,P,7)
+14 KILL ^BGPTMP($JOB)
+15 SET RETVAL="^BGPTMP("_$JOB_")"
+16 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
+17 DO EP^BGP9GNST(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPYN,BGPOT,BGPRT,BGPMFITI,BGPFN)
+18 SET BGPI=BGPI+1
+19 SET ^BGPTMP($JOB,BGPI)=+$GET(BGPERR)_$CHAR(30)
+20 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
+21 DO EN^XBVK("BGP")
+22 QUIT
ELD(RETVAL,BGPSTR) ;
+1 GOTO ELD^BGP9GR1
ONTL(RETVAL,BGPSTR) ;
+1 SET X="MERR^BGP9GU"
SET @^%ZOSF("TRAP")
+2 NEW P,BGPI,BGPDA,BGPRIEN
+3 SET P="|"
+4 SET BGPRIEN=$PIECE(BGPSTR,P)
+5 SET RETVAL="^BGPTMP("_$JOB_")"
+6 SET BGPI=0
+7 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
+8 SET BGPDA=0
FOR
SET BGPDA=$ORDER(^BGPGUIN(BGPRIEN,11,BGPDA))
IF 'BGPDA
QUIT
Begin DoDot:1
+9 SET BGPI=BGPI+1
+10 SET ^BGPTMP($JOB,BGPI)=$GET(^BGPGUIN(BGPRIEN,11,BGPDA,0))_$CHAR(30)
End DoDot:1
+11 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)_$GET(X)
+12 DO EN^XBVK("BGP")
+13 QUIT
+14 ;
DNTL(RETVAL,BGPSTR) ;
+1 ;m error trap
SET X="MERR^BGP9GU"
SET @^%ZOSF("TRAP")
+2 NEW P,BGPI,BGPDA,BGPRIEN
+3 SET P="|"
+4 SET BGPRIEN=$PIECE(BGPSTR,P)
+5 SET RETVAL="^BGPTMP("_$JOB_")"
+6 SET BGPI=0
+7 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
+8 SET BGPDA=0
FOR
SET BGPDA=$ORDER(^BGPGUIN(BGPRIEN,12,BGPDA))
IF 'BGPDA
QUIT
Begin DoDot:1
+9 SET BGPI=BGPI+1
+10 SET ^BGPTMP($JOB,BGPI)=$TRANSLATE($GET(^BGPGUIN(BGPRIEN,12,BGPDA,0)),"^","~")_$CHAR(30)
End DoDot:1
+11 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)_$GET(BGPERR)
+12 DO EN^XBVK("BGP")
+13 QUIT
+14 ;
CATSTR(BGPSRET,STR) ;EP
+1 NEW BGPDA
+2 SET BGPSRET=""
+3 SET BGPDA=0
FOR
SET BGPDA=$ORDER(STR(BGPDA))
IF 'BGPDA
QUIT
Begin DoDot:1
+4 SET BGPSRET=BGPSRET_$GET(STR(BGPDA))
End DoDot:1
+5 QUIT
+6 ;
CMP(RETVAL,BGPSTR) ;EP
+1 SET X="MERR^BGP9GU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPQTR,BGPRDT,BGPRE,BGPLIST,BGPPRV,BGPPROV,BGPOT,BGPOPT,BGPRT,R
+3 NEW BGPBEN,BGPBLDT,BGPFN
+4 SET P="|"
SET R="~"
+5 SET BGPI=0
+6 SET BGPERR=""
+7 SET BGPCT=$PIECE($PIECE(BGPSTR,P),R)
+8 IF $PIECE(BGPCT,R)'?.N
SET BGPCT=$ORDER(^ATXAX("B",BGPCT,0))
+9 SET BGPQTR=$PIECE(BGPSTR,P,2)
+10 SET BGPRDT=$PIECE(BGPSTR,P,3)
+11 SET BGPRE=$PIECE(BGPSTR,P,4)
+12 SET BGPOPT="CRS 09 NATIONAL GPRA COMPREHENSIVE PATIENT LIST"
+13 SET BGPLIST=$PIECE(BGPSTR,P,5)
+14 SET BGPPRV=$PIECE($PIECE(BGPSTR,P,6),R)
+15 SET BGPPROV=$PIECE($PIECE(BGPSTR,P,6),R,2)
+16 SET BGPOT=$PIECE(BGPSTR,P,7)
+17 SET BGPMFITI=$PIECE(BGPSTR,P,8)
+18 SET BGPBLDT=$PIECE(BGPSTR,P,9)
+19 SET BGPBEN=$PIECE(BGPSTR,P,10)
+20 SET BGPFN=$PIECE(BGPSTR,P,11)
+21 KILL ^BGPTMP($JOB)
+22 SET RETVAL="^BGPTMP("_$JOB_")"
+23 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
+24 DO EP^BGP9GCMP(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPLIST,BGPPRV,BGPPROV,BGPQTR,BGPRE,BGPCT,BGPOT,BGPRDT,BGPMFITI,BGPBLDT,BGPBEN,BGPFN)
+25 SET BGPI=BGPI+1
+26 SET ^BGPTMP($JOB,BGPI)=+$GET(BGPERR)_$CHAR(30)
+27 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
+28 DO EN^XBVK("BGP")
+29 QUIT
