BNIGU.m

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