- BGP1GU ; IHS/CMI/LAB - BGP Gui Utilities 10/29/2004 3:28:39 PM 19 Sep 2005 5:28 PM 27 Apr 2010 10:28 PM ;
- ;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
- ;
- ;
- DEBUG(RETVAL,BGPSTR) ;run the debugger
- D DEBUG^%Serenji("UPL^BGP1GU(.RETVAL,.BGPSTR)")
- Q
- ;
- KEYS(RETVAL,BGPSTR) ;-- return keys for user
- S X="MERR^BGP1GU",@^%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"_$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
- . 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 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)_$C(30)
- S ^BGPTMP($J,BGPI+1)=$C(31)_$G(BGPERR)
- Q
- ;
- TAXCHK(RETVAL,BGPSTR) ;-- check taxonomies for National GPRA Report
- S X="MERR^BGP1GU",@^%ZOSF("TRAP") ; m error trap
- N BGPI,BGPJ,BGPDATA,BGPDA,BGPRTN,P,BGPCALL
- S P="|"
- S BGPI=0
- S BGPERR=""
- S BGPRTN=$P(BGPSTR,P)
- S BGPCALL=$P(BGPSTR,P,2)
- I BGPCALL="GPU" S BGP1GPU=1
- K ^BGPTMP($J)
- S RETVAL="^BGPTMP("_$J_")"
- S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
- S BGPJ=0
- S IOM=80
- D GUIR^BGPXBLM("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)
- 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
- ;
- 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="0|"_ERR_$C(31) ;cmi/maw changed to end of table marker crs 8.0 p2
- S @RETVAL@(1)=BGPXA
- Q
- ;
- FAC(RETVAL,BGPSTR) ;-- return facilities based on parameters passed
- S X="MERR^BGP1GU",@^%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)
- S BGPNGR09=$P(BGPSTR,P,6) ;crs 8.0 p3 for area 09 report
- 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^BGP1ASL(.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^BGP1GU",@^%ZOSF("TRAP") ; m error trap
- N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPFAC,BGPTAX,BGPHLOC,R,BGPEISS
- S P="|",R="~"
- S BGPI=0
- S BGPERR=""
- S BGPFAC=$P($P(BGPSTR,P),R)
- S BGPTAX=$P($P(BGPSTR,P,2),R)
- S BGPHLOC=$P($P(BGPSTR,P,3),R)
- S BGPHLOCI=$O(^AUTTLOC("B",BGPHLOC,0))
- S BGPEISS=$P(BGPSTR,P,4)
- 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,.04)=BGPEISS
- . 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
- . 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)_BGPERR
- D EN^XBVK("BGP")
- Q
- ;
- LST(RETVAL,BGPSTR) ;-- list files
- S X="MERR^BGP1GU",@^%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^BGP1GLST(.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 11 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_")"
- I BGPSTR'[R S BGPSTR=R_BGPSTR ;ihs/cmi/maw v11.1 04/29/2011
- 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="^BGPGUIB(",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^BGP1GU",@^%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(BGPDA)) Q:'BGPDA D
- . N BGPFL
- . S BGPFL=$P($G(^DIBT(BGPDA,0)),U,4)
- . Q:'BGPFL
- . Q:'$D(BGPFLS(BGPFL))
- . S BGPI=BGPI+1
- . S ^BGPTMP($J,BGPI)=BGPDA_U_$P($G(^DIBT(BGPDA,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^BGP1GU",@^%ZOSF("TRAP") ; m error trap
- N BGPOPT
- S BGPP="|",BGPR="~"
- K ^BGPTMP($J)
- S RETVAL="^BGPTMP("_$J_")"
- S BGPI=0
- I $G(BGPSTR)="" D CATSTR(.BGPSTR,.BGPSTR)
- S BGPOPT="BGP 11 UPLOAD FILES"
- F BGPII=2:1 D Q:$P(BGPSTR,BGPP,BGPII)=""
- . Q:$P(BGPSTR,BGPP,BGPII)=""
- . N BGPFD,BGPDIR,BGPFL
- . S BGPFD=$P(BGPSTR,BGPP,BGPII)
- . S BGPDIR=$P(BGPFD,BGPR,1)
- . S BGPFL=$P(BGPFD,BGPR,2)
- . D EP^BGP1GUPL(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPDIR,BGPFL,DT)
- S ^BGPTMP($J,BGPI)="T00001Error^T00080ErrorMessage"_$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^BGP1GU",@^%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,"BG11*",.BGPLIST)
- S BGPOPT="BGP 11 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^BGP1GU",@^%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^T00250Export File(s)"_$C(30)
- N BGPDA
- S BGPDA=0 F S BGPDA=$O(^BGPGUIB("AUSR",BGPDUZ,BGPDA)) Q:'BGPDA D
- . N BGPIEN
- . S BGPIEN=0 F S BGPIEN=$O(^BGPGUIB("AUSR",BGPDUZ,BGPDA,BGPIEN)) Q:'BGPIEN D
- .. N BGPDATA,BGPNM,BGPUSER,BGPST,BGPET,BGPTOR,BGPRS,BGPTOO,BGPFLS
- .. S BGPDATA=$G(^BGPGUIB(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($P($P(BGPDATA,U,3),".")) D Q
- ... S DIK="^BGPGUIB(",DA=BGPIEN D ^DIK
- .. S BGPTOR=$P(BGPDATA,U,5)
- .. S BGPRS=$$GET1^DIQ(90546.08,BGPIEN,.06)
- .. S BGPTOO=$$GET1^DIQ(90546.08,BGPIEN,.07)
- .. S BGPFLS=$$GET1^DIQ(90546.08,BGPIEN,1)
- .. S BGPI=BGPI+1
- .. S ^BGPTMP($J,BGPI)=BGPIEN_U_BGPNM_U_BGPUSER_U_BGPST_U_BGPET_U_BGPTOR_U_BGPRS_U_BGPTOO_U_BGPFLS_$C(30)
- S ^BGPTMP($J,BGPI+1)=$C(31)
- Q
- ;
- SEVEN(ST) ;EP -- check to see if the start date is over 7 days ago
- I $$FMDIFF^XLFDT(DT,ST)>7 Q 1
- ;S X1=ST,X2=7 D C^%DTC
- ;I X<DT Q 1
- Q 0
- ;
- LABTAXC(RETVAL,BGPSTR) ;EP - from remote procedure
- S X="MERR^BGP1GU",@^%ZOSF("TRAP") ; m error trap
- N BGPI,BGPJ,BGPDATA,BGPDA,BGPRT,P,BGPOPT,BGPR,BGPFN
- S P="|"
- S BGPI=0
- S BGPERR=""
- S BGPOPT=$P(BGPSTR,P)
- S BGPOPT="CRS 11 LAB TAXONOMY REPORT" ;8.0 p2
- S BGPRT=$P(BGPSTR,P,2)
- S BGPR=$P(BGPSTR,P,3)
- S BGPFN=$P(BGPSTR,P,4)
- S BGPJ=0
- K ^BGPTMP($J)
- S RETVAL="^BGPTMP("_$J_")"
- S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
- D EP^BGP1GLTX(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPRT,BGPR,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
- MEDTAXC(RETVAL,BGPSTR) ;EP - from remote procedure
- S X="MERR^BGP1GU",@^%ZOSF("TRAP") ; m error trap
- N BGPI,BGPJ,BGPDATA,BGPDA,BGPRT,P,BGPOPT,BGPR,BGPFN
- S P="|"
- S BGPI=0
- S BGPERR=""
- S BGPOPT=$P(BGPSTR,P)
- S BGPOPT="CRS 11 MEDICATION TAXONOMY REPORT" ;8.0 p2
- S BGPRT=$P(BGPSTR,P,2)
- S BGPR=$P(BGPSTR,P,3)
- S BGPFN=$P(BGPSTR,P,4)
- S BGPJ=0
- K ^BGPTMP($J)
- S RETVAL="^BGPTMP("_$J_")"
- S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
- D EP^BGP1GMTX(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPRT,BGPR,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
- ;
- UPDTAX(BGPRET,BGPSTR) ;update taxonomies based on option selected
- S X="MERR^BGPGU",@^%ZOSF("TRAP") ; m error trap
- N P,BGPOPT,BGPI
- S P="|"
- S BGPI=0
- K ^BGPTMP($J)
- S BGPRET="^BGPTMP("_$J_")"
- S ^BGPTMP($J,BGPI)="T00080TAXONOMY NAME"_$C(30)
- S BGPRPTT1=1
- S BGPOPT=$P(BGPSTR,P)
- I BGPOPT="TAXNTL" D
- . S BGPRPTT1=1
- I BGPOPT="TAXCMS" D
- . S BGPRPTT1=5
- I BGPOPT="TAXCRS" D
- . S BGPRPTT1=9
- I BGPOPT="TAXONM" D
- . S BGPRPTT1=7
- I BGPOPT="TAXEO" D
- . S BGPRPTT1=8
- D INIT^BGP1CTS
- I BGPOPT="TAXALL" D
- . D INIT^BGP1XTV
- N BGPDA,BGPT
- S BGPDA=0 F S BGPDA=$O(BGPTAX("IDX",BGPDA)) Q:'BGPDA D
- . N BGPN,BGPFL,BGPRO,BGPFLT
- . S BGPI=BGPI+1
- . S BGPT=$P($G(BGPTAX("IDX",BGPDA,BGPDA)),U)
- . S BGPTT=$P($G(BGPTAX("IDX",BGPDA,BGPDA)),U,2)
- . I BGPTT="T" D
- .. S BGPN=$P($G(^ATXAX(BGPT,0)),U)
- .. S BGPRO=$S($P($G(^ATXAX(BGPT,0)),U,22):"Read Only",1:"Editable")
- .. S BGPFL=$P($G(^ATXAX(BGPT,0)),U,15)
- .. S BGPFLT=$S(BGPFL=50:"Med",1:"Tax")
- . I BGPTT="L" D
- .. S BGPN=$P($G(^ATXLAB(BGPT,0)),U)
- .. S BGPRO=$S($P($G(^ATXLAB(BGPT,0)),U,22):"Read Only",1:"Editable")
- .. S BGPFL=$P($G(^ATXLAB(BGPT,0)),U,9)
- .. S BGPFLT="Lab"
- . S ^BGPTMP($J,BGPI)=BGPN_"("_BGPRO_"/"_BGPFLT_"/"_BGPFL_")"_$C(30)
- S ^BGPTMP($J,BGPI+1)=$C(31)
- Q
- ;
- NEWTAX(BGPRET,BGPSTR) ;update taxonomies based on option selected
- S X="MERR^BGPGU",@^%ZOSF("TRAP") ; m error trap
- N P,BGPOPT,BGPI
- S P="|"
- S BGPI=0
- K ^BGPTMP($J)
- S BGPRET="^BGPTMP("_$J_")"
- S ^BGPTMP($J,BGPI)="T00080Taxonomy Name^T00010Taxonomy IEN^T00001ReadOnly^T00020File Number^T00003Tax Type"_$C(30)
- S BGPRPTT1=1
- S BGPOPT=$P(BGPSTR,P)
- I BGPOPT="TAXNTL" D
- . S BGPRPTT1=1
- I BGPOPT="TAXCMS" D
- . S BGPRPTT1=5
- I BGPOPT="TAXCRS" D
- . S BGPRPTT1=9
- I BGPOPT="TAXONM" D
- . S BGPRPTT1=7
- I BGPOPT="TAXEO" D
- . S BGPRPTT1=8
- D INIT^BGP1CTS
- I BGPOPT="TAXALL" D
- . D INIT^BGP1XTV
- N BGPDA,BGPT
- S BGPDA=0 F S BGPDA=$O(BGPTAX("IDX",BGPDA)) Q:'BGPDA D
- . N BGPN,BGPFL,BGPRO,BGPFLT
- . S BGPI=BGPI+1
- . S BGPT=$P($G(BGPTAX("IDX",BGPDA,BGPDA)),U)
- . S BGPTT=$P($G(BGPTAX("IDX",BGPDA,BGPDA)),U,2)
- . I BGPTT="T" D
- .. S BGPN=$P($G(^ATXAX(BGPT,0)),U)
- .. S BGPRO=$S($P($G(^ATXAX(BGPT,0)),U,22):"Read Only",1:"Editable")
- .. S BGPFL=$P($G(^ATXAX(BGPT,0)),U,15)
- .. S BGPFLT=$S(BGPFL=50:"Med",1:"Tax")
- . I BGPTT="L" D
- .. S BGPN=$P($G(^ATXLAB(BGPT,0)),U)
- .. S BGPRO=$S($P($G(^ATXLAB(BGPT,0)),U,22):"Read Only",1:"Editable")
- .. S BGPFL=$P($G(^ATXLAB(BGPT,0)),U,9)
- .. S BGPFLT="Lab"
- . S ^BGPTMP($J,BGPI)=BGPN_U_BGPT_U_$E(BGPRO,1,1)_U_BGPFL_U_BGPFLT_$C(30)
- S ^BGPTMP($J,BGPI+1)=$C(31)
- Q
- ;
- COMCHK(BGPRET,BGPSTR) ;EP
- S X="MERR^BGPGU",@^%ZOSF("TRAP") ; m error trap
- N P,BGPOPT,BGPI,T
- S P="|"
- S BGPI=0
- K ^BGPTMP($J)
- S BGPRET="^BGPTMP("_$J_")"
- S ^BGPTMP($J,BGPI)="T00200COMMUNITIES"_$C(30)
- S BGPI=0
- S T=$P(BGPSTR,P)
- K BGPC
- I '$G(T) Q 0
- I '$D(^ATXAX(T)) Q 0
- S X=0,G=0
- F S X=$O(^ATXAX(T,21,X)) Q:'X D
- .S C=$P(^ATXAX(T,21,X,0),U)
- .S BGPI=BGPI+1
- .I '$D(^AUTTCOM("B",C)) S ^BGPTMP($J,BGPI)="Warning "_C_" is in the taxonomy but not in the standard community table."_$C(30)
- S ^BGPTMP($J,BGPI+1)=$C(31)
- Q
- ;
- MFI(BGPRET,BGPSTR) ;-- check to see if this is an mfi site
- S X="MERR^BGPGU",@^%ZOSF("TRAP") ; m error trap
- N P,BGPOPT,BGPI,BGPDUZ2
- S P="|"
- S BGPI=0
- K ^BGPTMP($J)
- S BGPRET="^BGPTMP("_$J_")"
- S ^BGPTMP($J,BGPI)="T00001MFI"_$C(30)
- S BGPI=0
- S BGPDUZ2=$P(BGPSTR,P)
- S ^BGPTMP($J,1)=$S($E($P($G(^AUTTLOC(BGPDUZ2,0)),U,10),1,1)=3:1,1:0)_$C(30)
- S ^BGPTMP($J,2)=$C(31)
- Q
- ;
- BGP1GU ; IHS/CMI/LAB - BGP Gui Utilities 10/29/2004 3:28:39 PM 19 Sep 2005 5:28 PM 27 Apr 2010 10:28 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("UPL^BGP1GU(.RETVAL,.BGPSTR)")
- +2 QUIT
- +3 ;
- KEYS(RETVAL,BGPSTR) ;-- return keys for user
- +1 ; m error trap
- SET X="MERR^BGP1GU"
- 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"_$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
- +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 BGPI=BGPI+1
- +23 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)_$CHAR(30)
- End DoDot:1
- +24 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)_$GET(BGPERR)
- +25 QUIT
- +26 ;
- TAXCHK(RETVAL,BGPSTR) ;-- check taxonomies for National GPRA Report
- +1 ; m error trap
- SET X="MERR^BGP1GU"
- SET @^%ZOSF("TRAP")
- +2 NEW BGPI,BGPJ,BGPDATA,BGPDA,BGPRTN,P,BGPCALL
- +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 BGP1GPU=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^BGPXBLM("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 QUIT
- +23 ;
- CATSTR(BGPSRET,STR) ;EP -- 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 ;cmi/maw changed to end of table marker crs 8.0 p2
- SET BGPXA="0|"_ERR_$CHAR(31)
- +3 SET @RETVAL@(1)=BGPXA
- +4 QUIT
- +5 ;
- FAC(RETVAL,BGPSTR) ;-- return facilities based on parameters passed
- +1 ; m error trap
- SET X="MERR^BGP1GU"
- 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 ;crs 8.0 p3 for area 09 report
- SET BGPNGR09=$PIECE(BGPSTR,P,6)
- +13 KILL ^BGPTMP($JOB)
- +14 SET RETVAL="^BGPTMP("_$JOB_")"
- +15 SET ^BGPTMP($JOB,BGPI)="T00007BMXIEN^T00030Service Unit^T00030Facility^T00020Begin Date^T00020End Date^T00020Base Beg^T00020Base End^T00020Date Run"_$CHAR(30)
- +16 DO GET^BGP1ASL(.BGPFAC,.BGPFILE,BGPRT,BGPPER,BGPQTR,BGPBAS,BGPBEN)
- +17 NEW BGPDA
- SET BGPDA=0
- FOR
- SET BGPDA=$ORDER(BGPFAC(BGPDA))
- IF 'BGPDA
- QUIT
- Begin DoDot:1
- +18 SET BGPI=BGPI+1
- +19 SET ^BGPTMP($JOB,BGPI)=BGPDA_U_$GET(BGPFAC(BGPDA))_$CHAR(30)
- End DoDot:1
- +20 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)_BGPERR
- +21 DO EN^XBVK("BGP")
- +22 QUIT
- +23 ;
- SITE(RETVAL,BGPSTR) ;-- save the site parameters
- +1 ; m error trap
- SET X="MERR^BGP1GU"
- SET @^%ZOSF("TRAP")
- +2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPFAC,BGPTAX,BGPHLOC,R,BGPEISS
- +3 SET P="|"
- SET R="~"
- +4 SET BGPI=0
- +5 SET BGPERR=""
- +6 SET BGPFAC=$PIECE($PIECE(BGPSTR,P),R)
- +7 SET BGPTAX=$PIECE($PIECE(BGPSTR,P,2),R)
- +8 SET BGPHLOC=$PIECE($PIECE(BGPSTR,P,3),R)
- +9 SET BGPHLOCI=$ORDER(^AUTTLOC("B",BGPHLOC,0))
- +10 SET BGPEISS=$PIECE(BGPSTR,P,4)
- +11 KILL ^BGPTMP($JOB)
- +12 SET RETVAL="^BGPTMP("_$JOB_")"
- +13 SET ^BGPTMP($JOB,BGPI)="T00007BMXIEN^T00030Error"_$CHAR(30)
- +14 NEW BGPFDA,BGPIENS,BGPERR
- +15 IF $ORDER(^BGPSITE("B",BGPFAC,0))
- Begin DoDot:1
- +16 SET BGPIENS=$ORDER(^BGPSITE("B",BGPFAC,0))_","
- +17 SET BGPFDA(90241.02,BGPIENS,.05)=BGPTAX
- +18 SET BGPFDA(90241.02,BGPIENS,.02)=BGPHLOC
- +19 SET BGPFDA(90241.02,BGPIENS,.04)=BGPEISS
- +20 DO FILE^DIE("K","BGPFDA","BGPERR(1)")
- +21 IF $GET(BGPERR(1))
- Begin DoDot:2
- +22 SET BGPI=BGPI+1
- +23 SET ^BGPTMP($JOB,BGPI)="1^Error Saving Site Parameters"
- End DoDot:2
- QUIT
- +24 SET BGPI=BGPI+1
- +25 SET ^BGPTMP($JOB,BGPI)="0^Site Parameters Saved"
- End DoDot:1
- +26 IF '$ORDER(^BGPSITE("B",BGPFAC,0))
- Begin DoDot:1
- +27 SET BGPIENS=""
- +28 SET BGPIENS(1)=BGPFAC
- +29 SET BGPFDA(90241.02,"+1,",.01)=BGPFAC
- +30 SET BGPFDA(90241.02,"+1,",.02)=BGPHLOC
- +31 SET BGPFDA(90241.02,"+1,",.04)=BGPEISS
- +32 SET BGPFDA(90241.02,"+1,",.05)=BGPTAX
- +33 DO UPDATE^DIE("","BGPFDA","BGPIENS","BGPERR(1)")
- +34 IF $GET(BGPERR(1))
- Begin DoDot:2
- +35 SET BGPI=BGPI+1
- +36 SET ^BGPTMP($JOB,BGPI)="1^Error Saving Site Parameters"
- End DoDot:2
- QUIT
- +37 SET BGPI=BGPI+1
- +38 SET ^BGPTMP($JOB,BGPI)="0^Site Parameters Saved"
- End DoDot:1
- +39 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)_BGPERR
- +40 DO EN^XBVK("BGP")
- +41 QUIT
- +42 ;
- LST(RETVAL,BGPSTR) ;-- list files
- +1 ; m error trap
- SET X="MERR^BGP1GU"
- 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^BGP1GLST(.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 11 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 ;ihs/cmi/maw v11.1 04/29/2011
- IF BGPSTR'[R
- SET BGPSTR=R_BGPSTR
- +8 FOR I=2:1
- Begin DoDot:1
- +9 NEW BGPI
- +10 IF $PIECE(BGPSTR,R,I)=""
- QUIT
- +11 SET BGPI=$PIECE(BGPSTR,R,I)
- +12 SET DIK="^BGPGUIB("
- SET DA=BGPI
- DO ^DIK
- End DoDot:1
- IF $PIECE(BGPSTR,R,I)=""
- QUIT
- +13 SET ^BGPTMP($JOB,0)="T00250DATA"_$CHAR(30)
- +14 SET ^BGPTMP($JOB,1)=$GET(BGPERR)_$CHAR(30)
- +15 SET ^BGPTMP($JOB,2)=$CHAR(31)_BGPERR
- +16 QUIT
- +17 ;
- ST(RETVAL,BGPSTR) ;-- return search templates by file
- +1 ; m error trap
- SET X="MERR^BGP1GU"
- 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(BGPDA))
- IF 'BGPDA
- QUIT
- Begin DoDot:1
- +15 NEW BGPFL
- +16 SET BGPFL=$PIECE($GET(^DIBT(BGPDA,0)),U,4)
- +17 IF 'BGPFL
- QUIT
- +18 IF '$DATA(BGPFLS(BGPFL))
- QUIT
- +19 SET BGPI=BGPI+1
- +20 SET ^BGPTMP($JOB,BGPI)=BGPDA_U_$PIECE($GET(^DIBT(BGPDA,0)),U)_$CHAR(30)
- End DoDot:1
- +21 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
- +22 DO EN^XBVK("BGP")
- +23 QUIT
- +24 ;
- UPL(RETVAL,BGPSTR) ;-- upload a file
- +1 ; m error trap
- SET X="MERR^BGP1GU"
- SET @^%ZOSF("TRAP")
- +2 NEW BGPOPT
- +3 SET BGPP="|"
- SET BGPR="~"
- +4 KILL ^BGPTMP($JOB)
- +5 SET RETVAL="^BGPTMP("_$JOB_")"
- +6 SET BGPI=0
- +7 IF $GET(BGPSTR)=""
- DO CATSTR(.BGPSTR,.BGPSTR)
- +8 SET BGPOPT="BGP 11 UPLOAD FILES"
- +9 FOR BGPII=2:1
- Begin DoDot:1
- +10 IF $PIECE(BGPSTR,BGPP,BGPII)=""
- QUIT
- +11 NEW BGPFD,BGPDIR,BGPFL
- +12 SET BGPFD=$PIECE(BGPSTR,BGPP,BGPII)
- +13 SET BGPDIR=$PIECE(BGPFD,BGPR,1)
- +14 SET BGPFL=$PIECE(BGPFD,BGPR,2)
- +15 DO EP^BGP1GUPL(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPDIR,BGPFL,DT)
- End DoDot:1
- IF $PIECE(BGPSTR,BGPP,BGPII)=""
- QUIT
- +16 SET ^BGPTMP($JOB,BGPI)="T00001Error^T00080ErrorMessage"_$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^BGP1GU"
- 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,"BG11*",.BGPLIST)
- +9 SET BGPOPT="BGP 11 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^BGP1GU"
- 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^T00250Export File(s)"_$CHAR(30)
- +9 NEW BGPDA
- +10 SET BGPDA=0
- FOR
- SET BGPDA=$ORDER(^BGPGUIB("AUSR",BGPDUZ,BGPDA))
- IF 'BGPDA
- QUIT
- Begin DoDot:1
- +11 NEW BGPIEN
- +12 SET BGPIEN=0
- FOR
- SET BGPIEN=$ORDER(^BGPGUIB("AUSR",BGPDUZ,BGPDA,BGPIEN))
- IF 'BGPIEN
- QUIT
- Begin DoDot:2
- +13 NEW BGPDATA,BGPNM,BGPUSER,BGPST,BGPET,BGPTOR,BGPRS,BGPTOO,BGPFLS
- +14 SET BGPDATA=$GET(^BGPGUIB(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($PIECE($PIECE(BGPDATA,U,3),"."))
- Begin DoDot:3
- +20 SET DIK="^BGPGUIB("
- SET DA=BGPIEN
- DO ^DIK
- End DoDot:3
- QUIT
- +21 SET BGPTOR=$PIECE(BGPDATA,U,5)
- +22 SET BGPRS=$$GET1^DIQ(90546.08,BGPIEN,.06)
- +23 SET BGPTOO=$$GET1^DIQ(90546.08,BGPIEN,.07)
- +24 SET BGPFLS=$$GET1^DIQ(90546.08,BGPIEN,1)
- +25 SET BGPI=BGPI+1
- +26 SET ^BGPTMP($JOB,BGPI)=BGPIEN_U_BGPNM_U_BGPUSER_U_BGPST_U_BGPET_U_BGPTOR_U_BGPRS_U_BGPTOO_U_BGPFLS_$CHAR(30)
- End DoDot:2
- End DoDot:1
- +27 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
- +28 QUIT
- +29 ;
- SEVEN(ST) ;EP -- check to see if the start date is over 7 days ago
- +1 IF $$FMDIFF^XLFDT(DT,ST)>7
- QUIT 1
- +2 ;S X1=ST,X2=7 D C^%DTC
- +3 ;I X<DT Q 1
- +4 QUIT 0
- +5 ;
- LABTAXC(RETVAL,BGPSTR) ;EP - from remote procedure
- +1 ; m error trap
- SET X="MERR^BGP1GU"
- SET @^%ZOSF("TRAP")
- +2 NEW BGPI,BGPJ,BGPDATA,BGPDA,BGPRT,P,BGPOPT,BGPR,BGPFN
- +3 SET P="|"
- +4 SET BGPI=0
- +5 SET BGPERR=""
- +6 SET BGPOPT=$PIECE(BGPSTR,P)
- +7 ;8.0 p2
- SET BGPOPT="CRS 11 LAB TAXONOMY REPORT"
- +8 SET BGPRT=$PIECE(BGPSTR,P,2)
- +9 SET BGPR=$PIECE(BGPSTR,P,3)
- +10 SET BGPFN=$PIECE(BGPSTR,P,4)
- +11 SET BGPJ=0
- +12 KILL ^BGPTMP($JOB)
- +13 SET RETVAL="^BGPTMP("_$JOB_")"
- +14 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
- +15 DO EP^BGP1GLTX(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPRT,BGPR,BGPFN)
- +16 SET BGPI=BGPI+1
- +17 SET ^BGPTMP($JOB,BGPI)=+$GET(BGPERR)_$CHAR(30)
- +18 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
- +19 DO EN^XBVK("BGP")
- +20 QUIT
- MEDTAXC(RETVAL,BGPSTR) ;EP - from remote procedure
- +1 ; m error trap
- SET X="MERR^BGP1GU"
- SET @^%ZOSF("TRAP")
- +2 NEW BGPI,BGPJ,BGPDATA,BGPDA,BGPRT,P,BGPOPT,BGPR,BGPFN
- +3 SET P="|"
- +4 SET BGPI=0
- +5 SET BGPERR=""
- +6 SET BGPOPT=$PIECE(BGPSTR,P)
- +7 ;8.0 p2
- SET BGPOPT="CRS 11 MEDICATION TAXONOMY REPORT"
- +8 SET BGPRT=$PIECE(BGPSTR,P,2)
- +9 SET BGPR=$PIECE(BGPSTR,P,3)
- +10 SET BGPFN=$PIECE(BGPSTR,P,4)
- +11 SET BGPJ=0
- +12 KILL ^BGPTMP($JOB)
- +13 SET RETVAL="^BGPTMP("_$JOB_")"
- +14 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
- +15 DO EP^BGP1GMTX(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPRT,BGPR,BGPFN)
- +16 SET BGPI=BGPI+1
- +17 SET ^BGPTMP($JOB,BGPI)=+$GET(BGPERR)_$CHAR(30)
- +18 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
- +19 DO EN^XBVK("BGP")
- +20 QUIT
- +21 ;
- UPDTAX(BGPRET,BGPSTR) ;update taxonomies based on option selected
- +1 ; m error trap
- SET X="MERR^BGPGU"
- SET @^%ZOSF("TRAP")
- +2 NEW P,BGPOPT,BGPI
- +3 SET P="|"
- +4 SET BGPI=0
- +5 KILL ^BGPTMP($JOB)
- +6 SET BGPRET="^BGPTMP("_$JOB_")"
- +7 SET ^BGPTMP($JOB,BGPI)="T00080TAXONOMY NAME"_$CHAR(30)
- +8 SET BGPRPTT1=1
- +9 SET BGPOPT=$PIECE(BGPSTR,P)
- +10 IF BGPOPT="TAXNTL"
- Begin DoDot:1
- +11 SET BGPRPTT1=1
- End DoDot:1
- +12 IF BGPOPT="TAXCMS"
- Begin DoDot:1
- +13 SET BGPRPTT1=5
- End DoDot:1
- +14 IF BGPOPT="TAXCRS"
- Begin DoDot:1
- +15 SET BGPRPTT1=9
- End DoDot:1
- +16 IF BGPOPT="TAXONM"
- Begin DoDot:1
- +17 SET BGPRPTT1=7
- End DoDot:1
- +18 IF BGPOPT="TAXEO"
- Begin DoDot:1
- +19 SET BGPRPTT1=8
- End DoDot:1
- +20 DO INIT^BGP1CTS
- +21 IF BGPOPT="TAXALL"
- Begin DoDot:1
- +22 DO INIT^BGP1XTV
- End DoDot:1
- +23 NEW BGPDA,BGPT
- +24 SET BGPDA=0
- FOR
- SET BGPDA=$ORDER(BGPTAX("IDX",BGPDA))
- IF 'BGPDA
- QUIT
- Begin DoDot:1
- +25 NEW BGPN,BGPFL,BGPRO,BGPFLT
- +26 SET BGPI=BGPI+1
- +27 SET BGPT=$PIECE($GET(BGPTAX("IDX",BGPDA,BGPDA)),U)
- +28 SET BGPTT=$PIECE($GET(BGPTAX("IDX",BGPDA,BGPDA)),U,2)
- +29 IF BGPTT="T"
- Begin DoDot:2
- +30 SET BGPN=$PIECE($GET(^ATXAX(BGPT,0)),U)
- +31 SET BGPRO=$SELECT($PIECE($GET(^ATXAX(BGPT,0)),U,22):"Read Only",1:"Editable")
- +32 SET BGPFL=$PIECE($GET(^ATXAX(BGPT,0)),U,15)
- +33 SET BGPFLT=$SELECT(BGPFL=50:"Med",1:"Tax")
- End DoDot:2
- +34 IF BGPTT="L"
- Begin DoDot:2
- +35 SET BGPN=$PIECE($GET(^ATXLAB(BGPT,0)),U)
- +36 SET BGPRO=$SELECT($PIECE($GET(^ATXLAB(BGPT,0)),U,22):"Read Only",1:"Editable")
- +37 SET BGPFL=$PIECE($GET(^ATXLAB(BGPT,0)),U,9)
- +38 SET BGPFLT="Lab"
- End DoDot:2
- +39 SET ^BGPTMP($JOB,BGPI)=BGPN_"("_BGPRO_"/"_BGPFLT_"/"_BGPFL_")"_$CHAR(30)
- End DoDot:1
- +40 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
- +41 QUIT
- +42 ;
- NEWTAX(BGPRET,BGPSTR) ;update taxonomies based on option selected
- +1 ; m error trap
- SET X="MERR^BGPGU"
- SET @^%ZOSF("TRAP")
- +2 NEW P,BGPOPT,BGPI
- +3 SET P="|"
- +4 SET BGPI=0
- +5 KILL ^BGPTMP($JOB)
- +6 SET BGPRET="^BGPTMP("_$JOB_")"
- +7 SET ^BGPTMP($JOB,BGPI)="T00080Taxonomy Name^T00010Taxonomy IEN^T00001ReadOnly^T00020File Number^T00003Tax Type"_$CHAR(30)
- +8 SET BGPRPTT1=1
- +9 SET BGPOPT=$PIECE(BGPSTR,P)
- +10 IF BGPOPT="TAXNTL"
- Begin DoDot:1
- +11 SET BGPRPTT1=1
- End DoDot:1
- +12 IF BGPOPT="TAXCMS"
- Begin DoDot:1
- +13 SET BGPRPTT1=5
- End DoDot:1
- +14 IF BGPOPT="TAXCRS"
- Begin DoDot:1
- +15 SET BGPRPTT1=9
- End DoDot:1
- +16 IF BGPOPT="TAXONM"
- Begin DoDot:1
- +17 SET BGPRPTT1=7
- End DoDot:1
- +18 IF BGPOPT="TAXEO"
- Begin DoDot:1
- +19 SET BGPRPTT1=8
- End DoDot:1
- +20 DO INIT^BGP1CTS
- +21 IF BGPOPT="TAXALL"
- Begin DoDot:1
- +22 DO INIT^BGP1XTV
- End DoDot:1
- +23 NEW BGPDA,BGPT
- +24 SET BGPDA=0
- FOR
- SET BGPDA=$ORDER(BGPTAX("IDX",BGPDA))
- IF 'BGPDA
- QUIT
- Begin DoDot:1
- +25 NEW BGPN,BGPFL,BGPRO,BGPFLT
- +26 SET BGPI=BGPI+1
- +27 SET BGPT=$PIECE($GET(BGPTAX("IDX",BGPDA,BGPDA)),U)
- +28 SET BGPTT=$PIECE($GET(BGPTAX("IDX",BGPDA,BGPDA)),U,2)
- +29 IF BGPTT="T"
- Begin DoDot:2
- +30 SET BGPN=$PIECE($GET(^ATXAX(BGPT,0)),U)
- +31 SET BGPRO=$SELECT($PIECE($GET(^ATXAX(BGPT,0)),U,22):"Read Only",1:"Editable")
- +32 SET BGPFL=$PIECE($GET(^ATXAX(BGPT,0)),U,15)
- +33 SET BGPFLT=$SELECT(BGPFL=50:"Med",1:"Tax")
- End DoDot:2
- +34 IF BGPTT="L"
- Begin DoDot:2
- +35 SET BGPN=$PIECE($GET(^ATXLAB(BGPT,0)),U)
- +36 SET BGPRO=$SELECT($PIECE($GET(^ATXLAB(BGPT,0)),U,22):"Read Only",1:"Editable")
- +37 SET BGPFL=$PIECE($GET(^ATXLAB(BGPT,0)),U,9)
- +38 SET BGPFLT="Lab"
- End DoDot:2
- +39 SET ^BGPTMP($JOB,BGPI)=BGPN_U_BGPT_U_$EXTRACT(BGPRO,1,1)_U_BGPFL_U_BGPFLT_$CHAR(30)
- End DoDot:1
- +40 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
- +41 QUIT
- +42 ;
- COMCHK(BGPRET,BGPSTR) ;EP
- +1 ; m error trap
- SET X="MERR^BGPGU"
- SET @^%ZOSF("TRAP")
- +2 NEW P,BGPOPT,BGPI,T
- +3 SET P="|"
- +4 SET BGPI=0
- +5 KILL ^BGPTMP($JOB)
- +6 SET BGPRET="^BGPTMP("_$JOB_")"
- +7 SET ^BGPTMP($JOB,BGPI)="T00200COMMUNITIES"_$CHAR(30)
- +8 SET BGPI=0
- +9 SET T=$PIECE(BGPSTR,P)
- +10 KILL BGPC
- +11 IF '$GET(T)
- QUIT 0
- +12 IF '$DATA(^ATXAX(T))
- QUIT 0
- +13 SET X=0
- SET G=0
- +14 FOR
- SET X=$ORDER(^ATXAX(T,21,X))
- IF 'X
- QUIT
- Begin DoDot:1
- +15 SET C=$PIECE(^ATXAX(T,21,X,0),U)
- +16 SET BGPI=BGPI+1
- +17 IF '$DATA(^AUTTCOM("B",C))
- SET ^BGPTMP($JOB,BGPI)="Warning "_C_" is in the taxonomy but not in the standard community table."_$CHAR(30)
- End DoDot:1
- +18 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
- +19 QUIT
- +20 ;
- MFI(BGPRET,BGPSTR) ;-- check to see if this is an mfi site
- +1 ; m error trap
- SET X="MERR^BGPGU"
- SET @^%ZOSF("TRAP")
- +2 NEW P,BGPOPT,BGPI,BGPDUZ2
- +3 SET P="|"
- +4 SET BGPI=0
- +5 KILL ^BGPTMP($JOB)
- +6 SET BGPRET="^BGPTMP("_$JOB_")"
- +7 SET ^BGPTMP($JOB,BGPI)="T00001MFI"_$CHAR(30)
- +8 SET BGPI=0
- +9 SET BGPDUZ2=$PIECE(BGPSTR,P)
- +10 SET ^BGPTMP($JOB,1)=$SELECT($EXTRACT($PIECE($GET(^AUTTLOC(BGPDUZ2,0)),U,10),1,1)=3:1,1:0)_$CHAR(30)
- +11 SET ^BGPTMP($JOB,2)=$CHAR(31)
- +12 QUIT
- +13 ;
