BGPGR.m

BGPGR ; IHS/CMI/LAB - BGPG Visual CRS Reports 12/30/2004 12:29:35 PM ;

 ;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007

 ;

 ;

 ;

DEBUG(RETVAL,BGPSTR) ;run the debugger

 ;D DEBUG^%Serenji("COM^BGPGR(.RETVAL,.BGPSTR)")

 Q

 ;

NTL(RETVAL,BGPSTR) ;-- queue National GPRA Report

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

 N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT,R

 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 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)

 K ^BGPTMP($J)

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

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

 D EP^BGP5GNTL(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPYN,BGPOT,BGPRT)

 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 national patient lists

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

 N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPDT,BGPOT,BGPOPT,BGPRT,BGPPIEN,BGPPRV,BGPQTR,BGPLST,R,BGPIND,BGPINDL

 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 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="BGP 05 NATIONAL PAT 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)

 N I

 F I=9: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^BGP5GNPL(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,.BGPIND,.BGPINDL,BGPQTR,BGPDT,BGPLST,BGPPIEN,BGPPRV,BGPOT,BGPRT)

 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 indicators by community

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

 ;D EN^XBVK("BGP")

 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 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="BGP 05 SELECTED IND 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)

 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^BGP5GCOM(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPTP,.BGPIND,BGPQTR,BGPRE,BGPBAS,BGPPATT,BGPLIST,.BGPLIST,BGPPRV,BGPPROV,BGPOT,BGPRDT)

 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 National GPRA Report

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

 N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPSEAT,BGPOT,BGPOPT,BGPRT,P,R,A

 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 BGPCT=$P(BGPSTR,P)

 ;S BGPCT="GPRA"  ;for testing ask lori if this is supposed to be removed

 ;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="BGP 05 SEL PATIENT PANEL"

 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)

 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^BGP5GPP(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPTP,.BGPIND,BGPQTR,BGPRE,BGPBAS,BGPSEAT,BGPLIST,.BGPLIST,BGPPRV,BGPPROV,BGPOT,BGPRDT)

 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 indicators with all communities

 S X="MERR^BGPGU",@^%ZOSF("TRAP") ; m error 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

 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="BGP 05 SEL ALL PATS"

 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)

 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^BGP5GALL(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPTP,.BGPIND,BGPQTR,BGPRE,BGPBAS,BGPPATT,BGPLIST,.BGPLIST,BGPPRV,BGPPROV,BGPOT,BGPRDT)

 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^BGPGU",@^%ZOSF("TRAP") ; m error trap

 N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPDT,BGPOT,BGPOPT,BGPRT,BGPPIEN,BGPPRV,BGPQTR,BGPLST,R,BGPIND

 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))

 ;S BGPCT=$O(^ATXAX("B",BGPCT,0))

 S BGPDT=$P(BGPSTR,P,3)

 S BGPOPT="BGP 05 CMS PERF REPORT"

 S BGPRT=$P(BGPSTR,P,5)

 S BGPQTR=$P(BGPSTR,P,4)

 N I

 F I=7: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)=""

 K ^BGPTMP($J)

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

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

 D EP^BGP5GCMS(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,.BGPIND,BGPQTR,BGPDT,BGPRT)

 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^BGPGU",@^%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

 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 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 BGPOPT="BGP 05 GPU GPRA PERFORMANCE"

 K ^BGPTMP($J)

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

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

 D EP^BGP5GGPU(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPQTR,BGPRE,BGPBAS,BGPBEN,BGPYN,BGPOT,BGPRT)

 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^BGPGU",@^%ZOSF("TRAP") ; m error 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

 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 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="BGP 05 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)

 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^BGP5GHED(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPQTR,BGPRE,BGPBAS,BGPPATT,BGPYN,BGPLIST,.BGPLIST,BGPPRV,BGPPROV,BGPOT,BGPRDT)

 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^BGPGU",@^%ZOSF("TRAP") ; m error trap

 N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT,R

 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 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)

 K ^BGPTMP($J)

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

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

 D EP^BGP5GNPL(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPYN,BGPOT,BGPRT)

 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) ;ELDER CARE REPORT

 S X="MERR^BGPGU",@^%ZOSF("TRAP") ; m error 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,BGPEXP,BGPIND

 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 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="BGP 05 ELDER 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 BGPEXP=$P(BGPSTR,P,10)

 S BGPOT=$P(BGPSTR,P,11)

 S BGPINDI=$P(BGPSTR,P,13)

 S BGPLSTI=$P(BGPSTR,P,12)

 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^BGP5GELD(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPTP,.BGPIND,BGPQTR,BGPRE,BGPBAS,BGPPATT,BGPLIST,.BGPLIST,BGPPRV,BGPPROV,BGPEXP,BGPOT,BGPRDT)

 S BGPI=BGPI+1

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

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

 D EN^XBVK("BGP")

 Q

 ;

