BNIGU ; cmi/anch/maw - BNI Visual CPHAD Utilities 1/4/2006 1:26:59 PM
;;1.0;BNI CPHD ACTIVITY DATASYSTEM;;DEC 20, 2006
Q
;
DEBUG(BNIRET,BNISTR) ;-- debug the application
D DEBUG^%Serenji("PPARPT^BNIGU(.BNIRET,.BNISTR)")
Q
;
KEYS(RETVAL,BNISTR) ;-- return keys
S X="MERR^BNIGU",@^%ZOSF("TRAP")
N BNIDA,BNINS,P,BNIDATA,BNIKEYI,BNIKEY,BNII
S BNII=0
K ^BNITMP($J)
S RETVAL="^BNITMP("_$J_")"
S ^BNITMP($J,BNII)="T00030KEYS"_$C(30)
S P="|"
S BNINS=$P(BNISTR,P)
S BNIDA=0 F S BNIDA=$O(^VA(200,DUZ,51,BNIDA)) Q:'BNIDA D
. S BNIDATA=$G(^VA(200,DUZ,51,BNIDA,0))
. S BNIKEYI=$P(BNIDATA,U)
. S BNIKEY=$P($G(^DIC(19.1,BNIKEYI,0)),U)
. I BNINS'="*" Q:$E(BNIKEY,1,$L(BNINS))'[BNINS
. S BNII=BNII+1
. S ^BNITMP($J,BNII)=BNIKEY_$C(30)
S ^BNITMP($J,BNII+1)=$C(31)_$G(BNIERR)
Q
;
CHK(BNIRET,BNISTR) ;report status
S X="MERR^BNIGU",@^%ZOSF("TRAP")
N P,BNIDUZ,BNII
S P="|"
S BNIDUZ=$P(BNISTR,P)
K ^BNITMP($J)
S BNIRET="^BNITMP("_$J_")"
S BNII=0
S ^BNITMP($J,BNII)="T00007BMXIEN^T00030Name^T00030User^T00020Start Time^T00020End Time^T00030Type of Report^T00020Report Status^T00020Type of Output"_$C(30)
N BNIDA
S BNIDA=0 F S BNIDA=$O(^BNIGUI("AUSR",BNIDUZ,BNIDA)) Q:'BNIDA D
. N BNIIEN
. S BNIIEN=0 F S BNIIEN=$O(^BNIGUI("AUSR",BNIDUZ,BNIDA,BNIIEN)) Q:'BNIIEN D
.. N BNIDATA,BNINM,BNIUSER,BNIST,BNIET,BNITOR,BNIRS,BNITOO
.. S BNIDATA=$G(^BNIGUI(BNIIEN,0))
.. S BNINM=$P(BNIDATA,U)
.. S BNIUSER=$P($G(^VA(200,$P(BNIDATA,U,2),0)),U)
.. S BNIST=$$FMTE^XLFDT($P(BNIDATA,U,3))
.. S BNIET=$$FMTE^XLFDT($P(BNIDATA,U,4))
.. S BNITOR=$P(BNIDATA,U,5)
.. S BNIRS=$$GET1^DIQ(90512.08,BNIIEN,.06)
.. S BNITOO=$$GET1^DIQ(90512.08,BNIIEN,.07)
.. S BNII=BNII+1
.. S ^BNITMP($J,BNII)=BNIIEN_U_BNINM_U_BNIUSER_U_BNIST_U_BNIET_U_BNITOR_U_BNIRS_U_BNITOO_$C(30)
S ^BNITMP($J,BNII+1)=$C(31)
Q
;
ALLREC(BNIRET,BNISTR) ;-- user is allowed to see all records?
S X="MERR^BNIGU",@^%ZOSF("TRAP")
N P,BNIUSER,BNISITE,BNII,BNIA
S P="|"
S BNIRET="^BNITMP("_$J_")"
S BNII=0
S BNIA=0
S ^BNITMP($J,BNII)="T00001Allowed"_$C(30)
S BNII=BNII+1
S BNIUSER=$P(BNISTR,P)
S BNISITE=$P(BNISTR,P,2)
I $D(^BNISITE("ACP",BNISITE,BNIUSER)) S BNIA=1
S ^BNITMP($J,BNII)=BNIA_$C(30)
S ^BNITMP($J,BNII+1)=$C(31)
Q
;
REC(BNIRET,BNISTR) ;-- list of records the user is allowed to see
S X="MERR^BNIGU",@^%ZOSF("TRAP")
N P,BNIALL,BNIDA,BNIIEN,BNIUSR,BNII,R
S P="|",R="~"
S BNISITE=$P(BNISTR,P)
S BNIRET="^BNITMP("_$J_")"
S BNII=0
S ^BNITMP($J,BNII)="T00007BMXIEN^T00020Date of Activity^T00003Provider^T00020Date Created^T00030Created By^T00030Last Edited By^T00020Date Last Edited^T00030Location Where Record Created^T00030Location^T00030Person Performing Activity^"
S ^BNITMP($J,BNII)=^BNITMP($J,BNII)_"T00010Total Time Spent^T00050General Health Concern^T00100Specific Health Topic^T00050Type of Activity^T00050Group Served^T00060Activity Setting^T00050Community Within Service Area^"
S ^BNITMP($J,BNII)=^BNITMP($J,BNII)_"T00010Travel Time in Minutes^T00010Number Served^T00010Month^T00004Year^T00064General Health Concern (Other)^T00064Specific Health Topic (Other)^T00064Type of Activity (Other)^T00064Group Served (Other)"
S ^BNITMP($J,BNII)=^BNITMP($J,BNII)_$C(30)
S BNIDA=0 F S BNIDA=$O(^BNIREC("AE",BNIDA)) Q:'BNIDA D
. N BNIIEN
. S BNIIEN=0 F S BNIIEN=$O(^BNIREC("AE",BNIDA,BNIIEN)) Q:'BNIIEN D
.. N BNIDATA,BNIDATA1,BNIDATA2
.. Q:'$$ALLOW^BNIE(BNIIEN)
.. S BNIDATA=$G(^BNIREC(BNIIEN,0))
.. S BNIDATA1=$G(^BNIREC(BNIIEN,11))
.. S BNIDATA2=$G(^BNIREC(BNIIEN,12))
.. S BNII=BNII+1
.. N BNI01,BNI02,BNI03,BNI04,BNI05,BNI06,BNI07,BNI08,BNI09,BNI11,BNI12,BNI13,BNI14,BNI15,BNI16,BNI17,BNI18,BNI19,BNI21,BNI1101,BNI1102,BNI1103,BNI1201
.. S BNI01=$P(BNIDATA,U)
.. S BNI02=$P(BNIDATA,U,2)
.. S BNI03=$S($P(BNIDATA,U,3):$P(BNIDATA,U,3)_R_$P(^VA(200,$P(BNIDATA,U,3),0),U),1:"")
.. S BNI04=$S($P(BNIDATA,U,4):$P(BNIDATA,U,4)_R_$P(^VA(200,$P(BNIDATA,U,4),0),U),1:"")
.. S BNI05=$P(BNIDATA,U,5)
.. S BNI06=$S($P(BNIDATA,U,6):$P(BNIDATA,U,6)_R_$P(^AUTTLOC($P(BNIDATA,U,6),0),U),1:"")
.. S BNI07=$S($P(BNIDATA,U,7):$P(BNIDATA,U,7)_R_$P(^AUTTLOC($P(BNIDATA,U,7),0),U),1:"")
.. S BNI08=$S($P(BNIDATA,U,8):$P(BNIDATA,U,8)_R_$P(^VA(200,$P(BNIDATA,U,8),0),U),1:"")
.. S BNI09=$P(BNIDATA,U,9)
.. S BNI11=$S($P(BNIDATA,U,11):$P(BNIDATA,U,11)_R_$P(^BNIGHC($P(BNIDATA,U,11),0),U),1:"")
.. S BNI12=$S($P(BNIDATA,U,12):$P(BNIDATA,U,12)_R_$P(^BNISHT($P(BNIDATA,U,12),0),U),1:"")
.. S BNI13=$S($P(BNIDATA,U,13):$P(BNIDATA,U,13)_R_$P(^BNITOA($P(BNIDATA,U,13),0),U),1:"")
.. S BNI14=$S($P(BNIDATA,U,14):$P(BNIDATA,U,14)_R_$P(^BNIGS($P(BNIDATA,U,14),0),U),1:"")
.. S BNI15=$S($P(BNIDATA,U,15):$P(BNIDATA,U,15)_R_$P(^BNIAS($P(BNIDATA,U,15),0),U),1:"")
.. S BNI16=$S($P(BNIDATA,U,16):$P(BNIDATA,U,16)_R_$P(^AUTTCOM($P(BNIDATA,U,16),0),U),1:"")
.. S BNI17=$P(BNIDATA,U,17)
.. S BNI18=$P(BNIDATA,U,18)
.. S BNI19=$P(BNIDATA,U,19)
.. S BNI21=$P(BNIDATA,U,21)
.. S BNI1101=$P(BNIDATA1,U)
.. S BNI1102=$P(BNIDATA1,U,2)
.. S BNI1103=$P(BNIDATA1,U,3)
.. S BNI1201=$P(BNIDATA2,U)
.. S BNIINIT=$S($P(BNIDATA,U,8):$P(^VA(200,$P(BNIDATA,U,8),0),U,2),1:"")
.. I BNIINIT="" S BNIINIT="???"
.. S ^BNITMP($J,BNII)=BNIIEN_U_BNI01_U_BNIINIT_U_BNI02_U_BNI03_U_BNI04_U_BNI05_U_BNI06_U_BNI07_U_BNI08_U_BNI09_U_BNI11_U_BNI12_U_BNI13_U_BNI14_U_BNI15_U_BNI16_U_BNI17_U_BNI18_U_BNI19_U_BNI21_U_BNI1101_U_BNI1102_U_BNI1103_U_BNI1201_$C(30)
S ^BNITMP($J,BNII+1)=$C(31)
Q
;
CATSTR(BNISRET,STR) ;EP -- concatenate string
N BNIDA
S BNISRET=""
S BNIDA=0 F S BNIDA=$O(STR(BNIDA)) Q:'BNIDA D
. S BNISRET=BNISRET_$G(STR(BNIDA))
Q
;
AC(BNIRET,BNISTR) ;-- additional comments?
S X="MERR^BNIGU",@^%ZOSF("TRAP")
N P
S P="|"
K ^BNITMP($J)
S BNIRET="^BNITMP("_$J_")"
N BNII,BNIIEN
S BNII=0
S BNIIEN=$P(BNISTR,P)
S ^BNITMP($J,BNII)="T00001NOTES"_$C(30)
I $D(^BNIREC(BNIIEN,14,1)) D
. S BNII=BNII+1
. S ^BNITMP($J,BNII)=1_$C(30)
S ^BNITMP($J,BNII+1)=$C(31)
Q
;
SHT(BNIRET,BNISTR) ;-- get specific health topic based on Ghc passed in?
S X="MERR^BNIGU",@^%ZOSF("TRAP")
N P
S P="|"
K ^BNITMP($J)
S BNIRET="^BNITMP("_$J_")"
N BNII,BNIIEN
S BNII=0
S BNIGHC=$P(BNISTR,P)
S ^BNITMP($J,BNII)="T00001Specific Health Topic"_$C(30)
S BNII=BNII+1
S ^BNITMP($J,BNII)=$$SHTP(BNIGHC)_$C(30)
S ^BNITMP($J,BNII+1)=$C(31)
Q
;
SHTP(G) ;EP - called from screenman screen
I $G(G)="" Q ""
NEW X
S X=$O(^BNISHT("AA",G,1,0))
I X,$D(^BNISHT(X,0)) Q X_"~"_$P(^BNISHT(X,0),U,1)
Q ""
;
SITE(RETVAL) ;-- return site parameter
S X="MERR^BNIGU",@^%ZOSF("TRAP")
N BNIDA,BNINS,P,BNIDATA,BNIKEYI,BNIKEY,BNII,R
S BNII=0
K ^BNITMP($J)
S RETVAL="^BNITMP("_$J_")"
S ^BNITMP($J,BNII)="T00007BMXIEN^T00030Site^T00001Activity Setting^T00030Taxonomy"_$C(30)
S P="|",R="~"
S BNIDA=0 F S BNIDA=$O(^BNISITE(BNIDA)) Q:'BNIDA D
. N BNIDATA,BNISTE,BNITX,BNIRAS
. S BNIDATA=$G(^BNISITE(BNIDA,0))
. S BNIRAS=$P(BNIDATA,U,2)
. S BNISTE=$P(^DIC(4,$P(BNIDATA,U),0),U)
. I $P(BNIDATA,U,3) S BNITX=$P(BNIDATA,U,3)_R_$P(^ATXAX($P(BNIDATA,U,3),0),U)
. S BNII=BNII+1
. S ^BNITMP($J,BNII)=BNIDA_U_BNIDA_R_BNISTE_U_BNIRAS_U_$G(BNITX)_$C(30)
S ^BNITMP($J,BNII+1)=$C(31)_$G(BNIERR)
Q
;
SITEA(RETVAL) ;-- return site parameter
S X="MERR^BNIGU",@^%ZOSF("TRAP")
N BNIDA,BNINS,P,BNIDATA,BNIKEYI,BNIKEY,BNII,R
S BNII=0
K ^BNITMP($J)
S RETVAL="^BNITMP("_$J_")"
S ^BNITMP($J,BNII)="T00007BMXIEN^T00030Site"_$C(30)
S P="|",R="~"
S BNIDA=0 F S BNIDA=$O(^BNISITE(BNIDA)) Q:'BNIDA D
. N BNIDATA,BNISTE,BNITX,BNIRAS
. S BNIDATA=$G(^BNISITE(BNIDA,0))
. S BNIRAS=$P(BNIDATA,U,2)
. S BNISTE=$P(^DIC(4,$P(BNIDATA,U),0),U)
. I $P(BNIDATA,U,3) S BNITX=$P(BNIDATA,U,3)_R_$P(^ATXAX($P(BNIDATA,U,3),0),U)
. S BNII=BNII+1
. S ^BNITMP($J,BNII)=BNIDA_U_BNISTE_$C(30)
S ^BNITMP($J,BNII+1)=$C(31)_$G(BNIERR)
Q
;
COM(RETVAL,BNISTR) ;-- return communities based on value passed in
S X="MERR^BNIGU",@^%ZOSF("TRAP")
N BNIDA,BNINS,P,BNIDATA,BNIKEYI,BNIKEY,BNII,R
S BNII=0
K ^BNITMP($J)
S RETVAL="^BNITMP("_$J_")"
S ^BNITMP($J,BNII)="T00007BMXIEN^T00030Community^T00030State"_$C(30)
S P="|",R="~"
S BNIST=$P(BNISTR,P)
S BNIDA=0 F S BNIDA=$O(^BNISITE(BNIST,11,BNIDA)) Q:'BNIDA D
. N BNIDATA,BNICOM,BNISTA
. S BNIDATA=$G(^BNISITE(BNIST,11,BNIDA,0))
. S BNICOM=$P(^AUTTCOM(BNIDATA,0),U)
. S BNISTA=$P($G(^DIC(5,$P(^AUTTCOM(BNIDATA,0),U,3),0)),U)
. S BNII=BNII+1
. S ^BNITMP($J,BNII)=BNIDATA_U_BNICOM_U_BNISTA_$C(30)
S ^BNITMP($J,BNII+1)=$C(31)_$G(BNIERR)
Q
;
USRS(RETVAL,BNISTR) ;-- return users based on value passed in
S X="MERR^BNIGU",@^%ZOSF("TRAP")
N BNIDA,BNINS,P,BNIDATA,BNIKEYI,BNIKEY,BNII,R
S BNII=0
K ^BNITMP($J)
S RETVAL="^BNITMP("_$J_")"
S ^BNITMP($J,BNII)="T00007BMXIEN^T00030Users"_$C(30)
S P="|",R="~"
S BNIST=$P(BNISTR,P)
S BNIDA=0 F S BNIDA=$O(^BNISITE(BNIST,12,BNIDA)) Q:'BNIDA D
. N BNIDATA,BNIUSR
. S BNIDATA=$G(^BNISITE(BNIST,12,BNIDA,0))
. S BNIUSR=$P(^VA(200,BNIDATA,0),U)
. S BNII=BNII+1
. S ^BNITMP($J,BNII)=BNIDATA_U_BNIUSR_$C(30)
S ^BNITMP($J,BNII+1)=$C(31)_$G(BNIERR)
Q
;
MERR ;ERROR TRAP
N X
X ("S X=$"_"ZE")
S X="MUMPS error: """_X_""""
D ERR(X)
Q
;
ERR(ERR) ;ERROR PROCESSOR
N X
S X="ERROR|"_ERR_$C(30)
S @BNIRET@(1)=X
Q
;
CMT(BNIRET,BNISTR) ;-- return additional comments
S X="MERR^BNIGU",@^%ZOSF("TRAP")
N P,BNII,BNIREC,BNIDA
S P="|"
K ^BNITMP($J)
S BNIRET="^BNITMP("_$J_")"
S BNII=0
S BNIREC=$P(BNISTR,P)
S ^BNITMP($J,BNII)="T000250Comments"_$C(30)
S BNIDA=0 F S BNIDA=$O(^BNIREC(BNIREC,14,BNIDA)) Q:'BNIDA D
. N BNION
. S BNII=BNII+1
. S BNION=$P($G(^BNIREC(BNIREC,14,BNIDA,0)),U)
. S ^BNITMP($J,BNII)=BNION_$C(30)
S ^BNITMP($J,BNII+1)=$C(31)_$G(BNIERR)
Q
;
DISP(BNIRET,BNISTR) ;-- display a record
S X="MERR^BNIGU",@^%ZOSF("TRAP")
N P,BNII,BNIREC,BNIDA
S P="|"
K ^BNITMP($J)
S BNIRET="^BNITMP("_$J_")"
S BNII=0
S BNIREC=$P(BNISTR,P)
S ^BNITMP($J,BNII)="T000250Text"_$C(30)
D EN^BNIRDSG(BNIREC,"",1)
S BNIDA=0 F S BNIDA=$O(^TMP("BNIVDSG",$J,BNIDA)) Q:'BNIDA D
. N BNION
. S BNII=BNII+1
. S BNION=$G(^TMP("BNIVDSG",$J,BNIDA,0))
. S ^BNITMP($J,BNII)=BNION_$C(30)
S ^BNITMP($J,BNII+1)=$C(31)_$G(BNIERR)
Q
;
TBL(BNIRET,BNISTR) ;-- print table listings
S X="MERR^BNIGU",@^%ZOSF("TRAP")
N P,BNII,BNIREC,BNIDA,BNISORT,BNIRTN
S P="|"
K ^BNITMP($J)
S BNIRET="^BNITMP("_$J_")"
S BNII=0
S BNIREC=$P(BNISTR,P)
S BNISORT=$P(BNISTR,P,2)
I BNIREC="General Public Health Concern" S BNIRTN="PRINT^BNITGHC"
I BNIREC="Specific Health Topic" S BNIRTN="PRINT^BNITSHT"
I BNIREC="Type of Activity" S BNIRTN="PRINT^BNITTOA"
I BNIREC="Group Served" S BNIRTN="PRINT^BNITGS"
I BNIREC="Activity Setting" S BNIRTN="PRINT^BNITAS"
S ^BNITMP($J,BNII)="T00080Text"_$C(30)
D GUIR^XBLM(BNIRTN,"^TMP($J,""BNITBL"",")
S BNIDA=0 F S BNIDA=$O(^TMP($J,"BNITBL",BNIDA)) Q:'BNIDA D
. N BNION
. S BNII=BNII+1
. S BNION=$G(^TMP($J,"BNITBL",BNIDA))
. S ^BNITMP($J,BNII)=BNION_$C(30)
S ^BNITMP($J,BNII+1)=$C(31)_$G(BNIERR)
Q
;
GETTAX(BNIRET) ;-- get community taxonomies
S X="MERR^BNIGU",@^%ZOSF("TRAP")
N P,BNIOPT,BNII
S P="|"
S BNII=0
K ^BNITMP($J)
S BNIRET="^BNITMP("_$J_")"
S ^BNITMP($J,BNII)="T00080TAXONOMY NAME"_$C(30)
N BNIDA,BNIT
S BNIFN=9999999.05
S BNIIEN=0 F S BNIIEN=$O(^ATXAX("B",BNIIEN)) Q:BNIIEN="" D
. N BNIDA
. S BNIDA=0 F S BNIDA=$O(^ATXAX("B",BNIIEN,BNIDA)) Q:'BNIDA D
.. I BNIFN]"" Q:$P($G(^ATXAX(BNIDA,0)),U,15)'=BNIFN
.. S BNII=BNII+1
.. S BNIN=$P($G(^ATXAX(BNIDA,0)),U)
.. S BNIRO=$S($P($G(^ATXAX(BNIDA,0)),U,22):"Read Only",1:"Editable")
.. S BNIFL=$P($G(^ATXAX(BNIDA,0)),U,15)
.. S BNIFLT=$S(BNIFL=50:"Med",1:"Tax")
.. S ^BNITMP($J,BNII)=BNIN_"("_BNIRO_"/"_BNIFLT_"/"_BNIFL_")"_$C(30)
S ^BNITMP($J,BNII+1)=$C(31)
Q
;
RPT(RETVAL,BNISTR) ;-- get the report and queue
S X="MERR^BNIGU",@^%ZOSF("TRAP")
N P,BNIREP,BNIBG,BNIED,BNILR,BNIRDT,BNIRTN,BNII
S P="|"
S BNIH=$TR($H,",")
S BNIJ=$J
S BNIREP=$P(BNISTR,P)
S BNIBG=$P(BNISTR,P,2)
S BNIED=$P(BNISTR,P,3)
S BNILR=$P(BNISTR,P,4)
S BNIRDT=$P(BNISTR,P,5)
I BNIREP="PHC" S BNIRTN="BNIG^BNIRP2(.BNIERR,BNIJ,BNIH,BNIBG,BNIED,BNILR,BNIRDT)"
I BNIREP="SHT" S BNIRTN="BNIG^BNIRP3(.BNIERR,BNIJ,BNIH,BNIBG,BNIED,BNILR,BNIRDT)"
I BNIREP="TOA" S BNIRTN="BNIG^BNIRP4(.BNIERR,BNIJ,BNIH,BNIBG,BNIED,BNILR,BNIRDT)"
I BNIREP="ACS" S BNIRTN="BNIG^BNIRP5(.BNIERR,BNIJ,BNIH,BNIBG,BNIED,BNILR,BNIRDT)"
I BNIREP="GPE" S BNIRTN="BNIG^BNIRP6(.BNIERR,BNIJ,BNIH,BNIBG,BNIED,BNILR,BNIRDT)"
I BNIREP="TSD" S BNIRTN="BNIG^BNIRP7(.BNIERR,BNIJ,BNIH,BNIBG,BNIED,BNILR,BNIRDT)"
S BNII=0
S RETVAL="^BNITMP("_$J_")"
K ^BNITMP($J)
S ^BNITMP($J,0)="T00007BMXIEN^T00050Error"_$C(30)
S BNIGUI=1
D @BNIRTN
S ^BNITMP($J,1)=+$G(BNIERR)_U_$C(30)
S ^BNITMP($J,2)=$C(31)
K BNIGUI
Q
;
PPARPT(RETVAL,BNISTR) ;-- queue the PPA Report
S X="MERR^BNIGU",@^%ZOSF("TRAP")
N P,BNIREP,BNIBG,BNIED,BNILR,BNIRDT,BNIRTN,BNII,BNITYP,BNISUB,R,BNIPRVS
S P="|",R="~"
S BNIH=$TR($H,",")
S BNIJ=$J
S BNIREP=$P(BNISTR,P)
S BNIBG=$P(BNISTR,P,2)
S BNIED=$P(BNISTR,P,3)
S BNILR=$P(BNISTR,P,4)
S BNIRDT=$P(BNISTR,P,5)
S BNITYP=$P(BNISTR,P,6)
S BNISUB=$P(BNISTR,P,7)
S BNIPRV=$P(BNISTR,P,8)
S BNIPRVS=""
N I
F I=1:1 D Q:$P(BNIPRV,R,I)=""
. Q:$P(BNIPRV,R,I)=""
. S BNIPRVS(+$P(BNIPRV,R,I))=""
S BNII=0
S RETVAL="^BNITMP("_$J_")"
K ^BNITMP($J)
S BNIGUI=1
S ^BNITMP($J,0)="T00007BMXIEN^T00050Error"_$C(30)
D BNIG^BNIRP1(.BNIERR,BNIJ,BNIH,BNIBG,BNIED,BNILR,BNIRDT,BNITYP,BNISUB,.BNIPRVS)
S ^BNITMP($J,1)=+$G(BNIERR)_U_$C(30)
S ^BNITMP($J,2)=$C(31)
K BNIGUI
Q
;
DELRPT(RETVAL,BNISTR) ;-- delete a report
S X="MERR^BNIGU",@^%ZOSF("TRAP")
N P,R,I
S P="|",R="~"
S BNIERR=""
K ^BNITMP($J)
S RETVAL="^BNITMP("_$J_")"
N BNII F I=2:1 D Q:$P(BNISTR,R,I)=""
. ;N BNII
. Q:$P(BNISTR,R,I)=""
. S BNII=$P(BNISTR,R,I)
. S DIK="^BNIGUI(",DA=BNII D ^DIK
S ^BNITMP($J,0)="T00250DATA"_$C(30)
S ^BNITMP($J,1)=$G(BNIERR)_$C(30)
S ^BNITMP($J,2)=$C(31)_BNIERR
Q
;
REP(BNIRET,BNISTR) ;-- return Report Output
S X="MERR^BNIGU",@^%ZOSF("TRAP")
N P,BNII,BNIDA,BNIFL,BNIRIEN
S P="|"
S BNIRIEN=$P(BNISTR,P)
S BNIRET="^BNITMP("_$J_")"
S BNII=0
S ^BNITMP($J,BNII)="T00250DATA"_$C(30)
S BNIDA=0 F S BNIDA=$O(^BNIGUI(BNIRIEN,11,BNIDA)) Q:'BNIDA D
. S BNII=BNII+1
. S ^BNITMP($J,BNII)=$G(^BNIGUI(BNIRIEN,11,BNIDA,0))_$C(30)
S ^BNITMP($J,BNII+1)=$C(31)_$G(BNIERR)
Q
;
XL(BNIRET,BNISTR) ;-- return to excel
S X="MERR^BNIGU",@^%ZOSF("TRAP")
N P,BNII,BNIDA,BNIFL,BNIRIEN
S P="|"
S BNIRIEN=$P(BNISTR,P)
S BNIRET="^BNITMP("_$J_")"
K ^BNITMP($J)
S BNII=0
S ^BNITMP($J,BNII)="T00250DATA"_$C(30)
S BNIDA=0 F S BNIDA=$O(^BNIGUI(BNIRIEN,12,BNIDA)) Q:'BNIDA D
. S BNII=BNII+1
. S ^BNITMP($J,BNII)=$TR($G(^BNIGUI(BNIRIEN,12,BNIDA,0)),"^","~")_$C(30)
S ^BNITMP($J,BNII+1)=$C(31)_$G(BNIERR)
Q
;
BNIGU ; cmi/anch/maw - BNI Visual CPHAD Utilities 1/4/2006 1:26:59 PM
+1 ;;1.0;BNI CPHD ACTIVITY DATASYSTEM;;DEC 20, 2006
+2 QUIT
+3 ;
DEBUG(BNIRET,BNISTR) ;-- debug the application
+1 DO DEBUG^%Serenji("PPARPT^BNIGU(.BNIRET,.BNISTR)")
+2 QUIT
+3 ;
KEYS(RETVAL,BNISTR) ;-- return keys
+1 SET X="MERR^BNIGU"
SET @^%ZOSF("TRAP")
+2 NEW BNIDA,BNINS,P,BNIDATA,BNIKEYI,BNIKEY,BNII
+3 SET BNII=0
+4 KILL ^BNITMP($JOB)
+5 SET RETVAL="^BNITMP("_$JOB_")"
+6 SET ^BNITMP($JOB,BNII)="T00030KEYS"_$CHAR(30)
+7 SET P="|"
+8 SET BNINS=$PIECE(BNISTR,P)
+9 SET BNIDA=0
FOR
SET BNIDA=$ORDER(^VA(200,DUZ,51,BNIDA))
IF 'BNIDA
QUIT
Begin DoDot:1
+10 SET BNIDATA=$GET(^VA(200,DUZ,51,BNIDA,0))
+11 SET BNIKEYI=$PIECE(BNIDATA,U)
+12 SET BNIKEY=$PIECE($GET(^DIC(19.1,BNIKEYI,0)),U)
+13 IF BNINS'="*"
IF $EXTRACT(BNIKEY,1,$LENGTH(BNINS))'[BNINS
QUIT
+14 SET BNII=BNII+1
+15 SET ^BNITMP($JOB,BNII)=BNIKEY_$CHAR(30)
End DoDot:1
+16 SET ^BNITMP($JOB,BNII+1)=$CHAR(31)_$GET(BNIERR)
+17 QUIT
+18 ;
CHK(BNIRET,BNISTR) ;report status
+1 SET X="MERR^BNIGU"
SET @^%ZOSF("TRAP")
+2 NEW P,BNIDUZ,BNII
+3 SET P="|"
+4 SET BNIDUZ=$PIECE(BNISTR,P)
+5 KILL ^BNITMP($JOB)
+6 SET BNIRET="^BNITMP("_$JOB_")"
+7 SET BNII=0
+8 SET ^BNITMP($JOB,BNII)="T00007BMXIEN^T00030Name^T00030User^T00020Start Time^T00020End Time^T00030Type of Report^T00020Report Status^T00020Type of Output"_$CHAR(30)
+9 NEW BNIDA
+10 SET BNIDA=0
FOR
SET BNIDA=$ORDER(^BNIGUI("AUSR",BNIDUZ,BNIDA))
IF 'BNIDA
QUIT
Begin DoDot:1
+11 NEW BNIIEN
+12 SET BNIIEN=0
FOR
SET BNIIEN=$ORDER(^BNIGUI("AUSR",BNIDUZ,BNIDA,BNIIEN))
IF 'BNIIEN
QUIT
Begin DoDot:2
+13 NEW BNIDATA,BNINM,BNIUSER,BNIST,BNIET,BNITOR,BNIRS,BNITOO
+14 SET BNIDATA=$GET(^BNIGUI(BNIIEN,0))
+15 SET BNINM=$PIECE(BNIDATA,U)
+16 SET BNIUSER=$PIECE($GET(^VA(200,$PIECE(BNIDATA,U,2),0)),U)
+17 SET BNIST=$$FMTE^XLFDT($PIECE(BNIDATA,U,3))
+18 SET BNIET=$$FMTE^XLFDT($PIECE(BNIDATA,U,4))
+19 SET BNITOR=$PIECE(BNIDATA,U,5)
+20 SET BNIRS=$$GET1^DIQ(90512.08,BNIIEN,.06)
+21 SET BNITOO=$$GET1^DIQ(90512.08,BNIIEN,.07)
+22 SET BNII=BNII+1
+23 SET ^BNITMP($JOB,BNII)=BNIIEN_U_BNINM_U_BNIUSER_U_BNIST_U_BNIET_U_BNITOR_U_BNIRS_U_BNITOO_$CHAR(30)
End DoDot:2
End DoDot:1
+24 SET ^BNITMP($JOB,BNII+1)=$CHAR(31)
+25 QUIT
+26 ;
ALLREC(BNIRET,BNISTR) ;-- user is allowed to see all records?
+1 SET X="MERR^BNIGU"
SET @^%ZOSF("TRAP")
+2 NEW P,BNIUSER,BNISITE,BNII,BNIA
+3 SET P="|"
+4 SET BNIRET="^BNITMP("_$JOB_")"
+5 SET BNII=0
+6 SET BNIA=0
+7 SET ^BNITMP($JOB,BNII)="T00001Allowed"_$CHAR(30)
+8 SET BNII=BNII+1
+9 SET BNIUSER=$PIECE(BNISTR,P)
+10 SET BNISITE=$PIECE(BNISTR,P,2)
+11 IF $DATA(^BNISITE("ACP",BNISITE,BNIUSER))
SET BNIA=1
+12 SET ^BNITMP($JOB,BNII)=BNIA_$CHAR(30)
+13 SET ^BNITMP($JOB,BNII+1)=$CHAR(31)
+14 QUIT
+15 ;
REC(BNIRET,BNISTR) ;-- list of records the user is allowed to see
+1 SET X="MERR^BNIGU"
SET @^%ZOSF("TRAP")
+2 NEW P,BNIALL,BNIDA,BNIIEN,BNIUSR,BNII,R
+3 SET P="|"
SET R="~"
+4 SET BNISITE=$PIECE(BNISTR,P)
+5 SET BNIRET="^BNITMP("_$JOB_")"
+6 SET BNII=0
+7 SET ^BNITMP($JOB,BNII)="T00007BMXIEN^T00020Date of Activity^T00003Provider^T00020Date Created^T00030Created By^T00030Last Edited By^T00020Date Last Edited^T00030Location Where Record Created^T00030Location^T00030Person Performing Activity^"
+8 SET ^BNITMP($JOB,BNII)=^BNITMP($JOB,BNII)_"T00010Total Time Spent^T00050General Health Concern^T00100Specific Health Topic^T00050Type of Activity^T00050Group Served^T00060Activity Setting^T00050Community Within Service Area^"
+9 SET ^BNITMP($JOB,BNII)=^BNITMP($JOB,BNII)_"T00010Travel Time in Minutes^T00010Number Served^T00010Month^T00004Year^T00064General Health Concern (Other)^T00064Specific Health Topic (Other)^T00064Type of Activity (Other)^T00064Group Served (Other
)"
+10 SET ^BNITMP($JOB,BNII)=^BNITMP($JOB,BNII)_$CHAR(30)
+11 SET BNIDA=0
FOR
SET BNIDA=$ORDER(^BNIREC("AE",BNIDA))
IF 'BNIDA
QUIT
Begin DoDot:1
+12 NEW BNIIEN
+13 SET BNIIEN=0
FOR
SET BNIIEN=$ORDER(^BNIREC("AE",BNIDA,BNIIEN))
IF 'BNIIEN
QUIT
Begin DoDot:2
+14 NEW BNIDATA,BNIDATA1,BNIDATA2
+15 IF '$$ALLOW^BNIE(BNIIEN)
QUIT
+16 SET BNIDATA=$GET(^BNIREC(BNIIEN,0))
+17 SET BNIDATA1=$GET(^BNIREC(BNIIEN,11))
+18 SET BNIDATA2=$GET(^BNIREC(BNIIEN,12))
+19 SET BNII=BNII+1
+20 NEW BNI01,BNI02,BNI03,BNI04,BNI05,BNI06,BNI07,BNI08,BNI09,BNI11,BNI12,BNI13,BNI14,BNI15,BNI16,BNI17,BNI18,BNI19,BNI21,BNI1101,BNI1102,BNI1103,BNI1201
+21 SET BNI01=$PIECE(BNIDATA,U)
+22 SET BNI02=$PIECE(BNIDATA,U,2)
+23 SET BNI03=$SELECT($PIECE(BNIDATA,U,3):$PIECE(BNIDATA,U,3)_R_$PIECE(^VA(200,$PIECE(BNIDATA,U,3),0),U),1:"")
+24 SET BNI04=$SELECT($PIECE(BNIDATA,U,4):$PIECE(BNIDATA,U,4)_R_$PIECE(^VA(200,$PIECE(BNIDATA,U,4),0),U),1:"")
+25 SET BNI05=$PIECE(BNIDATA,U,5)
+26 SET BNI06=$SELECT($PIECE(BNIDATA,U,6):$PIECE(BNIDATA,U,6)_R_$PIECE(^AUTTLOC($PIECE(BNIDATA,U,6),0),U),1:"")
+27 SET BNI07=$SELECT($PIECE(BNIDATA,U,7):$PIECE(BNIDATA,U,7)_R_$PIECE(^AUTTLOC($PIECE(BNIDATA,U,7),0),U),1:"")
+28 SET BNI08=$SELECT($PIECE(BNIDATA,U,8):$PIECE(BNIDATA,U,8)_R_$PIECE(^VA(200,$PIECE(BNIDATA,U,8),0),U),1:"")
+29 SET BNI09=$PIECE(BNIDATA,U,9)
+30 SET BNI11=$SELECT($PIECE(BNIDATA,U,11):$PIECE(BNIDATA,U,11)_R_$PIECE(^BNIGHC($PIECE(BNIDATA,U,11),0),U),1:"")
+31 SET BNI12=$SELECT($PIECE(BNIDATA,U,12):$PIECE(BNIDATA,U,12)_R_$PIECE(^BNISHT($PIECE(BNIDATA,U,12),0),U),1:"")
+32 SET BNI13=$SELECT($PIECE(BNIDATA,U,13):$PIECE(BNIDATA,U,13)_R_$PIECE(^BNITOA($PIECE(BNIDATA,U,13),0),U),1:"")
+33 SET BNI14=$SELECT($PIECE(BNIDATA,U,14):$PIECE(BNIDATA,U,14)_R_$PIECE(^BNIGS($PIECE(BNIDATA,U,14),0),U),1:"")
+34 SET BNI15=$SELECT($PIECE(BNIDATA,U,15):$PIECE(BNIDATA,U,15)_R_$PIECE(^BNIAS($PIECE(BNIDATA,U,15),0),U),1:"")
+35 SET BNI16=$SELECT($PIECE(BNIDATA,U,16):$PIECE(BNIDATA,U,16)_R_$PIECE(^AUTTCOM($PIECE(BNIDATA,U,16),0),U),1:"")
+36 SET BNI17=$PIECE(BNIDATA,U,17)
+37 SET BNI18=$PIECE(BNIDATA,U,18)
+38 SET BNI19=$PIECE(BNIDATA,U,19)
+39 SET BNI21=$PIECE(BNIDATA,U,21)
+40 SET BNI1101=$PIECE(BNIDATA1,U)
+41 SET BNI1102=$PIECE(BNIDATA1,U,2)
+42 SET BNI1103=$PIECE(BNIDATA1,U,3)
+43 SET BNI1201=$PIECE(BNIDATA2,U)
+44 SET BNIINIT=$SELECT($PIECE(BNIDATA,U,8):$PIECE(^VA(200,$PIECE(BNIDATA,U,8),0),U,2),1:"")
+45 IF BNIINIT=""
SET BNIINIT="???"
+46 SET ^BNITMP($JOB,BNII)=BNIIEN_U_BNI01_U_BNIINIT_U_BNI02_U_BNI03_U_BNI04_U_BNI05_U_BNI06_U_BNI07_U_BNI08_U_BNI09_U_BNI11_U_BNI12_U_BNI13_U_BNI14_U_BNI15_U_BNI16_U_BNI17_U_BNI18_U_BNI19_U_BNI21_U_BNI1101_U_BNI1102_U_BNI1103_U_BNI1
201_$CHAR(30)
End DoDot:2
End DoDot:1
+47 SET ^BNITMP($JOB,BNII+1)=$CHAR(31)
+48 QUIT
+49 ;
CATSTR(BNISRET,STR) ;EP -- concatenate string
+1 NEW BNIDA
+2 SET BNISRET=""
+3 SET BNIDA=0
FOR
SET BNIDA=$ORDER(STR(BNIDA))
IF 'BNIDA
QUIT
Begin DoDot:1
+4 SET BNISRET=BNISRET_$GET(STR(BNIDA))
End DoDot:1
+5 QUIT
+6 ;
AC(BNIRET,BNISTR) ;-- additional comments?
+1 SET X="MERR^BNIGU"
SET @^%ZOSF("TRAP")
+2 NEW P
+3 SET P="|"
+4 KILL ^BNITMP($JOB)
+5 SET BNIRET="^BNITMP("_$JOB_")"
+6 NEW BNII,BNIIEN
+7 SET BNII=0
+8 SET BNIIEN=$PIECE(BNISTR,P)
+9 SET ^BNITMP($JOB,BNII)="T00001NOTES"_$CHAR(30)
+10 IF $DATA(^BNIREC(BNIIEN,14,1))
Begin DoDot:1
+11 SET BNII=BNII+1
+12 SET ^BNITMP($JOB,BNII)=1_$CHAR(30)
End DoDot:1
+13 SET ^BNITMP($JOB,BNII+1)=$CHAR(31)
+14 QUIT
+15 ;
SHT(BNIRET,BNISTR) ;-- get specific health topic based on Ghc passed in?
+1 SET X="MERR^BNIGU"
SET @^%ZOSF("TRAP")
+2 NEW P
+3 SET P="|"
+4 KILL ^BNITMP($JOB)
+5 SET BNIRET="^BNITMP("_$JOB_")"
+6 NEW BNII,BNIIEN
+7 SET BNII=0
+8 SET BNIGHC=$PIECE(BNISTR,P)
+9 SET ^BNITMP($JOB,BNII)="T00001Specific Health Topic"_$CHAR(30)
+10 SET BNII=BNII+1
+11 SET ^BNITMP($JOB,BNII)=$$SHTP(BNIGHC)_$CHAR(30)
+12 SET ^BNITMP($JOB,BNII+1)=$CHAR(31)
+13 QUIT
+14 ;
SHTP(G) ;EP - called from screenman screen
+1 IF $GET(G)=""
QUIT ""
+2 NEW X
+3 SET X=$ORDER(^BNISHT("AA",G,1,0))
+4 IF X
IF $DATA(^BNISHT(X,0))
QUIT X_"~"_$PIECE(^BNISHT(X,0),U,1)
+5 QUIT ""
+6 ;
SITE(RETVAL) ;-- return site parameter
+1 SET X="MERR^BNIGU"
SET @^%ZOSF("TRAP")
+2 NEW BNIDA,BNINS,P,BNIDATA,BNIKEYI,BNIKEY,BNII,R
+3 SET BNII=0
+4 KILL ^BNITMP($JOB)
+5 SET RETVAL="^BNITMP("_$JOB_")"
+6 SET ^BNITMP($JOB,BNII)="T00007BMXIEN^T00030Site^T00001Activity Setting^T00030Taxonomy"_$CHAR(30)
+7 SET P="|"
SET R="~"
+8 SET BNIDA=0
FOR
SET BNIDA=$ORDER(^BNISITE(BNIDA))
IF 'BNIDA
QUIT
Begin DoDot:1
+9 NEW BNIDATA,BNISTE,BNITX,BNIRAS
+10 SET BNIDATA=$GET(^BNISITE(BNIDA,0))
+11 SET BNIRAS=$PIECE(BNIDATA,U,2)
+12 SET BNISTE=$PIECE(^DIC(4,$PIECE(BNIDATA,U),0),U)
+13 IF $PIECE(BNIDATA,U,3)
SET BNITX=$PIECE(BNIDATA,U,3)_R_$PIECE(^ATXAX($PIECE(BNIDATA,U,3),0),U)
+14 SET BNII=BNII+1
+15 SET ^BNITMP($JOB,BNII)=BNIDA_U_BNIDA_R_BNISTE_U_BNIRAS_U_$GET(BNITX)_$CHAR(30)
End DoDot:1
+16 SET ^BNITMP($JOB,BNII+1)=$CHAR(31)_$GET(BNIERR)
+17 QUIT
+18 ;
SITEA(RETVAL) ;-- return site parameter
+1 SET X="MERR^BNIGU"
SET @^%ZOSF("TRAP")
+2 NEW BNIDA,BNINS,P,BNIDATA,BNIKEYI,BNIKEY,BNII,R
+3 SET BNII=0
+4 KILL ^BNITMP($JOB)
+5 SET RETVAL="^BNITMP("_$JOB_")"
+6 SET ^BNITMP($JOB,BNII)="T00007BMXIEN^T00030Site"_$CHAR(30)
+7 SET P="|"
SET R="~"
+8 SET BNIDA=0
FOR
SET BNIDA=$ORDER(^BNISITE(BNIDA))
IF 'BNIDA
QUIT
Begin DoDot:1
+9 NEW BNIDATA,BNISTE,BNITX,BNIRAS
+10 SET BNIDATA=$GET(^BNISITE(BNIDA,0))
+11 SET BNIRAS=$PIECE(BNIDATA,U,2)
+12 SET BNISTE=$PIECE(^DIC(4,$PIECE(BNIDATA,U),0),U)
+13 IF $PIECE(BNIDATA,U,3)
SET BNITX=$PIECE(BNIDATA,U,3)_R_$PIECE(^ATXAX($PIECE(BNIDATA,U,3),0),U)
+14 SET BNII=BNII+1
+15 SET ^BNITMP($JOB,BNII)=BNIDA_U_BNISTE_$CHAR(30)
End DoDot:1
+16 SET ^BNITMP($JOB,BNII+1)=$CHAR(31)_$GET(BNIERR)
+17 QUIT
+18 ;
COM(RETVAL,BNISTR) ;-- return communities based on value passed in
+1 SET X="MERR^BNIGU"
SET @^%ZOSF("TRAP")
+2 NEW BNIDA,BNINS,P,BNIDATA,BNIKEYI,BNIKEY,BNII,R
+3 SET BNII=0
+4 KILL ^BNITMP($JOB)
+5 SET RETVAL="^BNITMP("_$JOB_")"
+6 SET ^BNITMP($JOB,BNII)="T00007BMXIEN^T00030Community^T00030State"_$CHAR(30)
+7 SET P="|"
SET R="~"
+8 SET BNIST=$PIECE(BNISTR,P)
+9 SET BNIDA=0
FOR
SET BNIDA=$ORDER(^BNISITE(BNIST,11,BNIDA))
IF 'BNIDA
QUIT
Begin DoDot:1
+10 NEW BNIDATA,BNICOM,BNISTA
+11 SET BNIDATA=$GET(^BNISITE(BNIST,11,BNIDA,0))
+12 SET BNICOM=$PIECE(^AUTTCOM(BNIDATA,0),U)
+13 SET BNISTA=$PIECE($GET(^DIC(5,$PIECE(^AUTTCOM(BNIDATA,0),U,3),0)),U)
+14 SET BNII=BNII+1
+15 SET ^BNITMP($JOB,BNII)=BNIDATA_U_BNICOM_U_BNISTA_$CHAR(30)
End DoDot:1
+16 SET ^BNITMP($JOB,BNII+1)=$CHAR(31)_$GET(BNIERR)
+17 QUIT
+18 ;
USRS(RETVAL,BNISTR) ;-- return users based on value passed in
+1 SET X="MERR^BNIGU"
SET @^%ZOSF("TRAP")
+2 NEW BNIDA,BNINS,P,BNIDATA,BNIKEYI,BNIKEY,BNII,R
+3 SET BNII=0
+4 KILL ^BNITMP($JOB)
+5 SET RETVAL="^BNITMP("_$JOB_")"
+6 SET ^BNITMP($JOB,BNII)="T00007BMXIEN^T00030Users"_$CHAR(30)
+7 SET P="|"
SET R="~"
+8 SET BNIST=$PIECE(BNISTR,P)
+9 SET BNIDA=0
FOR
SET BNIDA=$ORDER(^BNISITE(BNIST,12,BNIDA))
IF 'BNIDA
QUIT
Begin DoDot:1
+10 NEW BNIDATA,BNIUSR
+11 SET BNIDATA=$GET(^BNISITE(BNIST,12,BNIDA,0))
+12 SET BNIUSR=$PIECE(^VA(200,BNIDATA,0),U)
+13 SET BNII=BNII+1
+14 SET ^BNITMP($JOB,BNII)=BNIDATA_U_BNIUSR_$CHAR(30)
End DoDot:1
+15 SET ^BNITMP($JOB,BNII+1)=$CHAR(31)_$GET(BNIERR)
+16 QUIT
+17 ;
MERR ;ERROR TRAP
+1 NEW X
+2 XECUTE ("S X=$"_"ZE")
+3 SET X="MUMPS error: """_X_""""
+4 DO ERR(X)
+5 QUIT
+6 ;
ERR(ERR) ;ERROR PROCESSOR
+1 NEW X
+2 SET X="ERROR|"_ERR_$CHAR(30)
+3 SET @BNIRET@(1)=X
+4 QUIT
+5 ;
CMT(BNIRET,BNISTR) ;-- return additional comments
+1 SET X="MERR^BNIGU"
SET @^%ZOSF("TRAP")
+2 NEW P,BNII,BNIREC,BNIDA
+3 SET P="|"
+4 KILL ^BNITMP($JOB)
+5 SET BNIRET="^BNITMP("_$JOB_")"
+6 SET BNII=0
+7 SET BNIREC=$PIECE(BNISTR,P)
+8 SET ^BNITMP($JOB,BNII)="T000250Comments"_$CHAR(30)
+9 SET BNIDA=0
FOR
SET BNIDA=$ORDER(^BNIREC(BNIREC,14,BNIDA))
IF 'BNIDA
QUIT
Begin DoDot:1
+10 NEW BNION
+11 SET BNII=BNII+1
+12 SET BNION=$PIECE($GET(^BNIREC(BNIREC,14,BNIDA,0)),U)
+13 SET ^BNITMP($JOB,BNII)=BNION_$CHAR(30)
End DoDot:1
+14 SET ^BNITMP($JOB,BNII+1)=$CHAR(31)_$GET(BNIERR)
+15 QUIT
+16 ;
DISP(BNIRET,BNISTR) ;-- display a record
+1 SET X="MERR^BNIGU"
SET @^%ZOSF("TRAP")
+2 NEW P,BNII,BNIREC,BNIDA
+3 SET P="|"
+4 KILL ^BNITMP($JOB)
+5 SET BNIRET="^BNITMP("_$JOB_")"
+6 SET BNII=0
+7 SET BNIREC=$PIECE(BNISTR,P)
+8 SET ^BNITMP($JOB,BNII)="T000250Text"_$CHAR(30)
+9 DO EN^BNIRDSG(BNIREC,"",1)
+10 SET BNIDA=0
FOR
SET BNIDA=$ORDER(^TMP("BNIVDSG",$JOB,BNIDA))
IF 'BNIDA
QUIT
Begin DoDot:1
+11 NEW BNION
+12 SET BNII=BNII+1
+13 SET BNION=$GET(^TMP("BNIVDSG",$JOB,BNIDA,0))
+14 SET ^BNITMP($JOB,BNII)=BNION_$CHAR(30)
End DoDot:1
+15 SET ^BNITMP($JOB,BNII+1)=$CHAR(31)_$GET(BNIERR)
+16 QUIT
+17 ;
TBL(BNIRET,BNISTR) ;-- print table listings
+1 SET X="MERR^BNIGU"
SET @^%ZOSF("TRAP")
+2 NEW P,BNII,BNIREC,BNIDA,BNISORT,BNIRTN
+3 SET P="|"
+4 KILL ^BNITMP($JOB)
+5 SET BNIRET="^BNITMP("_$JOB_")"
+6 SET BNII=0
+7 SET BNIREC=$PIECE(BNISTR,P)
+8 SET BNISORT=$PIECE(BNISTR,P,2)
+9 IF BNIREC="General Public Health Concern"
SET BNIRTN="PRINT^BNITGHC"
+10 IF BNIREC="Specific Health Topic"
SET BNIRTN="PRINT^BNITSHT"
+11 IF BNIREC="Type of Activity"
SET BNIRTN="PRINT^BNITTOA"
+12 IF BNIREC="Group Served"
SET BNIRTN="PRINT^BNITGS"
+13 IF BNIREC="Activity Setting"
SET BNIRTN="PRINT^BNITAS"
+14 SET ^BNITMP($JOB,BNII)="T00080Text"_$CHAR(30)
+15 DO GUIR^XBLM(BNIRTN,"^TMP($J,""BNITBL"",")
+16 SET BNIDA=0
FOR
SET BNIDA=$ORDER(^TMP($JOB,"BNITBL",BNIDA))
IF 'BNIDA
QUIT
Begin DoDot:1
+17 NEW BNION
+18 SET BNII=BNII+1
+19 SET BNION=$GET(^TMP($JOB,"BNITBL",BNIDA))
+20 SET ^BNITMP($JOB,BNII)=BNION_$CHAR(30)
End DoDot:1
+21 SET ^BNITMP($JOB,BNII+1)=$CHAR(31)_$GET(BNIERR)
+22 QUIT
+23 ;
GETTAX(BNIRET) ;-- get community taxonomies
+1 SET X="MERR^BNIGU"
SET @^%ZOSF("TRAP")
+2 NEW P,BNIOPT,BNII
+3 SET P="|"
+4 SET BNII=0
+5 KILL ^BNITMP($JOB)
+6 SET BNIRET="^BNITMP("_$JOB_")"
+7 SET ^BNITMP($JOB,BNII)="T00080TAXONOMY NAME"_$CHAR(30)
+8 NEW BNIDA,BNIT
+9 SET BNIFN=9999999.05
+10 SET BNIIEN=0
FOR
SET BNIIEN=$ORDER(^ATXAX("B",BNIIEN))
IF BNIIEN=""
QUIT
Begin DoDot:1
+11 NEW BNIDA
+12 SET BNIDA=0
FOR
SET BNIDA=$ORDER(^ATXAX("B",BNIIEN,BNIDA))
IF 'BNIDA
QUIT
Begin DoDot:2
+13 IF BNIFN]""
IF $PIECE($GET(^ATXAX(BNIDA,0)),U,15)'=BNIFN
QUIT
+14 SET BNII=BNII+1
+15 SET BNIN=$PIECE($GET(^ATXAX(BNIDA,0)),U)
+16 SET BNIRO=$SELECT($PIECE($GET(^ATXAX(BNIDA,0)),U,22):"Read Only",1:"Editable")
+17 SET BNIFL=$PIECE($GET(^ATXAX(BNIDA,0)),U,15)
+18 SET BNIFLT=$SELECT(BNIFL=50:"Med",1:"Tax")
+19 SET ^BNITMP($JOB,BNII)=BNIN_"("_BNIRO_"/"_BNIFLT_"/"_BNIFL_")"_$CHAR(30)
End DoDot:2
End DoDot:1
+20 SET ^BNITMP($JOB,BNII+1)=$CHAR(31)
+21 QUIT
+22 ;
RPT(RETVAL,BNISTR) ;-- get the report and queue
+1 SET X="MERR^BNIGU"
SET @^%ZOSF("TRAP")
+2 NEW P,BNIREP,BNIBG,BNIED,BNILR,BNIRDT,BNIRTN,BNII
+3 SET P="|"
+4 SET BNIH=$TRANSLATE($HOROLOG,",")
+5 SET BNIJ=$JOB
+6 SET BNIREP=$PIECE(BNISTR,P)
+7 SET BNIBG=$PIECE(BNISTR,P,2)
+8 SET BNIED=$PIECE(BNISTR,P,3)
+9 SET BNILR=$PIECE(BNISTR,P,4)
+10 SET BNIRDT=$PIECE(BNISTR,P,5)
+11 IF BNIREP="PHC"
SET BNIRTN="BNIG^BNIRP2(.BNIERR,BNIJ,BNIH,BNIBG,BNIED,BNILR,BNIRDT)"
+12 IF BNIREP="SHT"
SET BNIRTN="BNIG^BNIRP3(.BNIERR,BNIJ,BNIH,BNIBG,BNIED,BNILR,BNIRDT)"
+13 IF BNIREP="TOA"
SET BNIRTN="BNIG^BNIRP4(.BNIERR,BNIJ,BNIH,BNIBG,BNIED,BNILR,BNIRDT)"
+14 IF BNIREP="ACS"
SET BNIRTN="BNIG^BNIRP5(.BNIERR,BNIJ,BNIH,BNIBG,BNIED,BNILR,BNIRDT)"
+15 IF BNIREP="GPE"
SET BNIRTN="BNIG^BNIRP6(.BNIERR,BNIJ,BNIH,BNIBG,BNIED,BNILR,BNIRDT)"
+16 IF BNIREP="TSD"
SET BNIRTN="BNIG^BNIRP7(.BNIERR,BNIJ,BNIH,BNIBG,BNIED,BNILR,BNIRDT)"
+17 SET BNII=0
+18 SET RETVAL="^BNITMP("_$JOB_")"
+19 KILL ^BNITMP($JOB)
+20 SET ^BNITMP($JOB,0)="T00007BMXIEN^T00050Error"_$CHAR(30)
+21 SET BNIGUI=1
+22 DO @BNIRTN
+23 SET ^BNITMP($JOB,1)=+$GET(BNIERR)_U_$CHAR(30)
+24 SET ^BNITMP($JOB,2)=$CHAR(31)
+25 KILL BNIGUI
+26 QUIT
+27 ;
PPARPT(RETVAL,BNISTR) ;-- queue the PPA Report
+1 SET X="MERR^BNIGU"
SET @^%ZOSF("TRAP")
+2 NEW P,BNIREP,BNIBG,BNIED,BNILR,BNIRDT,BNIRTN,BNII,BNITYP,BNISUB,R,BNIPRVS
+3 SET P="|"
SET R="~"
+4 SET BNIH=$TRANSLATE($HOROLOG,",")
+5 SET BNIJ=$JOB
+6 SET BNIREP=$PIECE(BNISTR,P)
+7 SET BNIBG=$PIECE(BNISTR,P,2)
+8 SET BNIED=$PIECE(BNISTR,P,3)
+9 SET BNILR=$PIECE(BNISTR,P,4)
+10 SET BNIRDT=$PIECE(BNISTR,P,5)
+11 SET BNITYP=$PIECE(BNISTR,P,6)
+12 SET BNISUB=$PIECE(BNISTR,P,7)
+13 SET BNIPRV=$PIECE(BNISTR,P,8)
+14 SET BNIPRVS=""
+15 NEW I
+16 FOR I=1:1
Begin DoDot:1
+17 IF $PIECE(BNIPRV,R,I)=""
QUIT
+18 SET BNIPRVS(+$PIECE(BNIPRV,R,I))=""
End DoDot:1
IF $PIECE(BNIPRV,R,I)=""
QUIT
+19 SET BNII=0
+20 SET RETVAL="^BNITMP("_$JOB_")"
+21 KILL ^BNITMP($JOB)
+22 SET BNIGUI=1
+23 SET ^BNITMP($JOB,0)="T00007BMXIEN^T00050Error"_$CHAR(30)
+24 DO BNIG^BNIRP1(.BNIERR,BNIJ,BNIH,BNIBG,BNIED,BNILR,BNIRDT,BNITYP,BNISUB,.BNIPRVS)
+25 SET ^BNITMP($JOB,1)=+$GET(BNIERR)_U_$CHAR(30)
+26 SET ^BNITMP($JOB,2)=$CHAR(31)
+27 KILL BNIGUI
+28 QUIT
+29 ;
DELRPT(RETVAL,BNISTR) ;-- delete a report
+1 SET X="MERR^BNIGU"
SET @^%ZOSF("TRAP")
+2 NEW P,R,I
+3 SET P="|"
SET R="~"
+4 SET BNIERR=""
+5 KILL ^BNITMP($JOB)
+6 SET RETVAL="^BNITMP("_$JOB_")"
+7 NEW BNII
FOR I=2:1
Begin DoDot:1
+8 ;N BNII
+9 IF $PIECE(BNISTR,R,I)=""
QUIT
+10 SET BNII=$PIECE(BNISTR,R,I)
+11 SET DIK="^BNIGUI("
SET DA=BNII
DO ^DIK
End DoDot:1
IF $PIECE(BNISTR,R,I)=""
QUIT
+12 SET ^BNITMP($JOB,0)="T00250DATA"_$CHAR(30)
+13 SET ^BNITMP($JOB,1)=$GET(BNIERR)_$CHAR(30)
+14 SET ^BNITMP($JOB,2)=$CHAR(31)_BNIERR
+15 QUIT
+16 ;
REP(BNIRET,BNISTR) ;-- return Report Output
+1 SET X="MERR^BNIGU"
SET @^%ZOSF("TRAP")
+2 NEW P,BNII,BNIDA,BNIFL,BNIRIEN
+3 SET P="|"
+4 SET BNIRIEN=$PIECE(BNISTR,P)
+5 SET BNIRET="^BNITMP("_$JOB_")"
+6 SET BNII=0
+7 SET ^BNITMP($JOB,BNII)="T00250DATA"_$CHAR(30)
+8 SET BNIDA=0
FOR
SET BNIDA=$ORDER(^BNIGUI(BNIRIEN,11,BNIDA))
IF 'BNIDA
QUIT
Begin DoDot:1
+9 SET BNII=BNII+1
+10 SET ^BNITMP($JOB,BNII)=$GET(^BNIGUI(BNIRIEN,11,BNIDA,0))_$CHAR(30)
End DoDot:1
+11 SET ^BNITMP($JOB,BNII+1)=$CHAR(31)_$GET(BNIERR)
+12 QUIT
+13 ;
XL(BNIRET,BNISTR) ;-- return to excel
+1 SET X="MERR^BNIGU"
SET @^%ZOSF("TRAP")
+2 NEW P,BNII,BNIDA,BNIFL,BNIRIEN
+3 SET P="|"
+4 SET BNIRIEN=$PIECE(BNISTR,P)
+5 SET BNIRET="^BNITMP("_$JOB_")"
+6 KILL ^BNITMP($JOB)
+7 SET BNII=0
+8 SET ^BNITMP($JOB,BNII)="T00250DATA"_$CHAR(30)
+9 SET BNIDA=0
FOR
SET BNIDA=$ORDER(^BNIGUI(BNIRIEN,12,BNIDA))
IF 'BNIDA
QUIT
Begin DoDot:1
+10 SET BNII=BNII+1
+11 SET ^BNITMP($JOB,BNII)=$TRANSLATE($GET(^BNIGUI(BNIRIEN,12,BNIDA,0)),"^","~")_$CHAR(30)
End DoDot:1
+12 SET ^BNITMP($JOB,BNII+1)=$CHAR(31)_$GET(BNIERR)
+13 QUIT
+14 ;
