BGP6DHEP ; IHS/CMI/LAB - IHS HEDIS print ;
;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007
;
;
PRINT ;
K ^TMP($J)
S BGPIOSL=$S($G(BGPGUI):55,1:IOSL)
I BGPROT="D" G DEL
D ^BGP6HEH
S BGPGPG=0
S BGPQUIT=""
D PRINT1
K ^TMP($J)
I BGPROT="P" K ^XTMP("BGP6D",BGPJ,BGPH),^TMP($J) Q
;
DEL ;create delimited output file
I '$D(BGPGUI) D ^%ZISC ;close printer device
K ^TMP($J)
D ^BGP6HEL ;create ^tmp of delimited report
K ^XTMP("BGP6D",BGPJ,BGPH)
K ^TMP($J)
Q
;
PRINT1 ;EP
S BGPIC=0 F S BGPIC=$O(BGPIND(BGPIC)) Q:BGPIC=""!(BGPQUIT) D
.D HEADER^BGP6DPH ;header for all measures
.I $Y>(BGPIOSL-3) D HEADER^BGP6DPH Q:BGPQUIT
.W !,$P(^BGPHEIS(BGPIC,0),U,3),!
.I $Y>(BGPIOSL-3) D HEADER^BGP6DPH Q:BGPQUIT
.W !,"Denominator(s):"
.S BGPX=0 F S BGPX=$O(^BGPHEIS(BGPIC,61,"B",BGPX)) Q:BGPX'=+BGPX!(BGPQUIT) D
..S BGPY=0 F S BGPY=$O(^BGPHEIS(BGPIC,61,"B",BGPX,BGPY)) Q:BGPY'=+BGPY!(BGPQUIT) D
...I $P(^BGPHEIS(BGPIC,61,BGPY,0),U,2)'[BGPRTYPE Q ;not a denom def for this report
...S BGPZ=0 F S BGPZ=$O(^BGPHEIS(BGPIC,61,BGPY,1,BGPZ)) Q:BGPZ'=+BGPZ!(BGPQUIT) D
....I $Y>(BGPIOSL-3) D HEADER^BGP6DPH Q:BGPQUIT
....W !,^BGPHEIS(BGPIC,61,BGPY,1,BGPZ,0)
....Q
...;W !
...Q
..Q
.I $Y>(BGPIOSL-3) D HEADER^BGP6DPH Q:BGPQUIT
.W !!,"Numerator(s):"
.S BGPX=0 F S BGPX=$O(^BGPHEIS(BGPIC,62,"B",BGPX)) Q:BGPX'=+BGPX!(BGPQUIT) D
..S BGPY=0 F S BGPY=$O(^BGPHEIS(BGPIC,62,"B",BGPX,BGPY)) Q:BGPY'=+BGPY!(BGPQUIT) D
...I $P(^BGPHEIS(BGPIC,62,BGPY,0),U,2)'[BGPRTYPE Q ;not a denom def for this report
...S BGPZ=0 F S BGPZ=$O(^BGPHEIS(BGPIC,62,BGPY,1,BGPZ)) Q:BGPZ'=+BGPZ!(BGPQUIT) D
....I $Y>(BGPIOSL-3) D HEADER^BGP6DPH Q:BGPQUIT
....W !,^BGPHEIS(BGPIC,62,BGPY,1,BGPZ,0)
....Q
...;W !
...Q
..Q
.W ! S BGPX=0 F S BGPX=$O(^BGPHEIS(BGPIC,11,BGPX)) Q:BGPX'=+BGPX D
..I $Y>(BGPIOSL-3) D HEADER^BGP6DPH Q:BGPQUIT
..W !,^BGPHEIS(BGPIC,11,BGPX,0)
.W ! S BGPX=0 F S BGPX=$O(^BGPHEIS(BGPIC,51,BGPX)) Q:BGPX'=+BGPX D
..I $Y>(BGPIOSL-3) D HEADER^BGP6DPH Q:BGPQUIT
..W !,^BGPHEIS(BGPIC,51,BGPX,0)
.W ! S BGPX=0 F S BGPX=$O(^BGPHEIS(BGPIC,52,BGPX)) Q:BGPX'=+BGPX D
..I $Y>(BGPIOSL-3) D HEADER^BGP6DPH Q:BGPQUIT
..W !,^BGPHEIS(BGPIC,52,BGPX,0)
.X ^BGPHEIS(BGPIC,3)
;
;D ^BGP6DSP
D ^BGP6HES
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
BGP6DHEP ; IHS/CMI/LAB - IHS HEDIS print ;
+1 ;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007
+2 ;
+3 ;
PRINT ;
+1 KILL ^TMP($JOB)
+2 SET BGPIOSL=$SELECT($GET(BGPGUI):55,1:IOSL)
+3 IF BGPROT="D"
GOTO DEL
+4 DO ^BGP6HEH
+5 SET BGPGPG=0
+6 SET BGPQUIT=""
+7 DO PRINT1
+8 KILL ^TMP($JOB)
+9 IF BGPROT="P"
KILL ^XTMP("BGP6D",BGPJ,BGPH),^TMP($JOB)
QUIT
+10 ;
DEL ;create delimited output file
+1 ;close printer device
IF '$DATA(BGPGUI)
DO ^%ZISC
+2 KILL ^TMP($JOB)
+3 ;create ^tmp of delimited report
DO ^BGP6HEL
+4 KILL ^XTMP("BGP6D",BGPJ,BGPH)
+5 KILL ^TMP($JOB)
+6 QUIT
+7 ;
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^BGP6DPH
+3 IF $Y>(BGPIOSL-3)
DO HEADER^BGP6DPH
IF BGPQUIT
QUIT
+4 WRITE !,$PIECE(^BGPHEIS(BGPIC,0),U,3),!
+5 IF $Y>(BGPIOSL-3)
DO HEADER^BGP6DPH
IF BGPQUIT
QUIT
+6 WRITE !,"Denominator(s):"
+7 SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPHEIS(BGPIC,61,"B",BGPX))
IF BGPX'=+BGPX!(BGPQUIT)
QUIT
Begin DoDot:2
+8 SET BGPY=0
FOR
SET BGPY=$ORDER(^BGPHEIS(BGPIC,61,"B",BGPX,BGPY))
IF BGPY'=+BGPY!(BGPQUIT)
QUIT
Begin DoDot:3
+9 ;not a denom def for this report
IF $PIECE(^BGPHEIS(BGPIC,61,BGPY,0),U,2)'[BGPRTYPE
QUIT
+10 SET BGPZ=0
FOR
SET BGPZ=$ORDER(^BGPHEIS(BGPIC,61,BGPY,1,BGPZ))
IF BGPZ'=+BGPZ!(BGPQUIT)
QUIT
Begin DoDot:4
+11 IF $Y>(BGPIOSL-3)
DO HEADER^BGP6DPH
IF BGPQUIT
QUIT
+12 WRITE !,^BGPHEIS(BGPIC,61,BGPY,1,BGPZ,0)
+13 QUIT
End DoDot:4
+14 ;W !
+15 QUIT
End DoDot:3
+16 QUIT
End DoDot:2
+17 IF $Y>(BGPIOSL-3)
DO HEADER^BGP6DPH
IF BGPQUIT
QUIT
+18 WRITE !!,"Numerator(s):"
+19 SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPHEIS(BGPIC,62,"B",BGPX))
IF BGPX'=+BGPX!(BGPQUIT)
QUIT
Begin DoDot:2
+20 SET BGPY=0
FOR
SET BGPY=$ORDER(^BGPHEIS(BGPIC,62,"B",BGPX,BGPY))
IF BGPY'=+BGPY!(BGPQUIT)
QUIT
Begin DoDot:3
+21 ;not a denom def for this report
IF $PIECE(^BGPHEIS(BGPIC,62,BGPY,0),U,2)'[BGPRTYPE
QUIT
+22 SET BGPZ=0
FOR
SET BGPZ=$ORDER(^BGPHEIS(BGPIC,62,BGPY,1,BGPZ))
IF BGPZ'=+BGPZ!(BGPQUIT)
QUIT
Begin DoDot:4
+23 IF $Y>(BGPIOSL-3)
DO HEADER^BGP6DPH
IF BGPQUIT
QUIT
+24 WRITE !,^BGPHEIS(BGPIC,62,BGPY,1,BGPZ,0)
+25 QUIT
End DoDot:4
+26 ;W !
+27 QUIT
End DoDot:3
+28 QUIT
End DoDot:2
+29 WRITE !
SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPHEIS(BGPIC,11,BGPX))
IF BGPX'=+BGPX
QUIT
Begin DoDot:2
+30 IF $Y>(BGPIOSL-3)
DO HEADER^BGP6DPH
IF BGPQUIT
QUIT
+31 WRITE !,^BGPHEIS(BGPIC,11,BGPX,0)
End DoDot:2
+32 WRITE !
SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPHEIS(BGPIC,51,BGPX))
IF BGPX'=+BGPX
QUIT
Begin DoDot:2
+33 IF $Y>(BGPIOSL-3)
DO HEADER^BGP6DPH
IF BGPQUIT
QUIT
+34 WRITE !,^BGPHEIS(BGPIC,51,BGPX,0)
End DoDot:2
+35 WRITE !
SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPHEIS(BGPIC,52,BGPX))
IF BGPX'=+BGPX
QUIT
Begin DoDot:2
+36 IF $Y>(BGPIOSL-3)
DO HEADER^BGP6DPH
IF BGPQUIT
QUIT
+37 WRITE !,^BGPHEIS(BGPIC,52,BGPX,0)
End DoDot:2
+38 XECUTE ^BGPHEIS(BGPIC,3)
End DoDot:1
+39 ;
+40 ;D ^BGP6DSP
+41 DO ^BGP6HES
+42 DO EXIT
+43 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