ONTL(RETVAL,BGPSTR) ;-- get the national gpra report output

 S X="MERR^BGPGU",@^%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(^BGPGUI(BGPRIEN,11,BGPDA)) Q:'BGPDA  D

 . S BGPI=BGPI+1

 . S ^BGPTMP($J,BGPI)=$G(^BGPGUI(BGPRIEN,11,BGPDA,0))_$C(30)

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

 D EN^XBVK("BGP")

 Q

 ;

DNTL(RETVAL,BGPSTR) ;-- get the national gpra report output delimited

 S X="MERR^BGPGU",@^%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(^BGPGUI(BGPRIEN,12,BGPDA)) Q:'BGPDA  D

 . S BGPI=BGPI+1

 . S ^BGPTMP($J,BGPI)=$TR($G(^BGPGUI(BGPRIEN,12,BGPDA,0)),"^","~")_$C(30)

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

 D EN^XBVK("BGP")

 Q

 ;

CATSTR(BGPSRET,STR) ;EP -- concatenate a long string in

 N BGPDA

 S BGPSRET=""

 S BGPDA=0 F  S BGPDA=$O(STR(BGPDA)) Q:'BGPDA  D

 . S BGPSRET=BGPSRET_$G(STR(BGPDA))

 Q

 ;

BGPGR     ; IHS/CMI/LAB - BGPG Visual CRS Reports 12/30/2004 12:29:35 PM ;

 +1       ;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007

 +2       ;

 +3       ;

 +4       ;

DEBUG(RETVAL,BGPSTR) ;run the debugger

 +1       ;D DEBUG^%Serenji("COM^BGPGR(.RETVAL,.BGPSTR)")

 +2        QUIT 

 +3       ;

NTL(RETVAL,BGPSTR) ;-- queue National GPRA Report

 +1       ; m error trap

           SET X="MERR^BGPGU"

           SET @^%ZOSF("TRAP")

 +2        NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT,R

 +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       ;S BGPCT=$O(^ATXAX("B",BGPCT,0))

 +9        SET BGPYN=$PIECE(BGPSTR,P,2)

 +10       SET BGPOT=$PIECE(BGPSTR,P,3)

 +11       SET BGPOPT=$PIECE(BGPSTR,P,4)

 +12       SET BGPRT=$PIECE(BGPSTR,P,5)

 +13       KILL ^BGPTMP($JOB)

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

 +15       SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)

 +16       DO EP^BGP5GNTL(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPYN,BGPOT,BGPRT)

 +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      ;

