- BGP0DPAW ; IHS/CMI/LAB - COMP NATIONAL GPRA FOR PTS W/APPT 01 Oct 2008 1:20 PM 13 Aug 2009 11:32 AM ;
- ;;10.0;IHS CLINICAL REPORTING;**1**;JUN 18, 2010
- ;
- DONE ;
- K DIR
- I $E(IOST)="C",IO=IO(0) S DIR(0)="EO",DIR("A")="End of report. PRESS ENTER" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
- ;W:$D(IOF) @IOF
- K BGPTS,BGPS,BGPM,BGPET,BGPX,BGPGPYR
- K ^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH)
- Q
- ;
- PRINT ;EP - called from xbdbque
- S BGPIOSL=$S($G(BGPGUI):55,1:IOSL)
- I $G(BGPGUI) S IOSL=55 ;cmi/maw added 1/14/2009
- K BGPQ S BGPPG=0,BGPNOD=0
- I BGPRT1="P" D PPRINT,DONE Q
- I BGPRT1="C" D CPRINT,DONE Q
- I BGPRT1="A" D APRINT,DONE Q
- I BGPRT1="D" D DPRINT,DONE Q
- Q
- CPRINT ;
- I '$D(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"APPTS")) D HEADER S BGPNOD=1 D
- .I '$O(BGPCLN(0)) W !!,"There were either no appointments found or there were no patients due for any",!,"GPRA measure for any clinic during the specified timeframe of ",!,$$FMTE^XLFDT(BGPABD)," to ",$$FMTE^XLFDT(BGPAED),".",! Q
- .W !!,"There were either no appointments found or there were no patients due for any",!,"GPRA measure for any of the clinics selected during the specified timeframe",!,"of ",$$FMTE^XLFDT(BGPABD)," to ",$$FMTE^XLFDT(BGPAED),"."
- .W !,"The following clinics were selected:"
- .S X=0 F S X=$O(BGPCLN(X)) Q:X'=+X W !?10,$P(^SC(X,0),U)
- ;I '$D(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"APPTS")) D HEADER S BGPNOD=1 W !!,"NO GPRA MEASURES DUE",! Q
- S BGPCLN="" F S BGPCLN=$O(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPCLN)) Q:BGPCLN=""!($D(BGPQ)) D
- .S BGPD=0 F S BGPD=$O(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPCLN,BGPD)) Q:BGPD'=+BGPD!($D(BGPQ)) D
- ..S BGPADT=0 F S BGPADT=$O(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPCLN,BGPD,BGPADT)) Q:BGPADT'=+BGPADT!($D(BGPQ)) D
- ...S BGPNAME="" F S BGPNAME=$O(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPCLN,BGPD,BGPADT,BGPNAME)) Q:BGPNAME=""!($D(BGPQ)) D
- ....S DFN=0 F S DFN=$O(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPCLN,BGPD,BGPADT,BGPNAME,DFN)) Q:DFN'=+DFN!($D(BGPQ)) D
- .....D HEADER Q:$D(BGPQ)
- .....D SUB
- .....S BGPIC=0 F S BGPIC=$O(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPCLN,BGPD,BGPADT,BGPNAME,DFN,BGPIC)) Q:BGPIC'=+BGPIC!($D(BGPQ)) D
- ......S BGPI=0 F S BGPI=$O(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPCLN,BGPD,BGPADT,BGPNAME,DFN,BGPIC,BGPI)) Q:BGPI'=+BGPI!($D(BGPQ)) D
- .......I $Y>(IOSL-3) D HEADER Q:$D(BGPQ) D SUB
- .......S Y=^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPCLN,BGPD,BGPADT,BGPNAME,DFN,BGPIC,BGPI)
- .......D WRITE
- .......;S BGPX=$P(Y,U,2)
- .......;S BGPT=$P(Y,U,1),BGPT1=$P(Y,U,4)
- .......;W !,BGPT
- .......;F X=1:1 S Y=$P(BGPX,"|",X) Q:Y="" W:X'=1 ! W ?27,Y
- .......;I $Y>(IOSL-4) D HEADER Q:$D(BGPQ) D SUB
- .......;D WP
- ......Q
- .....Q
- ....Q
- ...Q
- ..Q
- .Q
- Q
- DPRINT ;
- I '$D(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"APPTS")) D HEADER S BGPNOD=1 D Q
- .W !!,"There were either no appointments found for this division or there were no " D
- ..W !,"patients due for any GPRA measure for any clinic during the specified ",!,"timeframe of ",$$FMTE^XLFDT(BGPABD)," to ",$$FMTE^XLFDT(BGPAED),".",! Q
- .;W !!,"There either no appointments found or there were no patients due for any GPRA",!,"measure for any of the clinics selected during the specified timeframe",!,"of ",$$FMTE^XLFDT(BGPABD)," to ",$$FMTE^XLFDT(BGPAED),"."
- .I $O(BGPCLN(0)) W !,"The following clinics were selected:" D
- ..S X=0 F S X=$O(BGPCLN(X)) Q:X'=+X W !?10,$P(^SC(X,0),U)
- S BGPDIVI=0 F S BGPDIVI=$O(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPDIVI)) Q:BGPDIVI'=+BGPDIVI!($D(BGPQ)) D DPRINT1
- Q
- DPRINT1 ;
- S BGPCLN="" F S BGPCLN=$O(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPDIVI,BGPCLN)) Q:BGPCLN=""!($D(BGPQ)) D
- .S BGPD=0 F S BGPD=$O(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPDIVI,BGPCLN,BGPD)) Q:BGPD'=+BGPD!($D(BGPQ)) D
- ..S BGPADT=0 F S BGPADT=$O(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPDIVI,BGPCLN,BGPD,BGPADT)) Q:BGPADT'=+BGPADT!($D(BGPQ)) D
- ...S BGPNAME="" F S BGPNAME=$O(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPDIVI,BGPCLN,BGPD,BGPADT,BGPNAME)) Q:BGPNAME=""!($D(BGPQ)) D
- ....S DFN=0 F S DFN=$O(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPDIVI,BGPCLN,BGPD,BGPADT,BGPNAME,DFN)) Q:DFN'=+DFN!($D(BGPQ)) D
- .....D HEADER Q:$D(BGPQ)
- .....D SUB
- .....S BGPIC=0 F S BGPIC=$O(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPDIVI,BGPCLN,BGPD,BGPADT,BGPNAME,DFN,BGPIC)) Q:BGPIC'=+BGPIC!($D(BGPQ)) D
- ......S BGPI=0 F S BGPI=$O(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPDIVI,BGPCLN,BGPD,BGPADT,BGPNAME,DFN,BGPIC,BGPI)) Q:BGPI'=+BGPI!($D(BGPQ)) D
- .......I $Y>(IOSL-3) D HEADER Q:$D(BGPQ) D SUB
- .......S Y=^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPDIVI,BGPCLN,BGPD,BGPADT,BGPNAME,DFN,BGPIC,BGPI)
- .......D WRITE
- .......;
- .......;S BGPX=$P(Y,U,2)
- .......;S BGPT=$P(Y,U,1),BGPT1=$P(Y,U,4)
- .......;W !,BGPT
- .......;F X=1:1 S Y=$P(BGPX,"|",X) Q:Y="" W:X'=1 ! W ?27,Y
- .......;I $Y>(IOSL-4) D HEADER Q:$D(BGPQ) D SUB
- .......;D WP
- ......Q
- .....Q
- ....Q
- ...Q
- ..Q
- .Q
- Q
- PPRINT ;
- I '$D(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"PATS")) D HEADER S BGPNOD=1 D Q
- .W !!,"There were either no appointments found for " S X=$O(BGPPATS(0)) W $P(^DPT(X,0),U),!,"during the specified timeframe of ",$$FMTE^XLFDT(BGPABD)," to ",$$FMTE^XLFDT(BGPAED)," or",!,"this patient was not due for any GPRA measure." Q
- S BGPNAME="" F S BGPNAME=$O(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"PATS",BGPNAME)) Q:BGPNAME=""!($D(BGPQ)) D
- .S DFN=0 F S DFN=$O(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"PATS",BGPNAME,DFN)) Q:DFN'=+DFN!($D(BGPQ)) D
- ..S BGPD=0 F S BGPD=$O(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"PATS",BGPNAME,DFN,BGPD)) Q:BGPD'=+BGPD!($D(BGPQ)) D
- ...S BGPCLN="" F S BGPCLN=$O(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"PATS",BGPNAME,DFN,BGPD,BGPCLN)) Q:BGPCLN=""!($D(BGPQ)) D
- ....S BGPADT=0 F S BGPADT=$O(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"PATS",BGPNAME,DFN,BGPD,BGPCLN,BGPADT)) Q:BGPADT=""!($D(BGPQ)) D
- .....D HEADER Q:$D(BGPQ)
- .....D SUB
- .....S BGPIC=0 F S BGPIC=$O(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"PATS",BGPNAME,DFN,BGPD,BGPCLN,BGPADT,BGPIC)) Q:BGPIC'=+BGPIC!($D(BGPQ)) D
- ......S BGPI=0 F S BGPI=$O(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"PATS",BGPNAME,DFN,BGPD,BGPCLN,BGPADT,BGPIC,BGPI)) Q:BGPI'=+BGPI!($D(BGPQ)) D
- .......I $Y>(IOSL-3) D HEADER Q:$D(BGPQ) D SUB
- .......S Y=^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"PATS",BGPNAME,DFN,BGPD,BGPCLN,BGPADT,BGPIC,BGPI)
- .......D WRITE
- .......;
- .......;S BGPT=$P(Y,U,1),BGPT1=$P(Y,U,4)
- .......;W !,BGPT
- .......;F X=1:1 S Y=$P(BGPX,"|",X) Q:Y="" W:X'=1 ! W ?27,Y
- .......;I $Y>(IOSL-4) D HEADER Q:$D(BGPQ) D SUB
- .......;D WP
- ......Q
- .....Q
- ....Q
- ...Q
- ..Q
- .Q
- Q
- WRITE ;
- S BGPNOBAN=""
- S BGPX=$P(Y,U,2)
- S BGPT=$P(Y,U,1),BGPT1=$P(Y,U,4)
- W !,BGPT
- W ?27,$P(BGPX,"|",1)
- W !,BGPT1
- I $P(BGPX,"|",2)="" S BGPNOBAN=1
- F X=2:1 S Y=$P(BGPX,"|",X) Q:Y="" W:X'=2 ! W ?27,Y
- I $Y>(IOSL-4) D HEADER Q:$D(BGPQ) D SUB
- D WP
- Q
- WP ;
- K ^UTILITY($J,"W")
- S BGPZ=0
- ;LORI - CHANGE 09 TO 1601 IF NEEDED LATER
- S DIWL=28,DIWR=78,DIWF="" F S BGPZ=$O(^BGPINDTC(BGPI,$S($G(BGPNGR09):1601,1:16),BGPZ)) Q:BGPZ'=+BGPZ D
- .S X=^BGPINDTC(BGPI,$S($G(BGPNGR09):1601,1:16),BGPZ,0) D ^DIWP
- .Q
- WPS ;
- S Z=0 F S Z=$O(^UTILITY($J,"W",DIWL,Z)) Q:Z'=+Z D
- .I Z=1,'BGPNOBAN W !
- .W ?27,^UTILITY($J,"W",DIWL,Z,0),!
- K DIWL,DIWR,DIWF,Z
- K ^UTILITY($J,"W"),X
- Q
- APRINT ;
- I '$D(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"ANY")) D HEADER S BGPNOD=1 D Q
- .W !!,"There were no GPRA Measures due for any patient selected."
- S BGPNAME="" F S BGPNAME=$O(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"ANY",BGPNAME)) Q:BGPNAME=""!($D(BGPQ)) D
- .S DFN=0 F S DFN=$O(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"ANY",BGPNAME,DFN)) Q:DFN'=+DFN!($D(BGPQ)) D
- ..D HEADER Q:$D(BGPQ)
- ..D SUB
- ..S BGPIC=0 F S BGPIC=$O(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"ANY",BGPNAME,DFN,BGPIC)) Q:BGPIC'=+BGPIC!($D(BGPQ)) D
- ...S BGPI=0 F S BGPI=$O(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"ANY",BGPNAME,DFN,BGPIC,BGPI)) Q:BGPI'=+BGPI!($D(BGPQ)) D
- ....I $Y>(IOSL-3) D HEADER Q:$D(BGPQ) D SUB
- ....S Y=^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"ANY",BGPNAME,DFN,BGPIC,BGPI)
- ....D WRITE
- ....;S BGPX=$P(Y,U,2)
- ....;S BGPT=$P(Y,U,1),BGPT1=$P(Y,U,4)
- ....;W !,BGPT
- ....;F X=1:1 S Y=$P(BGPX,"|",X) Q:Y="" W:X'=1 ! W ?27,Y
- ....;I $Y>(IOSL-4) D HEADER Q:$D(BGPQ) D SUB
- ....;D WP
- ...Q
- ..Q
- .Q
- Q
- SUB ;
- S T=$S(BGPRT1="A":0,1:11)
- I BGPRT1'="A" W !,$P($$FMTE^XLFDT(BGPADT,"P")," ",4,99)
- I BGPRT1="A" W !
- W ?T,$E($P(^DPT(DFN,0),U),1,25),?38,$$HRN^AUPNPAT(DFN,DUZ(2)),?46,$$SEX^AUPNPAT(DFN),?50,$$DATE^BGP0UTL($$DOB^AUPNPAT(DFN)),?60,$E($$COMMRES^AUPNPAT(DFN,"E"),1,20),!
- Q
- G:'BGPPG HEADER1
- K DIR I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BGPQ="" Q
- I BGPPG W:$D(IOF) @IOF
- S BGPPG=BGPPG+1
- I $G(BGPGUI),BGPPG'=1 W !,"ZZZZZZZ"
- W !,$P(^VA(200,DUZ,0),U,2),?5,"***CONFIDENTIAL PATIENT INFORMATION-COVERED BY THE PRIVACY ACT***",?70,"Page ",BGPPG
- I '$G(BGPNGR09) W !,$$CTR("GPRA & PART Forecast Patient List",80)
- I $G(BGPNGR09) W !,$$CTR("GPRA & PART Forecast Patient List, Run Using 2010 Logic")
- W !,$$CTR("GPRA Measures Not Met or Due During "_$$FMTE^XLFDT(BGPBD)_"-"_$$FMTE^XLFDT(BGPED),80)
- W !,$$CTR($$RPTVER^BGP0BAN,80)
- I BGPRT1'="A",BGPCLN]"" W !,$$CTR("Patients with an Appointment in "_BGPCLN_$S($G(BGPD):" on "_$$FMTE^XLFDT(BGPD),1:""),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: "_$P(^VA(200,DUZ,0),U),80)
- W !,$TR($J("",80)," ","-")
- I BGPRT1'="A" W !,"Appt Time",?11,"Patient Name"
- I BGPRT1="A" W !,"Patient Name"
- W ?38,"HRN",?46,"Sex",?50,"DOB",?60,"Community"
- W !,"GPRA Measure Not Met",?27,"Date of Last Screening and Next Due Date"
- W !?27,"Tests Counted for GPRA Measure"
- W !,$TR($J("",80)," ","-")
- 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"))
- K DIR
- K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
- S DIR("A")="End of report. Press Enter",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")
- ;----------
- LOC() ;EP - Return location name from file 4 based on DUZ(2).
- Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
- ;----------
- BGP0DPAW ; IHS/CMI/LAB - COMP NATIONAL GPRA FOR PTS W/APPT 01 Oct 2008 1:20 PM 13 Aug 2009 11:32 AM ;
- +1 ;;10.0;IHS CLINICAL REPORTING;**1**;JUN 18, 2010
- +2 ;
- DONE ;
- +1 KILL DIR
- +2 IF $EXTRACT(IOST)="C"
- IF IO=IO(0)
- SET DIR(0)="EO"
- SET DIR("A")="End of report. PRESS ENTER"
- DO ^DIR
- KILL DIR
- IF $DATA(DUOUT)
- SET DIRUT=1
- +3 ;W:$D(IOF) @IOF
- +4 KILL BGPTS,BGPS,BGPM,BGPET,BGPX,BGPGPYR
- +5 KILL ^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH)
- +6 QUIT
- +7 ;
- PRINT ;EP - called from xbdbque
- +1 SET BGPIOSL=$SELECT($GET(BGPGUI):55,1:IOSL)
- +2 ;cmi/maw added 1/14/2009
- IF $GET(BGPGUI)
- SET IOSL=55
- +3 KILL BGPQ
- SET BGPPG=0
- SET BGPNOD=0
- +4 IF BGPRT1="P"
- DO PPRINT
- DO DONE
- QUIT
- +5 IF BGPRT1="C"
- DO CPRINT
- DO DONE
- QUIT
- +6 IF BGPRT1="A"
- DO APRINT
- DO DONE
- QUIT
- +7 IF BGPRT1="D"
- DO DPRINT
- DO DONE
- QUIT
- +8 QUIT
- CPRINT ;
- +1 IF '$DATA(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"APPTS"))
- DO HEADER
- SET BGPNOD=1
- Begin DoDot:1
- +2 IF '$ORDER(BGPCLN(0))
- WRITE !!,"There were either no appointments found or there were no patients due for any",!,"GPRA measure for any clinic during the specified timeframe of ",!,$$FMTE^XLFDT(BGPABD)," to ",$$FMTE^XLFDT(BGPAED),".",!
- QUIT
- +3 WRITE !!,"There were either no appointments found or there were no patients due for any",!,"GPRA measure for any of the clinics selected during the specified timeframe",!,"of ",$$FMTE^XLFDT(BGPABD)," to ",$$FMTE^XLFDT(BGPAED),"."
- +4 WRITE !,"The following clinics were selected:"
- +5 SET X=0
- FOR
- SET X=$ORDER(BGPCLN(X))
- IF X'=+X
- QUIT
- WRITE !?10,$PIECE(^SC(X,0),U)
- End DoDot:1
- +6 ;I '$D(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"APPTS")) D HEADER S BGPNOD=1 W !!,"NO GPRA MEASURES DUE",! Q
- +7 SET BGPCLN=""
- FOR
- SET BGPCLN=$ORDER(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPCLN))
- IF BGPCLN=""!($DATA(BGPQ))
- QUIT
- Begin DoDot:1
- +8 SET BGPD=0
- FOR
- SET BGPD=$ORDER(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPCLN,BGPD))
- IF BGPD'=+BGPD!($DATA(BGPQ))
- QUIT
- Begin DoDot:2
- +9 SET BGPADT=0
- FOR
- SET BGPADT=$ORDER(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPCLN,BGPD,BGPADT))
- IF BGPADT'=+BGPADT!($DATA(BGPQ))
- QUIT
- Begin DoDot:3
- +10 SET BGPNAME=""
- FOR
- SET BGPNAME=$ORDER(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPCLN,BGPD,BGPADT,BGPNAME))
- IF BGPNAME=""!($DATA(BGPQ))
- QUIT
- Begin DoDot:4
- +11 SET DFN=0
- FOR
- SET DFN=$ORDER(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPCLN,BGPD,BGPADT,BGPNAME,DFN))
- IF DFN'=+DFN!($DATA(BGPQ))
- QUIT
- Begin DoDot:5
- +12 DO HEADER
- IF $DATA(BGPQ)
- QUIT
- +13 DO SUB
- +14 SET BGPIC=0
- FOR
- SET BGPIC=$ORDER(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPCLN,BGPD,BGPADT,BGPNAME,DFN,BGPIC))
- IF BGPIC'=+BGPIC!($DATA(BGPQ))
- QUIT
- Begin DoDot:6
- +15 SET BGPI=0
- FOR
- SET BGPI=$ORDER(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPCLN,BGPD,BGPADT,BGPNAME,DFN,BGPIC,BGPI))
- IF BGPI'=+BGPI!($DATA(BGPQ))
- QUIT
- Begin DoDot:7
- +16 IF $Y>(IOSL-3)
- DO HEADER
- IF $DATA(BGPQ)
- QUIT
- DO SUB
- +17 SET Y=^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPCLN,BGPD,BGPADT,BGPNAME,DFN,BGPIC,BGPI)
- +18 DO WRITE
- +19 ;S BGPX=$P(Y,U,2)
- +20 ;S BGPT=$P(Y,U,1),BGPT1=$P(Y,U,4)
- +21 ;W !,BGPT
- +22 ;F X=1:1 S Y=$P(BGPX,"|",X) Q:Y="" W:X'=1 ! W ?27,Y
- +23 ;I $Y>(IOSL-4) D HEADER Q:$D(BGPQ) D SUB
- +24 ;D WP
- End DoDot:7
- +25 QUIT
- End DoDot:6
- +26 QUIT
- End DoDot:5
- +27 QUIT
- End DoDot:4
- +28 QUIT
- End DoDot:3
- +29 QUIT
- End DoDot:2
- +30 QUIT
- End DoDot:1
- +31 QUIT
- DPRINT ;
- +1 IF '$DATA(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"APPTS"))
- DO HEADER
- SET BGPNOD=1
- Begin DoDot:1
- +2 WRITE !!,"There were either no appointments found for this division or there were no "
- Begin DoDot:2
- +3 WRITE !,"patients due for any GPRA measure for any clinic during the specified ",!,"timeframe of ",$$FMTE^XLFDT(BGPABD)," to ",$$FMTE^XLFDT(BGPAED),".",!
- QUIT
- End DoDot:2
- +4 ;W !!,"There either no appointments found or there were no patients due for any GPRA",!,"measure for any of the clinics selected during the specified timeframe",!,"of ",$$FMTE^XLFDT(BGPABD)," to ",$$FMTE^XLFDT(BGPAED),"."
- +5 IF $ORDER(BGPCLN(0))
- WRITE !,"The following clinics were selected:"
- Begin DoDot:2
- +6 SET X=0
- FOR
- SET X=$ORDER(BGPCLN(X))
- IF X'=+X
- QUIT
- WRITE !?10,$PIECE(^SC(X,0),U)
- End DoDot:2
- End DoDot:1
- QUIT
- +7 SET BGPDIVI=0
- FOR
- SET BGPDIVI=$ORDER(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPDIVI))
- IF BGPDIVI'=+BGPDIVI!($DATA(BGPQ))
- QUIT
- DO DPRINT1
- +8 QUIT
- DPRINT1 ;
- +1 SET BGPCLN=""
- FOR
- SET BGPCLN=$ORDER(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPDIVI,BGPCLN))
- IF BGPCLN=""!($DATA(BGPQ))
- QUIT
- Begin DoDot:1
- +2 SET BGPD=0
- FOR
- SET BGPD=$ORDER(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPDIVI,BGPCLN,BGPD))
- IF BGPD'=+BGPD!($DATA(BGPQ))
- QUIT
- Begin DoDot:2
- +3 SET BGPADT=0
- FOR
- SET BGPADT=$ORDER(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPDIVI,BGPCLN,BGPD,BGPADT))
- IF BGPADT'=+BGPADT!($DATA(BGPQ))
- QUIT
- Begin DoDot:3
- +4 SET BGPNAME=""
- FOR
- SET BGPNAME=$ORDER(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPDIVI,BGPCLN,BGPD,BGPADT,BGPNAME))
- IF BGPNAME=""!($DATA(BGPQ))
- QUIT
- Begin DoDot:4
- +5 SET DFN=0
- FOR
- SET DFN=$ORDER(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPDIVI,BGPCLN,BGPD,BGPADT,BGPNAME,DFN))
- IF DFN'=+DFN!($DATA(BGPQ))
- QUIT
- Begin DoDot:5
- +6 DO HEADER
- IF $DATA(BGPQ)
- QUIT
- +7 DO SUB
- +8 SET BGPIC=0
- FOR
- SET BGPIC=$ORDER(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPDIVI,BGPCLN,BGPD,BGPADT,BGPNAME,DFN,BGPIC))
- IF BGPIC'=+BGPIC!($DATA(BGPQ))
- QUIT
- Begin DoDot:6
- +9 SET BGPI=0
- FOR
- SET BGPI=$ORDER(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPDIVI,BGPCLN,BGPD,BGPADT,BGPNAME,DFN,BGPIC,BGPI))
- IF BGPI'=+BGPI!($DATA(BGPQ))
- QUIT
- Begin DoDot:7
- +10 IF $Y>(IOSL-3)
- DO HEADER
- IF $DATA(BGPQ)
- QUIT
- DO SUB
- +11 SET Y=^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPDIVI,BGPCLN,BGPD,BGPADT,BGPNAME,DFN,BGPIC,BGPI)
- +12 DO WRITE
- +13 ;
- +14 ;S BGPX=$P(Y,U,2)
- +15 ;S BGPT=$P(Y,U,1),BGPT1=$P(Y,U,4)
- +16 ;W !,BGPT
- +17 ;F X=1:1 S Y=$P(BGPX,"|",X) Q:Y="" W:X'=1 ! W ?27,Y
- +18 ;I $Y>(IOSL-4) D HEADER Q:$D(BGPQ) D SUB
- +19 ;D WP
- End DoDot:7
- +20 QUIT
- End DoDot:6
- +21 QUIT
- End DoDot:5
- +22 QUIT
- End DoDot:4
- +23 QUIT
- End DoDot:3
- +24 QUIT
- End DoDot:2
- +25 QUIT
- End DoDot:1
- +26 QUIT
- PPRINT ;
- +1 IF '$DATA(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"PATS"))
- DO HEADER
- SET BGPNOD=1
- Begin DoDot:1
- +2 WRITE !!,"There were either no appointments found for "
- SET X=$ORDER(BGPPATS(0))
- WRITE $PIECE(^DPT(X,0),U),!,"during the specified timeframe of ",$$FMTE^XLFDT(BGPABD)," to ",$$FMTE^XLFDT(BGPAED)," or",!,"this patient was not due for any GPRA measure."
- QUIT
- End DoDot:1
- QUIT
- +3 SET BGPNAME=""
- FOR
- SET BGPNAME=$ORDER(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"PATS",BGPNAME))
- IF BGPNAME=""!($DATA(BGPQ))
- QUIT
- Begin DoDot:1
- +4 SET DFN=0
- FOR
- SET DFN=$ORDER(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"PATS",BGPNAME,DFN))
- IF DFN'=+DFN!($DATA(BGPQ))
- QUIT
- Begin DoDot:2
- +5 SET BGPD=0
- FOR
- SET BGPD=$ORDER(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"PATS",BGPNAME,DFN,BGPD))
- IF BGPD'=+BGPD!($DATA(BGPQ))
- QUIT
- Begin DoDot:3
- +6 SET BGPCLN=""
- FOR
- SET BGPCLN=$ORDER(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"PATS",BGPNAME,DFN,BGPD,BGPCLN))
- IF BGPCLN=""!($DATA(BGPQ))
- QUIT
- Begin DoDot:4
- +7 SET BGPADT=0
- FOR
- SET BGPADT=$ORDER(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"PATS",BGPNAME,DFN,BGPD,BGPCLN,BGPADT))
- IF BGPADT=""!($DATA(BGPQ))
- QUIT
- Begin DoDot:5
- +8 DO HEADER
- IF $DATA(BGPQ)
- QUIT
- +9 DO SUB
- +10 SET BGPIC=0
- FOR
- SET BGPIC=$ORDER(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"PATS",BGPNAME,DFN,BGPD,BGPCLN,BGPADT,BGPIC))
- IF BGPIC'=+BGPIC!($DATA(BGPQ))
- QUIT
- Begin DoDot:6
- +11 SET BGPI=0
- FOR
- SET BGPI=$ORDER(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"PATS",BGPNAME,DFN,BGPD,BGPCLN,BGPADT,BGPIC,BGPI))
- IF BGPI'=+BGPI!($DATA(BGPQ))
- QUIT
- Begin DoDot:7
- +12 IF $Y>(IOSL-3)
- DO HEADER
- IF $DATA(BGPQ)
- QUIT
- DO SUB
- +13 SET Y=^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"PATS",BGPNAME,DFN,BGPD,BGPCLN,BGPADT,BGPIC,BGPI)
- +14 DO WRITE
- +15 ;
- +16 ;S BGPT=$P(Y,U,1),BGPT1=$P(Y,U,4)
- +17 ;W !,BGPT
- +18 ;F X=1:1 S Y=$P(BGPX,"|",X) Q:Y="" W:X'=1 ! W ?27,Y
- +19 ;I $Y>(IOSL-4) D HEADER Q:$D(BGPQ) D SUB
- +20 ;D WP
- End DoDot:7
- +21 QUIT
- End DoDot:6
- +22 QUIT
- End DoDot:5
- +23 QUIT
- End DoDot:4
- +24 QUIT
- End DoDot:3
- +25 QUIT
- End DoDot:2
- +26 QUIT
- End DoDot:1
- +27 QUIT
- WRITE ;
- +1 SET BGPNOBAN=""
- +2 SET BGPX=$PIECE(Y,U,2)
- +3 SET BGPT=$PIECE(Y,U,1)
- SET BGPT1=$PIECE(Y,U,4)
- +4 WRITE !,BGPT
- +5 WRITE ?27,$PIECE(BGPX,"|",1)
- +6 WRITE !,BGPT1
- +7 IF $PIECE(BGPX,"|",2)=""
- SET BGPNOBAN=1
- +8 FOR X=2:1
- SET Y=$PIECE(BGPX,"|",X)
- IF Y=""
- QUIT
- IF X'=2
- WRITE !
- WRITE ?27,Y
- +9 IF $Y>(IOSL-4)
- DO HEADER
- IF $DATA(BGPQ)
- QUIT
- DO SUB
- +10 DO WP
- +11 QUIT
- WP ;
- +1 KILL ^UTILITY($JOB,"W")
- +2 SET BGPZ=0
- +3 ;LORI - CHANGE 09 TO 1601 IF NEEDED LATER
- +4 SET DIWL=28
- SET DIWR=78
- SET DIWF=""
- FOR
- SET BGPZ=$ORDER(^BGPINDTC(BGPI,$SELECT($GET(BGPNGR09):1601,1:16),BGPZ))
- IF BGPZ'=+BGPZ
- QUIT
- Begin DoDot:1
- +5 SET X=^BGPINDTC(BGPI,$SELECT($GET(BGPNGR09):1601,1:16),BGPZ,0)
- DO ^DIWP
- +6 QUIT
- End DoDot:1
- WPS ;
- +1 SET Z=0
- FOR
- SET Z=$ORDER(^UTILITY($JOB,"W",DIWL,Z))
- IF Z'=+Z
- QUIT
- Begin DoDot:1
- +2 IF Z=1
- IF 'BGPNOBAN
- WRITE !
- +3 WRITE ?27,^UTILITY($JOB,"W",DIWL,Z,0),!
- End DoDot:1
- +4 KILL DIWL,DIWR,DIWF,Z
- +5 KILL ^UTILITY($JOB,"W"),X
- +6 QUIT
- APRINT ;
- +1 IF '$DATA(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"ANY"))
- DO HEADER
- SET BGPNOD=1
- Begin DoDot:1
- +2 WRITE !!,"There were no GPRA Measures due for any patient selected."
- End DoDot:1
- QUIT
- +3 SET BGPNAME=""
- FOR
- SET BGPNAME=$ORDER(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"ANY",BGPNAME))
- IF BGPNAME=""!($DATA(BGPQ))
- QUIT
- Begin DoDot:1
- +4 SET DFN=0
- FOR
- SET DFN=$ORDER(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"ANY",BGPNAME,DFN))
- IF DFN'=+DFN!($DATA(BGPQ))
- QUIT
- Begin DoDot:2
- +5 DO HEADER
- IF $DATA(BGPQ)
- QUIT
- +6 DO SUB
- +7 SET BGPIC=0
- FOR
- SET BGPIC=$ORDER(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"ANY",BGPNAME,DFN,BGPIC))
- IF BGPIC'=+BGPIC!($DATA(BGPQ))
- QUIT
- Begin DoDot:3
- +8 SET BGPI=0
- FOR
- SET BGPI=$ORDER(^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"ANY",BGPNAME,DFN,BGPIC,BGPI))
- IF BGPI'=+BGPI!($DATA(BGPQ))
- QUIT
- Begin DoDot:4
- +9 IF $Y>(IOSL-3)
- DO HEADER
- IF $DATA(BGPQ)
- QUIT
- DO SUB
- +10 SET Y=^XTMP("BGP0DPA",BGPGPRAJ,BGPGPRAH,"ANY",BGPNAME,DFN,BGPIC,BGPI)
- +11 DO WRITE
- +12 ;S BGPX=$P(Y,U,2)
- +13 ;S BGPT=$P(Y,U,1),BGPT1=$P(Y,U,4)
- +14 ;W !,BGPT
- +15 ;F X=1:1 S Y=$P(BGPX,"|",X) Q:Y="" W:X'=1 ! W ?27,Y
- +16 ;I $Y>(IOSL-4) D HEADER Q:$D(BGPQ) D SUB
- +17 ;D WP
- End DoDot:4
- +18 QUIT
- End DoDot:3
- +19 QUIT
- End DoDot:2
- +20 QUIT
- End DoDot:1
- +21 QUIT
- SUB ;
- +1 SET T=$SELECT(BGPRT1="A":0,1:11)
- +2 IF BGPRT1'="A"
- WRITE !,$PIECE($$FMTE^XLFDT(BGPADT,"P")," ",4,99)
- +3 IF BGPRT1="A"
- WRITE !
- +4 WRITE ?T,$EXTRACT($PIECE(^DPT(DFN,0),U),1,25),?38,$$HRN^AUPNPAT(DFN,DUZ(2)),?46,$$SEX^AUPNPAT(DFN),?50,$$DATE^BGP0UTL($$DOB^AUPNPAT(DFN)),?60,$EXTRACT($$COMMRES^AUPNPAT(DFN,"E"),1,20),!
- +5 QUIT
- +1 IF 'BGPPG
- GOTO HEADER1
- +2 KILL DIR
- IF $EXTRACT(IOST)="C"
- IF IO=IO(0)
- WRITE !
- SET DIR(0)="EO"
- DO ^DIR
- KILL DIR
- IF Y=0!(Y="^")!($DATA(DTOUT))
- SET BGPQ=""
- QUIT
- +1 IF BGPPG
- IF $DATA(IOF)
- WRITE @IOF
- +2 SET BGPPG=BGPPG+1
- +3 IF $GET(BGPGUI)
- IF BGPPG'=1
- WRITE !,"ZZZZZZZ"
- +4 WRITE !,$PIECE(^VA(200,DUZ,0),U,2),?5,"***CONFIDENTIAL PATIENT INFORMATION-COVERED BY THE PRIVACY ACT***",?70,"Page ",BGPPG
- +5 IF '$GET(BGPNGR09)
- WRITE !,$$CTR("GPRA & PART Forecast Patient List",80)
- +6 IF $GET(BGPNGR09)
- WRITE !,$$CTR("GPRA & PART Forecast Patient List, Run Using 2010 Logic")
- +7 WRITE !,$$CTR("GPRA Measures Not Met or Due During "_$$FMTE^XLFDT(BGPBD)_"-"_$$FMTE^XLFDT(BGPED),80)
- +8 WRITE !,$$CTR($$RPTVER^BGP0BAN,80)
- +9 IF BGPRT1'="A"
- IF BGPCLN]""
- WRITE !,$$CTR("Patients with an Appointment in "_BGPCLN_$SELECT($GET(BGPD):" on "_$$FMTE^XLFDT(BGPD),1:""),80)
- +10 WRITE !,$$CTR("Date Report Run: "_$$FMTE^XLFDT(DT),80)
- +11 WRITE !,$$CTR("Site where Run: "_$PIECE(^DIC(4,DUZ(2),0),U),80)
- +12 WRITE !,$$CTR("Report Generated by: "_$PIECE(^VA(200,DUZ,0),U),80)
- +13 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-")
- +14 IF BGPRT1'="A"
- WRITE !,"Appt Time",?11,"Patient Name"
- +15 IF BGPRT1="A"
- WRITE !,"Patient Name"
- +16 WRITE ?38,"HRN",?46,"Sex",?50,"DOB",?60,"Community"
- +17 WRITE !,"GPRA Measure Not Met",?27,"Date of Last Screening and Next Due Date"
- +18 WRITE !?27,"Tests Counted for GPRA Measure"
- +19 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-")
- +20 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 KILL DIR
- +4 KILL DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
- +5 SET DIR("A")="End of report. Press Enter"
- 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 ;----------
- LOC() ;EP - Return location name from file 4 based on DUZ(2).
- +1 QUIT $SELECT($GET(DUZ(2)):$SELECT($DATA(^DIC(4,DUZ(2),0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
- +2 ;----------
