BGP5DELP ; IHS/CMI/LAB - IHS HEDIS print ;
;;15.1;IHS CLINICAL REPORTING;;MAY 06, 2015;Build 143
;
;
PRINT ;
K ^TMP($J)
S BGPIOSL=$S($G(BGPGUI):55,1:IOSL)
I BGPROT="D" G DEL
S BGPPTYPE="P"
D ^BGP5ELH
S BGPGPG=0
S BGPQUIT=""
D PRINT1
K ^TMP($J)
I BGPROT="P" K ^XTMP("BGP5D",BGPJ,BGPH),^TMP($J) Q
;
DEL ;create delimited output file
D ^%ZISC ;close printer device
K ^TMP($J)
S BGPPTYPE="D"
D ^BGP5ELL ;create ^tmp of delimited report
K ^XTMP("BGP5D",BGPJ,BGPH)
K ^TMP($J)
Q
WP ;
K ^UTILITY($J,"W")
S BGPZ=0,BGPLCNT=0
S DIWL=1,DIWR=80,DIWF="" F S BGPZ=$O(^BGPELIK(BGPIC,BGPNODE,BGPY,1,BGPZ)) Q:BGPZ'=+BGPZ D
.S BGPLCNT=BGPLCNT+1
.S X=^BGPELIK(BGPIC,BGPNODE,BGPY,1,BGPZ,0) S:BGPLCNT=1 X=" - "_X D ^DIWP
.Q
WPS ;
S Z=0 F S Z=$O(^UTILITY($J,"W",DIWL,Z)) Q:Z'=+Z D
.I $Y>(BGPIOSL-3) D HEADER^BGP5DPH Q:BGPQUIT
.;D W^BGP5DP(^UTILITY($J,"W",DIWL,Z,0),0,1,BGPPTYPE)
.W !,^UTILITY($J,"W",DIWL,Z,0)
K DIWL,DIWR,DIWF,Z
K ^UTILITY($J,"W"),X
Q
;
PRINT1 ;EP
S BGPIC=0 F S BGPIC=$O(BGPIND(BGPIC)) Q:BGPIC=""!(BGPQUIT) D
.D HEADER^BGP5DPH ;header for all measures
.I $Y>(BGPIOSL-3) D HEADER^BGP5DPH Q:BGPQUIT
.W !,$P(^BGPELIK(BGPIC,0),U,3),!
.I $G(BGPDNT) G CALC
.I $Y>(BGPIOSL-3) D HEADER^BGP5DPH Q:BGPQUIT
.W !,"Denominator(s):"
.S BGPNODE=61
.S BGPX=0 F S BGPX=$O(^BGPELIK(BGPIC,61,"B",BGPX)) Q:BGPX'=+BGPX!(BGPQUIT) D
..S BGPY=0 F S BGPY=$O(^BGPELIK(BGPIC,61,"B",BGPX,BGPY)) Q:BGPY'=+BGPY!(BGPQUIT) D
...;S BGPZ=0 F S BGPZ=$O(^BGPELIK(BGPIC,61,BGPY,1,BGPZ)) Q:BGPZ'=+BGPZ!(BGPQUIT) D
...;I $Y>(BGPIOSL-3) D HEADER^BGP5DPH Q:BGPQUIT
...D WP ;W !,^BGPELIK(BGPIC,61,BGPY,1,BGPZ,0)
...Q
...;W !
...Q
..Q
.I $Y>(BGPIOSL-3) D HEADER^BGP5DPH Q:BGPQUIT
.W !!,"Numerator(s):"
.S BGPNODE=62
.S BGPX=0 F S BGPX=$O(^BGPELIK(BGPIC,62,"B",BGPX)) Q:BGPX'=+BGPX!(BGPQUIT) D
..S BGPY=0 F S BGPY=$O(^BGPELIK(BGPIC,62,"B",BGPX,BGPY)) Q:BGPY'=+BGPY!(BGPQUIT) D
...;S BGPZ=0 F S BGPZ=$O(^BGPELIK(BGPIC,62,BGPY,1,BGPZ)) Q:BGPZ'=+BGPZ!(BGPQUIT) D
...;.I $Y>(BGPIOSL-3) D HEADER^BGP5DPH Q:BGPQUIT
...;.W !,^BGPELIK(BGPIC,62,BGPY,1,BGPZ,0)
...D WP ;.Q
...Q
..Q
.I $O(^BGPELIK(BGPIC,11,0)) W !!,"Logic" S BGPX=0 F S BGPX=$O(^BGPELIK(BGPIC,11,BGPX)) Q:BGPX'=+BGPX D
..I $Y>(BGPIOSL-3) D HEADER^BGP5DPH Q:BGPQUIT
..W !,^BGPELIK(BGPIC,11,BGPX,0)
.I $O(^BGPELIK(BGPIC,51,0)) W !!,"Performance Measure Description" S BGPX=0 F S BGPX=$O(^BGPELIK(BGPIC,51,BGPX)) Q:BGPX'=+BGPX D
..I $Y>(BGPIOSL-3) D HEADER^BGP5DPH Q:BGPQUIT
..W !,^BGPELIK(BGPIC,51,BGPX,0)
.I $O(^BGPELIK(BGPIC,52,0)) W !!,"Past Performance and/or Target" S BGPX=0 F S BGPX=$O(^BGPELIK(BGPIC,52,BGPX)) Q:BGPX'=+BGPX D
..I $Y>(BGPIOSL-3) D HEADER^BGP5DPH Q:BGPQUIT
..W !,^BGPELIK(BGPIC,52,BGPX,0)
CALC .;
.X ^BGPELIK(BGPIC,3)
;
D ^BGP5ELS
D EXIT
Q
EXIT ;
I $E(IOST)="C",IO=IO(0),'$D(ZTQUEUED) W ! S DIR(0)="EO",DIR("A")="End of report. Press ENTER" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q
C(X,X2,X3) ;
D COMMA^%DTC
Q X
BGP5DELP ; IHS/CMI/LAB - IHS HEDIS print ;
+1 ;;15.1;IHS CLINICAL REPORTING;;MAY 06, 2015;Build 143
+2 ;
+3 ;
PRINT ;
+1 KILL ^TMP($JOB)
+2 SET BGPIOSL=$SELECT($GET(BGPGUI):55,1:IOSL)
+3 IF BGPROT="D"
GOTO DEL
+4 SET BGPPTYPE="P"
+5 DO ^BGP5ELH
+6 SET BGPGPG=0
+7 SET BGPQUIT=""
+8 DO PRINT1
+9 KILL ^TMP($JOB)
+10 IF BGPROT="P"
KILL ^XTMP("BGP5D",BGPJ,BGPH),^TMP($JOB)
QUIT
+11 ;
DEL ;create delimited output file
+1 ;close printer device
DO ^%ZISC
+2 KILL ^TMP($JOB)
+3 SET BGPPTYPE="D"
+4 ;create ^tmp of delimited report
DO ^BGP5ELL
+5 KILL ^XTMP("BGP5D",BGPJ,BGPH)
+6 KILL ^TMP($JOB)
+7 QUIT
WP ;
+1 KILL ^UTILITY($JOB,"W")
+2 SET BGPZ=0
SET BGPLCNT=0
+3 SET DIWL=1
SET DIWR=80
SET DIWF=""
FOR
SET BGPZ=$ORDER(^BGPELIK(BGPIC,BGPNODE,BGPY,1,BGPZ))
IF BGPZ'=+BGPZ
QUIT
Begin DoDot:1
+4 SET BGPLCNT=BGPLCNT+1
+5 SET X=^BGPELIK(BGPIC,BGPNODE,BGPY,1,BGPZ,0)
IF BGPLCNT=1
SET X=" - "_X
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 $Y>(BGPIOSL-3)
DO HEADER^BGP5DPH
IF BGPQUIT
QUIT
+3 ;D W^BGP5DP(^UTILITY($J,"W",DIWL,Z,0),0,1,BGPPTYPE)
+4 WRITE !,^UTILITY($JOB,"W",DIWL,Z,0)
End DoDot:1
+5 KILL DIWL,DIWR,DIWF,Z
+6 KILL ^UTILITY($JOB,"W"),X
+7 QUIT
+8 ;
PRINT1 ;EP
+1 SET BGPIC=0
FOR
SET BGPIC=$ORDER(BGPIND(BGPIC))
IF BGPIC=""!(BGPQUIT)
QUIT
Begin DoDot:1
+2 ;header for all measures
DO HEADER^BGP5DPH
+3 IF $Y>(BGPIOSL-3)
DO HEADER^BGP5DPH
IF BGPQUIT
QUIT
+4 WRITE !,$PIECE(^BGPELIK(BGPIC,0),U,3),!
+5 IF $GET(BGPDNT)
GOTO CALC
+6 IF $Y>(BGPIOSL-3)
DO HEADER^BGP5DPH
IF BGPQUIT
QUIT
+7 WRITE !,"Denominator(s):"
+8 SET BGPNODE=61
+9 SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPELIK(BGPIC,61,"B",BGPX))
IF BGPX'=+BGPX!(BGPQUIT)
QUIT
Begin DoDot:2
+10 SET BGPY=0
FOR
SET BGPY=$ORDER(^BGPELIK(BGPIC,61,"B",BGPX,BGPY))
IF BGPY'=+BGPY!(BGPQUIT)
QUIT
Begin DoDot:3
+11 ;S BGPZ=0 F S BGPZ=$O(^BGPELIK(BGPIC,61,BGPY,1,BGPZ)) Q:BGPZ'=+BGPZ!(BGPQUIT) D
+12 ;I $Y>(BGPIOSL-3) D HEADER^BGP5DPH Q:BGPQUIT
+13 ;W !,^BGPELIK(BGPIC,61,BGPY,1,BGPZ,0)
DO WP
+14 QUIT
+15 ;W !
+16 QUIT
End DoDot:3
+17 QUIT
End DoDot:2
+18 IF $Y>(BGPIOSL-3)
DO HEADER^BGP5DPH
IF BGPQUIT
QUIT
+19 WRITE !!,"Numerator(s):"
+20 SET BGPNODE=62
+21 SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPELIK(BGPIC,62,"B",BGPX))
IF BGPX'=+BGPX!(BGPQUIT)
QUIT
Begin DoDot:2
+22 SET BGPY=0
FOR
SET BGPY=$ORDER(^BGPELIK(BGPIC,62,"B",BGPX,BGPY))
IF BGPY'=+BGPY!(BGPQUIT)
QUIT
Begin DoDot:3
+23 ;S BGPZ=0 F S BGPZ=$O(^BGPELIK(BGPIC,62,BGPY,1,BGPZ)) Q:BGPZ'=+BGPZ!(BGPQUIT) D
+24 ;.I $Y>(BGPIOSL-3) D HEADER^BGP5DPH Q:BGPQUIT
+25 ;.W !,^BGPELIK(BGPIC,62,BGPY,1,BGPZ,0)
+26 ;.Q
DO WP
+27 QUIT
End DoDot:3
+28 QUIT
End DoDot:2
+29 IF $ORDER(^BGPELIK(BGPIC,11,0))
WRITE !!,"Logic"
SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPELIK(BGPIC,11,BGPX))
IF BGPX'=+BGPX
QUIT
Begin DoDot:2
+30 IF $Y>(BGPIOSL-3)
DO HEADER^BGP5DPH
IF BGPQUIT
QUIT
+31 WRITE !,^BGPELIK(BGPIC,11,BGPX,0)
End DoDot:2
+32 IF $ORDER(^BGPELIK(BGPIC,51,0))
WRITE !!,"Performance Measure Description"
SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPELIK(BGPIC,51,BGPX))
IF BGPX'=+BGPX
QUIT
Begin DoDot:2
+33 IF $Y>(BGPIOSL-3)
DO HEADER^BGP5DPH
IF BGPQUIT
QUIT
+34 WRITE !,^BGPELIK(BGPIC,51,BGPX,0)
End DoDot:2
+35 IF $ORDER(^BGPELIK(BGPIC,52,0))
WRITE !!,"Past Performance and/or Target"
SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPELIK(BGPIC,52,BGPX))
IF BGPX'=+BGPX
QUIT
Begin DoDot:2
+36 IF $Y>(BGPIOSL-3)
DO HEADER^BGP5DPH
IF BGPQUIT
QUIT
+37 WRITE !,^BGPELIK(BGPIC,52,BGPX,0)
End DoDot:2
CALC ;
+1 XECUTE ^BGPELIK(BGPIC,3)
End DoDot:1
+2 ;
+3 DO ^BGP5ELS
+4 DO EXIT
+5 QUIT
EXIT ;
+1 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
IF '$DATA(ZTQUEUED)
WRITE !
SET DIR(0)="EO"
SET DIR("A")="End of report. Press ENTER"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 QUIT
C(X,X2,X3) ;
+1 DO COMMA^%DTC
+2 QUIT X
