BGP3ELHH ; IHS/CMI/LAB - cover page for ELDER 25 Jun 2010 10:20 AM ;
;;13.0;IHS CLINICAL REPORTING;;NOV 20, 2012;Build 81
;
;
S X="Cover Page" D S(X,1,1)
S X=" " D S(X,1,1)
I $G(BGPAREAA) G AREACP
S X="*** IHS 2013 Elder Care Report ***" D S(X,1,1)
S X=$$RPTVER^BGP3BAN D S(X,1,1)
S X="Date Report Run: "_$$FMTE^XLFDT(DT) D S(X,1,1)
S X="Site where Run: "_$P(^DIC(4,DUZ(2),0),U) D S(X,1,1)
S X="Report Generated by: "_$$USR D S(X,1,1)
S X="Reporting Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED) S X=X D S(X,1,1)
S X="Previous Year Period: "_$$FMTE^XLFDT(BGPPBD)_" to "_$$FMTE^XLFDT(BGPPED) S X=X D S(X,1,1)
S X="Baseline Period: "_$$FMTE^XLFDT(BGPBBD)_" to "_$$FMTE^XLFDT(BGPBED) S X=X D S(X,1,1)
S X=" " D S(X,1,1)
I BGPZZ="A" S X="Measures: Elder Care Performance Measures" D S(X,1,1)
I BGPZZ="S" S X="Measures: Selected Elder Care Performance Measures (User Defined)" D S(X,1,1)
S X="Population: "_$S(BGPBEN=1:"AI/AN Only (Classification 01)",BGPBEN=2:"non AI/AN Only (Classification NOT 01)",BGPBEN=3:"All (Both AI/AN and non AI/AN)",1:"") D S(X,1,1)
S X=" " D S(X,1,1)
D ENDTIME
D ELDERHDR
S X=" " D S(X,1,1)
I $G(BGPEXPT) D
.S X="A file will be created called BG130"_$P(^AUTTLOC(DUZ(2),0),U,10)_".EL"_BGPRPT_"." D S(X,1,1) S X="It will reside in the public/export directory. This file should be sent to your Area Office." D S(X,1,1)
I BGPROT'="P",'$D(BGPGUI) D
.S X="A delimited output file called "_BGPDELF D S(X,1,1) S X="has been placed in the "_$$GETDEDIR^BGP3UTL2()_" directory for your use in Excel or some other software package." D
..D S(X,1,1) S X="See your site manager to access this file." D S(X,1,1)
S X=" " D S(X,1,1)
S X="Community Taxonomy Name: "_$P(^ATXAX(BGPTAXI,0),U) D S(X,1,1)
S X="The following communities are included in this report:" D S(X,1,1) D
.S BGPZZ="",N=0,Y="" F S BGPZZ=$O(BGPTAX(BGPZZ)) Q:BGPZZ="" S N=N+1,Y=Y_$S(N=1:"",1:";")_BGPZZ
.S BGPZZ=0,C=0 F BGPZZ=1:3:N D
..S X=$E($P(Y,";",BGPZZ),1,20),$P(X,U,2)=$E($P(Y,";",(BGPZZ+1)),1,20),$P(X,U,3)=$E($P(Y,";",(BGPZZ+2)),1,20) D S(X,1,1)
..Q
S X=" " D S(X,1,1)
I $G(BGPMFITI) S X="MFI Visit Location Taxonomy Name: "_$P(^ATXAX(BGPMFITI,0),U) D S(X,1,1)
I $G(BGPMFITI) S X="The following locations are used for patient visits in this report:" D S(X,1,1) D
.S BGPZZ="",N=0,Y="" F S BGPZZ=$O(^ATXAX(BGPMFITI,21,"B",BGPZZ)) Q:BGPZZ="" S N=N+1,Y=Y_$S(N=1:"",1:";")_$P($G(^DIC(4,BGPZZ,0)),U)
.S BGPZZ=0,C=0 F BGPZZ=1:3:N D
..S X=$E($P(Y,";",BGPZZ),1,20),$P(X,U,2)=$E($P(Y,";",(BGPZZ+1)),1,20),$P(X,U,3)=$E($P(Y,";",(BGPZZ+2)),1,20) D S(X,1,1)
..Q
S X=" " D S(X,1,1)
K BGPX,BGPQUIT
Q
ELDERHDR ;
S X=" " D S(X,1,1)
;Q:$G(BGPSEAT)
S BGPNODEP=$S(BGPCHSO:26,1:22)
S BGPNODEP=$S(BGPURBAN:52,1:BGPNODEP)
S BGPX=$O(^BGPCTRL("B",2013,0))
S BGPY=0 F S BGPY=$O(^BGPCTRL(BGPX,BGPNODEP,BGPY)) Q:BGPY'=+BGPY D
.S X=^BGPCTRL(BGPX,BGPNODEP,BGPY,0) D S(X,1,1)
.Q
Q
ENDTIME ;
I $D(BGPET) S BGPTS=(86400*($P(BGPET,",")-$P(BGPBT,",")))+($P(BGPET,",",2)-$P(BGPBT,",",2)),BGPHR=$P(BGPTS/3600,".") S:BGPHR="" BGPHR=0 D
.S BGPTS=BGPTS-(BGPHR*3600),BGPM=$P(BGPTS/60,".") S:BGPM="" BGPM=0 S BGPTS=BGPTS-(BGPM*60),BGPS=BGPTS S X="RUN TIME (H.M.S): "_BGPHR_"."_BGPM_"."_BGPS D S(X,1,1)
Q
AREACP ;EP - area cover page
S X="*** IHS 2013 Elder Care Report ***" D S(X,1,1)
S X="AREA AGGREGATE" D S(X,1,1)
S X=$$RPTVER^BGP3BAN D S(X,1,1)
S X="Date Report Run: "_$$FMTE^XLFDT(DT) D S(X,1,1)
S X="Site where Run: "_$$VAL^XBDIQ1(9999999.06,DUZ(2),.04) D S(X,1,1)
S X="Report Generated by: "_$$USR D S(X,1,1)
S X="Reporting Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED) D S(X,1,1)
S X="Previous Year Period: "_$$FMTE^XLFDT(BGPPBD)_" to "_$$FMTE^XLFDT(BGPPED) D S(X,1,1)
S X="Baseline Period: "_$$FMTE^XLFDT(BGPBBD)_" to "_$$FMTE^XLFDT(BGPBED) D S(X,1,1)
S X=" " D S(X,1,1)
S X="Measures: Elder Care Performance Measures" D S(X,1,1)
I BGPRTYPE'=1 S X="Population: "_$S(BGPBEN=1:"AI/AN Only (Classification 01)",BGPBEN=2:"non AI/AN Only (Classification NOT 01)",BGPBEN=3:"All (Both AI/AN and non AI/AN)",1:"") D S(X,1,1)
S X=" " D S(X,1,1)
D ENDTIME
S X=" " D S(X,1,1)
S BGPCHSO="",X=0 F S X=$O(BGPSUL(X)) Q:X'=+X I $P(^BGPELDCH(X,0),U,17) S BGPCHSO=1
S BGPCHSN="",X=0 F S X=$O(BGPSUL(X)) Q:X'=+X I '$P(^BGPELDCH(X,0),U,17) S BGPCHSN=1
S BGPURBO="",X=0 F S X=$O(BGPSUL(X)) Q:X'=+X I $P(^BGPELDCH(X,0),U,19) S BGPURBO=1
S BGPURBN="",X=0 F S X=$O(BGPSUL(X)) Q:X'=+X I '$P(^BGPELDCH(X,0),U,19) S BGPURBN=1
D ELDHDRA
S X=" " D S(X,1,1)
I BGPROT'="P",'$D(BGPGUI) D
.S X="A delimited output file called "_BGPDELF D S(X,1,1) S X="has been placed in the "_$$GETDEDIR^BGP3UTL2()_" directory for your use in Excel or some" D S(X,1,1) D
..S X="other software package. See your site manager to access this file." D S(X,1,1)
S X=" " D S(X,1,1)
S X="Report includes data from the following facilities:" D S(X,1,1)
NEW BGPX
S BGPX="",BGPC=0 F S BGPX=$O(BGPSUL(BGPX)) Q:BGPX="" D
.S X=$P(^BGPELDCH(BGPX,0),U,9),X=$O(^AUTTLOC("C",X,0)) S X=$S(X:$P(^DIC(4,X,0),U),1:"?????")
.S BGPC=BGPC+1,X=BGPC_". "_$S($P(^BGPELDCH(BGPX,0),U,17):"*",1:"")_X D S(X,1,1)
.Q
S X=" " D S(X,1,1)
S X="The following communities are included in this report:" D S(X,1,1)
S BGPX="",BGPC=0 F S BGPX=$O(BGPSUL(BGPX)) Q:BGPX="" D
.S X=$P(^BGPELDCH(BGPX,0),U,9),X=$O(^AUTTLOC("C",X,0)) S X=$S(X:$P(^DIC(4,X,0),U),1:"?????")
.S BGPC=BGPC+1,X=BGPC_". "_$S($P(^BGPELDCH(BGPX,0),U,17):"*",1:"")_X D S(X,1,1)
.;S X="Communities: " D S(X,1,1)
.S X="Community Taxonomy Name: "_$P(^BGPELDCH(BGPX,0),U,18) D S(X,1,1)
.;W !?5,"Communities: "
.S X=0,N=0,Y="",Z="" F S X=$O(^BGPELDCH(BGPX,9999,X)) Q:X'=+X S N=N+1,Y=Y_$S(N=1:"",1:";")_$P(^BGPELDCH(BGPX,9999,X,0),U)
.S X=0,C=0 F X=1:3:N S Z=$E($P(Y,";",X),1,20),$P(Z,U,2)=$E($P(Y,";",(X+1)),1,20),$P(Z,U,3)=$E($P(Y,";",(X+2)),1,20) D S(Z,1,1)
.I $O(^BGPELDCH(BGPX,1111,0)) D
..S X=" " D S(X,1,1)
..S X="MFI Site: Locations for visits: " D S(X,1,1) S X=0,N=0,Y="",Z="" F S X=$O(^BGPELDCH(BGPX,1111,X)) Q:X'=+X S N=N+1,Y=Y_$S(N=1:"",1:";")_$P(^BGPELDCH(BGPX,1111,X,0),U)
..S X=0,C=0 F X=1:3:N S Z=$E($P(Y,";",X),1,20),$P(Z,U,2)=$E($P(Y,";",(X+1)),1,20),$P(Z,U,3)=$E($P(Y,";",(X+2)),1,20) D S(Z,1,1)
..Q
.S X=" " D S(X,1,1)
.Q
S X=" " D S(X,1,1)
I BGPCHSO D
.S X=" " D S(X,1,1) S X="* CHS-only site. Uses Active Clinical CHS Population definition vs. Active Clinical." D S(X,1,1)
I BGPURBO D
.S X=" " D S(X,1,1) S X="**Urban Outreach & Referral-only site. Uses Active Clinical Behavioral Health Population definition vs. Active Clinical" D S(X,1,1)
S X=" " D S(X,1,1)
Q
S(Y,F,P) ;set up array
I '$G(F) S F=0
S %=$P(^TMP($J,"BGPDEL",0),U)+F,$P(^TMP($J,"BGPDEL",0),U)=%
I '$D(^TMP($J,"BGPDEL",%)) S ^TMP($J,"BGPDEL",%)=""
S $P(^TMP($J,"BGPDEL",%),U,P)=Y
Q
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;----------
EOP ;EP - End of page.
Q:$E(IOST)'="C"
Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))
NEW DIR
K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
S DIR(0)="E" D ^DIR
Q
;----------
USR() ;EP - Return name of current user from ^VA(200.
Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
;----------
;;
ELDHDRA ;EP
S BGPX=$O(^BGPCTRL("B",2013,0))
S BGPNODEP=89 D 2
;D W^BGP3DP("",0,1,BGPPTYPE)
I BGPCHSO S BGPTEXT="CHS" F BGPJ1=1:1 S BGPX=$T(@BGPTEXT+BGPJ1) Q:$P(BGPX,";;",2)="QUIT" D
.S BGPT=$P(BGPX,";;",2)
.D S(BGPT,1,1)
I BGPURBO S BGPTEXT="URB" F BGPJ1=1:1 S BGPX=$T(@BGPTEXT+BGPJ1) Q:$P(BGPX,";;",2)="QUIT" D
.S BGPT=$P(BGPX,";;",2)
.D S(BGPT,1,1)
S BGPTEXT="UP" F BGPJ1=1:1 S BGPX=$T(@BGPTEXT+BGPJ1) Q:$P(BGPX,";;",2)="QUIT" D
.S BGPT=$P(BGPX,";;",2)
.D S(BGPT,1,1)
Q
2 S BGPY=0 F S BGPY=$O(^BGPCTRL(BGPX,BGPNODEP,BGPY)) Q:BGPY'=+BGPY D
.D S(^BGPCTRL(BGPX,BGPNODEP,BGPY,0),1,1)
.Q
Q
;
CHS ;;
;;
;;ACTIVE CLINICAL CHS POPULATION:
;;1. Must reside in a community specified in the community taxonomy used for
;;this report.
;;2. Must be alive on the last day of the Report period.
;;3. User defines: a) Indian/Alaska Natives Only - based on Classification
;;of 01; b) Non AI/AN (not 01); or c) Both.
;;4. Must have 2 CHS visits in the 3 years prior to the end of the Report period.
;;QUIT
;;
URB ;;
;;
;;ACTIVE BEHAVIORAL HEALTH URBAN OUTREACH & REFERRAL POPULATION:
;;1. Must reside in a community specified in the community taxonomy used for
;;this report.
;;2. Must be alive on the last day of the Report period.
;;3. User defines: a) Indian/Alaska Natives Only - based on Classification
;;of 01; b) Non AI/AN (not 01); or c) Both.
;;4. Must have 2 visits to behavioral health or case management clinics in the
;;3 years prior to the end of the Report period.
;;QUIT
;;
UP ;;
;;
;;USER POPULATION:
;;1. Definitions 1-3 above.
;;2. Must have been seen at least once in the 3 years prior to the end of
;;the Report period, regardless of the clinic type.
;;QUIT
;
BGP3ELHH ; IHS/CMI/LAB - cover page for ELDER 25 Jun 2010 10:20 AM ;
+1 ;;13.0;IHS CLINICAL REPORTING;;NOV 20, 2012;Build 81
+2 ;
+3 ;
+4 SET X="Cover Page"
DO S(X,1,1)
+5 SET X=" "
DO S(X,1,1)
+6 IF $GET(BGPAREAA)
GOTO AREACP
+7 SET X="*** IHS 2013 Elder Care Report ***"
DO S(X,1,1)
+8 SET X=$$RPTVER^BGP3BAN
DO S(X,1,1)
+9 SET X="Date Report Run: "_$$FMTE^XLFDT(DT)
DO S(X,1,1)
+10 SET X="Site where Run: "_$PIECE(^DIC(4,DUZ(2),0),U)
DO S(X,1,1)
+11 SET X="Report Generated by: "_$$USR
DO S(X,1,1)
+12 SET X="Reporting Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED)
SET X=X
DO S(X,1,1)
+13 SET X="Previous Year Period: "_$$FMTE^XLFDT(BGPPBD)_" to "_$$FMTE^XLFDT(BGPPED)
SET X=X
DO S(X,1,1)
+14 SET X="Baseline Period: "_$$FMTE^XLFDT(BGPBBD)_" to "_$$FMTE^XLFDT(BGPBED)
SET X=X
DO S(X,1,1)
+15 SET X=" "
DO S(X,1,1)
+16 IF BGPZZ="A"
SET X="Measures: Elder Care Performance Measures"
DO S(X,1,1)
+17 IF BGPZZ="S"
SET X="Measures: Selected Elder Care Performance Measures (User Defined)"
DO S(X,1,1)
+18 SET X="Population: "_$SELECT(BGPBEN=1:"AI/AN Only (Classification 01)",BGPBEN=2:"non AI/AN Only (Classification NOT 01)",BGPBEN=3:"All (Both AI/AN and non AI/AN)",1:"")
DO S(X,1,1)
+19 SET X=" "
DO S(X,1,1)
+20 DO ENDTIME
+21 DO ELDERHDR
+22 SET X=" "
DO S(X,1,1)
+23 IF $GET(BGPEXPT)
Begin DoDot:1
+24 SET X="A file will be created called BG130"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_".EL"_BGPRPT_"."
DO S(X,1,1)
SET X="It will reside in the public/export directory. This file should be sent to your Area Office."
DO S(X,1,1)
End DoDot:1
+25 IF BGPROT'="P"
IF '$DATA(BGPGUI)
Begin DoDot:1
+26 SET X="A delimited output file called "_BGPDELF
DO S(X,1,1)
SET X="has been placed in the "_$$GETDEDIR^BGP3UTL2()_" directory for your use in Excel or some other software package."
Begin DoDot:2
+27 DO S(X,1,1)
SET X="See your site manager to access this file."
DO S(X,1,1)
End DoDot:2
End DoDot:1
+28 SET X=" "
DO S(X,1,1)
+29 SET X="Community Taxonomy Name: "_$PIECE(^ATXAX(BGPTAXI,0),U)
DO S(X,1,1)
+30 SET X="The following communities are included in this report:"
DO S(X,1,1)
Begin DoDot:1
+31 SET BGPZZ=""
SET N=0
SET Y=""
FOR
SET BGPZZ=$ORDER(BGPTAX(BGPZZ))
IF BGPZZ=""
QUIT
SET N=N+1
SET Y=Y_$SELECT(N=1:"",1:";")_BGPZZ
+32 SET BGPZZ=0
SET C=0
FOR BGPZZ=1:3:N
Begin DoDot:2
+33 SET X=$EXTRACT($PIECE(Y,";",BGPZZ),1,20)
SET $PIECE(X,U,2)=$EXTRACT($PIECE(Y,";",(BGPZZ+1)),1,20)
SET $PIECE(X,U,3)=$EXTRACT($PIECE(Y,";",(BGPZZ+2)),1,20)
DO S(X,1,1)
+34 QUIT
End DoDot:2
End DoDot:1
+35 SET X=" "
DO S(X,1,1)
+36 IF $GET(BGPMFITI)
SET X="MFI Visit Location Taxonomy Name: "_$PIECE(^ATXAX(BGPMFITI,0),U)
DO S(X,1,1)
+37 IF $GET(BGPMFITI)
SET X="The following locations are used for patient visits in this report:"
DO S(X,1,1)
Begin DoDot:1
+38 SET BGPZZ=""
SET N=0
SET Y=""
FOR
SET BGPZZ=$ORDER(^ATXAX(BGPMFITI,21,"B",BGPZZ))
IF BGPZZ=""
QUIT
SET N=N+1
SET Y=Y_$SELECT(N=1:"",1:";")_$PIECE($GET(^DIC(4,BGPZZ,0)),U)
+39 SET BGPZZ=0
SET C=0
FOR BGPZZ=1:3:N
Begin DoDot:2
+40 SET X=$EXTRACT($PIECE(Y,";",BGPZZ),1,20)
SET $PIECE(X,U,2)=$EXTRACT($PIECE(Y,";",(BGPZZ+1)),1,20)
SET $PIECE(X,U,3)=$EXTRACT($PIECE(Y,";",(BGPZZ+2)),1,20)
DO S(X,1,1)
+41 QUIT
End DoDot:2
End DoDot:1
+42 SET X=" "
DO S(X,1,1)
+43 KILL BGPX,BGPQUIT
+44 QUIT
ELDERHDR ;
+1 SET X=" "
DO S(X,1,1)
+2 ;Q:$G(BGPSEAT)
+3 SET BGPNODEP=$SELECT(BGPCHSO:26,1:22)
+4 SET BGPNODEP=$SELECT(BGPURBAN:52,1:BGPNODEP)
+5 SET BGPX=$ORDER(^BGPCTRL("B",2013,0))
+6 SET BGPY=0
FOR
SET BGPY=$ORDER(^BGPCTRL(BGPX,BGPNODEP,BGPY))
IF BGPY'=+BGPY
QUIT
Begin DoDot:1
+7 SET X=^BGPCTRL(BGPX,BGPNODEP,BGPY,0)
DO S(X,1,1)
+8 QUIT
End DoDot:1
+9 QUIT
ENDTIME ;
+1 IF $DATA(BGPET)
SET BGPTS=(86400*($PIECE(BGPET,",")-$PIECE(BGPBT,",")))+($PIECE(BGPET,",",2)-$PIECE(BGPBT,",",2))
SET BGPHR=$PIECE(BGPTS/3600,".")
IF BGPHR=""
SET BGPHR=0
Begin DoDot:1
+2 SET BGPTS=BGPTS-(BGPHR*3600)
SET BGPM=$PIECE(BGPTS/60,".")
IF BGPM=""
SET BGPM=0
SET BGPTS=BGPTS-(BGPM*60)
SET BGPS=BGPTS
SET X="RUN TIME (H.M.S): "_BGPHR_"."_BGPM_"."_BGPS
DO S(X,1,1)
End DoDot:1
+3 QUIT
AREACP ;EP - area cover page
+1 SET X="*** IHS 2013 Elder Care Report ***"
DO S(X,1,1)
+2 SET X="AREA AGGREGATE"
DO S(X,1,1)
+3 SET X=$$RPTVER^BGP3BAN
DO S(X,1,1)
+4 SET X="Date Report Run: "_$$FMTE^XLFDT(DT)
DO S(X,1,1)
+5 SET X="Site where Run: "_$$VAL^XBDIQ1(9999999.06,DUZ(2),.04)
DO S(X,1,1)
+6 SET X="Report Generated by: "_$$USR
DO S(X,1,1)
+7 SET X="Reporting Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED)
DO S(X,1,1)
+8 SET X="Previous Year Period: "_$$FMTE^XLFDT(BGPPBD)_" to "_$$FMTE^XLFDT(BGPPED)
DO S(X,1,1)
+9 SET X="Baseline Period: "_$$FMTE^XLFDT(BGPBBD)_" to "_$$FMTE^XLFDT(BGPBED)
DO S(X,1,1)
+10 SET X=" "
DO S(X,1,1)
+11 SET X="Measures: Elder Care Performance Measures"
DO S(X,1,1)
+12 IF BGPRTYPE'=1
SET X="Population: "_$SELECT(BGPBEN=1:"AI/AN Only (Classification 01)",BGPBEN=2:"non AI/AN Only (Classification NOT 01)",BGPBEN=3:"All (Both AI/AN and non AI/AN)",1:"")
DO S(X,1,1)
+13 SET X=" "
DO S(X,1,1)
+14 DO ENDTIME
+15 SET X=" "
DO S(X,1,1)
+16 SET BGPCHSO=""
SET X=0
FOR
SET X=$ORDER(BGPSUL(X))
IF X'=+X
QUIT
IF $PIECE(^BGPELDCH(X,0),U,17)
SET BGPCHSO=1
+17 SET BGPCHSN=""
SET X=0
FOR
SET X=$ORDER(BGPSUL(X))
IF X'=+X
QUIT
IF '$PIECE(^BGPELDCH(X,0),U,17)
SET BGPCHSN=1
+18 SET BGPURBO=""
SET X=0
FOR
SET X=$ORDER(BGPSUL(X))
IF X'=+X
QUIT
IF $PIECE(^BGPELDCH(X,0),U,19)
SET BGPURBO=1
+19 SET BGPURBN=""
SET X=0
FOR
SET X=$ORDER(BGPSUL(X))
IF X'=+X
QUIT
IF '$PIECE(^BGPELDCH(X,0),U,19)
SET BGPURBN=1
+20 DO ELDHDRA
+21 SET X=" "
DO S(X,1,1)
+22 IF BGPROT'="P"
IF '$DATA(BGPGUI)
Begin DoDot:1
+23 SET X="A delimited output file called "_BGPDELF
DO S(X,1,1)
SET X="has been placed in the "_$$GETDEDIR^BGP3UTL2()_" directory for your use in Excel or some"
DO S(X,1,1)
Begin DoDot:2
+24 SET X="other software package. See your site manager to access this file."
DO S(X,1,1)
End DoDot:2
End DoDot:1
+25 SET X=" "
DO S(X,1,1)
+26 SET X="Report includes data from the following facilities:"
DO S(X,1,1)
+27 NEW BGPX
+28 SET BGPX=""
SET BGPC=0
FOR
SET BGPX=$ORDER(BGPSUL(BGPX))
IF BGPX=""
QUIT
Begin DoDot:1
+29 SET X=$PIECE(^BGPELDCH(BGPX,0),U,9)
SET X=$ORDER(^AUTTLOC("C",X,0))
SET X=$SELECT(X:$PIECE(^DIC(4,X,0),U),1:"?????")
+30 SET BGPC=BGPC+1
SET X=BGPC_". "_$SELECT($PIECE(^BGPELDCH(BGPX,0),U,17):"*",1:"")_X
DO S(X,1,1)
+31 QUIT
End DoDot:1
+32 SET X=" "
DO S(X,1,1)
+33 SET X="The following communities are included in this report:"
DO S(X,1,1)
+34 SET BGPX=""
SET BGPC=0
FOR
SET BGPX=$ORDER(BGPSUL(BGPX))
IF BGPX=""
QUIT
Begin DoDot:1
+35 SET X=$PIECE(^BGPELDCH(BGPX,0),U,9)
SET X=$ORDER(^AUTTLOC("C",X,0))
SET X=$SELECT(X:$PIECE(^DIC(4,X,0),U),1:"?????")
+36 SET BGPC=BGPC+1
SET X=BGPC_". "_$SELECT($PIECE(^BGPELDCH(BGPX,0),U,17):"*",1:"")_X
DO S(X,1,1)
+37 ;S X="Communities: " D S(X,1,1)
+38 SET X="Community Taxonomy Name: "_$PIECE(^BGPELDCH(BGPX,0),U,18)
DO S(X,1,1)
+39 ;W !?5,"Communities: "
+40 SET X=0
SET N=0
SET Y=""
SET Z=""
FOR
SET X=$ORDER(^BGPELDCH(BGPX,9999,X))
IF X'=+X
QUIT
SET N=N+1
SET Y=Y_$SELECT(N=1:"",1:";")_$PIECE(^BGPELDCH(BGPX,9999,X,0),U)
+41 SET X=0
SET C=0
FOR X=1:3:N
SET Z=$EXTRACT($PIECE(Y,";",X),1,20)
SET $PIECE(Z,U,2)=$EXTRACT($PIECE(Y,";",(X+1)),1,20)
SET $PIECE(Z,U,3)=$EXTRACT($PIECE(Y,";",(X+2)),1,20)
DO S(Z,1,1)
+42 IF $ORDER(^BGPELDCH(BGPX,1111,0))
Begin DoDot:2
+43 SET X=" "
DO S(X,1,1)
+44 SET X="MFI Site: Locations for visits: "
DO S(X,1,1)
SET X=0
SET N=0
SET Y=""
SET Z=""
FOR
SET X=$ORDER(^BGPELDCH(BGPX,1111,X))
IF X'=+X
QUIT
SET N=N+1
SET Y=Y_$SELECT(N=1:"",1:";")_$PIECE(^BGPELDCH(BGPX,1111,X,0),U)
+45 SET X=0
SET C=0
FOR X=1:3:N
SET Z=$EXTRACT($PIECE(Y,";",X),1,20)
SET $PIECE(Z,U,2)=$EXTRACT($PIECE(Y,";",(X+1)),1,20)
SET $PIECE(Z,U,3)=$EXTRACT($PIECE(Y,";",(X+2)),1,20)
DO S(Z,1,1)
+46 QUIT
End DoDot:2
+47 SET X=" "
DO S(X,1,1)
+48 QUIT
End DoDot:1
+49 SET X=" "
DO S(X,1,1)
+50 IF BGPCHSO
Begin DoDot:1
+51 SET X=" "
DO S(X,1,1)
SET X="* CHS-only site. Uses Active Clinical CHS Population definition vs. Active Clinical."
DO S(X,1,1)
End DoDot:1
+52 IF BGPURBO
Begin DoDot:1
+53 SET X=" "
DO S(X,1,1)
SET X="**Urban Outreach & Referral-only site. Uses Active Clinical Behavioral Health Population definition vs. Active Clinical"
DO S(X,1,1)
End DoDot:1
+54 SET X=" "
DO S(X,1,1)
+55 QUIT
S(Y,F,P) ;set up array
+1 IF '$GET(F)
SET F=0
+2 SET %=$PIECE(^TMP($JOB,"BGPDEL",0),U)+F
SET $PIECE(^TMP($JOB,"BGPDEL",0),U)=%
+3 IF '$DATA(^TMP($JOB,"BGPDEL",%))
SET ^TMP($JOB,"BGPDEL",%)=""
+4 SET $PIECE(^TMP($JOB,"BGPDEL",%),U,P)=Y
+5 QUIT
CTR(X,Y) ;EP - Center X in a field Y wide.
+1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
+2 ;----------
EOP ;EP - End of page.
+1 IF $EXTRACT(IOST)'="C"
QUIT
+2 IF $DATA(ZTQUEUED)!'(IOT="TRM")!$DATA(IO("S"))
QUIT
+3 NEW DIR
+4 KILL DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
+5 SET DIR(0)="E"
DO ^DIR
+6 QUIT
+7 ;----------
USR() ;EP - Return name of current user from ^VA(200.
+1 QUIT $SELECT($GET(DUZ):$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
+2 ;----------
+3 ;;
ELDHDRA ;EP
+1 SET BGPX=$ORDER(^BGPCTRL("B",2013,0))
+2 SET BGPNODEP=89
DO 2
+3 ;D W^BGP3DP("",0,1,BGPPTYPE)
+4 IF BGPCHSO
SET BGPTEXT="CHS"
FOR BGPJ1=1:1
SET BGPX=$TEXT(@BGPTEXT+BGPJ1)
IF $PIECE(BGPX,";;",2)="QUIT"
QUIT
Begin DoDot:1
+5 SET BGPT=$PIECE(BGPX,";;",2)
+6 DO S(BGPT,1,1)
End DoDot:1
+7 IF BGPURBO
SET BGPTEXT="URB"
FOR BGPJ1=1:1
SET BGPX=$TEXT(@BGPTEXT+BGPJ1)
IF $PIECE(BGPX,";;",2)="QUIT"
QUIT
Begin DoDot:1
+8 SET BGPT=$PIECE(BGPX,";;",2)
+9 DO S(BGPT,1,1)
End DoDot:1
+10 SET BGPTEXT="UP"
FOR BGPJ1=1:1
SET BGPX=$TEXT(@BGPTEXT+BGPJ1)
IF $PIECE(BGPX,";;",2)="QUIT"
QUIT
Begin DoDot:1
+11 SET BGPT=$PIECE(BGPX,";;",2)
+12 DO S(BGPT,1,1)
End DoDot:1
+13 QUIT
2 SET BGPY=0
FOR
SET BGPY=$ORDER(^BGPCTRL(BGPX,BGPNODEP,BGPY))
IF BGPY'=+BGPY
QUIT
Begin DoDot:1
+1 DO S(^BGPCTRL(BGPX,BGPNODEP,BGPY,0),1,1)
+2 QUIT
End DoDot:1
+3 QUIT
+4 ;
CHS ;;
+1 ;;
+2 ;;ACTIVE CLINICAL CHS POPULATION:
+3 ;;1. Must reside in a community specified in the community taxonomy used for
+4 ;;this report.
+5 ;;2. Must be alive on the last day of the Report period.
+6 ;;3. User defines: a) Indian/Alaska Natives Only - based on Classification
+7 ;;of 01; b) Non AI/AN (not 01); or c) Both.
+8 ;;4. Must have 2 CHS visits in the 3 years prior to the end of the Report period.
+9 ;;QUIT
+10 ;;
URB ;;
+1 ;;
+2 ;;ACTIVE BEHAVIORAL HEALTH URBAN OUTREACH & REFERRAL POPULATION:
+3 ;;1. Must reside in a community specified in the community taxonomy used for
+4 ;;this report.
+5 ;;2. Must be alive on the last day of the Report period.
+6 ;;3. User defines: a) Indian/Alaska Natives Only - based on Classification
+7 ;;of 01; b) Non AI/AN (not 01); or c) Both.
+8 ;;4. Must have 2 visits to behavioral health or case management clinics in the
+9 ;;3 years prior to the end of the Report period.
+10 ;;QUIT
+11 ;;
UP ;;
+1 ;;
+2 ;;USER POPULATION:
+3 ;;1. Definitions 1-3 above.
+4 ;;2. Must have been seen at least once in the 3 years prior to the end of
+5 ;;the Report period, regardless of the clinic type.
+6 ;;QUIT
+7 ;
