- BGP0GRB ; IHS/CMI/LAB - BGP Gui Area Reports 5/2/2005 8:38:59 PM ;
- ;;10.0;IHS CLINICAL REPORTING;**1**;JUN 18, 2010
- ;
- ;
- ;
- ;area GPRA reports
- Q
- ;
- DEBUG(RETVAL,BGPSTR) ;run the debugger
- D DEBUG^%Serenji("FOR^BGP0GRB(.RETVAL,.BGPSTR)")
- Q
- ;
- FOR(RETVAL,BGPSTR) ;-- gpra patient forcast report
- S X="MERR^BGP0GU",@^%ZOSF("TRAP") ; m error trap
- N BGPI,BGPGDA,P,R,BGPLST,BGPDIV,BGPBADT,BGPEADT,BGPCLN,BGPPATL,BGPPATI,BGPPAT,BGPCLNL,BGPST,BGPSTI,BGPCNT,BGPFN
- S P="|",R="~"
- S RETVAL="^BGPTMP("_$J_")"
- S BGPI=0
- S BGPOPT="CRS 10 PATIENT FORECAST REPORT"
- I $G(BGPSTR)="" D CATSTR^BGP0GU(.BGPSTR,.BGPSTR)
- S BGPLST=$P(BGPSTR,P)
- S BGPDIV=$P(BGPSTR,P,2)
- I BGPDIV]"" S BGPDIV=$O(^DG(40.8,"B",BGPDIV,0))
- S BGPBADT=$P(BGPSTR,P,3)
- S BGPEADT=$P(BGPSTR,P,4)
- S BGPCLNL=$P(BGPSTR,P,5)
- S BGPPATL=$P(BGPSTR,P,6)
- S BGPPATI=$P(BGPSTR,P,7)
- I BGPPATI]"" S BGPPATL(BGPPATI)="",BGPPAT(BGPPATI)=""
- S BGPRT=$P(BGPSTR,P,8)
- S BGPST=$P(BGPSTR,P,9)
- S BGPFN=$P(BGPSTR,P,10)
- ;I BGPST]"" S BGPSTI=$O(^DIBT("B",BGPST,0))
- I BGPCLNL]"",BGPCLNL'="A" D
- . N I
- . F I=1:1 D Q:$P(BGPCLNL,R,I)=""
- .. Q:$P(BGPCLNL,R,I)=""
- .. S BGPCLN($P(BGPCLNL,R,I))=$P(BGPCLNL,R,I)
- I BGPPATL]"" D
- . N J
- . F J=1:1 D Q:$P(BGPPATL,R,J)=""
- .. Q:$P(BGPPATL,R,J)=""
- .. S BGPPAT($P(BGPPATL,R,J))=$P(BGPPATL,R,J)
- I $G(BGPST) D
- . N BGPDA
- . S BGPCNT=0
- . S BGPDA=0 F S BGPDA=$O(^DIBT(BGPST,1,BGPDA)) Q:'BGPDA D
- .. S BGPCNT=BGPCNT+1
- .. S BGPPAT(BGPCNT)=BGPDA
- S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
- D EP^BGP0GFOR(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPLST,BGPDIV,BGPBADT,BGPEADT,.BGPCLN,.BGPPAT,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
- ;
- FORD(RETVAL,BGPSTR) ;-- return the patient forecast denominator
- S X="MERR^BGP0GU",@^%ZOSF("TRAP") ; m error trap
- N P,BGPRDT,BGPFN
- S P="|"
- S BGPRDT=$P(BGPSTR,P)
- S BGPFN=$P(BGPSTR,P,2)
- S RETVAL="^BGPTMP("_$J_")"
- S BGPI=0
- S BGPGUI=1
- S BGPOPT="CRS 10 PATIENT FORECAST DENOMINATOR DEFINITIONS"
- D ^XBFMK
- D GUILOG(BGPOPT,BGPRDT,BGPFN)
- S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
- K ZTSAVE S ZTSAVE("*")=""
- S ZTIO="",ZTDTH=$S(BGPRDT]"":BGPRDT,1:$$NOW^XLFDT),ZTRTN="GUIECP^BGP0DPA",ZTDESC="GUI Denominator Definitions" D ^%ZTLOAD
- S BGPI=BGPI+1
- S ^BGPTMP($J,BGPI)=+$G(BGPERR)_$C(30)
- S ^BGPTMP($J,BGPI+1)=$C(31)
- D EN^XBVK("BGP")
- Q
- AEO(RETVAL,BGPSTR) ;-- area EO report
- S X="MERR^BGP0GU",@^%ZOSF("TRAP") ; m error trap
- N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT,BGPHC
- N BGPQTR,BGPRE,BGPBAS,BGPBEN,BGPFAC,A,R,BGPFN
- I $G(BGPSTR)="" D CATSTR^BGPGR(.BGPSTR,.BGPSTR)
- S P="|",A="*",R="~"
- S BGPI=0
- S BGPERR=""
- S BGPQTR=$P(BGPSTR,P)
- S BGPRT=$P(BGPSTR,P,2)
- S BGPRE=$P(BGPSTR,P,3)
- S BGPPER=$P(BGPSTR,P,4)
- S BGPBAS=$P(BGPSTR,P,5)
- S BGPBEN=$P(BGPSTR,P,6)
- S BGPOT=$P(BGPSTR,P,7)
- S BGPLSTI=$P(BGPSTR,P,8)
- S BGPHC=$P(BGPSTR,P,9)
- S BGPFN=$P(BGPSTR,P,11)
- S BGPOPT="CRS 10 AREA EO REPORT"
- 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^BGP0GAEO(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPRT,.BGPLIST,BGPQTR,BGPPER,BGPBAS,BGPBEN,BGPOT,BGPRE,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
- ;
- GUILOG(BGPOPT,RDT,FN) ;-- log in the GUI REPORT FILE
- D NOW^%DTC
- S BGPNOW=$G(%)
- K DD,D0,DIC
- S X=DUZ_$$NOW^XLFDT
- S X=FN
- S BGPGFNM=X
- S DIC="^BGPGUIT(",DIC(0)="L",DIADD=1,DLAYGO=90378.08,DIC("DR")=".02////"_DUZ_";.03////"_$S(RDT]"":RDT,1:$$NOW^XLFDT)_";.05///"_BGPOPT_";.06///R;.07///P"
- K DD,D0,DO D FILE^DICN K DLAYGO,DIADD,DD,D0,DO
- I Y=-1 S BGPIEN=-1 Q
- S BGPIEN=+Y
- Q
- ;
- FOR9(RETVAL,BGPSTR) ;-- gpra patient forcast report
- S X="MERR^BGP0GU",@^%ZOSF("TRAP") ; m error trap
- N BGPI,BGPGDA,P,R,BGPLST,BGPDIV,BGPBADT,BGPEADT,BGPCLN,BGPPATL,BGPPATI,BGPPAT,BGPCLNL,BGPST,BGPSTI,BGPCNT,BGPFN
- S P="|",R="~"
- S RETVAL="^BGPTMP("_$J_")"
- S BGPI=0
- S BGPOPT="CRS 10 PATIENT FORECAST REPORT 10"
- I $G(BGPSTR)="" D CATSTR^BGP0GU(.BGPSTR,.BGPSTR)
- S BGPLST=$P(BGPSTR,P)
- S BGPDIV=$P(BGPSTR,P,2)
- I BGPDIV]"" S BGPDIV=$O(^DG(40.8,"B",BGPDIV,0))
- S BGPBADT=$P(BGPSTR,P,3)
- S BGPEADT=$P(BGPSTR,P,4)
- S BGPCLNL=$P(BGPSTR,P,5)
- S BGPPATL=$P(BGPSTR,P,6)
- S BGPPATI=$P(BGPSTR,P,7)
- I BGPPATI]"" S BGPPATL(BGPPATI)="",BGPPAT(BGPPATI)=""
- S BGPRT=$P(BGPSTR,P,8)
- S BGPST=$P(BGPSTR,P,9)
- S BGPFN=$P(BGPSTR,P,10)
- I BGPST]"" S BGPSTI=$O(^DIBT("B",BGPST,0))
- I BGPCLNL]"",BGPCLNL'="A" D
- . N I
- . F I=1:1 D Q:$P(BGPCLNL,R,I)=""
- .. Q:$P(BGPCLNL,R,I)=""
- .. S BGPCLN($P(BGPCLNL,R,I))=$P(BGPCLNL,R,I)
- I BGPPATL]"" D
- . N J
- . F J=1:1 D Q:$P(BGPPATL,R,J)=""
- .. Q:$P(BGPPATL,R,J)=""
- .. S BGPPAT($P(BGPPATL,R,J))=$P(BGPPATL,R,J)
- I $G(BGPSTI) D
- . N BGPDA
- . S BGPCNT=0
- . S BGPDA=0 F S BGPDA=$O(^DIBT(BGPSTI,1,BGPDA)) Q:'BGPDA D
- .. S BGPCNT=BGPCNT+1
- .. S BGPPAT(BGPCNT)=BGPDA
- S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
- D EP^BGP0GFO9(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPLST,BGPDIV,BGPBADT,BGPEADT,.BGPCLN,.BGPPAT,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
- ;
- FOR10(RETVAL,BGPSTR) ;-- gpra patient forcast report
- S X="MERR^BGP0GU",@^%ZOSF("TRAP") ; m error trap
- N BGPI,BGPGDA,P,R,BGPLST,BGPDIV,BGPBADT,BGPEADT,BGPCLN,BGPPATL,BGPPATI,BGPPAT,BGPCLNL,BGPST,BGPSTI,BGPCNT,BGPFN
- S P="|",R="~"
- S RETVAL="^BGPTMP("_$J_")"
- S BGPI=0
- S BGPOPT="CRS 10 PATIENT FORECAST REPORT 10"
- I $G(BGPSTR)="" D CATSTR^BGP0GU(.BGPSTR,.BGPSTR)
- S BGPLST=$P(BGPSTR,P)
- S BGPDIV=$P(BGPSTR,P,2)
- I BGPDIV]"" S BGPDIV=$O(^DG(40.8,"B",BGPDIV,0))
- S BGPBADT=$P(BGPSTR,P,3)
- S BGPEADT=$P(BGPSTR,P,4)
- S BGPCLNL=$P(BGPSTR,P,5)
- S BGPPATL=$P(BGPSTR,P,6)
- S BGPPATI=$P(BGPSTR,P,7)
- I BGPPATI]"" S BGPPATL(BGPPATI)="",BGPPAT(BGPPATI)=""
- S BGPRT=$P(BGPSTR,P,8)
- S BGPST=$P(BGPSTR,P,9)
- S BGPFN=$P(BGPSTR,P,10)
- I BGPST]"" S BGPSTI=$O(^DIBT("B",BGPST,0))
- I BGPCLNL]"",BGPCLNL'="A" D
- . N I
- . F I=1:1 D Q:$P(BGPCLNL,R,I)=""
- .. Q:$P(BGPCLNL,R,I)=""
- .. S BGPCLN($P(BGPCLNL,R,I))=$P(BGPCLNL,R,I)
- I BGPPATL]"" D
- . N J
- . F J=1:1 D Q:$P(BGPPATL,R,J)=""
- .. Q:$P(BGPPATL,R,J)=""
- .. S BGPPAT($P(BGPPATL,R,J))=$P(BGPPATL,R,J)
- I $G(BGPSTI) D
- . N BGPDA
- . S BGPCNT=0
- . S BGPDA=0 F S BGPDA=$O(^DIBT(BGPSTI,1,BGPDA)) Q:'BGPDA D
- .. S BGPCNT=BGPCNT+1
- .. S BGPPAT(BGPCNT)=BGPDA
- S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
- D EP^BGP0GFO9(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPLST,BGPDIV,BGPBADT,BGPEADT,.BGPCLN,.BGPPAT,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
- ;
- BGP0GRB ; IHS/CMI/LAB - BGP Gui Area Reports 5/2/2005 8:38:59 PM ;
- +1 ;;10.0;IHS CLINICAL REPORTING;**1**;JUN 18, 2010
- +2 ;
- +3 ;
- +4 ;
- +5 ;area GPRA reports
- +6 QUIT
- +7 ;
- DEBUG(RETVAL,BGPSTR) ;run the debugger
- +1 DO DEBUG^%Serenji("FOR^BGP0GRB(.RETVAL,.BGPSTR)")
- +2 QUIT
- +3 ;
- FOR(RETVAL,BGPSTR) ;-- gpra patient forcast report
- +1 ; m error trap
- SET X="MERR^BGP0GU"
- SET @^%ZOSF("TRAP")
- +2 NEW BGPI,BGPGDA,P,R,BGPLST,BGPDIV,BGPBADT,BGPEADT,BGPCLN,BGPPATL,BGPPATI,BGPPAT,BGPCLNL,BGPST,BGPSTI,BGPCNT,BGPFN
- +3 SET P="|"
- SET R="~"
- +4 SET RETVAL="^BGPTMP("_$JOB_")"
- +5 SET BGPI=0
- +6 SET BGPOPT="CRS 10 PATIENT FORECAST REPORT"
- +7 IF $GET(BGPSTR)=""
- DO CATSTR^BGP0GU(.BGPSTR,.BGPSTR)
- +8 SET BGPLST=$PIECE(BGPSTR,P)
- +9 SET BGPDIV=$PIECE(BGPSTR,P,2)
- +10 IF BGPDIV]""
- SET BGPDIV=$ORDER(^DG(40.8,"B",BGPDIV,0))
- +11 SET BGPBADT=$PIECE(BGPSTR,P,3)
- +12 SET BGPEADT=$PIECE(BGPSTR,P,4)
- +13 SET BGPCLNL=$PIECE(BGPSTR,P,5)
- +14 SET BGPPATL=$PIECE(BGPSTR,P,6)
- +15 SET BGPPATI=$PIECE(BGPSTR,P,7)
- +16 IF BGPPATI]""
- SET BGPPATL(BGPPATI)=""
- SET BGPPAT(BGPPATI)=""
- +17 SET BGPRT=$PIECE(BGPSTR,P,8)
- +18 SET BGPST=$PIECE(BGPSTR,P,9)
- +19 SET BGPFN=$PIECE(BGPSTR,P,10)
- +20 ;I BGPST]"" S BGPSTI=$O(^DIBT("B",BGPST,0))
- +21 IF BGPCLNL]""
- IF BGPCLNL'="A"
- Begin DoDot:1
- +22 NEW I
- +23 FOR I=1:1
- Begin DoDot:2
- +24 IF $PIECE(BGPCLNL,R,I)=""
- QUIT
- +25 SET BGPCLN($PIECE(BGPCLNL,R,I))=$PIECE(BGPCLNL,R,I)
- End DoDot:2
- IF $PIECE(BGPCLNL,R,I)=""
- QUIT
- End DoDot:1
- +26 IF BGPPATL]""
- Begin DoDot:1
- +27 NEW J
- +28 FOR J=1:1
- Begin DoDot:2
- +29 IF $PIECE(BGPPATL,R,J)=""
- QUIT
- +30 SET BGPPAT($PIECE(BGPPATL,R,J))=$PIECE(BGPPATL,R,J)
- End DoDot:2
- IF $PIECE(BGPPATL,R,J)=""
- QUIT
- End DoDot:1
- +31 IF $GET(BGPST)
- Begin DoDot:1
- +32 NEW BGPDA
- +33 SET BGPCNT=0
- +34 SET BGPDA=0
- FOR
- SET BGPDA=$ORDER(^DIBT(BGPST,1,BGPDA))
- IF 'BGPDA
- QUIT
- Begin DoDot:2
- +35 SET BGPCNT=BGPCNT+1
- +36 SET BGPPAT(BGPCNT)=BGPDA
- End DoDot:2
- End DoDot:1
- +37 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
- +38 DO EP^BGP0GFOR(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPLST,BGPDIV,BGPBADT,BGPEADT,.BGPCLN,.BGPPAT,BGPRT,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 ;
- FORD(RETVAL,BGPSTR) ;-- return the patient forecast denominator
- +1 ; m error trap
- SET X="MERR^BGP0GU"
- SET @^%ZOSF("TRAP")
- +2 NEW P,BGPRDT,BGPFN
- +3 SET P="|"
- +4 SET BGPRDT=$PIECE(BGPSTR,P)
- +5 SET BGPFN=$PIECE(BGPSTR,P,2)
- +6 SET RETVAL="^BGPTMP("_$JOB_")"
- +7 SET BGPI=0
- +8 SET BGPGUI=1
- +9 SET BGPOPT="CRS 10 PATIENT FORECAST DENOMINATOR DEFINITIONS"
- +10 DO ^XBFMK
- +11 DO GUILOG(BGPOPT,BGPRDT,BGPFN)
- +12 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
- +13 KILL ZTSAVE
- SET ZTSAVE("*")=""
- +14 SET ZTIO=""
- SET ZTDTH=$SELECT(BGPRDT]"":BGPRDT,1:$$NOW^XLFDT)
- SET ZTRTN="GUIECP^BGP0DPA"
- SET ZTDESC="GUI Denominator Definitions"
- DO ^%ZTLOAD
- +15 SET BGPI=BGPI+1
- +16 SET ^BGPTMP($JOB,BGPI)=+$GET(BGPERR)_$CHAR(30)
- +17 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
- +18 DO EN^XBVK("BGP")
- +19 QUIT
- AEO(RETVAL,BGPSTR) ;-- area EO report
- +1 ; m error trap
- SET X="MERR^BGP0GU"
- SET @^%ZOSF("TRAP")
- +2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT,BGPHC
- +3 NEW BGPQTR,BGPRE,BGPBAS,BGPBEN,BGPFAC,A,R,BGPFN
- +4 IF $GET(BGPSTR)=""
- DO CATSTR^BGPGR(.BGPSTR,.BGPSTR)
- +5 SET P="|"
- SET A="*"
- SET R="~"
- +6 SET BGPI=0
- +7 SET BGPERR=""
- +8 SET BGPQTR=$PIECE(BGPSTR,P)
- +9 SET BGPRT=$PIECE(BGPSTR,P,2)
- +10 SET BGPRE=$PIECE(BGPSTR,P,3)
- +11 SET BGPPER=$PIECE(BGPSTR,P,4)
- +12 SET BGPBAS=$PIECE(BGPSTR,P,5)
- +13 SET BGPBEN=$PIECE(BGPSTR,P,6)
- +14 SET BGPOT=$PIECE(BGPSTR,P,7)
- +15 SET BGPLSTI=$PIECE(BGPSTR,P,8)
- +16 SET BGPHC=$PIECE(BGPSTR,P,9)
- +17 SET BGPFN=$PIECE(BGPSTR,P,11)
- +18 SET BGPOPT="CRS 10 AREA EO REPORT"
- +19 NEW I
- +20 FOR I=2:1
- Begin DoDot:1
- +21 IF $PIECE(BGPLSTI,A,I)=""
- QUIT
- +22 NEW BGPL
- +23 SET BGPL=$PIECE($PIECE(BGPLSTI,A,I),R)
- +24 SET BGPLIST(BGPL)=""
- End DoDot:1
- IF $PIECE(BGPLSTI,A,I)=""
- QUIT
- +25 KILL ^BGPTMP($JOB)
- +26 SET RETVAL="^BGPTMP("_$JOB_")"
- +27 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
- +28 DO EP^BGP0GAEO(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPRT,.BGPLIST,BGPQTR,BGPPER,BGPBAS,BGPBEN,BGPOT,BGPRE,BGPHC,BGPFN)
- +29 SET BGPI=BGPI+1
- +30 SET ^BGPTMP($JOB,BGPI)=$GET(BGPERR)_$CHAR(30)
- +31 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
- +32 DO EN^XBVK("BGP")
- +33 QUIT
- +34 ;
- GUILOG(BGPOPT,RDT,FN) ;-- log in the GUI REPORT FILE
- +1 DO NOW^%DTC
- +2 SET BGPNOW=$GET(%)
- +3 KILL DD,D0,DIC
- +4 SET X=DUZ_$$NOW^XLFDT
- +5 SET X=FN
- +6 SET BGPGFNM=X
- +7 SET DIC="^BGPGUIT("
- SET DIC(0)="L"
- SET DIADD=1
- SET DLAYGO=90378.08
- SET DIC("DR")=".02////"_DUZ_";.03////"_$SELECT(RDT]"":RDT,1:$$NOW^XLFDT)_";.05///"_BGPOPT_";.06///R;.07///P"
- +8 KILL DD,D0,DO
- DO FILE^DICN
- KILL DLAYGO,DIADD,DD,D0,DO
- +9 IF Y=-1
- SET BGPIEN=-1
- QUIT
- +10 SET BGPIEN=+Y
- +11 QUIT
- +12 ;
- FOR9(RETVAL,BGPSTR) ;-- gpra patient forcast report
- +1 ; m error trap
- SET X="MERR^BGP0GU"
- SET @^%ZOSF("TRAP")
- +2 NEW BGPI,BGPGDA,P,R,BGPLST,BGPDIV,BGPBADT,BGPEADT,BGPCLN,BGPPATL,BGPPATI,BGPPAT,BGPCLNL,BGPST,BGPSTI,BGPCNT,BGPFN
- +3 SET P="|"
- SET R="~"
- +4 SET RETVAL="^BGPTMP("_$JOB_")"
- +5 SET BGPI=0
- +6 SET BGPOPT="CRS 10 PATIENT FORECAST REPORT 10"
- +7 IF $GET(BGPSTR)=""
- DO CATSTR^BGP0GU(.BGPSTR,.BGPSTR)
- +8 SET BGPLST=$PIECE(BGPSTR,P)
- +9 SET BGPDIV=$PIECE(BGPSTR,P,2)
- +10 IF BGPDIV]""
- SET BGPDIV=$ORDER(^DG(40.8,"B",BGPDIV,0))
- +11 SET BGPBADT=$PIECE(BGPSTR,P,3)
- +12 SET BGPEADT=$PIECE(BGPSTR,P,4)
- +13 SET BGPCLNL=$PIECE(BGPSTR,P,5)
- +14 SET BGPPATL=$PIECE(BGPSTR,P,6)
- +15 SET BGPPATI=$PIECE(BGPSTR,P,7)
- +16 IF BGPPATI]""
- SET BGPPATL(BGPPATI)=""
- SET BGPPAT(BGPPATI)=""
- +17 SET BGPRT=$PIECE(BGPSTR,P,8)
- +18 SET BGPST=$PIECE(BGPSTR,P,9)
- +19 SET BGPFN=$PIECE(BGPSTR,P,10)
- +20 IF BGPST]""
- SET BGPSTI=$ORDER(^DIBT("B",BGPST,0))
- +21 IF BGPCLNL]""
- IF BGPCLNL'="A"
- Begin DoDot:1
- +22 NEW I
- +23 FOR I=1:1
- Begin DoDot:2
- +24 IF $PIECE(BGPCLNL,R,I)=""
- QUIT
- +25 SET BGPCLN($PIECE(BGPCLNL,R,I))=$PIECE(BGPCLNL,R,I)
- End DoDot:2
- IF $PIECE(BGPCLNL,R,I)=""
- QUIT
- End DoDot:1
- +26 IF BGPPATL]""
- Begin DoDot:1
- +27 NEW J
- +28 FOR J=1:1
- Begin DoDot:2
- +29 IF $PIECE(BGPPATL,R,J)=""
- QUIT
- +30 SET BGPPAT($PIECE(BGPPATL,R,J))=$PIECE(BGPPATL,R,J)
- End DoDot:2
- IF $PIECE(BGPPATL,R,J)=""
- QUIT
- End DoDot:1
- +31 IF $GET(BGPSTI)
- Begin DoDot:1
- +32 NEW BGPDA
- +33 SET BGPCNT=0
- +34 SET BGPDA=0
- FOR
- SET BGPDA=$ORDER(^DIBT(BGPSTI,1,BGPDA))
- IF 'BGPDA
- QUIT
- Begin DoDot:2
- +35 SET BGPCNT=BGPCNT+1
- +36 SET BGPPAT(BGPCNT)=BGPDA
- End DoDot:2
- End DoDot:1
- +37 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
- +38 DO EP^BGP0GFO9(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPLST,BGPDIV,BGPBADT,BGPEADT,.BGPCLN,.BGPPAT,BGPRT,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 ;
- FOR10(RETVAL,BGPSTR) ;-- gpra patient forcast report
- +1 ; m error trap
- SET X="MERR^BGP0GU"
- SET @^%ZOSF("TRAP")
- +2 NEW BGPI,BGPGDA,P,R,BGPLST,BGPDIV,BGPBADT,BGPEADT,BGPCLN,BGPPATL,BGPPATI,BGPPAT,BGPCLNL,BGPST,BGPSTI,BGPCNT,BGPFN
- +3 SET P="|"
- SET R="~"
- +4 SET RETVAL="^BGPTMP("_$JOB_")"
- +5 SET BGPI=0
- +6 SET BGPOPT="CRS 10 PATIENT FORECAST REPORT 10"
- +7 IF $GET(BGPSTR)=""
- DO CATSTR^BGP0GU(.BGPSTR,.BGPSTR)
- +8 SET BGPLST=$PIECE(BGPSTR,P)
- +9 SET BGPDIV=$PIECE(BGPSTR,P,2)
- +10 IF BGPDIV]""
- SET BGPDIV=$ORDER(^DG(40.8,"B",BGPDIV,0))
- +11 SET BGPBADT=$PIECE(BGPSTR,P,3)
- +12 SET BGPEADT=$PIECE(BGPSTR,P,4)
- +13 SET BGPCLNL=$PIECE(BGPSTR,P,5)
- +14 SET BGPPATL=$PIECE(BGPSTR,P,6)
- +15 SET BGPPATI=$PIECE(BGPSTR,P,7)
- +16 IF BGPPATI]""
- SET BGPPATL(BGPPATI)=""
- SET BGPPAT(BGPPATI)=""
- +17 SET BGPRT=$PIECE(BGPSTR,P,8)
- +18 SET BGPST=$PIECE(BGPSTR,P,9)
- +19 SET BGPFN=$PIECE(BGPSTR,P,10)
- +20 IF BGPST]""
- SET BGPSTI=$ORDER(^DIBT("B",BGPST,0))
- +21 IF BGPCLNL]""
- IF BGPCLNL'="A"
- Begin DoDot:1
- +22 NEW I
- +23 FOR I=1:1
- Begin DoDot:2
- +24 IF $PIECE(BGPCLNL,R,I)=""
- QUIT
- +25 SET BGPCLN($PIECE(BGPCLNL,R,I))=$PIECE(BGPCLNL,R,I)
- End DoDot:2
- IF $PIECE(BGPCLNL,R,I)=""
- QUIT
- End DoDot:1
- +26 IF BGPPATL]""
- Begin DoDot:1
- +27 NEW J
- +28 FOR J=1:1
- Begin DoDot:2
- +29 IF $PIECE(BGPPATL,R,J)=""
- QUIT
- +30 SET BGPPAT($PIECE(BGPPATL,R,J))=$PIECE(BGPPATL,R,J)
- End DoDot:2
- IF $PIECE(BGPPATL,R,J)=""
- QUIT
- End DoDot:1
- +31 IF $GET(BGPSTI)
- Begin DoDot:1
- +32 NEW BGPDA
- +33 SET BGPCNT=0
- +34 SET BGPDA=0
- FOR
- SET BGPDA=$ORDER(^DIBT(BGPSTI,1,BGPDA))
- IF 'BGPDA
- QUIT
- Begin DoDot:2
- +35 SET BGPCNT=BGPCNT+1
- +36 SET BGPPAT(BGPCNT)=BGPDA
- End DoDot:2
- End DoDot:1
- +37 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
- +38 DO EP^BGP0GFO9(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPLST,BGPDIV,BGPBADT,BGPEADT,.BGPCLN,.BGPPAT,BGPRT,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 ;
