- BGP9GR1 ; IHS/CMI/LAB - BGPG Visual CRS Reports 12/30/2004 12:29:35 PM ;
- ;;9.0;IHS CLINICAL REPORTING;**1**;JUL 01, 2009
- ;
- DEBUG(RETVAL,BGPSTR) ;run the debugger
- D DEBUG^%Serenji("NTLSUM^BGP9GR1(.RETVAL,.BGPSTR)")
- Q
- ;
- ELD ;EP
- S X="MERR^BGP9GU",@^%ZOSF("TRAP") ; m error trap
- N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPOT,BGPOPT,BGPRT,P,R,A,BGPFN
- N BGPTP,BGPQTR,BGPRDT,BGPRE,BGPBAS,BGPPATT,BGPLIST,BGPPRV,BGPPROV,BGPEXP,BGPIND
- S P="|",R="~",A="*"
- I $G(BGPSTR)="" D CATSTR^BGP9GR(.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 ELDER CARE 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)
- S BGPMFITI=$P(BGPSTR,P,14)
- S BGPFN=$P(BGPSTR,P,15)
- 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^BGP9GELD(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPTP,.BGPIND,BGPQTR,BGPRE,BGPBAS,BGPPATT,BGPLIST,.BGPLIST,BGPPRV,BGPPROV,BGPEXP,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
- ;
- EO(RETVAL,BGPSTR) ;EP
- S X="MERR^BGP9GU",@^%ZOSF("TRAP") ; m error trap
- N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPOT,BGPOPT,BGPRT,P,R,A,BGPFN
- N BGPTP,BGPQTR,BGPRDT,BGPRE,BGPBAS,BGPPATT,BGPLIST,BGPPRV,BGPPROV,BGPEXP,BGPIND,BGPHC
- S P="|",R="~",A="*"
- I $G(BGPSTR)="" D CATSTR^BGP9GR(.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 EO 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)
- S BGPMFITI=$P(BGPSTR,P,14)
- S BGPHC=$P(BGPSTR,P,15)
- S BGPFN=$P(BGPSTR,P,16)
- 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^BGP9GEO(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPTP,.BGPIND,BGPQTR,BGPRE,BGPBAS,BGPPATT,BGPLIST,.BGPLIST,BGPPRV,BGPPROV,BGPEXP,BGPOT,BGPRDT,BGPMFITI,BGPHC,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
- ;
- NTL9(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,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 RPT FOR 2010" ;8.0 p2
- 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^BGP9GNT9(.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
- NTLSUM(RETVAL,BGPSTR) ;-- queue National GPRA Report PERFORMANCE SUMMARIES
- S X="MERR^BGP9GU",@^%ZOSF("TRAP") ;m error trap
- N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT,R,BGPOM,BGPSUMON,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 PERF SUMM" ;8.0 p2
- 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)
- S BGPSUMON=1
- K ^BGPTMP($J)
- S RETVAL="^BGPTMP("_$J_")"
- S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
- D EPSUM^BGP9GNTS(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPYN,BGPOT,BGPRT,BGPMFITI,BGPYWCHW,BGPOM,BGPSUMON,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
- ;
- DPRV(RETVAL,BGPSTR) ;-- queue National GPRA Report - BY PROVIDER
- S X="MERR^BGP9GU",@^%ZOSF("TRAP") ;m error trap
- N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT,R,BGPOM,BGPDPRV,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=0
- S BGPOT=$P(BGPSTR,P,3)
- S BGPOPT=$P(BGPSTR,P,4)
- S BGPOPT="CRS 09 NATIONAL GPRA RPT DESG P" ;8.0 p2
- S BGPRT=$P(BGPSTR,P,5)
- S BGPMFITI=$P(BGPSTR,P,6)
- S BGPYWCHW=0
- S BGPOM=$P(BGPSTR,P,8)
- S BGPDPRV=$P(BGPSTR,P,9) ;ien of designated provider selected by the user
- S BGPFN=$P(BGPSTR,P,10)
- K ^BGPTMP($J)
- S RETVAL="^BGPTMP("_$J_")"
- S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
- D EP^BGP9GNTP(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPYN,BGPOT,BGPRT,BGPMFITI,BGPYWCHW,BGPOM,BGPDPRV,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
- ;
- BGP9GR1 ; IHS/CMI/LAB - BGPG Visual CRS Reports 12/30/2004 12:29:35 PM ;
- +1 ;;9.0;IHS CLINICAL REPORTING;**1**;JUL 01, 2009
- +2 ;
- DEBUG(RETVAL,BGPSTR) ;run the debugger
- +1 DO DEBUG^%Serenji("NTLSUM^BGP9GR1(.RETVAL,.BGPSTR)")
- +2 QUIT
- +3 ;
- ELD ;EP
- +1 ; m error trap
- SET X="MERR^BGP9GU"
- SET @^%ZOSF("TRAP")
- +2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPOT,BGPOPT,BGPRT,P,R,A,BGPFN
- +3 NEW BGPTP,BGPQTR,BGPRDT,BGPRE,BGPBAS,BGPPATT,BGPLIST,BGPPRV,BGPPROV,BGPEXP,BGPIND
- +4 SET P="|"
- SET R="~"
- SET A="*"
- +5 IF $GET(BGPSTR)=""
- DO CATSTR^BGP9GR(.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 ELDER CARE 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 BGPEXP=$PIECE(BGPSTR,P,10)
- +21 SET BGPOT=$PIECE(BGPSTR,P,11)
- +22 SET BGPINDI=$PIECE(BGPSTR,P,13)
- +23 SET BGPLSTI=$PIECE(BGPSTR,P,12)
- +24 SET BGPMFITI=$PIECE(BGPSTR,P,14)
- +25 SET BGPFN=$PIECE(BGPSTR,P,15)
- +26 NEW I
- +27 FOR I=2:1
- Begin DoDot:1
- +28 IF $PIECE(BGPLSTI,A,I)=""
- QUIT
- +29 NEW BGPL
- +30 SET BGPL=$PIECE($PIECE(BGPLSTI,A,I),R)
- +31 SET BGPLIST(BGPL)=""
- End DoDot:1
- IF $PIECE(BGPLSTI,A,I)=""
- QUIT
- +32 NEW J
- +33 FOR J=2:1
- Begin DoDot:1
- +34 IF $PIECE(BGPINDI,A,J)=""
- QUIT
- +35 NEW BGPL
- +36 SET BGPL=$PIECE($PIECE(BGPINDI,A,J),R)
- +37 SET BGPIND(BGPL)=""
- End DoDot:1
- IF $PIECE(BGPINDI,A,J)=""
- QUIT
- +38 KILL ^BGPTMP($JOB)
- +39 SET RETVAL="^BGPTMP("_$JOB_")"
- +40 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
- +41 DO EP^BGP9GELD(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPTP,.BGPIND,BGPQTR,BGPRE,BGPBAS,BGPPATT,BGPLIST,.BGPLIST,BGPPRV,BGPPROV,BGPEXP,BGPOT,BGPRDT,BGPMFITI,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
- +47 ;
- EO(RETVAL,BGPSTR) ;EP
- +1 ; m error trap
- SET X="MERR^BGP9GU"
- SET @^%ZOSF("TRAP")
- +2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPOT,BGPOPT,BGPRT,P,R,A,BGPFN
- +3 NEW BGPTP,BGPQTR,BGPRDT,BGPRE,BGPBAS,BGPPATT,BGPLIST,BGPPRV,BGPPROV,BGPEXP,BGPIND,BGPHC
- +4 SET P="|"
- SET R="~"
- SET A="*"
- +5 IF $GET(BGPSTR)=""
- DO CATSTR^BGP9GR(.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 EO 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 BGPEXP=$PIECE(BGPSTR,P,10)
- +21 SET BGPOT=$PIECE(BGPSTR,P,11)
- +22 SET BGPINDI=$PIECE(BGPSTR,P,13)
- +23 SET BGPLSTI=$PIECE(BGPSTR,P,12)
- +24 SET BGPMFITI=$PIECE(BGPSTR,P,14)
- +25 SET BGPHC=$PIECE(BGPSTR,P,15)
- +26 SET BGPFN=$PIECE(BGPSTR,P,16)
- +27 NEW I
- +28 FOR I=2:1
- Begin DoDot:1
- +29 IF $PIECE(BGPLSTI,A,I)=""
- QUIT
- +30 NEW BGPL
- +31 SET BGPL=$PIECE($PIECE(BGPLSTI,A,I),R)
- +32 SET BGPLIST(BGPL)=""
- End DoDot:1
- IF $PIECE(BGPLSTI,A,I)=""
- QUIT
- +33 NEW J
- +34 FOR J=2:1
- Begin DoDot:1
- +35 IF $PIECE(BGPINDI,A,J)=""
- QUIT
- +36 NEW BGPL
- +37 SET BGPL=$PIECE($PIECE(BGPINDI,A,J),R)
- +38 SET BGPIND(BGPL)=""
- End DoDot:1
- IF $PIECE(BGPINDI,A,J)=""
- QUIT
- +39 KILL ^BGPTMP($JOB)
- +40 SET RETVAL="^BGPTMP("_$JOB_")"
- +41 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
- +42 DO EP^BGP9GEO(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPTP,.BGPIND,BGPQTR,BGPRE,BGPBAS,BGPPATT,BGPLIST,.BGPLIST,BGPPRV,BGPPROV,BGPEXP,BGPOT,BGPRDT,BGPMFITI,BGPHC,BGPFN)
- +43 SET BGPI=BGPI+1
- +44 SET ^BGPTMP($JOB,BGPI)=$GET(BGPERR)_$CHAR(30)
- +45 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
- +46 DO EN^XBVK("BGP")
- +47 QUIT
- +48 ;
- NTL9(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,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 ;8.0 p2
- SET BGPOPT="CRS 09 NATIONAL GPRA RPT FOR 2010"
- +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^BGP9GNT9(.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
- NTLSUM(RETVAL,BGPSTR) ;-- queue National GPRA Report PERFORMANCE SUMMARIES
- +1 ;m error trap
- SET X="MERR^BGP9GU"
- SET @^%ZOSF("TRAP")
- +2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT,R,BGPOM,BGPSUMON,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 ;8.0 p2
- SET BGPOPT="CRS 09 NATIONAL GPRA PERF SUMM"
- +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 SET BGPSUMON=1
- +18 KILL ^BGPTMP($JOB)
- +19 SET RETVAL="^BGPTMP("_$JOB_")"
- +20 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
- +21 DO EPSUM^BGP9GNTS(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPYN,BGPOT,BGPRT,BGPMFITI,BGPYWCHW,BGPOM,BGPSUMON,BGPFN)
- +22 SET BGPI=BGPI+1
- +23 SET ^BGPTMP($JOB,BGPI)=+$GET(BGPERR)_$CHAR(30)
- +24 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
- +25 DO EN^XBVK("BGP")
- +26 QUIT
- +27 ;
- DPRV(RETVAL,BGPSTR) ;-- queue National GPRA Report - BY PROVIDER
- +1 ;m error trap
- SET X="MERR^BGP9GU"
- SET @^%ZOSF("TRAP")
- +2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT,R,BGPOM,BGPDPRV,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=0
- +9 SET BGPOT=$PIECE(BGPSTR,P,3)
- +10 SET BGPOPT=$PIECE(BGPSTR,P,4)
- +11 ;8.0 p2
- SET BGPOPT="CRS 09 NATIONAL GPRA RPT DESG P"
- +12 SET BGPRT=$PIECE(BGPSTR,P,5)
- +13 SET BGPMFITI=$PIECE(BGPSTR,P,6)
- +14 SET BGPYWCHW=0
- +15 SET BGPOM=$PIECE(BGPSTR,P,8)
- +16 ;ien of designated provider selected by the user
- SET BGPDPRV=$PIECE(BGPSTR,P,9)
- +17 SET BGPFN=$PIECE(BGPSTR,P,10)
- +18 KILL ^BGPTMP($JOB)
- +19 SET RETVAL="^BGPTMP("_$JOB_")"
- +20 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
- +21 DO EP^BGP9GNTP(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPYN,BGPOT,BGPRT,BGPMFITI,BGPYWCHW,BGPOM,BGPDPRV,BGPFN)
- +22 SET BGPI=BGPI+1
- +23 SET ^BGPTMP($JOB,BGPI)=+$GET(BGPERR)_$CHAR(30)
- +24 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
- +25 DO EN^XBVK("BGP")
- +26 QUIT
- +27 ;