- BGP2ELHH ; IHS/CMI/LAB - cover page for ELDER 25 Jun 2010 10:20 AM ;
- ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
- ;
- ;
- S X="Cover Page" D S(X,1,1)
- S X=" " D S(X,1,1)
- I $G(BGPAREAA) G AREACP
- S X="*** IHS 2012 Elder Care Report ***" D S(X,1,1)
- S X=$$RPTVER^BGP2BAN 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 BG121"_$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^BGP2UTL2()_" 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",2012,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 2012 Elder Care Report ***" D S(X,1,1)
- S X="AREA AGGREGATE" D S(X,1,1)
- S X=$$RPTVER^BGP2BAN 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(^BGPELDCW(X,0),U,17) S BGPCHSO=1
- S BGPCHSN="",X=0 F S X=$O(BGPSUL(X)) Q:X'=+X I '$P(^BGPELDCW(X,0),U,17) S BGPCHSN=1
- S BGPURBO="",X=0 F S X=$O(BGPSUL(X)) Q:X'=+X I $P(^BGPELDCW(X,0),U,19) S BGPURBO=1
- S BGPURBN="",X=0 F S X=$O(BGPSUL(X)) Q:X'=+X I '$P(^BGPELDCW(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^BGP2UTL2()_" 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(^BGPELDCW(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(^BGPELDCW(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(^BGPELDCW(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(^BGPELDCW(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(^BGPELDCW(BGPX,0),U,18) D S(X,1,1)
- .;W !?5,"Communities: "
- .S X=0,N=0,Y="",Z="" F S X=$O(^BGPELDCW(BGPX,9999,X)) Q:X'=+X S N=N+1,Y=Y_$S(N=1:"",1:";")_$P(^BGPELDCW(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(^BGPELDCW(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(^BGPELDCW(BGPX,1111,X)) Q:X'=+X S N=N+1,Y=Y_$S(N=1:"",1:";")_$P(^BGPELDCW(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",2012,0))
- S BGPNODEP=89 D 2
- ;D W^BGP2DP("",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
- ;
- BGP2ELHH ; IHS/CMI/LAB - cover page for ELDER 25 Jun 2010 10:20 AM ;
- +1 ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
- +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 2012 Elder Care Report ***"
- DO S(X,1,1)
- +8 SET X=$$RPTVER^BGP2BAN
- 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 BG121"_$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^BGP2UTL2()_" 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",2012,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 2012 Elder Care Report ***"
- DO S(X,1,1)
- +2 SET X="AREA AGGREGATE"
- DO S(X,1,1)
- +3 SET X=$$RPTVER^BGP2BAN
- 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(^BGPELDCW(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(^BGPELDCW(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(^BGPELDCW(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(^BGPELDCW(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^BGP2UTL2()_" 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(^BGPELDCW(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(^BGPELDCW(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(^BGPELDCW(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(^BGPELDCW(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(^BGPELDCW(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(^BGPELDCW(BGPX,9999,X))
- IF X'=+X
- QUIT
- SET N=N+1
- SET Y=Y_$SELECT(N=1:"",1:";")_$PIECE(^BGPELDCW(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(^BGPELDCW(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(^BGPELDCW(BGPX,1111,X))
- IF X'=+X
- QUIT
- SET N=N+1
- SET Y=Y_$SELECT(N=1:"",1:";")_$PIECE(^BGPELDCW(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",2012,0))
- +2 SET BGPNODEP=89
- DO 2
- +3 ;D W^BGP2DP("",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 ;