BGP1DPAW ; IHS/CMI/LAB - COMP NATIONAL GPRA FOR PTS W/APPT 01 Oct 2009 1:20 PM 13 Aug 2010 11:32 AM ;
;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
;
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("BGP1DPA",BGPGPRAJ,BGPGPRAH)
Q
CNT(T) ;
NEW X,C
S (X,C)=0
F S X=$O(^DIBT(T,1,X)) Q:X'=+X S C=C+1
Q C
;
PRINT ;EP - called from xbdbque
S BGPIOSL=$S($G(BGPGUI):55,1:IOSL)
I $G(BGPGUI) S IOSL=55 ;cmi/maw added 1/14/2010
K BGPQ S BGPPG=0,BGPNOD=0
I $G(BGPSTMP) D Q
.D HEADER
.W !!,"Search Template ",$P(^DIBT(BGPSTMP,0),U,1)," created with ",$$CNT(BGPSTMP)," patients.",!!
.D DONE
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("BGP1DPA",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("BGP1DPA",BGPGPRAJ,BGPGPRAH,"APPTS")) D HEADER S BGPNOD=1 W !!,"NO GPRA MEASURES DUE",! Q
S BGPCLN="" F S BGPCLN=$O(^XTMP("BGP1DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPCLN)) Q:BGPCLN=""!($D(BGPQ)) D
.S BGPD=0 F S BGPD=$O(^XTMP("BGP1DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPCLN,BGPD)) Q:BGPD'=+BGPD!($D(BGPQ)) D
..S BGPADT=0 F S BGPADT=$O(^XTMP("BGP1DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPCLN,BGPD,BGPADT)) Q:BGPADT'=+BGPADT!($D(BGPQ)) D
...S BGPNAME="" F S BGPNAME=$O(^XTMP("BGP1DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPCLN,BGPD,BGPADT,BGPNAME)) Q:BGPNAME=""!($D(BGPQ)) D
....S DFN=0 F S DFN=$O(^XTMP("BGP1DPA",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("BGP1DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPCLN,BGPD,BGPADT,BGPNAME,DFN,BGPIC)) Q:BGPIC'=+BGPIC!($D(BGPQ)) D
......S BGPI=0 F S BGPI=$O(^XTMP("BGP1DPA",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("BGP1DPA",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("BGP1DPA",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("BGP1DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPDIVI)) Q:BGPDIVI'=+BGPDIVI!($D(BGPQ)) D DPRINT1
Q
DPRINT1 ;
S BGPCLN="" F S BGPCLN=$O(^XTMP("BGP1DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPDIVI,BGPCLN)) Q:BGPCLN=""!($D(BGPQ)) D
.S BGPD=0 F S BGPD=$O(^XTMP("BGP1DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPDIVI,BGPCLN,BGPD)) Q:BGPD'=+BGPD!($D(BGPQ)) D
..S BGPADT=0 F S BGPADT=$O(^XTMP("BGP1DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPDIVI,BGPCLN,BGPD,BGPADT)) Q:BGPADT'=+BGPADT!($D(BGPQ)) D
...S BGPNAME="" F S BGPNAME=$O(^XTMP("BGP1DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPDIVI,BGPCLN,BGPD,BGPADT,BGPNAME)) Q:BGPNAME=""!($D(BGPQ)) D
....S DFN=0 F S DFN=$O(^XTMP("BGP1DPA",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("BGP1DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPDIVI,BGPCLN,BGPD,BGPADT,BGPNAME,DFN,BGPIC)) Q:BGPIC'=+BGPIC!($D(BGPQ)) D
......S BGPI=0 F S BGPI=$O(^XTMP("BGP1DPA",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("BGP1DPA",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("BGP1DPA",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("BGP1DPA",BGPGPRAJ,BGPGPRAH,"PATS",BGPNAME)) Q:BGPNAME=""!($D(BGPQ)) D
.S DFN=0 F S DFN=$O(^XTMP("BGP1DPA",BGPGPRAJ,BGPGPRAH,"PATS",BGPNAME,DFN)) Q:DFN'=+DFN!($D(BGPQ)) D
..S BGPD=0 F S BGPD=$O(^XTMP("BGP1DPA",BGPGPRAJ,BGPGPRAH,"PATS",BGPNAME,DFN,BGPD)) Q:BGPD'=+BGPD!($D(BGPQ)) D
...S BGPCLN="" F S BGPCLN=$O(^XTMP("BGP1DPA",BGPGPRAJ,BGPGPRAH,"PATS",BGPNAME,DFN,BGPD,BGPCLN)) Q:BGPCLN=""!($D(BGPQ)) D
....S BGPADT=0 F S BGPADT=$O(^XTMP("BGP1DPA",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("BGP1DPA",BGPGPRAJ,BGPGPRAH,"PATS",BGPNAME,DFN,BGPD,BGPCLN,BGPADT,BGPIC)) Q:BGPIC'=+BGPIC!($D(BGPQ)) D
......S BGPI=0 F S BGPI=$O(^XTMP("BGP1DPA",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("BGP1DPA",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(^BGPINDBC(BGPI,$S($G(BGPNGR09):1601,1:16),BGPZ)) Q:BGPZ'=+BGPZ D
.S X=^BGPINDBC(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("BGP1DPA",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("BGP1DPA",BGPGPRAJ,BGPGPRAH,"ANY",BGPNAME)) Q:BGPNAME=""!($D(BGPQ)) D
.S DFN=0 F S DFN=$O(^XTMP("BGP1DPA",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("BGP1DPA",BGPGPRAJ,BGPGPRAH,"ANY",BGPNAME,DFN,BGPIC)) Q:BGPIC'=+BGPIC!($D(BGPQ)) D
...S BGPI=0 F S BGPI=$O(^XTMP("BGP1DPA",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("BGP1DPA",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^BGP1UTL($$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 2011 Logic")
W !,$$CTR("GPRA Measures Not Met or Due During "_$$FMTE^XLFDT(BGPBD)_"-"_$$FMTE^XLFDT(BGPED),80)
W !,$$CTR($$RPTVER^BGP1BAN,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")
;----------
BGP1DPAW ; IHS/CMI/LAB - COMP NATIONAL GPRA FOR PTS W/APPT 01 Oct 2009 1:20 PM 13 Aug 2010 11:32 AM ;
+1 ;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
+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("BGP1DPA",BGPGPRAJ,BGPGPRAH)
+6 QUIT
CNT(T) ;
+1 NEW X,C
+2 SET (X,C)=0
+3 FOR
SET X=$ORDER(^DIBT(T,1,X))
IF X'=+X
QUIT
SET C=C+1
+4 QUIT C
+5 ;
PRINT ;EP - called from xbdbque
+1 SET BGPIOSL=$SELECT($GET(BGPGUI):55,1:IOSL)
+2 ;cmi/maw added 1/14/2010
IF $GET(BGPGUI)
SET IOSL=55
+3 KILL BGPQ
SET BGPPG=0
SET BGPNOD=0
+4 IF $GET(BGPSTMP)
Begin DoDot:1
+5 DO HEADER
+6 WRITE !!,"Search Template ",$PIECE(^DIBT(BGPSTMP,0),U,1)," created with ",$$CNT(BGPSTMP)," patients.",!!
+7 DO DONE
End DoDot:1
QUIT
+8 IF BGPRT1="P"
DO PPRINT
DO DONE
QUIT
+9 IF BGPRT1="C"
DO CPRINT
DO DONE
QUIT
+10 IF BGPRT1="A"
DO APRINT
DO DONE
QUIT
+11 IF BGPRT1="D"
DO DPRINT
DO DONE
QUIT
+12 QUIT
CPRINT ;
+1 IF '$DATA(^XTMP("BGP1DPA",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("BGP1DPA",BGPGPRAJ,BGPGPRAH,"APPTS")) D HEADER S BGPNOD=1 W !!,"NO GPRA MEASURES DUE",! Q
+7 SET BGPCLN=""
FOR
SET BGPCLN=$ORDER(^XTMP("BGP1DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPCLN))
IF BGPCLN=""!($DATA(BGPQ))
QUIT
Begin DoDot:1
+8 SET BGPD=0
FOR
SET BGPD=$ORDER(^XTMP("BGP1DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPCLN,BGPD))
IF BGPD'=+BGPD!($DATA(BGPQ))
QUIT
Begin DoDot:2
+9 SET BGPADT=0
FOR
SET BGPADT=$ORDER(^XTMP("BGP1DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPCLN,BGPD,BGPADT))
IF BGPADT'=+BGPADT!($DATA(BGPQ))
QUIT
Begin DoDot:3
+10 SET BGPNAME=""
FOR
SET BGPNAME=$ORDER(^XTMP("BGP1DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPCLN,BGPD,BGPADT,BGPNAME))
IF BGPNAME=""!($DATA(BGPQ))
QUIT
Begin DoDot:4
+11 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("BGP1DPA",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("BGP1DPA",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("BGP1DPA",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("BGP1DPA",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("BGP1DPA",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("BGP1DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPDIVI))
IF BGPDIVI'=+BGPDIVI!($DATA(BGPQ))
QUIT
DO DPRINT1
+8 QUIT
DPRINT1 ;
+1 SET BGPCLN=""
FOR
SET BGPCLN=$ORDER(^XTMP("BGP1DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPDIVI,BGPCLN))
IF BGPCLN=""!($DATA(BGPQ))
QUIT
Begin DoDot:1
+2 SET BGPD=0
FOR
SET BGPD=$ORDER(^XTMP("BGP1DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPDIVI,BGPCLN,BGPD))
IF BGPD'=+BGPD!($DATA(BGPQ))
QUIT
Begin DoDot:2
+3 SET BGPADT=0
FOR
SET BGPADT=$ORDER(^XTMP("BGP1DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPDIVI,BGPCLN,BGPD,BGPADT))
IF BGPADT'=+BGPADT!($DATA(BGPQ))
QUIT
Begin DoDot:3
+4 SET BGPNAME=""
FOR
SET BGPNAME=$ORDER(^XTMP("BGP1DPA",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("BGP1DPA",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("BGP1DPA",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("BGP1DPA",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("BGP1DPA",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("BGP1DPA",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("BGP1DPA",BGPGPRAJ,BGPGPRAH,"PATS",BGPNAME))
IF BGPNAME=""!($DATA(BGPQ))
QUIT
Begin DoDot:1
+4 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("BGP1DPA",BGPGPRAJ,BGPGPRAH,"PATS",BGPNAME,DFN))
IF DFN'=+DFN!($DATA(BGPQ))
QUIT
Begin DoDot:2
+5 SET BGPD=0
FOR
SET BGPD=$ORDER(^XTMP("BGP1DPA",BGPGPRAJ,BGPGPRAH,"PATS",BGPNAME,DFN,BGPD))
IF BGPD'=+BGPD!($DATA(BGPQ))
QUIT
Begin DoDot:3
+6 SET BGPCLN=""
FOR
SET BGPCLN=$ORDER(^XTMP("BGP1DPA",BGPGPRAJ,BGPGPRAH,"PATS",BGPNAME,DFN,BGPD,BGPCLN))
IF BGPCLN=""!($DATA(BGPQ))
QUIT
Begin DoDot:4
+7 SET BGPADT=0
FOR
SET BGPADT=$ORDER(^XTMP("BGP1DPA",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("BGP1DPA",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("BGP1DPA",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("BGP1DPA",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(^BGPINDBC(BGPI,$SELECT($GET(BGPNGR09):1601,1:16),BGPZ))
IF BGPZ'=+BGPZ
QUIT
Begin DoDot:1
+5 SET X=^BGPINDBC(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("BGP1DPA",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("BGP1DPA",BGPGPRAJ,BGPGPRAH,"ANY",BGPNAME))
IF BGPNAME=""!($DATA(BGPQ))
QUIT
Begin DoDot:1
+4 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("BGP1DPA",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("BGP1DPA",BGPGPRAJ,BGPGPRAH,"ANY",BGPNAME,DFN,BGPIC))
IF BGPIC'=+BGPIC!($DATA(BGPQ))
QUIT
Begin DoDot:3
+8 SET BGPI=0
FOR
SET BGPI=$ORDER(^XTMP("BGP1DPA",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("BGP1DPA",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^BGP1UTL($$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 2011 Logic")
+7 WRITE !,$$CTR("GPRA Measures Not Met or Due During "_$$FMTE^XLFDT(BGPBD)_"-"_$$FMTE^XLFDT(BGPED),80)
+8 WRITE !,$$CTR($$RPTVER^BGP1BAN,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 ;----------
