BGP6DPAW ; IHS/CMI/LAB - COMP NATIONAL GPRA FOR PTS W/APPT 01 Oct 2009 1:20 PM 13 Aug 2010 11:32 AM 14 Apr 2016 10:30 AM ;
;;16.1;IHS CLINICAL REPORTING;;MAR 22, 2016;Build 170
;
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("BGP6DPA",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("BGP6DPA",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("BGP6DPA",BGPGPRAJ,BGPGPRAH,"APPTS")) D HEADER S BGPNOD=1 W !!,"NO GPRA MEASURES DUE",! Q
S BGPCLN="" F S BGPCLN=$O(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPCLN)) Q:BGPCLN=""!($D(BGPQ)) D
.S BGPD=0 F S BGPD=$O(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPCLN,BGPD)) Q:BGPD'=+BGPD!($D(BGPQ)) D
..S BGPADT=0 F S BGPADT=$O(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPCLN,BGPD,BGPADT)) Q:BGPADT'=+BGPADT!($D(BGPQ)) D
...S BGPNAME="" F S BGPNAME=$O(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPCLN,BGPD,BGPADT,BGPNAME)) Q:BGPNAME=""!($D(BGPQ)) D
....S DFN=0 F S DFN=$O(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPCLN,BGPD,BGPADT,BGPNAME,DFN)) Q:DFN'=+DFN!($D(BGPQ)) D
.....D HEADER Q:$D(BGPQ)
.....D SUB
.....S BGPO="" F S BGPO=$O(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPCLN,BGPD,BGPADT,BGPNAME,DFN,BGPO)) Q:BGPO=""!($D(BGPQ)) D
......S BGPIC="" F S BGPIC=$O(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPCLN,BGPD,BGPADT,BGPNAME,DFN,BGPO,BGPIC)) Q:BGPIC=""!($D(BGPQ)) D
.......S BGPI=0 F S BGPI=$O(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPCLN,BGPD,BGPADT,BGPNAME,DFN,BGPO,BGPIC,BGPI)) Q:BGPI'=+BGPI!($D(BGPQ)) D
........I $Y>(IOSL-3) D HEADER Q:$D(BGPQ) D SUB
........S Y=^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPCLN,BGPD,BGPADT,BGPNAME,DFN,BGPO,BGPIC,BGPI)
........D WRITE
Q
DPRINT ;
I '$D(^XTMP("BGP6DPA",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("BGP6DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPDIVI)) Q:BGPDIVI'=+BGPDIVI!($D(BGPQ)) D DPRINT1
Q
DPRINT1 ;
S BGPCLN="" F S BGPCLN=$O(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPDIVI,BGPCLN)) Q:BGPCLN=""!($D(BGPQ)) D
.S BGPD=0 F S BGPD=$O(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPDIVI,BGPCLN,BGPD)) Q:BGPD'=+BGPD!($D(BGPQ)) D
..S BGPADT=0 F S BGPADT=$O(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPDIVI,BGPCLN,BGPD,BGPADT)) Q:BGPADT'=+BGPADT!($D(BGPQ)) D
...S BGPNAME="" F S BGPNAME=$O(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPDIVI,BGPCLN,BGPD,BGPADT,BGPNAME)) Q:BGPNAME=""!($D(BGPQ)) D
....S DFN=0 F S DFN=$O(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPDIVI,BGPCLN,BGPD,BGPADT,BGPNAME,DFN)) Q:DFN'=+DFN!($D(BGPQ)) D
.....D HEADER Q:$D(BGPQ)
.....D SUB
.....S BGPO="" F S BGPO=$O(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPDIVI,BGPCLN,BGPD,BGPADT,BGPNAME,DFN,BGPO)) Q:BGPO=""!($D(BGPQ)) D
......S BGPIC="" F S BGPIC=$O(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPDIVI,BGPCLN,BGPD,BGPADT,BGPNAME,DFN,BGPO,BGPIC)) Q:BGPIC=""!($D(BGPQ)) D
.......S BGPI=0 F S BGPI=$O(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPDIVI,BGPCLN,BGPD,BGPADT,BGPNAME,DFN,BGPO,BGPIC,BGPI)) Q:BGPI'=+BGPI!($D(BGPQ)) D
........I $Y>(IOSL-3) D HEADER Q:$D(BGPQ) D SUB
........S Y=^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPDIVI,BGPCLN,BGPD,BGPADT,BGPNAME,DFN,BGPO,BGPIC,BGPI)
........D WRITE
Q
PPRINT ;
I '$D(^XTMP("BGP6DPA",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("BGP6DPA",BGPGPRAJ,BGPGPRAH,"PATS",BGPNAME)) Q:BGPNAME=""!($D(BGPQ)) D
.S DFN=0 F S DFN=$O(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"PATS",BGPNAME,DFN)) Q:DFN'=+DFN!($D(BGPQ)) D
..S BGPD=0 F S BGPD=$O(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"PATS",BGPNAME,DFN,BGPD)) Q:BGPD'=+BGPD!($D(BGPQ)) D
...S BGPCLN="" F S BGPCLN=$O(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"PATS",BGPNAME,DFN,BGPD,BGPCLN)) Q:BGPCLN=""!($D(BGPQ)) D
....S BGPADT=0 F S BGPADT=$O(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"PATS",BGPNAME,DFN,BGPD,BGPCLN,BGPADT)) Q:BGPADT=""!($D(BGPQ)) D
.....D HEADER Q:$D(BGPQ)
.....D SUB
.....S BGPO="" F S BGPO=$O(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"PATS",BGPNAME,DFN,BGPD,BGPCLN,BGPADT,BGPO)) Q:BGPO=""!($D(BGPQ)) D
......S BGPIC="" F S BGPIC=$O(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"PATS",BGPNAME,DFN,BGPD,BGPCLN,BGPADT,BGPO,BGPIC)) Q:BGPIC=""!($D(BGPQ)) D
.......S BGPI=0 F S BGPI=$O(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"PATS",BGPNAME,DFN,BGPD,BGPCLN,BGPADT,BGPO,BGPIC,BGPI)) Q:BGPI'=+BGPI!($D(BGPQ)) D
........I $Y>(IOSL-3) D HEADER Q:$D(BGPQ) D SUB
........S Y=^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"PATS",BGPNAME,DFN,BGPD,BGPCLN,BGPADT,BGPO,BGPIC,BGPI)
........D WRITE
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(^BGPINDMC(BGPI,$S($G(BGPNGR09):1601,1:16),BGPZ)) Q:BGPZ'=+BGPZ D
.S X=^BGPINDMC(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("BGP6DPA",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("BGP6DPA",BGPGPRAJ,BGPGPRAH,"ANY",BGPNAME)) Q:BGPNAME=""!($D(BGPQ)) D
.S DFN=0 F S DFN=$O(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"ANY",BGPNAME,DFN)) Q:DFN'=+DFN!($D(BGPQ)) D
..D HEADER Q:$D(BGPQ)
..D SUB
..S BGPO="" F S BGPO=$O(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"ANY",BGPNAME,DFN,BGPO)) Q:BGPO=""!($D(BGPQ)) D
...S BGPIC="" F S BGPIC=$O(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"ANY",BGPNAME,DFN,BGPO,BGPIC)) Q:BGPIC=""!($D(BGPQ)) D
....S BGPI=0 F S BGPI=$O(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"ANY",BGPNAME,DFN,BGPO,BGPIC,BGPI)) Q:BGPI'=+BGPI!($D(BGPQ)) D
.....I $Y>(IOSL-3) D HEADER Q:$D(BGPQ) D SUB
.....S Y=^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"ANY",BGPNAME,DFN,BGPO,BGPIC,BGPI)
.....D WRITE
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^BGP6UTL($$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/GPRAMA Forecast Patient List",80)
I $G(BGPNGR09) W !,$$CTR("GPRA/GPRAMA Forecast Patient List, Run Using 2016 Logic")
W !,$$CTR("GPRA Measures Not Met or Due During "_$$FMTE^XLFDT(BGPBD)_"-"_$$FMTE^XLFDT(BGPED),80)
W !,$$CTR($$RPTVER^BGP6BAN,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 !!,"THIS REPORT SHOULD ONLY BE USED TO DETERMINE WHICH GPRA MEASURES HAVE NOT"
W !,"BEEN MET FOR PATIENTS. IT SHOULD NOT BE USED TO DETERMINE APPROPRIATE"
W !,"PATIENT CARE FOR INDIVIDUALS, AS THIS MAY VARY FROM PATIENT TO PATIENT."
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")
;----------
BGP6DPAW ; IHS/CMI/LAB - COMP NATIONAL GPRA FOR PTS W/APPT 01 Oct 2009 1:20 PM 13 Aug 2010 11:32 AM 14 Apr 2016 10:30 AM ;
+1 ;;16.1;IHS CLINICAL REPORTING;;MAR 22, 2016;Build 170
+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("BGP6DPA",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("BGP6DPA",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("BGP6DPA",BGPGPRAJ,BGPGPRAH,"APPTS")) D HEADER S BGPNOD=1 W !!,"NO GPRA MEASURES DUE",! Q
+7 SET BGPCLN=""
FOR
SET BGPCLN=$ORDER(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPCLN))
IF BGPCLN=""!($DATA(BGPQ))
QUIT
Begin DoDot:1
+8 SET BGPD=0
FOR
SET BGPD=$ORDER(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPCLN,BGPD))
IF BGPD'=+BGPD!($DATA(BGPQ))
QUIT
Begin DoDot:2
+9 SET BGPADT=0
FOR
SET BGPADT=$ORDER(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPCLN,BGPD,BGPADT))
IF BGPADT'=+BGPADT!($DATA(BGPQ))
QUIT
Begin DoDot:3
+10 SET BGPNAME=""
FOR
SET BGPNAME=$ORDER(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPCLN,BGPD,BGPADT,BGPNAME))
IF BGPNAME=""!($DATA(BGPQ))
QUIT
Begin DoDot:4
+11 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("BGP6DPA",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 BGPO=""
FOR
SET BGPO=$ORDER(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPCLN,BGPD,BGPADT,BGPNAME,DFN,BGPO))
IF BGPO=""!($DATA(BGPQ))
QUIT
Begin DoDot:6
+15 SET BGPIC=""
FOR
SET BGPIC=$ORDER(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPCLN,BGPD,BGPADT,BGPNAME,DFN,BGPO,BGPIC))
IF BGPIC=""!($DATA(BGPQ))
QUIT
Begin DoDot:7
+16 SET BGPI=0
FOR
SET BGPI=$ORDER(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPCLN,BGPD,BGPADT,BGPNAME,DFN,BGPO,BGPIC,BGPI))
IF BGPI'=+BGPI!($DATA(BGPQ))
QUIT
Begin DoDot:8
+17 IF $Y>(IOSL-3)
DO HEADER
IF $DATA(BGPQ)
QUIT
DO SUB
+18 SET Y=^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPCLN,BGPD,BGPADT,BGPNAME,DFN,BGPO,BGPIC,BGPI)
+19 DO WRITE
End DoDot:8
End DoDot:7
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+20 QUIT
DPRINT ;
+1 IF '$DATA(^XTMP("BGP6DPA",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("BGP6DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPDIVI))
IF BGPDIVI'=+BGPDIVI!($DATA(BGPQ))
QUIT
DO DPRINT1
+8 QUIT
DPRINT1 ;
+1 SET BGPCLN=""
FOR
SET BGPCLN=$ORDER(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPDIVI,BGPCLN))
IF BGPCLN=""!($DATA(BGPQ))
QUIT
Begin DoDot:1
+2 SET BGPD=0
FOR
SET BGPD=$ORDER(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPDIVI,BGPCLN,BGPD))
IF BGPD'=+BGPD!($DATA(BGPQ))
QUIT
Begin DoDot:2
+3 SET BGPADT=0
FOR
SET BGPADT=$ORDER(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPDIVI,BGPCLN,BGPD,BGPADT))
IF BGPADT'=+BGPADT!($DATA(BGPQ))
QUIT
Begin DoDot:3
+4 SET BGPNAME=""
FOR
SET BGPNAME=$ORDER(^XTMP("BGP6DPA",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("BGP6DPA",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 BGPO=""
FOR
SET BGPO=$ORDER(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPDIVI,BGPCLN,BGPD,BGPADT,BGPNAME,DFN,BGPO))
IF BGPO=""!($DATA(BGPQ))
QUIT
Begin DoDot:6
+9 SET BGPIC=""
FOR
SET BGPIC=$ORDER(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPDIVI,BGPCLN,BGPD,BGPADT,BGPNAME,DFN,BGPO,BGPIC))
IF BGPIC=""!($DATA(BGPQ))
QUIT
Begin DoDot:7
+10 SET BGPI=0
FOR
SET BGPI=$ORDER(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPDIVI,BGPCLN,BGPD,BGPADT,BGPNAME,DFN,BGPO,BGPIC,BGPI))
IF BGPI'=+BGPI!($DATA(BGPQ))
QUIT
Begin DoDot:8
+11 IF $Y>(IOSL-3)
DO HEADER
IF $DATA(BGPQ)
QUIT
DO SUB
+12 SET Y=^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"APPTS",BGPDIVI,BGPCLN,BGPD,BGPADT,BGPNAME,DFN,BGPO,BGPIC,BGPI)
+13 DO WRITE
End DoDot:8
End DoDot:7
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+14 QUIT
PPRINT ;
+1 IF '$DATA(^XTMP("BGP6DPA",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("BGP6DPA",BGPGPRAJ,BGPGPRAH,"PATS",BGPNAME))
IF BGPNAME=""!($DATA(BGPQ))
QUIT
Begin DoDot:1
+4 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"PATS",BGPNAME,DFN))
IF DFN'=+DFN!($DATA(BGPQ))
QUIT
Begin DoDot:2
+5 SET BGPD=0
FOR
SET BGPD=$ORDER(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"PATS",BGPNAME,DFN,BGPD))
IF BGPD'=+BGPD!($DATA(BGPQ))
QUIT
Begin DoDot:3
+6 SET BGPCLN=""
FOR
SET BGPCLN=$ORDER(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"PATS",BGPNAME,DFN,BGPD,BGPCLN))
IF BGPCLN=""!($DATA(BGPQ))
QUIT
Begin DoDot:4
+7 SET BGPADT=0
FOR
SET BGPADT=$ORDER(^XTMP("BGP6DPA",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 BGPO=""
FOR
SET BGPO=$ORDER(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"PATS",BGPNAME,DFN,BGPD,BGPCLN,BGPADT,BGPO))
IF BGPO=""!($DATA(BGPQ))
QUIT
Begin DoDot:6
+11 SET BGPIC=""
FOR
SET BGPIC=$ORDER(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"PATS",BGPNAME,DFN,BGPD,BGPCLN,BGPADT,BGPO,BGPIC))
IF BGPIC=""!($DATA(BGPQ))
QUIT
Begin DoDot:7
+12 SET BGPI=0
FOR
SET BGPI=$ORDER(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"PATS",BGPNAME,DFN,BGPD,BGPCLN,BGPADT,BGPO,BGPIC,BGPI))
IF BGPI'=+BGPI!($DATA(BGPQ))
QUIT
Begin DoDot:8
+13 IF $Y>(IOSL-3)
DO HEADER
IF $DATA(BGPQ)
QUIT
DO SUB
+14 SET Y=^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"PATS",BGPNAME,DFN,BGPD,BGPCLN,BGPADT,BGPO,BGPIC,BGPI)
+15 DO WRITE
End DoDot:8
End DoDot:7
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+16 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(^BGPINDMC(BGPI,$SELECT($GET(BGPNGR09):1601,1:16),BGPZ))
IF BGPZ'=+BGPZ
QUIT
Begin DoDot:1
+5 SET X=^BGPINDMC(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("BGP6DPA",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("BGP6DPA",BGPGPRAJ,BGPGPRAH,"ANY",BGPNAME))
IF BGPNAME=""!($DATA(BGPQ))
QUIT
Begin DoDot:1
+4 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("BGP6DPA",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 BGPO=""
FOR
SET BGPO=$ORDER(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"ANY",BGPNAME,DFN,BGPO))
IF BGPO=""!($DATA(BGPQ))
QUIT
Begin DoDot:3
+8 SET BGPIC=""
FOR
SET BGPIC=$ORDER(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"ANY",BGPNAME,DFN,BGPO,BGPIC))
IF BGPIC=""!($DATA(BGPQ))
QUIT
Begin DoDot:4
+9 SET BGPI=0
FOR
SET BGPI=$ORDER(^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"ANY",BGPNAME,DFN,BGPO,BGPIC,BGPI))
IF BGPI'=+BGPI!($DATA(BGPQ))
QUIT
Begin DoDot:5
+10 IF $Y>(IOSL-3)
DO HEADER
IF $DATA(BGPQ)
QUIT
DO SUB
+11 SET Y=^XTMP("BGP6DPA",BGPGPRAJ,BGPGPRAH,"ANY",BGPNAME,DFN,BGPO,BGPIC,BGPI)
+12 DO WRITE
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+13 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^BGP6UTL($$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/GPRAMA Forecast Patient List",80)
+6 IF $GET(BGPNGR09)
WRITE !,$$CTR("GPRA/GPRAMA Forecast Patient List, Run Using 2016 Logic")
+7 WRITE !,$$CTR("GPRA Measures Not Met or Due During "_$$FMTE^XLFDT(BGPBD)_"-"_$$FMTE^XLFDT(BGPED),80)
+8 WRITE !,$$CTR($$RPTVER^BGP6BAN,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 !!,"THIS REPORT SHOULD ONLY BE USED TO DETERMINE WHICH GPRA MEASURES HAVE NOT"
+14 WRITE !,"BEEN MET FOR PATIENTS. IT SHOULD NOT BE USED TO DETERMINE APPROPRIATE"
+15 WRITE !,"PATIENT CARE FOR INDIVIDUALS, AS THIS MAY VARY FROM PATIENT TO PATIENT."
+16 WRITE !!,$TRANSLATE($JUSTIFY("",80)," ","-")
+17 IF BGPRT1'="A"
WRITE !,"Appt Time",?11,"Patient Name"
+18 IF BGPRT1="A"
WRITE !,"Patient Name"
+19 WRITE ?38,"HRN",?46,"Sex",?50,"DOB",?60,"Community"
+20 WRITE !,"GPRA Measure Not Met",?27,"Date of Last Screening and Next Due Date"
+21 WRITE !?27,"Tests Counted for GPRA Measure"
+22 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-")
+23 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 ;----------
