BGPGU ; IHS/CMI/LAB - BGP Gui Utilities 10/29/2004 3:28:39 PM ;
;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
;
;
DEBUG(RETVAL,BGPSTR) ;run the debugger
D DEBUG^%Serenji("SITE^BGPGU(.RETVAL,.BGPSTR)")
Q
;
KEYS(RETVAL,BGPSTR) ;-- return keys for user
S X="MERR^BGPGU",@^%ZOSF("TRAP") ; m error trap
N BGPDA,BGPNS,P,BGPDATA,BGPKEYI,BGPKEY,BGPI
S BGPI=0
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S ^BGPTMP($J,BGPI)="T00030KEYS"_$C(30)
S P="|"
S BGPNS=$P(BGPSTR,P)
S BGPDA=0 F S BGPDA=$O(^VA(200,DUZ,51,BGPDA)) Q:'BGPDA D
. S BGPDATA=$G(^VA(200,DUZ,51,BGPDA,0))
. S BGPKEYI=$P(BGPDATA,U)
. S BGPKEY=$P($G(^DIC(19.1,BGPKEYI,0)),U)
. I BGPNS'="*" Q:$E(BGPKEY,1,$L(BGPNS))'[BGPNS
. S BGPI=BGPI+1
. S ^BGPTMP($J,BGPI)=BGPKEY_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)_$G(BGPERR)
Q
;
SP(RETVAL,BGPSTR) ;-- get the site parameter entry
N BGPDA,BGPI,P
S P="|"
S BGPSE=$P(BGPSTR,P)
I BGPSE="" S BGPSE=DUZ(2)
I BGPSE'?.N S BGPSE=$O(^DIC(4,"B",BGPSE,0))
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S BGPI=0
S ^BGPTMP($J,BGPI)="T00010BMXIEN^T00050Location^T00050Home Location^T00050Community Taxonomy^T00001EISS^T00001CHS^T00001HeightWeight^T00050Location Taxonomy^T00050Demo Template^T00001Outreach^T00040ExportDirectory"_$C(30)
S BGPDA=0 F S BGPDA=$O(^BGPSITE("B",BGPSE,BGPDA)) Q:'BGPDA D
. N BGPDATA,BGPLI,BGPL,BGPLA,BGPHI,BGPH,BGPHA,BGPTX,BGPTXI,BGPEISS,BGPCHS,BGPMTAX,BGPMTAXI,BGPHTWT,BGPDEMOI,BGPDEMO,BGPOUT,BGPEDIR
. S BGPDATA=$G(^BGPSITE(BGPDA,0))
. S BGPLI=$P(BGPDATA,U)
. S BGPL=$P($G(^DIC(4,BGPLI,0)),U)
. S BGPLA=$P($G(^AUTTLOC(BGPLI,0)),U,10)
. S BGPHI=$P(BGPDATA,U,2)
. S BGPH=$S($G(BGPHI):$P($G(^DIC(4,BGPHI,0)),U),1:"")
. S BGPHA=$S($G(BGPHI):$P($G(^AUTTLOC(BGPHI,0)),U,10),1:"")
. S BGPTXI=$P(BGPDATA,U,5)
. S BGPTX=$S($P(BGPDATA,U,5):$P($G(^ATXAX($P(BGPDATA,U,5),0)),U),1:"")
. S BGPEISS=$S($P(BGPDATA,U,8):1,1:0)
. S BGPCHS=$P(BGPDATA,U,6)
. S BGPHTWT=$P(BGPDATA,U,11) ;cmi/anch/maw v7.0
. S BGPMTAXI=$P(BGPDATA,U,9)
. S BGPMTAX=$S($P(BGPDATA,U,9):$P($G(^ATXAX($P(BGPDATA,U,9),0)),U),1:"")
. S BGPDEMOI=$P(BGPDATA,U,12)
. S BGPDEMO=$S(BGPDEMOI]"":$P($G(^DIBT(BGPDEMOI,0)),U),1:"")
. S BGPOUT=$P(BGPDATA,U,13)
. S BGPEDIR=$P(BGPDATA,U,14)
. S BGPI=BGPI+1
. S ^BGPTMP($J,BGPI)=BGPDA_U_$S($G(BGPLI):BGPLI_"~"_BGPL,1:"")_U_$S($G(BGPHI):BGPHI_"~"_BGPH,1:"")_U_$S($G(BGPTXI):BGPTXI_"~"_$G(BGPTX),1:"")_U_$G(BGPEISS)_U_$G(BGPCHS)_U_$G(BGPHTWT)_U_$S($G(BGPMTAXI):BGPMTAXI_"~"_$G(BGPMTAX),1:"")
. S ^BGPTMP($J,BGPI)=^BGPTMP($J,BGPI)_U_$S($G(BGPDEMOI):BGPDEMOI_"~"_$G(BGPDEMO),1:"")_U_BGPOUT_U_BGPEDIR_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)_$G(BGPERR)
Q
;
TAXCHK(RETVAL,BGPSTR) ;-- check taxonomies for National GPRA Report
S X="MERR^BGPGU",@^%ZOSF("TRAP") ; m error trap
N BGPI,BGPJ,BGPDATA,BGPDA,BGPRTN,P
S P="|"
S BGPI=0
S BGPERR=""
S BGPRTN=$P(BGPSTR,P)
S BGPCALL=$P(BGPSTR,P,2)
I BGPCALL="GPU" S (BGP8GPU,BGP9GPU)=1
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
S BGPJ=0
S IOM=80
D GUIR^XBLM("GUICHK^"_BGPRTN,"^XTMP(""BGPTAX"",$J)")
S BGPDA=.5 F S BGPDA=$O(^XTMP("BGPTAX",$J,BGPDA)) Q:'BGPDA D
. N BGPDATA
. S BGPI=BGPI+1
. S BGPDATA=$G(^XTMP("BGPTAX",$J,BGPDA))
. S ^BGPTMP($J,BGPI)=BGPDATA_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)_BGPERR
K ^XTMP("BGPTAX",$J)
K BGP8GPU,BGP9GPU
Q
;
CATSTR(BGPSRET,STR) ;-- 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
;
MERR ; MUMPS ERROR TRAP
N BGPX
X ("S BGPX=$"_"ZE")
S BGPX="MUMPS error: """_BGPX_""""
D ^%ZTER
D ERR(BGPX)
Q
;
ERR(ERR) ; BMX ADO SCHEMA ERROR PROCESSOR
N BGPXA
S BGPXA="ERROR|"_ERR_$C(30)
S @RETVAL@(1)=BGPXA
Q
;
FAC(RETVAL,BGPSTR) ;-- return facilities based on parameters passed
S X="MERR^BGPGU",@^%ZOSF("TRAP") ; m error trap
N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT
N BGPQTR,BGPRE,BGPBAS,BGPBEN,BGPFAC
S P="|"
S BGPI=0
S BGPERR=""
S BGPRT=$P(BGPSTR,P)
S BGPPER=$P(BGPSTR,P,2)
S BGPQTR=$P(BGPSTR,P,3)
S BGPBAS=$P(BGPSTR,P,4)
S BGPBEN=$P(BGPSTR,P,5)
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S ^BGPTMP($J,BGPI)="T00007BMXIEN^T00030Service Unit^T00030Facility^T00020Begin Date^T00020End Date^T00020Base Beg^T00020Base End^T00020Date Run"_$C(30)
D GET^BGP5ASL(.BGPFAC,.BGPFILE,BGPRT,BGPPER,BGPQTR,BGPBAS,BGPBEN)
N BGPDA S BGPDA=0 F S BGPDA=$O(BGPFAC(BGPDA)) Q:'BGPDA D
. S BGPI=BGPI+1
. S ^BGPTMP($J,BGPI)=BGPDA_U_$G(BGPFAC(BGPDA))_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)_BGPERR
D EN^XBVK("BGP")
Q
;
SITE(RETVAL,BGPSTR) ;-- save the site parameters
S X="MERR^BGPGU",@^%ZOSF("TRAP") ; m error trap
N BGPI,BGPJ,BGPDATA,BGPDA,BGPHTWT,P,BGPERR,BGPFAC,BGPTAX,BGPHLOC,R,BGPEISS,BGPCHS,BGPDEMO,BGPOUT,BGPEDIR
S P="|",R="~"
S BGPI=0
S BGPERR=""
S BGPFAC=$P($P(BGPSTR,P),R)
I BGPFAC="" S BGPFAC="@" ;8.0 p2
S BGPTAX=$P($P(BGPSTR,P,2),R)
I BGPTAX="" S BGPTAX="@" ;8.0 p2
S BGPHLOC=$P($P(BGPSTR,P,3),R)
I BGPHLOC="" S BGPHLOC="@" ;8.0 p2
I BGPHLOC]"" S BGPHLOCI=$O(^AUTTLOC("B",BGPHLOC,0))
S BGPEISS=$P(BGPSTR,P,4)
S BGPCHS=$P(BGPSTR,P,5)
S BGPHTWT=$P(BGPSTR,P,6) ;cmi/anch/maw v7.0
S BGPMTAX=$P($P(BGPSTR,P,7),R)
S BGPDEMO=$P(BGPSTR,P,8)
I BGPDEMO="" S BGPDEMO="@" ;8.0 p2
S BGPOUT=$P(BGPSTR,P,9)
S BGPEDIR=$P(BGPSTR,P,10)
I '$G(BGPEISS) S BGPMTAX="@" ; remove taxonomy if not mfi site
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S ^BGPTMP($J,BGPI)="T00007BMXIEN^T00030Error"_$C(30)
N BGPFDA,BGPIENS,BGPERR
I $O(^BGPSITE("B",BGPFAC,0)) D
. S BGPIENS=$O(^BGPSITE("B",BGPFAC,0))_","
. S BGPFDA(90241.02,BGPIENS,.05)=BGPTAX
. S BGPFDA(90241.02,BGPIENS,.02)=BGPHLOC
. S BGPFDA(90241.02,BGPIENS,.08)=BGPEISS
. S BGPFDA(90241.02,BGPIENS,.06)=BGPCHS
. S BGPFDA(90241.02,BGPIENS,.09)=BGPMTAX
. S BGPFDA(90241.02,BGPIENS,.11)=BGPHTWT ;cmi anch/maw v7.0
. S BGPFDA(90241.02,BGPIENS,.12)=BGPDEMO ;cmi/maw 8.0 p2
. S BGPFDA(90241.02,BGPIENS,.13)=BGPOUT
. S BGPFDA(90241.02,BGPIENS,.14)=BGPEDIR
. D FILE^DIE("K","BGPFDA","BGPERR(1)")
. I $G(BGPERR(1)) D Q
.. S BGPI=BGPI+1
.. S ^BGPTMP($J,BGPI)="1^Error Saving Site Parameters"
. S BGPI=BGPI+1
. S ^BGPTMP($J,BGPI)="0^Site Parameters Saved"
I '$O(^BGPSITE("B",BGPFAC,0)) D
. S BGPIENS=""
. S BGPIENS(1)=BGPFAC
. S BGPFDA(90241.02,"+1,",.01)=BGPFAC
. S BGPFDA(90241.02,"+1,",.02)=BGPHLOC
. S BGPFDA(90241.02,"+1,",.04)=BGPEISS
. S BGPFDA(90241.02,"+1,",.05)=BGPTAX
. S BGPFDA(90241.02,"+1,",.06)=BGPCHS
. S BGPFDA(90241.02,"+1,",.09)=BGPMTAX
. S BGPFDA(90241.02,"+1,",.11)=BGPHTWT
. S BGPFDA(90241.02,"+1,",.12)=BGPDEMO ; 8.0 p2
. S BGPFDA(90241.02,"+1,",.13)=BGPOUT
. S BGPFDA(90241.02,"+1,",.14)=BGPEDIR
. D UPDATE^DIE("","BGPFDA","BGPIENS","BGPERR(1)")
. I $G(BGPERR(1)) D Q
.. S BGPI=BGPI+1
.. S ^BGPTMP($J,BGPI)="1^Error Saving Site Parameters"
. S BGPI=BGPI+1
. S ^BGPTMP($J,BGPI)="0^Site Parameters Saved"
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
S P="|"
S BGPI=0
S BGPERR=""
S BGPCT=$P(BGPSTR,P)
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^BGP5GLST(.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)_BGPERR
D EN^XBVK("BGP")
Q
;
DELRPT(RETVAL,BGPSTR) ;-- delete a report out of the BGP 05 GUI REPORT file
S X="MERR^BGPGU",@^%ZOSF("TRAP") ; m error trap
N P,R,I
S P="|",R="~"
S BGPERR=""
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
F I=2:1 D Q:$P(BGPSTR,R,I)=""
. N BGPI
. Q:$P(BGPSTR,R,I)=""
. S BGPI=$P(BGPSTR,R,I)
. S DIK="^BGPGUI(",DA=BGPI D ^DIK
S ^BGPTMP($J,0)="T00250DATA"_$C(30)
S ^BGPTMP($J,1)=$G(BGPERR)_$C(30)
S ^BGPTMP($J,2)=$C(31)_BGPERR
Q
;
ST(RETVAL,BGPSTR) ;-- return search templates by file
S X="MERR^BGPGU",@^%ZOSF("TRAP") ; m error trap
N P,BGPI,R,BGPFLS
S P="|",R="~"
S BGPFLS=$P(BGPSTR,P)
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S BGPI=0
S ^BGPTMP($J,BGPI)="T00007BMXIEN^T00050Search Template"_$C(30)
N I
F I=1:1 D Q:$P(BGPFLS,R,I)=""
. Q:$P(BGPFLS,R,I)=""
. S BGPFLS($P(BGPFLS,R,I))=$P(BGPFLS,R,I)
N BGPDA
S BGPDA=0 F S BGPDA=$O(^DIBT("B",BGPDA)) Q:BGPDA="" D
. N BGPIEN
. S BGPIEN=0 F S BGPIEN=$O(^DIBT("B",BGPDA,BGPIEN)) Q:'BGPIEN D
.. N BGLFL
.. S BGPFL=$P($G(^DIBT(BGPIEN,0)),U,4)
.. Q:'BGPFL
.. Q:'$D(BGPFLS(BGPFL))
.. S BGPI=BGPI+1
.. S ^BGPTMP($J,BGPI)=BGPIEN_U_$P($G(^DIBT(BGPIEN,0)),U)_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)
D EN^XBVK("BGP")
Q
;
UPL(RETVAL,BGPSTR) ;-- upload a file
S X="MERR^BGPGU",@^%ZOSF("TRAP") ; m error trap
N P,BGPOPT,BGPI,R
S P="|",R="~"
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S BGPI=0
S BGPOPT="BGP 05 UPLOAD FILES"
N I
F I=1:1 D Q:$P(BGPSTR,P,I)=""
. Q:$P(BGPSTR,P,I)=""
. N BGPFD,BGPDIR,BGPFL
. S BGPFD=$P(BGPSTR,P,I)
. S BGPDIR=$P(BGPFD,R,1)
. S BGPFL=$P(BGPFD,R,2)
. D EP^BGP5GUPL(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPDIR,BGPFL,DT)
S ^BGPTMP($J,BGPI)="T00080Result"_$C(30)
S BGPI=BGPI+1
S ^BGPTMP($J,BGPI)=+$G(BGPERR)_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)
D EN^XBVK("BGP")
Q
;
LSTF(RETVAL,BGPSTR) ;-- list files
S X="MERR^BGPGU",@^%ZOSF("TRAP") ; m error trap
N P,BGPDIR,BGPFL,BGPOPT,BGPI
S P="|"
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S BGPI=0
S BGPDIR=$P(BGPSTR,P)
K BGPLIST S BGPLIST="",X=$$LIST^%ZISH(BGPDIR,"BG05*",.BGPLIST)
S BGPOPT="BGP 05 UPLOAD FILES"
S ^BGPTMP($J,BGPI)="T00080Directory^T00080File Name"_$C(30)
N BGPDA
S BGPDA=0 F S BGPDA=$O(BGPLIST(BGPDA)) Q:'BGPDA D
. N BGPFL
. S BGPFL=$G(BGPLIST(BGPDA))
. S BGPI=BGPI+1
. S ^BGPTMP($J,BGPI)=BGPDIR_U_BGPFL_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)
D EN^XBVK("BGP")
Q
;
CHK(BGPRET,BGPSTR) ;check report status
S X="MERR^BGPGU",@^%ZOSF("TRAP") ; m error trap
N P,BGPDUZ2,BGPI
S P="|"
S BGPDUZ=$P(BGPSTR,P)
K ^BGPTMP($J)
S BGPRET="^BGPTMP("_$J_")"
S BGPI=0
S ^BGPTMP($J,BGPI)="T00007BMXIEN^T00030Name^T00030User^T00020Start Time^T00020End Time^T00030Type of Report^T00020Report Status^T00020Type of Output"_$C(30)
N BGPDA
S BGPDA=0 F S BGPDA=$O(^BGPGUI("AUSR",BGPDUZ,BGPDA)) Q:'BGPDA D
. N BGPIEN
. S BGPIEN=0 F S BGPIEN=$O(^BGPGUI("AUSR",BGPDUZ,BGPDA,BGPIEN)) Q:'BGPIEN D
.. N BGPDATA,BGPNM,BGPUSER,BGPST,BGPET,BGPTOR,BGPRS,BGPTOO
.. S BGPDATA=$G(^BGPGUI(BGPIEN,0))
.. S BGPNM=$P(BGPDATA,U)
.. S BGPUSER=$P($G(^VA(200,$P(BGPDATA,U,2),0)),U)
.. S BGPST=$$FMTE^XLFDT($P(BGPDATA,U,3))
.. S BGPET=$$FMTE^XLFDT($P(BGPDATA,U,4))
.. I $P(BGPDATA,U,4)="",$$SEVEN^BGP6GU(BGPST) D Q
... S DIK="^BGPGUIS(",DA=BGPDA D ^DIK
.. S BGPTOR=$P(BGPDATA,U,5)
.. S BGPRS=$$GET1^DIQ(90372.08,BGPIEN,.06)
.. S BGPTOO=$$GET1^DIQ(90372.08,BGPIEN,.07)
.. S BGPI=BGPI+1
.. S ^BGPTMP($J,BGPI)=BGPIEN_U_BGPNM_U_BGPUSER_U_BGPST_U_BGPET_U_BGPTOR_U_BGPRS_U_BGPTOO_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)
Q
;
ADDST(BGPRET,BGPSTR) ;-- add a search template
S X="MERR^BGPGU",@^%ZOSF("TRAP") ; m error trap
N P,BGPDUZ2,BGPI,BGPNM
S P="|"
S BGPNM=$P(BGPSTR,P)
K ^BGPTMP($J)
S BGPRET="^BGPTMP("_$J_")"
S BGPI=0
S ^BGPTMP($J,BGPI)="T00007Error"_$C(30)
N BGPFDA,BGPIENS,BGPERR
S BGPIENS=""
S BGPFDA(.401,"+1,",.01)=BGPNM
S BGPFDA(.401,"+1,",2)=DT
S BGPFDA(.401,"+1,",4)=9000001
S BGPFDA(.401,"+1,",5)=DUZ
S DIC="^DIBT("
D UPDATE^DIE("","BGPFDA","BGPIENS","BGPERR(1)")
I $G(BGPIENS(1)) S ^BGPTMP($J,1)=$G(BGPIENS(1))_$C(30)
S ^BGPTMP($J,2)=$C(31)
Q
;
RC(RETVAL,BGPSTR) ;EP -- return record counts for a file for the BH GUI Search Form (frmSearchSingle, frmSearchMultiple)
N BGPGB
S BGPGB=$G(^DIC(BGPSTR,0,"GL"))_"0)"
I BGPGB'[U S RETVAL=0
S RETVAL=$P($G(@BGPGB),U,4)
I RETVAL="" S RETVAL=0
Q
;
BGPGU ; IHS/CMI/LAB - BGP Gui Utilities 10/29/2004 3:28:39 PM ;
+1 ;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
+2 ;
+3 ;
DEBUG(RETVAL,BGPSTR) ;run the debugger
+1 DO DEBUG^%Serenji("SITE^BGPGU(.RETVAL,.BGPSTR)")
+2 QUIT
+3 ;
KEYS(RETVAL,BGPSTR) ;-- return keys for user
+1 ; m error trap
SET X="MERR^BGPGU"
SET @^%ZOSF("TRAP")
+2 NEW BGPDA,BGPNS,P,BGPDATA,BGPKEYI,BGPKEY,BGPI
+3 SET BGPI=0
+4 KILL ^BGPTMP($JOB)
+5 SET RETVAL="^BGPTMP("_$JOB_")"
+6 SET ^BGPTMP($JOB,BGPI)="T00030KEYS"_$CHAR(30)
+7 SET P="|"
+8 SET BGPNS=$PIECE(BGPSTR,P)
+9 SET BGPDA=0
FOR
SET BGPDA=$ORDER(^VA(200,DUZ,51,BGPDA))
IF 'BGPDA
QUIT
Begin DoDot:1
+10 SET BGPDATA=$GET(^VA(200,DUZ,51,BGPDA,0))
+11 SET BGPKEYI=$PIECE(BGPDATA,U)
+12 SET BGPKEY=$PIECE($GET(^DIC(19.1,BGPKEYI,0)),U)
+13 IF BGPNS'="*"
IF $EXTRACT(BGPKEY,1,$LENGTH(BGPNS))'[BGPNS
QUIT
+14 SET BGPI=BGPI+1
+15 SET ^BGPTMP($JOB,BGPI)=BGPKEY_$CHAR(30)
End DoDot:1
+16 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)_$GET(BGPERR)
+17 QUIT
+18 ;
SP(RETVAL,BGPSTR) ;-- get the site parameter entry
+1 NEW BGPDA,BGPI,P
+2 SET P="|"
+3 SET BGPSE=$PIECE(BGPSTR,P)
+4 IF BGPSE=""
SET BGPSE=DUZ(2)
+5 IF BGPSE'?.N
SET BGPSE=$ORDER(^DIC(4,"B",BGPSE,0))
+6 KILL ^BGPTMP($JOB)
+7 SET RETVAL="^BGPTMP("_$JOB_")"
+8 SET BGPI=0
+9 SET ^BGPTMP($JOB,BGPI)="T00010BMXIEN^T00050Location^T00050Home Location^T00050Community Taxonomy^T00001EISS^T00001CHS^T00001HeightWeight^T00050Location Taxonomy^T00050Demo Template^T00001Outreach^T00040ExportDirectory"_$CHAR(30)
+10 SET BGPDA=0
FOR
SET BGPDA=$ORDER(^BGPSITE("B",BGPSE,BGPDA))
IF 'BGPDA
QUIT
Begin DoDot:1
+11 NEW BGPDATA,BGPLI,BGPL,BGPLA,BGPHI,BGPH,BGPHA,BGPTX,BGPTXI,BGPEISS,BGPCHS,BGPMTAX,BGPMTAXI,BGPHTWT,BGPDEMOI,BGPDEMO,BGPOUT,BGPEDIR
+12 SET BGPDATA=$GET(^BGPSITE(BGPDA,0))
+13 SET BGPLI=$PIECE(BGPDATA,U)
+14 SET BGPL=$PIECE($GET(^DIC(4,BGPLI,0)),U)
+15 SET BGPLA=$PIECE($GET(^AUTTLOC(BGPLI,0)),U,10)
+16 SET BGPHI=$PIECE(BGPDATA,U,2)
+17 SET BGPH=$SELECT($GET(BGPHI):$PIECE($GET(^DIC(4,BGPHI,0)),U),1:"")
+18 SET BGPHA=$SELECT($GET(BGPHI):$PIECE($GET(^AUTTLOC(BGPHI,0)),U,10),1:"")
+19 SET BGPTXI=$PIECE(BGPDATA,U,5)
+20 SET BGPTX=$SELECT($PIECE(BGPDATA,U,5):$PIECE($GET(^ATXAX($PIECE(BGPDATA,U,5),0)),U),1:"")
+21 SET BGPEISS=$SELECT($PIECE(BGPDATA,U,8):1,1:0)
+22 SET BGPCHS=$PIECE(BGPDATA,U,6)
+23 ;cmi/anch/maw v7.0
SET BGPHTWT=$PIECE(BGPDATA,U,11)
+24 SET BGPMTAXI=$PIECE(BGPDATA,U,9)
+25 SET BGPMTAX=$SELECT($PIECE(BGPDATA,U,9):$PIECE($GET(^ATXAX($PIECE(BGPDATA,U,9),0)),U),1:"")
+26 SET BGPDEMOI=$PIECE(BGPDATA,U,12)
+27 SET BGPDEMO=$SELECT(BGPDEMOI]"":$PIECE($GET(^DIBT(BGPDEMOI,0)),U),1:"")
+28 SET BGPOUT=$PIECE(BGPDATA,U,13)
+29 SET BGPEDIR=$PIECE(BGPDATA,U,14)
+30 SET BGPI=BGPI+1
+31 SET ^BGPTMP($JOB,BGPI)=BGPDA_U_$SELECT($GET(BGPLI):BGPLI_"~"_BGPL,1:"")_U_$SELECT($GET(BGPHI):BGPHI_"~"_BGPH,1:"")_U_$SELECT(...
... $GET(BGPTXI):BGPTXI_"~"_$GET(BGPTX),1:"")_U_$GET(BGPEISS)_U_$GET(BGPCHS)_U_$GET(BGPHTWT)_U_$SELECT($GET(BGPMTAXI):BGPMTAXI_"~"_$GET(BGPMTAX),1:"")
+32 SET ^BGPTMP($JOB,BGPI)=^BGPTMP($JOB,BGPI)_U_$SELECT($GET(BGPDEMOI):BGPDEMOI_"~"_$GET(BGPDEMO),1:"")_U_BGPOUT_U_BGPEDIR_$CHAR(30)
End DoDot:1
+33 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)_$GET(BGPERR)
+34 QUIT
+35 ;
TAXCHK(RETVAL,BGPSTR) ;-- check taxonomies for National GPRA Report
+1 ; m error trap
SET X="MERR^BGPGU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,BGPJ,BGPDATA,BGPDA,BGPRTN,P
+3 SET P="|"
+4 SET BGPI=0
+5 SET BGPERR=""
+6 SET BGPRTN=$PIECE(BGPSTR,P)
+7 SET BGPCALL=$PIECE(BGPSTR,P,2)
+8 IF BGPCALL="GPU"
SET (BGP8GPU,BGP9GPU)=1
+9 KILL ^BGPTMP($JOB)
+10 SET RETVAL="^BGPTMP("_$JOB_")"
+11 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
+12 SET BGPJ=0
+13 SET IOM=80
+14 DO GUIR^XBLM("GUICHK^"_BGPRTN,"^XTMP(""BGPTAX"",$J)")
+15 SET BGPDA=.5
FOR
SET BGPDA=$ORDER(^XTMP("BGPTAX",$JOB,BGPDA))
IF 'BGPDA
QUIT
Begin DoDot:1
+16 NEW BGPDATA
+17 SET BGPI=BGPI+1
+18 SET BGPDATA=$GET(^XTMP("BGPTAX",$JOB,BGPDA))
+19 SET ^BGPTMP($JOB,BGPI)=BGPDATA_$CHAR(30)
End DoDot:1
+20 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)_BGPERR
+21 KILL ^XTMP("BGPTAX",$JOB)
+22 KILL BGP8GPU,BGP9GPU
+23 QUIT
+24 ;
CATSTR(BGPSRET,STR) ;-- concatenate a long string in
+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 ;
MERR ; MUMPS ERROR TRAP
+1 NEW BGPX
+2 XECUTE ("S BGPX=$"_"ZE")
+3 SET BGPX="MUMPS error: """_BGPX_""""
+4 DO ^%ZTER
+5 DO ERR(BGPX)
+6 QUIT
+7 ;
ERR(ERR) ; BMX ADO SCHEMA ERROR PROCESSOR
+1 NEW BGPXA
+2 SET BGPXA="ERROR|"_ERR_$CHAR(30)
+3 SET @RETVAL@(1)=BGPXA
+4 QUIT
+5 ;
FAC(RETVAL,BGPSTR) ;-- return facilities based on parameters passed
+1 ; m error trap
SET X="MERR^BGPGU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT
+3 NEW BGPQTR,BGPRE,BGPBAS,BGPBEN,BGPFAC
+4 SET P="|"
+5 SET BGPI=0
+6 SET BGPERR=""
+7 SET BGPRT=$PIECE(BGPSTR,P)
+8 SET BGPPER=$PIECE(BGPSTR,P,2)
+9 SET BGPQTR=$PIECE(BGPSTR,P,3)
+10 SET BGPBAS=$PIECE(BGPSTR,P,4)
+11 SET BGPBEN=$PIECE(BGPSTR,P,5)
+12 KILL ^BGPTMP($JOB)
+13 SET RETVAL="^BGPTMP("_$JOB_")"
+14 SET ^BGPTMP($JOB,BGPI)="T00007BMXIEN^T00030Service Unit^T00030Facility^T00020Begin Date^T00020End Date^T00020Base Beg^T00020Base End^T00020Date Run"_$CHAR(30)
+15 DO GET^BGP5ASL(.BGPFAC,.BGPFILE,BGPRT,BGPPER,BGPQTR,BGPBAS,BGPBEN)
+16 NEW BGPDA
SET BGPDA=0
FOR
SET BGPDA=$ORDER(BGPFAC(BGPDA))
IF 'BGPDA
QUIT
Begin DoDot:1
+17 SET BGPI=BGPI+1
+18 SET ^BGPTMP($JOB,BGPI)=BGPDA_U_$GET(BGPFAC(BGPDA))_$CHAR(30)
End DoDot:1
+19 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)_BGPERR
+20 DO EN^XBVK("BGP")
+21 QUIT
+22 ;
SITE(RETVAL,BGPSTR) ;-- save the site parameters
+1 ; m error trap
SET X="MERR^BGPGU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,BGPJ,BGPDATA,BGPDA,BGPHTWT,P,BGPERR,BGPFAC,BGPTAX,BGPHLOC,R,BGPEISS,BGPCHS,BGPDEMO,BGPOUT,BGPEDIR
+3 SET P="|"
SET R="~"
+4 SET BGPI=0
+5 SET BGPERR=""
+6 SET BGPFAC=$PIECE($PIECE(BGPSTR,P),R)
+7 ;8.0 p2
IF BGPFAC=""
SET BGPFAC="@"
+8 SET BGPTAX=$PIECE($PIECE(BGPSTR,P,2),R)
+9 ;8.0 p2
IF BGPTAX=""
SET BGPTAX="@"
+10 SET BGPHLOC=$PIECE($PIECE(BGPSTR,P,3),R)
+11 ;8.0 p2
IF BGPHLOC=""
SET BGPHLOC="@"
+12 IF BGPHLOC]""
SET BGPHLOCI=$ORDER(^AUTTLOC("B",BGPHLOC,0))
+13 SET BGPEISS=$PIECE(BGPSTR,P,4)
+14 SET BGPCHS=$PIECE(BGPSTR,P,5)
+15 ;cmi/anch/maw v7.0
SET BGPHTWT=$PIECE(BGPSTR,P,6)
+16 SET BGPMTAX=$PIECE($PIECE(BGPSTR,P,7),R)
+17 SET BGPDEMO=$PIECE(BGPSTR,P,8)
+18 ;8.0 p2
IF BGPDEMO=""
SET BGPDEMO="@"
+19 SET BGPOUT=$PIECE(BGPSTR,P,9)
+20 SET BGPEDIR=$PIECE(BGPSTR,P,10)
+21 ; remove taxonomy if not mfi site
IF '$GET(BGPEISS)
SET BGPMTAX="@"
+22 KILL ^BGPTMP($JOB)
+23 SET RETVAL="^BGPTMP("_$JOB_")"
+24 SET ^BGPTMP($JOB,BGPI)="T00007BMXIEN^T00030Error"_$CHAR(30)
+25 NEW BGPFDA,BGPIENS,BGPERR
+26 IF $ORDER(^BGPSITE("B",BGPFAC,0))
Begin DoDot:1
+27 SET BGPIENS=$ORDER(^BGPSITE("B",BGPFAC,0))_","
+28 SET BGPFDA(90241.02,BGPIENS,.05)=BGPTAX
+29 SET BGPFDA(90241.02,BGPIENS,.02)=BGPHLOC
+30 SET BGPFDA(90241.02,BGPIENS,.08)=BGPEISS
+31 SET BGPFDA(90241.02,BGPIENS,.06)=BGPCHS
+32 SET BGPFDA(90241.02,BGPIENS,.09)=BGPMTAX
+33 ;cmi anch/maw v7.0
SET BGPFDA(90241.02,BGPIENS,.11)=BGPHTWT
+34 ;cmi/maw 8.0 p2
SET BGPFDA(90241.02,BGPIENS,.12)=BGPDEMO
+35 SET BGPFDA(90241.02,BGPIENS,.13)=BGPOUT
+36 SET BGPFDA(90241.02,BGPIENS,.14)=BGPEDIR
+37 DO FILE^DIE("K","BGPFDA","BGPERR(1)")
+38 IF $GET(BGPERR(1))
Begin DoDot:2
+39 SET BGPI=BGPI+1
+40 SET ^BGPTMP($JOB,BGPI)="1^Error Saving Site Parameters"
End DoDot:2
QUIT
+41 SET BGPI=BGPI+1
+42 SET ^BGPTMP($JOB,BGPI)="0^Site Parameters Saved"
End DoDot:1
+43 IF '$ORDER(^BGPSITE("B",BGPFAC,0))
Begin DoDot:1
+44 SET BGPIENS=""
+45 SET BGPIENS(1)=BGPFAC
+46 SET BGPFDA(90241.02,"+1,",.01)=BGPFAC
+47 SET BGPFDA(90241.02,"+1,",.02)=BGPHLOC
+48 SET BGPFDA(90241.02,"+1,",.04)=BGPEISS
+49 SET BGPFDA(90241.02,"+1,",.05)=BGPTAX
+50 SET BGPFDA(90241.02,"+1,",.06)=BGPCHS
+51 SET BGPFDA(90241.02,"+1,",.09)=BGPMTAX
+52 SET BGPFDA(90241.02,"+1,",.11)=BGPHTWT
+53 ; 8.0 p2
SET BGPFDA(90241.02,"+1,",.12)=BGPDEMO
+54 SET BGPFDA(90241.02,"+1,",.13)=BGPOUT
+55 SET BGPFDA(90241.02,"+1,",.14)=BGPEDIR
+56 DO UPDATE^DIE("","BGPFDA","BGPIENS","BGPERR(1)")
+57 IF $GET(BGPERR(1))
Begin DoDot:2
+58 SET BGPI=BGPI+1
+59 SET ^BGPTMP($JOB,BGPI)="1^Error Saving Site Parameters"
End DoDot:2
QUIT
+60 SET BGPI=BGPI+1
+61 SET ^BGPTMP($JOB,BGPI)="0^Site Parameters Saved"
End DoDot:1
+62 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
+63 DO EN^XBVK("BGP")
+64 QUIT
+65 ;
LST(RETVAL,BGPSTR) ;-- list files
+1 ; m error trap
SET X="MERR^BGPGU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT
+3 SET P="|"
+4 SET BGPI=0
+5 SET BGPERR=""
+6 SET BGPCT=$PIECE(BGPSTR,P)
+7 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 KILL ^BGPTMP($JOB)
+13 SET RETVAL="^BGPTMP("_$JOB_")"
+14 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
+15 DO EP^BGP5GLST(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPYN,BGPOT,BGPRT)
+16 SET BGPI=BGPI+1
+17 SET ^BGPTMP($JOB,BGPI)=$GET(BGPERR)_$CHAR(30)
+18 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)_BGPERR
+19 DO EN^XBVK("BGP")
+20 QUIT
+21 ;
DELRPT(RETVAL,BGPSTR) ;-- delete a report out of the BGP 05 GUI REPORT file
+1 ; m error trap
SET X="MERR^BGPGU"
SET @^%ZOSF("TRAP")
+2 NEW P,R,I
+3 SET P="|"
SET R="~"
+4 SET BGPERR=""
+5 KILL ^BGPTMP($JOB)
+6 SET RETVAL="^BGPTMP("_$JOB_")"
+7 FOR I=2:1
Begin DoDot:1
+8 NEW BGPI
+9 IF $PIECE(BGPSTR,R,I)=""
QUIT
+10 SET BGPI=$PIECE(BGPSTR,R,I)
+11 SET DIK="^BGPGUI("
SET DA=BGPI
DO ^DIK
End DoDot:1
IF $PIECE(BGPSTR,R,I)=""
QUIT
+12 SET ^BGPTMP($JOB,0)="T00250DATA"_$CHAR(30)
+13 SET ^BGPTMP($JOB,1)=$GET(BGPERR)_$CHAR(30)
+14 SET ^BGPTMP($JOB,2)=$CHAR(31)_BGPERR
+15 QUIT
+16 ;
ST(RETVAL,BGPSTR) ;-- return search templates by file
+1 ; m error trap
SET X="MERR^BGPGU"
SET @^%ZOSF("TRAP")
+2 NEW P,BGPI,R,BGPFLS
+3 SET P="|"
SET R="~"
+4 SET BGPFLS=$PIECE(BGPSTR,P)
+5 KILL ^BGPTMP($JOB)
+6 SET RETVAL="^BGPTMP("_$JOB_")"
+7 SET BGPI=0
+8 SET ^BGPTMP($JOB,BGPI)="T00007BMXIEN^T00050Search Template"_$CHAR(30)
+9 NEW I
+10 FOR I=1:1
Begin DoDot:1
+11 IF $PIECE(BGPFLS,R,I)=""
QUIT
+12 SET BGPFLS($PIECE(BGPFLS,R,I))=$PIECE(BGPFLS,R,I)
End DoDot:1
IF $PIECE(BGPFLS,R,I)=""
QUIT
+13 NEW BGPDA
+14 SET BGPDA=0
FOR
SET BGPDA=$ORDER(^DIBT("B",BGPDA))
IF BGPDA=""
QUIT
Begin DoDot:1
+15 NEW BGPIEN
+16 SET BGPIEN=0
FOR
SET BGPIEN=$ORDER(^DIBT("B",BGPDA,BGPIEN))
IF 'BGPIEN
QUIT
Begin DoDot:2
+17 NEW BGLFL
+18 SET BGPFL=$PIECE($GET(^DIBT(BGPIEN,0)),U,4)
+19 IF 'BGPFL
QUIT
+20 IF '$DATA(BGPFLS(BGPFL))
QUIT
+21 SET BGPI=BGPI+1
+22 SET ^BGPTMP($JOB,BGPI)=BGPIEN_U_$PIECE($GET(^DIBT(BGPIEN,0)),U)_$CHAR(30)
End DoDot:2
End DoDot:1
+23 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
+24 DO EN^XBVK("BGP")
+25 QUIT
+26 ;
UPL(RETVAL,BGPSTR) ;-- upload a file
+1 ; m error trap
SET X="MERR^BGPGU"
SET @^%ZOSF("TRAP")
+2 NEW P,BGPOPT,BGPI,R
+3 SET P="|"
SET R="~"
+4 KILL ^BGPTMP($JOB)
+5 SET RETVAL="^BGPTMP("_$JOB_")"
+6 SET BGPI=0
+7 SET BGPOPT="BGP 05 UPLOAD FILES"
+8 NEW I
+9 FOR I=1:1
Begin DoDot:1
+10 IF $PIECE(BGPSTR,P,I)=""
QUIT
+11 NEW BGPFD,BGPDIR,BGPFL
+12 SET BGPFD=$PIECE(BGPSTR,P,I)
+13 SET BGPDIR=$PIECE(BGPFD,R,1)
+14 SET BGPFL=$PIECE(BGPFD,R,2)
+15 DO EP^BGP5GUPL(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPDIR,BGPFL,DT)
End DoDot:1
IF $PIECE(BGPSTR,P,I)=""
QUIT
+16 SET ^BGPTMP($JOB,BGPI)="T00080Result"_$CHAR(30)
+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 ;
LSTF(RETVAL,BGPSTR) ;-- list files
+1 ; m error trap
SET X="MERR^BGPGU"
SET @^%ZOSF("TRAP")
+2 NEW P,BGPDIR,BGPFL,BGPOPT,BGPI
+3 SET P="|"
+4 KILL ^BGPTMP($JOB)
+5 SET RETVAL="^BGPTMP("_$JOB_")"
+6 SET BGPI=0
+7 SET BGPDIR=$PIECE(BGPSTR,P)
+8 KILL BGPLIST
SET BGPLIST=""
SET X=$$LIST^%ZISH(BGPDIR,"BG05*",.BGPLIST)
+9 SET BGPOPT="BGP 05 UPLOAD FILES"
+10 SET ^BGPTMP($JOB,BGPI)="T00080Directory^T00080File Name"_$CHAR(30)
+11 NEW BGPDA
+12 SET BGPDA=0
FOR
SET BGPDA=$ORDER(BGPLIST(BGPDA))
IF 'BGPDA
QUIT
Begin DoDot:1
+13 NEW BGPFL
+14 SET BGPFL=$GET(BGPLIST(BGPDA))
+15 SET BGPI=BGPI+1
+16 SET ^BGPTMP($JOB,BGPI)=BGPDIR_U_BGPFL_$CHAR(30)
End DoDot:1
+17 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
+18 DO EN^XBVK("BGP")
+19 QUIT
+20 ;
CHK(BGPRET,BGPSTR) ;check report status
+1 ; m error trap
SET X="MERR^BGPGU"
SET @^%ZOSF("TRAP")
+2 NEW P,BGPDUZ2,BGPI
+3 SET P="|"
+4 SET BGPDUZ=$PIECE(BGPSTR,P)
+5 KILL ^BGPTMP($JOB)
+6 SET BGPRET="^BGPTMP("_$JOB_")"
+7 SET BGPI=0
+8 SET ^BGPTMP($JOB,BGPI)="T00007BMXIEN^T00030Name^T00030User^T00020Start Time^T00020End Time^T00030Type of Report^T00020Report Status^T00020Type of Output"_$CHAR(30)
+9 NEW BGPDA
+10 SET BGPDA=0
FOR
SET BGPDA=$ORDER(^BGPGUI("AUSR",BGPDUZ,BGPDA))
IF 'BGPDA
QUIT
Begin DoDot:1
+11 NEW BGPIEN
+12 SET BGPIEN=0
FOR
SET BGPIEN=$ORDER(^BGPGUI("AUSR",BGPDUZ,BGPDA,BGPIEN))
IF 'BGPIEN
QUIT
Begin DoDot:2
+13 NEW BGPDATA,BGPNM,BGPUSER,BGPST,BGPET,BGPTOR,BGPRS,BGPTOO
+14 SET BGPDATA=$GET(^BGPGUI(BGPIEN,0))
+15 SET BGPNM=$PIECE(BGPDATA,U)
+16 SET BGPUSER=$PIECE($GET(^VA(200,$PIECE(BGPDATA,U,2),0)),U)
+17 SET BGPST=$$FMTE^XLFDT($PIECE(BGPDATA,U,3))
+18 SET BGPET=$$FMTE^XLFDT($PIECE(BGPDATA,U,4))
+19 IF $PIECE(BGPDATA,U,4)=""
IF $$SEVEN^BGP6GU(BGPST)
Begin DoDot:3
+20 SET DIK="^BGPGUIS("
SET DA=BGPDA
DO ^DIK
End DoDot:3
QUIT
+21 SET BGPTOR=$PIECE(BGPDATA,U,5)
+22 SET BGPRS=$$GET1^DIQ(90372.08,BGPIEN,.06)
+23 SET BGPTOO=$$GET1^DIQ(90372.08,BGPIEN,.07)
+24 SET BGPI=BGPI+1
+25 SET ^BGPTMP($JOB,BGPI)=BGPIEN_U_BGPNM_U_BGPUSER_U_BGPST_U_BGPET_U_BGPTOR_U_BGPRS_U_BGPTOO_$CHAR(30)
End DoDot:2
End DoDot:1
+26 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
+27 QUIT
+28 ;
ADDST(BGPRET,BGPSTR) ;-- add a search template
+1 ; m error trap
SET X="MERR^BGPGU"
SET @^%ZOSF("TRAP")
+2 NEW P,BGPDUZ2,BGPI,BGPNM
+3 SET P="|"
+4 SET BGPNM=$PIECE(BGPSTR,P)
+5 KILL ^BGPTMP($JOB)
+6 SET BGPRET="^BGPTMP("_$JOB_")"
+7 SET BGPI=0
+8 SET ^BGPTMP($JOB,BGPI)="T00007Error"_$CHAR(30)
+9 NEW BGPFDA,BGPIENS,BGPERR
+10 SET BGPIENS=""
+11 SET BGPFDA(.401,"+1,",.01)=BGPNM
+12 SET BGPFDA(.401,"+1,",2)=DT
+13 SET BGPFDA(.401,"+1,",4)=9000001
+14 SET BGPFDA(.401,"+1,",5)=DUZ
+15 SET DIC="^DIBT("
+16 DO UPDATE^DIE("","BGPFDA","BGPIENS","BGPERR(1)")
+17 IF $GET(BGPIENS(1))
SET ^BGPTMP($JOB,1)=$GET(BGPIENS(1))_$CHAR(30)
+18 SET ^BGPTMP($JOB,2)=$CHAR(31)
+19 QUIT
+20 ;
RC(RETVAL,BGPSTR) ;EP -- return record counts for a file for the BH GUI Search Form (frmSearchSingle, frmSearchMultiple)
+1 NEW BGPGB
+2 SET BGPGB=$GET(^DIC(BGPSTR,0,"GL"))_"0)"
+3 IF BGPGB'[U
SET RETVAL=0
+4 SET RETVAL=$PIECE($GET(@BGPGB),U,4)
+5 IF RETVAL=""
SET RETVAL=0
+6 QUIT
+7 ;
