- BGP7ELH ; IHS/CMI/LAB - cover page for ELDER 25 Jun 2010 10:20 AM ;
- ;;17.1;IHS CLINICAL REPORTING;;MAY 10, 2017;Build 29
- ;
- ;
- I $G(BGPAREAA) D AREACP Q
- W !!,$$CTR("Cover Page",80)
- W !!,$$CTR("*** IHS 2017 Elder Care Report ***",80)
- W !,$$CTR($$RPTVER^BGP7BAN,80)
- W !,$$CTR("Date Report Run: "_$$FMTE^XLFDT(DT),80)
- W !,$$CTR("Site where Run: "_$P(^DIC(4,DUZ(2),0),U),80)
- W !,$$CTR("Report Generated by: "_$$USR,80)
- S X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED) W !,$$CTR(X,80)
- S X="Previous Year Period: "_$$FMTE^XLFDT(BGPPBD)_" to "_$$FMTE^XLFDT(BGPPED) W !,$$CTR(X,80)
- S X="Baseline Period: "_$$FMTE^XLFDT(BGPBBD)_" to "_$$FMTE^XLFDT(BGPBED) W !,$$CTR(X,80)
- I BGPZZ="A" W !!,"Measures: Elder Care Performance Measures"
- I BGPZZ="S" W !!,"Measures: Selected Elder Care Performance Measures (User Defined)"
- W !!,"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 ENDTIME
- D ELDERHDR
- I $G(BGPEXPT) W !!,"A file will be created called BG171",$P(^AUTTLOC(DUZ(2),0),U,10)_".EL"_BGPRPT,".",!,"It will reside in the public/export directory.",!,"This file should be sent to your Area Office.",!
- I BGPROT'="P",'$D(BGPGUI) W !!,"A delimited output file called ",BGPDELF,!,"has been placed in the "_$$GETDEDIR^BGP7UTL2()_" directory for your use in Excel or some",!,"other software package.",!,"See your site manager to access this file.",!
- I $G(BGPALLPT) W !!,"All Communities Included.",!
- I '$G(BGPALLPT),'$G(BGPSEAT) W !!?10,"Community Taxonomy Name: ",$P(^ATXAX(BGPTAXI,0),U)
- I '$G(BGPALLPT),'$G(BGPSEAT) W !!?10,"The following communities are included in this report:",! 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
- ..I $Y>(BGPIOSL-3) D EOP
- ..W !?10,$E($P(Y,";",BGPZZ),1,20),?30,$E($P(Y,";",(BGPZZ+1)),1,20),?60,$E($P(Y,";",(BGPZZ+2)),1,20)
- ..Q
- K BGPX,BGPQUIT
- Q
- ELDERHDR ;
- W !
- I $G(BGPAREAA) D ELDHDRA Q
- S BGPNODEP=22
- S BGPX=$O(^BGPCTRL("B",2017,0))
- S BGPY=0 F S BGPY=$O(^BGPCTRL(BGPX,BGPNODEP,BGPY)) Q:BGPY'=+BGPY D
- .I $Y>(BGPIOSL-2) D EOP W:$D(IOF) @IOF
- .W !,^BGPCTRL(BGPX,BGPNODEP,BGPY,0)
- .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 W !!,"RUN TIME (H.M.S): ",BGPHR,".",BGPM,".",BGPS
- Q
- AREACP ;EP - area cover page
- ;
- ;W:$D(IOF) @IOF
- W !!,$$CTR("Cover Page",80)
- W !!,$$CTR("*** IHS 2017 Elder Care Report ***",80)
- W !,$$CTR("AREA AGGREGATE",80)
- W !,$$CTR($$RPTVER^BGP7BAN,80)
- W !,$$CTR("Date Report Run: "_$$FMTE^XLFDT(DT),80)
- W !,$$CTR("Site where Run: "_$$VAL^XBDIQ1(9999999.06,DUZ(2),.04))
- W !,$$CTR("Report Generated by: "_$$USR,80)
- S X="Reporting Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED) W !,$$CTR(X,80)
- S X="Previous Year Period: "_$$FMTE^XLFDT(BGPPBD)_" to "_$$FMTE^XLFDT(BGPPED) W !,$$CTR(X,80)
- S X="Baseline Period: "_$$FMTE^XLFDT(BGPBBD)_" to "_$$FMTE^XLFDT(BGPBED) W !,$$CTR(X,80)
- W !!,"Measures: Elder Care Performance Measures"
- W !,"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 ENDTIME
- D ELDERHDR
- I BGPROT'="P",'$D(BGPGUI) W !!,"A delimited output file called ",BGPDELF,!,"has been placed in the "_$$GETDEDIR^BGP7UTL2()_" directory for your use in Excel or some",!,"other software package.",!,"See your site manager to access this file.",!
- W !!?1,"Report includes data from the following facilities:"
- NEW BGPX
- S BGPX="",BGPC=0 F S BGPX=$O(BGPSUL(BGPX)) Q:BGPX="" D
- .S BGPC=BGPC+1
- .S X=$P(^BGPEDLCG(BGPX,0),U,9),X=$O(^AUTTLOC("C",X,0)) S X=$S(X:$P(^DIC(4,X,0),U),1:"?????")
- .W !?3,BGPC,". ",$S($P(^BGPEDLCG(BGPX,0),U,17):"*",$P(^BGPEDLCG(BGPX,0),U,19):"**",1:""),X
- W !!?1,"The following communities are included in this report:"
- NEW BGPX
- S BGPX="",BGPC=0 F S BGPX=$O(BGPSUL(BGPX)) Q:BGPX="" D
- .S BGPC=BGPC+1
- .S X=$P(^BGPEDLCG(BGPX,0),U,9),X=$O(^AUTTLOC("C",X,0)) S X=$S(X:$P(^DIC(4,X,0),U),1:"?????")
- .W !!?3,BGPC,". ",$S($P(^BGPEDLCG(BGPX,0),U,17):"*",1:""),X
- .;W !?5,"Communities: "
- .W !?3,"Community Taxonomy Name: ",$P(^BGPEDLCG(BGPX,0),U,18)
- .;W !?5,"Communities: "
- .S BGPXX=0,BGPXN=0,BGPXY="" F S BGPXX=$O(^BGPEDLCG(BGPX,9999,BGPXX)) Q:BGPXX'=+BGPXX S BGPXN=BGPXN+1,BGPXY=BGPXY_$S(BGPXN=1:"",1:";")_$P(^BGPEDLCG(BGPX,9999,BGPXX,0),U)
- .S BGPX1=0,C=0 F BGPX1=1:3:BGPXN D
- ..W !?10,$E($P(BGPXY,";",BGPX1),1,20),?30,$E($P(BGPXY,";",(BGPX1+1)),1,20),?60,$E($P(BGPXY,";",(BGPX1+2)),1,20)
- K BGPX,BGPQUIT
- 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
- W !
- S BGPX=$O(^BGPCTRL("B",2017,0))
- S BGPNODEP=89 D 2
- ;D W^BGP7DP("",0,1,BGPPTYPE)
- S BGPTEXT="UP" F BGPJ1=1:1 S BGPX=$T(@BGPTEXT+BGPJ1) Q:$P(BGPX,";;",2)="QUIT" D
- .S BGPT=$P(BGPX,";;",2)
- .I BGPPTYPE="P",$Y>(BGPIOSL-2) D EOP
- .W !,BGPT
- Q
- 2 S BGPY=0 F S BGPY=$O(^BGPCTRL(BGPX,BGPNODEP,BGPY)) Q:BGPY'=+BGPY D
- .I BGPPTYPE="P",$Y>(BGPIOSL-2) D EOP
- .W !,^BGPCTRL(BGPX,BGPNODEP,BGPY,0)
- .Q
- Q
- ;
- 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
- ;;
- BGP7ELH ; IHS/CMI/LAB - cover page for ELDER 25 Jun 2010 10:20 AM ;
- +1 ;;17.1;IHS CLINICAL REPORTING;;MAY 10, 2017;Build 29
- +2 ;
- +3 ;
- +4 IF $GET(BGPAREAA)
- DO AREACP
- QUIT
- +5 WRITE !!,$$CTR("Cover Page",80)
- +6 WRITE !!,$$CTR("*** IHS 2017 Elder Care Report ***",80)
- +7 WRITE !,$$CTR($$RPTVER^BGP7BAN,80)
- +8 WRITE !,$$CTR("Date Report Run: "_$$FMTE^XLFDT(DT),80)
- +9 WRITE !,$$CTR("Site where Run: "_$PIECE(^DIC(4,DUZ(2),0),U),80)
- +10 WRITE !,$$CTR("Report Generated by: "_$$USR,80)
- +11 SET X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED)
- WRITE !,$$CTR(X,80)
- +12 SET X="Previous Year Period: "_$$FMTE^XLFDT(BGPPBD)_" to "_$$FMTE^XLFDT(BGPPED)
- WRITE !,$$CTR(X,80)
- +13 SET X="Baseline Period: "_$$FMTE^XLFDT(BGPBBD)_" to "_$$FMTE^XLFDT(BGPBED)
- WRITE !,$$CTR(X,80)
- +14 IF BGPZZ="A"
- WRITE !!,"Measures: Elder Care Performance Measures"
- +15 IF BGPZZ="S"
- WRITE !!,"Measures: Selected Elder Care Performance Measures (User Defined)"
- +16 WRITE !!,"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:"")
- +17 DO ENDTIME
- +18 DO ELDERHDR
- +19 IF $GET(BGPEXPT)
- WRITE !!,"A file will be created called BG171",$PIECE(^AUTTLOC(DUZ(2),0),U,10)_".EL"_BGPRPT,".",!,"It will reside in the public/export directory.",!,"This file should be sent to your Area Office.",!
- +20 IF BGPROT'="P"
- IF '$DATA(BGPGUI)
- WRITE !!,"A delimited output file called ",BGPDELF,!,"has been placed in the "_$$GETDEDIR^BGP7UTL2()_" directory for your use in Excel or some",!,"other software package.",!,"See your site manager to access this file.",!
- +21 IF $GET(BGPALLPT)
- WRITE !!,"All Communities Included.",!
- +22 IF '$GET(BGPALLPT)
- IF '$GET(BGPSEAT)
- WRITE !!?10,"Community Taxonomy Name: ",$PIECE(^ATXAX(BGPTAXI,0),U)
- +23 IF '$GET(BGPALLPT)
- IF '$GET(BGPSEAT)
- WRITE !!?10,"The following communities are included in this report:",!
- Begin DoDot:1
- +24 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
- +25 SET BGPZZ=0
- SET C=0
- FOR BGPZZ=1:3:N
- Begin DoDot:2
- +26 IF $Y>(BGPIOSL-3)
- DO EOP
- +27 WRITE !?10,$EXTRACT($PIECE(Y,";",BGPZZ),1,20),?30,$EXTRACT($PIECE(Y,";",(BGPZZ+1)),1,20),?60,$EXTRACT($PIECE(Y,";",(BGPZZ+2)),1,20)
- +28 QUIT
- End DoDot:2
- End DoDot:1
- +29 KILL BGPX,BGPQUIT
- +30 QUIT
- ELDERHDR ;
- +1 WRITE !
- +2 IF $GET(BGPAREAA)
- DO ELDHDRA
- QUIT
- +3 SET BGPNODEP=22
- +4 SET BGPX=$ORDER(^BGPCTRL("B",2017,0))
- +5 SET BGPY=0
- FOR
- SET BGPY=$ORDER(^BGPCTRL(BGPX,BGPNODEP,BGPY))
- IF BGPY'=+BGPY
- QUIT
- Begin DoDot:1
- +6 IF $Y>(BGPIOSL-2)
- DO EOP
- IF $DATA(IOF)
- WRITE @IOF
- +7 WRITE !,^BGPCTRL(BGPX,BGPNODEP,BGPY,0)
- +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
- WRITE !!,"RUN TIME (H.M.S): ",BGPHR,".",BGPM,".",BGPS
- End DoDot:1
- +3 QUIT
- AREACP ;EP - area cover page
- +1 ;
- +2 ;W:$D(IOF) @IOF
- +3 WRITE !!,$$CTR("Cover Page",80)
- +4 WRITE !!,$$CTR("*** IHS 2017 Elder Care Report ***",80)
- +5 WRITE !,$$CTR("AREA AGGREGATE",80)
- +6 WRITE !,$$CTR($$RPTVER^BGP7BAN,80)
- +7 WRITE !,$$CTR("Date Report Run: "_$$FMTE^XLFDT(DT),80)
- +8 WRITE !,$$CTR("Site where Run: "_$$VAL^XBDIQ1(9999999.06,DUZ(2),.04))
- +9 WRITE !,$$CTR("Report Generated by: "_$$USR,80)
- +10 SET X="Reporting Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED)
- WRITE !,$$CTR(X,80)
- +11 SET X="Previous Year Period: "_$$FMTE^XLFDT(BGPPBD)_" to "_$$FMTE^XLFDT(BGPPED)
- WRITE !,$$CTR(X,80)
- +12 SET X="Baseline Period: "_$$FMTE^XLFDT(BGPBBD)_" to "_$$FMTE^XLFDT(BGPBED)
- WRITE !,$$CTR(X,80)
- +13 WRITE !!,"Measures: Elder Care Performance Measures"
- +14 WRITE !,"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:"")
- +15 DO ENDTIME
- +16 DO ELDERHDR
- +17 IF BGPROT'="P"
- IF '$DATA(BGPGUI)
- WRITE !!,"A delimited output file called ",BGPDELF,!,"has been placed in the "_$$GETDEDIR^BGP7UTL2()_" directory for your use in Excel or some",!,"other software package.",!,"See your site manager to access this file.",!
- +18 WRITE !!?1,"Report includes data from the following facilities:"
- +19 NEW BGPX
- +20 SET BGPX=""
- SET BGPC=0
- FOR
- SET BGPX=$ORDER(BGPSUL(BGPX))
- IF BGPX=""
- QUIT
- Begin DoDot:1
- +21 SET BGPC=BGPC+1
- +22 SET X=$PIECE(^BGPEDLCG(BGPX,0),U,9)
- SET X=$ORDER(^AUTTLOC("C",X,0))
- SET X=$SELECT(X:$PIECE(^DIC(4,X,0),U),1:"?????")
- +23 WRITE !?3,BGPC,". ",$SELECT($PIECE(^BGPEDLCG(BGPX,0),U,17):"*",$PIECE(^BGPEDLCG(BGPX,0),U,19):"**",1:""),X
- End DoDot:1
- +24 WRITE !!?1,"The following communities are included in this report:"
- +25 NEW BGPX
- +26 SET BGPX=""
- SET BGPC=0
- FOR
- SET BGPX=$ORDER(BGPSUL(BGPX))
- IF BGPX=""
- QUIT
- Begin DoDot:1
- +27 SET BGPC=BGPC+1
- +28 SET X=$PIECE(^BGPEDLCG(BGPX,0),U,9)
- SET X=$ORDER(^AUTTLOC("C",X,0))
- SET X=$SELECT(X:$PIECE(^DIC(4,X,0),U),1:"?????")
- +29 WRITE !!?3,BGPC,". ",$SELECT($PIECE(^BGPEDLCG(BGPX,0),U,17):"*",1:""),X
- +30 ;W !?5,"Communities: "
- +31 WRITE !?3,"Community Taxonomy Name: ",$PIECE(^BGPEDLCG(BGPX,0),U,18)
- +32 ;W !?5,"Communities: "
- +33 SET BGPXX=0
- SET BGPXN=0
- SET BGPXY=""
- FOR
- SET BGPXX=$ORDER(^BGPEDLCG(BGPX,9999,BGPXX))
- IF BGPXX'=+BGPXX
- QUIT
- SET BGPXN=BGPXN+1
- SET BGPXY=BGPXY_$SELECT(BGPXN=1:"",1:";")_$PIECE(^BGPEDLCG(BGPX,9999,BGPXX,0),U)
- +34 SET BGPX1=0
- SET C=0
- FOR BGPX1=1:3:BGPXN
- Begin DoDot:2
- +35 WRITE !?10,$EXTRACT($PIECE(BGPXY,";",BGPX1),1,20),?30,$EXTRACT($PIECE(BGPXY,";",(BGPX1+1)),1,20),?60,$EXTRACT($PIECE(BGPXY,";",(BGPX1+2)),1,20)
- End DoDot:2
- End DoDot:1
- +36 KILL BGPX,BGPQUIT
- +37 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 WRITE !
- +2 SET BGPX=$ORDER(^BGPCTRL("B",2017,0))
- +3 SET BGPNODEP=89
- DO 2
- +4 ;D W^BGP7DP("",0,1,BGPPTYPE)
- +5 SET BGPTEXT="UP"
- FOR BGPJ1=1:1
- SET BGPX=$TEXT(@BGPTEXT+BGPJ1)
- IF $PIECE(BGPX,";;",2)="QUIT"
- QUIT
- Begin DoDot:1
- +6 SET BGPT=$PIECE(BGPX,";;",2)
- +7 IF BGPPTYPE="P"
- IF $Y>(BGPIOSL-2)
- DO EOP
- +8 WRITE !,BGPT
- End DoDot:1
- +9 QUIT
- 2 SET BGPY=0
- FOR
- SET BGPY=$ORDER(^BGPCTRL(BGPX,BGPNODEP,BGPY))
- IF BGPY'=+BGPY
- QUIT
- Begin DoDot:1
- +1 IF BGPPTYPE="P"
- IF $Y>(BGPIOSL-2)
- DO EOP
- +2 WRITE !,^BGPCTRL(BGPX,BGPNODEP,BGPY,0)
- +3 QUIT
- End DoDot:1
- +4 QUIT
- +5 ;
- 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 ;;
- +7 ;;QUIT
- +8 ;;
