- BGP0HEL ; IHS/CMI/LAB - IHS gpra print 01 Jul 2009 8:00 PM ;
- ;;10.0;IHS CLINICAL REPORTING;;JUN 18, 2010
- ;
- ;
- DEL ;
- K ^TMP($J)
- S ^TMP($J,"BGPDEL",0)=0
- D ^BGP0HEHH
- D DEL1
- D ^BGP0HESL ;print lists to delimited file
- ;if screen selected do screen
- I BGPDELT="S" D SCREEN,EXIT Q
- ;call xbgsave to create output file
- K ^TMP($J,"SUMMARYDEL")
- S XBGL="BGPDATA"
- L +^BGPDATA:300 E W:'$D(ZTQUEUED) "Unable to lock global" Q
- K ^BGPDATA ;global for saving. NOTE: Kill of unscripted global. Export to area, using standard name per SAC.
- S X=0 F S X=$O(^TMP($J,"BGPDEL",X)) Q:X'=+X S ^BGPDATA(X)=^TMP($J,"BGPDEL",X)
- I '$D(BGPGUI) D
- .S XBFLT=1,XBFN=BGPDELF_".txt",XBMED="F",XBTLE="CRS 2010 HEDIS DELIMITED OUTPUT",XBQ="N"
- .D ^XBGSAVE
- .K XBFLT,XBFN,XBMED,XBTLE,XBE,XBF
- I $D(BGPGUI) D
- .S (C,X)=0 F S X=$O(^BGPDATA(X)) Q:X'=+X S C=C+1,^BGPGUIT(BGPGIEN,12,C,0)=^BGPDATA(X)
- .S ^BGPGUIT(BGPGIEN,12,0)="^90378.0812^"_C_"^"_C_"^"_DT
- L -^BGPDATA
- K ^BGPDATA
- D EXIT
- Q
- ;
- SCREEN ;
- S X=0 F S X=$O(^TMP($J,"BGPDEL",X)) Q:X'=+X W !,^TMP($J,"BGPDEL",X)
- Q
- DEL1 ;EP
- S BGPIC=0 F S BGPIC=$O(BGPIND(BGPIC)) Q:BGPIC="" D
- .;now print individual measure
- .S X=" " D S(X,1,1),S(X,1,1)
- .S X=$P(^BGPHEIT(BGPIC,0),U,3) D S(X,1,1)
- .S X=" " D S(X,1,1)
- .S X="Denominator(s):" D S(X,1,1)
- .S BGPX=0 F S BGPX=$O(^BGPHEIT(BGPIC,61,"B",BGPX)) Q:BGPX'=+BGPX D
- ..S BGPY=0 F S BGPY=$O(^BGPHEIT(BGPIC,61,"B",BGPX,BGPY)) Q:BGPY'=+BGPY D
- ...I $P(^BGPHEIT(BGPIC,61,BGPY,0),U,2)'[BGPRTYPE Q ;not a denom def for this report
- ...S BGPZ=0 F S BGPZ=$O(^BGPHEIT(BGPIC,61,BGPY,1,BGPZ)) Q:BGPZ'=+BGPZ D
- ....S Y=^BGPHEIT(BGPIC,61,BGPY,1,BGPZ,0) S:BGPZ=1 Y=" - "_Y D S(Y,1,1)
- ....Q
- ...Q
- ..Q
- .S X=" " D S(X,1,1)
- .S X="Numerator(s):" D S(X,1,1)
- .S BGPX=0 F S BGPX=$O(^BGPHEIT(BGPIC,62,"B",BGPX)) Q:BGPX'=+BGPX D
- ..S BGPY=0 F S BGPY=$O(^BGPHEIT(BGPIC,62,"B",BGPX,BGPY)) Q:BGPY'=+BGPY D
- ...I $P(^BGPHEIT(BGPIC,62,BGPY,0),U,2)'[BGPRTYPE Q ;not a denom def for this report
- ...S BGPZ=0 F S BGPZ=$O(^BGPHEIT(BGPIC,62,BGPY,1,BGPZ)) Q:BGPZ'=+BGPZ D
- ....S X=^BGPHEIT(BGPIC,62,BGPY,1,BGPZ,0) S:BGPZ=1 X=" - "_X D S(X,1,1)
- ....Q
- ...Q
- ..Q
- .S X=" " D S(X,1,1)
- .I $O(^BGPHEIT(BGPIC,11,0)) D S("Logic:",1,1) S BGPX=0 F S BGPX=$O(^BGPHEIT(BGPIC,11,BGPX)) Q:BGPX'=+BGPX D
- ..S X=^BGPHEIT(BGPIC,11,BGPX,0) D S(X,1,1)
- .I $O(^BGPHEIT(BGPIC,51,0)) D S(" ",1,1) S X="Performance Measure Description :" D S(X,1,1) S BGPX=0 F S BGPX=$O(^BGPHEIT(BGPIC,51,BGPX)) Q:BGPX'=+BGPX D
- ..S X=^BGPHEIT(BGPIC,51,BGPX,0) D S(X,1,1)
- .S X=" " D S(X,1,1) D S("HEDIS Rates:",1,1)
- .D:'$O(^BGPHEIT(BGPIC,52,0)) S("Not Reported",1,1)
- .S BGPX=0 F S BGPX=$O(^BGPHEIT(BGPIC,52,BGPX)) Q:BGPX'=+BGPX D
- ..S X=^BGPHEIT(BGPIC,52,BGPX,0) D S(X,1,1)
- .X ^BGPHEIT(BGPIC,4)
- Q
- S Y=$P(^VA(200,DUZ,0),U,2),$E(Y,35)=$$FMTE^XLFDT(DT) D S(Y,1,1)
- I BGPRTYPE=3 S Y="*** IHS 2010 HEDIS Clinical Performance Report***" D S(Y,1,1)
- I $G(BGPAREAA) S Y="AREA AGGREGATE" D S(Y,1,1)
- I '$G(BGPAREAA) S Y=$P(^DIC(4,DUZ(2),0),U) D S(Y,1,1)
- S X="Date Report Run: "_$$FMTE^XLFDT(DT) D S(X,1,1)
- S X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED) D S(X,1,1)
- S X="Previous Year Period: "_$$FMTE^XLFDT(BGPPBD)_" to "_$$FMTE^XLFDT(BGPPED) D S(X,1,1)
- S X="Baseline Period: "_$$FMTE^XLFDT(BGPBBD)_" to "_$$FMTE^XLFDT(BGPBED) D S(X,1,1)
- S X=$TR($J(""," ","-"),80) D S(X,1,1)
- Q
- EXIT ;
- K ^TMP($J)
- Q
- CTR(X,Y) ;EP - Center X in a field Y wide.
- Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
- ;----------
- 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")
- ;----------
- S(Y,F,P) ;set up array
- I '$G(F) S F=0
- S %=$P(^TMP($J,"BGPDEL",0),U)+F,$P(^TMP($J,"BGPDEL",0),U)=%
- I '$D(^TMP($J,"BGPDEL",%)) S ^TMP($J,"BGPDEL",%)=""
- S $P(^TMP($J,"BGPDEL",%),U,P)=Y
- Q
- C(X,X2,X3) ;
- D COMMA^%DTC
- Q X
- BGP0HEL ; IHS/CMI/LAB - IHS gpra print 01 Jul 2009 8:00 PM ;
- +1 ;;10.0;IHS CLINICAL REPORTING;;JUN 18, 2010
- +2 ;
- +3 ;
- DEL ;
- +1 KILL ^TMP($JOB)
- +2 SET ^TMP($JOB,"BGPDEL",0)=0
- +3 DO ^BGP0HEHH
- +4 DO DEL1
- +5 ;print lists to delimited file
- DO ^BGP0HESL
- +6 ;if screen selected do screen
- +7 IF BGPDELT="S"
- DO SCREEN
- DO EXIT
- QUIT
- +8 ;call xbgsave to create output file
- +9 KILL ^TMP($JOB,"SUMMARYDEL")
- +10 SET XBGL="BGPDATA"
- +11 LOCK +^BGPDATA:300
- IF '$TEST
- IF '$DATA(ZTQUEUED)
- WRITE "Unable to lock global"
- QUIT
- +12 ;global for saving. NOTE: Kill of unscripted global. Export to area, using standard name per SAC.
- KILL ^BGPDATA
- +13 SET X=0
- FOR
- SET X=$ORDER(^TMP($JOB,"BGPDEL",X))
- IF X'=+X
- QUIT
- SET ^BGPDATA(X)=^TMP($JOB,"BGPDEL",X)
- +14 IF '$DATA(BGPGUI)
- Begin DoDot:1
- +15 SET XBFLT=1
- SET XBFN=BGPDELF_".txt"
- SET XBMED="F"
- SET XBTLE="CRS 2010 HEDIS DELIMITED OUTPUT"
- SET XBQ="N"
- +16 DO ^XBGSAVE
- +17 KILL XBFLT,XBFN,XBMED,XBTLE,XBE,XBF
- End DoDot:1
- +18 IF $DATA(BGPGUI)
- Begin DoDot:1
- +19 SET (C,X)=0
- FOR
- SET X=$ORDER(^BGPDATA(X))
- IF X'=+X
- QUIT
- SET C=C+1
- SET ^BGPGUIT(BGPGIEN,12,C,0)=^BGPDATA(X)
- +20 SET ^BGPGUIT(BGPGIEN,12,0)="^90378.0812^"_C_"^"_C_"^"_DT
- End DoDot:1
- +21 LOCK -^BGPDATA
- +22 KILL ^BGPDATA
- +23 DO EXIT
- +24 QUIT
- +25 ;
- SCREEN ;
- +1 SET X=0
- FOR
- SET X=$ORDER(^TMP($JOB,"BGPDEL",X))
- IF X'=+X
- QUIT
- WRITE !,^TMP($JOB,"BGPDEL",X)
- +2 QUIT
- DEL1 ;EP
- +1 SET BGPIC=0
- FOR
- SET BGPIC=$ORDER(BGPIND(BGPIC))
- IF BGPIC=""
- QUIT
- Begin DoDot:1
- +2 ;now print individual measure
- +3 SET X=" "
- DO S(X,1,1)
- DO S(X,1,1)
- +4 SET X=$PIECE(^BGPHEIT(BGPIC,0),U,3)
- DO S(X,1,1)
- +5 SET X=" "
- DO S(X,1,1)
- +6 SET X="Denominator(s):"
- DO S(X,1,1)
- +7 SET BGPX=0
- FOR
- SET BGPX=$ORDER(^BGPHEIT(BGPIC,61,"B",BGPX))
- IF BGPX'=+BGPX
- QUIT
- Begin DoDot:2
- +8 SET BGPY=0
- FOR
- SET BGPY=$ORDER(^BGPHEIT(BGPIC,61,"B",BGPX,BGPY))
- IF BGPY'=+BGPY
- QUIT
- Begin DoDot:3
- +9 ;not a denom def for this report
- IF $PIECE(^BGPHEIT(BGPIC,61,BGPY,0),U,2)'[BGPRTYPE
- QUIT
- +10 SET BGPZ=0
- FOR
- SET BGPZ=$ORDER(^BGPHEIT(BGPIC,61,BGPY,1,BGPZ))
- IF BGPZ'=+BGPZ
- QUIT
- Begin DoDot:4
- +11 SET Y=^BGPHEIT(BGPIC,61,BGPY,1,BGPZ,0)
- IF BGPZ=1
- SET Y=" - "_Y
- DO S(Y,1,1)
- +12 QUIT
- End DoDot:4
- +13 QUIT
- End DoDot:3
- +14 QUIT
- End DoDot:2
- +15 SET X=" "
- DO S(X,1,1)
- +16 SET X="Numerator(s):"
- DO S(X,1,1)
- +17 SET BGPX=0
- FOR
- SET BGPX=$ORDER(^BGPHEIT(BGPIC,62,"B",BGPX))
- IF BGPX'=+BGPX
- QUIT
- Begin DoDot:2
- +18 SET BGPY=0
- FOR
- SET BGPY=$ORDER(^BGPHEIT(BGPIC,62,"B",BGPX,BGPY))
- IF BGPY'=+BGPY
- QUIT
- Begin DoDot:3
- +19 ;not a denom def for this report
- IF $PIECE(^BGPHEIT(BGPIC,62,BGPY,0),U,2)'[BGPRTYPE
- QUIT
- +20 SET BGPZ=0
- FOR
- SET BGPZ=$ORDER(^BGPHEIT(BGPIC,62,BGPY,1,BGPZ))
- IF BGPZ'=+BGPZ
- QUIT
- Begin DoDot:4
- +21 SET X=^BGPHEIT(BGPIC,62,BGPY,1,BGPZ,0)
- IF BGPZ=1
- SET X=" - "_X
- DO S(X,1,1)
- +22 QUIT
- End DoDot:4
- +23 QUIT
- End DoDot:3
- +24 QUIT
- End DoDot:2
- +25 SET X=" "
- DO S(X,1,1)
- +26 IF $ORDER(^BGPHEIT(BGPIC,11,0))
- DO S("Logic:",1,1)
- SET BGPX=0
- FOR
- SET BGPX=$ORDER(^BGPHEIT(BGPIC,11,BGPX))
- IF BGPX'=+BGPX
- QUIT
- Begin DoDot:2
- +27 SET X=^BGPHEIT(BGPIC,11,BGPX,0)
- DO S(X,1,1)
- End DoDot:2
- +28 IF $ORDER(^BGPHEIT(BGPIC,51,0))
- DO S(" ",1,1)
- SET X="Performance Measure Description :"
- DO S(X,1,1)
- SET BGPX=0
- FOR
- SET BGPX=$ORDER(^BGPHEIT(BGPIC,51,BGPX))
- IF BGPX'=+BGPX
- QUIT
- Begin DoDot:2
- +29 SET X=^BGPHEIT(BGPIC,51,BGPX,0)
- DO S(X,1,1)
- End DoDot:2
- +30 SET X=" "
- DO S(X,1,1)
- DO S("HEDIS Rates:",1,1)
- +31 IF '$ORDER(^BGPHEIT(BGPIC,52,0))
- DO S("Not Reported",1,1)
- +32 SET BGPX=0
- FOR
- SET BGPX=$ORDER(^BGPHEIT(BGPIC,52,BGPX))
- IF BGPX'=+BGPX
- QUIT
- Begin DoDot:2
- +33 SET X=^BGPHEIT(BGPIC,52,BGPX,0)
- DO S(X,1,1)
- End DoDot:2
- +34 XECUTE ^BGPHEIT(BGPIC,4)
- End DoDot:1
- +35 QUIT
- +1 SET Y=$PIECE(^VA(200,DUZ,0),U,2)
- SET $EXTRACT(Y,35)=$$FMTE^XLFDT(DT)
- DO S(Y,1,1)
- +2 IF BGPRTYPE=3
- SET Y="*** IHS 2010 HEDIS Clinical Performance Report***"
- DO S(Y,1,1)
- +3 IF $GET(BGPAREAA)
- SET Y="AREA AGGREGATE"
- DO S(Y,1,1)
- +4 IF '$GET(BGPAREAA)
- SET Y=$PIECE(^DIC(4,DUZ(2),0),U)
- DO S(Y,1,1)
- +5 SET X="Date Report Run: "_$$FMTE^XLFDT(DT)
- DO S(X,1,1)
- +6 SET X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED)
- DO S(X,1,1)
- +7 SET X="Previous Year Period: "_$$FMTE^XLFDT(BGPPBD)_" to "_$$FMTE^XLFDT(BGPPED)
- DO S(X,1,1)
- +8 SET X="Baseline Period: "_$$FMTE^XLFDT(BGPBBD)_" to "_$$FMTE^XLFDT(BGPBED)
- DO S(X,1,1)
- +9 SET X=$TRANSLATE($JUSTIFY(""," ","-"),80)
- DO S(X,1,1)
- +10 QUIT
- EXIT ;
- +1 KILL ^TMP($JOB)
- +2 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 ;----------
- 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 ;----------
- S(Y,F,P) ;set up array
- +1 IF '$GET(F)
- SET F=0
- +2 SET %=$PIECE(^TMP($JOB,"BGPDEL",0),U)+F
- SET $PIECE(^TMP($JOB,"BGPDEL",0),U)=%
- +3 IF '$DATA(^TMP($JOB,"BGPDEL",%))
- SET ^TMP($JOB,"BGPDEL",%)=""
- +4 SET $PIECE(^TMP($JOB,"BGPDEL",%),U,P)=Y
- +5 QUIT
- C(X,X2,X3) ;
- +1 DO COMMA^%DTC
- +2 QUIT X
