- BGP1DELP ; IHS/CMI/LAB - IHS HEDIS print ;
- ;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
- ;
- ;
- PRINT ;
- K ^TMP($J)
- S BGPIOSL=$S($G(BGPGUI):55,1:IOSL)
- I BGPROT="D" G DEL
- S BGPPTYPE="P"
- D ^BGP1ELH
- S BGPGPG=0
- S BGPQUIT=""
- D PRINT1
- K ^TMP($J)
- I BGPROT="P" K ^XTMP("BGP1D",BGPJ,BGPH),^TMP($J) Q
- ;
- DEL ;create delimited output file
- D ^%ZISC ;close printer device
- K ^TMP($J)
- S BGPPTYPE="D"
- D ^BGP1ELL ;create ^tmp of delimited report
- K ^XTMP("BGP1D",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(^BGPELIB(BGPIC,BGPNODE,BGPY,1,BGPZ)) Q:BGPZ'=+BGPZ D
- .S BGPLCNT=BGPLCNT+1
- .S X=^BGPELIB(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^BGP1DPH Q:BGPQUIT
- .;D W^BGP1DP(^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^BGP1DPH ;header for all measures
- .I $Y>(BGPIOSL-3) D HEADER^BGP1DPH Q:BGPQUIT
- .W !,$P(^BGPELIB(BGPIC,0),U,3),!
- .I $Y>(BGPIOSL-3) D HEADER^BGP1DPH Q:BGPQUIT
- .W !,"Denominator(s):"
- .S BGPNODE=61
- .S BGPX=0 F S BGPX=$O(^BGPELIB(BGPIC,61,"B",BGPX)) Q:BGPX'=+BGPX!(BGPQUIT) D
- ..S BGPY=0 F S BGPY=$O(^BGPELIB(BGPIC,61,"B",BGPX,BGPY)) Q:BGPY'=+BGPY!(BGPQUIT) D
- ...;S BGPZ=0 F S BGPZ=$O(^BGPELIB(BGPIC,61,BGPY,1,BGPZ)) Q:BGPZ'=+BGPZ!(BGPQUIT) D
- ...;I $Y>(BGPIOSL-3) D HEADER^BGP1DPH Q:BGPQUIT
- ...D WP ;W !,^BGPELIB(BGPIC,61,BGPY,1,BGPZ,0)
- ...Q
- ...;W !
- ...Q
- ..Q
- .I $Y>(BGPIOSL-3) D HEADER^BGP1DPH Q:BGPQUIT
- .W !!,"Numerator(s):"
- .S BGPNODE=62
- .S BGPX=0 F S BGPX=$O(^BGPELIB(BGPIC,62,"B",BGPX)) Q:BGPX'=+BGPX!(BGPQUIT) D
- ..S BGPY=0 F S BGPY=$O(^BGPELIB(BGPIC,62,"B",BGPX,BGPY)) Q:BGPY'=+BGPY!(BGPQUIT) D
- ...;S BGPZ=0 F S BGPZ=$O(^BGPELIB(BGPIC,62,BGPY,1,BGPZ)) Q:BGPZ'=+BGPZ!(BGPQUIT) D
- ...;.I $Y>(BGPIOSL-3) D HEADER^BGP1DPH Q:BGPQUIT
- ...;.W !,^BGPELIB(BGPIC,62,BGPY,1,BGPZ,0)
- ...D WP ;.Q
- ...Q
- ..Q
- .I $O(^BGPELIB(BGPIC,11,0)) W !!,"Logic" S BGPX=0 F S BGPX=$O(^BGPELIB(BGPIC,11,BGPX)) Q:BGPX'=+BGPX D
- ..I $Y>(BGPIOSL-3) D HEADER^BGP1DPH Q:BGPQUIT
- ..W !,^BGPELIB(BGPIC,11,BGPX,0)
- .I $O(^BGPELIB(BGPIC,51,0)) W !!,"Performance Measure Description" S BGPX=0 F S BGPX=$O(^BGPELIB(BGPIC,51,BGPX)) Q:BGPX'=+BGPX D
- ..I $Y>(BGPIOSL-3) D HEADER^BGP1DPH Q:BGPQUIT
- ..W !,^BGPELIB(BGPIC,51,BGPX,0)
- .I $O(^BGPELIB(BGPIC,52,0)) W !!,"Past Performance and/or Target" S BGPX=0 F S BGPX=$O(^BGPELIB(BGPIC,52,BGPX)) Q:BGPX'=+BGPX D
- ..I $Y>(BGPIOSL-3) D HEADER^BGP1DPH Q:BGPQUIT
- ..W !,^BGPELIB(BGPIC,52,BGPX,0)
- .X ^BGPELIB(BGPIC,3)
- ;
- D ^BGP1ELS
- 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
- BGP1DELP ; IHS/CMI/LAB - IHS HEDIS print ;
- +1 ;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
- +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 ^BGP1ELH
- +6 SET BGPGPG=0
- +7 SET BGPQUIT=""
- +8 DO PRINT1
- +9 KILL ^TMP($JOB)
- +10 IF BGPROT="P"
- KILL ^XTMP("BGP1D",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 ^BGP1ELL
- +5 KILL ^XTMP("BGP1D",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(^BGPELIB(BGPIC,BGPNODE,BGPY,1,BGPZ))
- IF BGPZ'=+BGPZ
- QUIT
- Begin DoDot:1
- +4 SET BGPLCNT=BGPLCNT+1
- +5 SET X=^BGPELIB(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^BGP1DPH
- IF BGPQUIT
- QUIT
- +3 ;D W^BGP1DP(^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^BGP1DPH
- +3 IF $Y>(BGPIOSL-3)
- DO HEADER^BGP1DPH
- IF BGPQUIT
- QUIT
- +4 WRITE !,$PIECE(^BGPELIB(BGPIC,0),U,3),!
- +5 IF $Y>(BGPIOSL-3)
- DO HEADER^BGP1DPH
- IF BGPQUIT
- QUIT
- +6 WRITE !,"Denominator(s):"
- +7 SET BGPNODE=61
- +8 SET BGPX=0
- FOR
- SET BGPX=$ORDER(^BGPELIB(BGPIC,61,"B",BGPX))
- IF BGPX'=+BGPX!(BGPQUIT)
- QUIT
- Begin DoDot:2
- +9 SET BGPY=0
- FOR
- SET BGPY=$ORDER(^BGPELIB(BGPIC,61,"B",BGPX,BGPY))
- IF BGPY'=+BGPY!(BGPQUIT)
- QUIT
- Begin DoDot:3
- +10 ;S BGPZ=0 F S BGPZ=$O(^BGPELIB(BGPIC,61,BGPY,1,BGPZ)) Q:BGPZ'=+BGPZ!(BGPQUIT) D
- +11 ;I $Y>(BGPIOSL-3) D HEADER^BGP1DPH Q:BGPQUIT
- +12 ;W !,^BGPELIB(BGPIC,61,BGPY,1,BGPZ,0)
- DO WP
- +13 QUIT
- +14 ;W !
- +15 QUIT
- End DoDot:3
- +16 QUIT
- End DoDot:2
- +17 IF $Y>(BGPIOSL-3)
- DO HEADER^BGP1DPH
- IF BGPQUIT
- QUIT
- +18 WRITE !!,"Numerator(s):"
- +19 SET BGPNODE=62
- +20 SET BGPX=0
- FOR
- SET BGPX=$ORDER(^BGPELIB(BGPIC,62,"B",BGPX))
- IF BGPX'=+BGPX!(BGPQUIT)
- QUIT
- Begin DoDot:2
- +21 SET BGPY=0
- FOR
- SET BGPY=$ORDER(^BGPELIB(BGPIC,62,"B",BGPX,BGPY))
- IF BGPY'=+BGPY!(BGPQUIT)
- QUIT
- Begin DoDot:3
- +22 ;S BGPZ=0 F S BGPZ=$O(^BGPELIB(BGPIC,62,BGPY,1,BGPZ)) Q:BGPZ'=+BGPZ!(BGPQUIT) D
- +23 ;.I $Y>(BGPIOSL-3) D HEADER^BGP1DPH Q:BGPQUIT
- +24 ;.W !,^BGPELIB(BGPIC,62,BGPY,1,BGPZ,0)
- +25 ;.Q
- DO WP
- +26 QUIT
- End DoDot:3
- +27 QUIT
- End DoDot:2
- +28 IF $ORDER(^BGPELIB(BGPIC,11,0))
- WRITE !!,"Logic"
- SET BGPX=0
- FOR
- SET BGPX=$ORDER(^BGPELIB(BGPIC,11,BGPX))
- IF BGPX'=+BGPX
- QUIT
- Begin DoDot:2
- +29 IF $Y>(BGPIOSL-3)
- DO HEADER^BGP1DPH
- IF BGPQUIT
- QUIT
- +30 WRITE !,^BGPELIB(BGPIC,11,BGPX,0)
- End DoDot:2
- +31 IF $ORDER(^BGPELIB(BGPIC,51,0))
- WRITE !!,"Performance Measure Description"
- SET BGPX=0
- FOR
- SET BGPX=$ORDER(^BGPELIB(BGPIC,51,BGPX))
- IF BGPX'=+BGPX
- QUIT
- Begin DoDot:2
- +32 IF $Y>(BGPIOSL-3)
- DO HEADER^BGP1DPH
- IF BGPQUIT
- QUIT
- +33 WRITE !,^BGPELIB(BGPIC,51,BGPX,0)
- End DoDot:2
- +34 IF $ORDER(^BGPELIB(BGPIC,52,0))
- WRITE !!,"Past Performance and/or Target"
- SET BGPX=0
- FOR
- SET BGPX=$ORDER(^BGPELIB(BGPIC,52,BGPX))
- IF BGPX'=+BGPX
- QUIT
- Begin DoDot:2
- +35 IF $Y>(BGPIOSL-3)
- DO HEADER^BGP1DPH
- IF BGPQUIT
- QUIT
- +36 WRITE !,^BGPELIB(BGPIC,52,BGPX,0)
- End DoDot:2
- +37 XECUTE ^BGPELIB(BGPIC,3)
- End DoDot:1
- +38 ;
- +39 DO ^BGP1ELS
- +40 DO EXIT
- +41 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