NPL(RETVAL,BGPSTR) ;-- queue national patient lists

 +1       ; m error trap

           SET X="MERR^BGPGU"

           SET @^%ZOSF("TRAP")

 +2        NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPDT,BGPOT,BGPOPT,BGPRT,BGPPIEN,BGPPRV,BGPQTR,BGPLST,R,BGPIND,BGPINDL

 +3        SET P="|"

           SET R="~"

 +4        SET BGPI=0

 +5        SET BGPERR=""

 +6        IF $GET(BGPSTR)=""

               DO CATSTR(.BGPSTR,.BGPSTR)

 +7        SET BGPCT=$PIECE($PIECE(BGPSTR,P),R)

 +8        IF $PIECE(BGPCT,R)'?.N

               SET BGPCT=$ORDER(^ATXAX("B",BGPCT,0))

 +9       ;S BGPCT=$O(^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="BGP 05 NATIONAL PAT 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       NEW I

 +19       FOR I=9:1

               Begin DoDot:1

 +20               IF $PIECE(BGPSTR,P,I)=""

                       QUIT 

 +21               NEW BGPNSTR

 +22               SET BGPNSTR=$PIECE(BGPSTR,P,I)

 +23               SET BGPINDI=$PIECE(BGPNSTR,R)

 +24               SET BGPIND(BGPINDI)=""

 +25               NEW J

 +26               FOR J=2:1

                       Begin DoDot:2

 +27                       IF $PIECE(BGPNSTR,R,J)=""

                               QUIT 

 +28                       NEW BGPSIND

 +29                       SET BGPSIND=$PIECE(BGPNSTR,R,J)

 +30                       SET BGPINDL(BGPINDI,BGPSIND)=""

                       End DoDot:2

                       IF $PIECE(BGPNSTR,R,J)=""

                           QUIT 

               End DoDot:1

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

                   QUIT 

 +31       KILL ^BGPTMP($JOB)

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

 +33       SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)

 +34       DO EP^BGP5GNPL(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,.BGPIND,.BGPINDL,BGPQTR,BGPDT,BGPLST,BGPPIEN,BGPPRV,BGPOT,BGPRT)

 +35       SET BGPI=BGPI+1

 +36       SET ^BGPTMP($JOB,BGPI)=+$GET(BGPERR)_$CHAR(30)

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

 +38       DO EN^XBVK("BGP")

 +39       QUIT 

COM(RETVAL,BGPSTR) ;selected indicators by community

 +1       ; m error trap

           SET X="MERR^BGPGU"

           SET @^%ZOSF("TRAP")

 +2       ;D EN^XBVK("BGP")

 +3        NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPOT,BGPOPT,BGPRT,P,R,A

 +4        NEW BGPTP,BGPQTR,BGPRDT,BGPRE,BGPBAS,BGPPATT,BGPLIST,BGPPRV,BGPPROV,BGPIND,BGPINDI,BGPLSTI

 +5        SET P="|"

           SET R="~"

           SET A="*"

 +6        IF $GET(BGPSTR)=""

               DO CATSTR(.BGPSTR,.BGPSTR)

 +7        SET BGPI=0

 +8        SET BGPERR=""

 +9        SET BGPCT=$PIECE($PIECE(BGPSTR,P),R)

 +10       IF $PIECE(BGPCT,R)'?.N

               SET BGPCT=$ORDER(^ATXAX("B",BGPCT,0))

 +11      ;S BGPCT=$O(^ATXAX("B",BGPCT,0))

 +12       SET BGPTP=$PIECE(BGPSTR,P,2)

 +13       SET BGPQTR=$PIECE(BGPSTR,P,3)

 +14       SET BGPRDT=$PIECE(BGPSTR,P,4)

 +15       SET BGPRE=$PIECE(BGPSTR,P,5)

 +16       SET BGPOPT="BGP 05 SELECTED IND REPORT"

 +17       SET BGPBAS=$PIECE(BGPSTR,P,6)

 +18       SET BGPPATT=$PIECE(BGPSTR,P,7)

 +19       SET BGPLIST=$PIECE(BGPSTR,P,8)

 +20       SET BGPPRV=$PIECE($PIECE(BGPSTR,P,9),R)

 +21       SET BGPPROV=$PIECE($PIECE(BGPSTR,P,9),R,2)

 +22       SET BGPOT=$PIECE(BGPSTR,P,10)

 +23       SET BGPINDI=$PIECE(BGPSTR,P,12)

 +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_")"