- BGPMUPH ; IHS/MSC/MGH - MU REPORT HEADER 01 Jul 2009 7:54 PM ;17-Mar-2011 16:51;DU
- ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
- ;
- ;HEADERS FOR REPORTS
- CALC(N,O) ;ENTRY POINT
- NEW Z
- ;I O=0!(N=0)!(O="")!(N="") Q "**"
- ;NEW X,X2,X3
- ;S X=N,X2=1,X3=0 D COMMA^%DTC S N=X
- ;S X=O,X2=1,X3=0 D COMMA^%DTC S O=X
- ;I +O=0 Q "**"
- ;S Z=(((N-O)/O)*100),Z=$FN(Z,"+,",1)
- S Z=N-O,Z=$FN(Z,"+,",1)
- Q Z
- C(X,X2,X3) ;
- D COMMA^%DTC
- Q X
- N BGPZ
- I BGPPTYPE="D" Q
- K DIR I $E(IOST)="C",IO=IO(0),'$D(ZTQUEUED) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BGPQUIT=1
- I $G(BGPGUI),BGPPTYPE="P" D W^BGPMUPP("ZZZZZZZ",0,1,BGPPTYPE),W^BGPMUPP("",0,1,BGPPTYPE) ;GUI
- I BGPPTYPE="P" W:$D(IOF) @IOF S BGPGPG=BGPGPG+1
- S X=$P(^VA(200,DUZ,0),U,2),$E(X,35)=$$FMTE^XLFDT(DT),$E(X,70)="Page "_BGPGPG D W^BGPMUPP(X,1,0,BGPPTYPE)
- S X="*** IHS Stage 1 Meaningful Use ***" D W^BGPMUPP(X,1,2,BGPPTYPE)
- I $G(BGPMUT)'="H" S X="*** Eligible Professional (EP) Clinical Quality Measures Report ***" D W^BGPMUPP(X,1,1,BGPPTYPE)
- I $G(BGPMUT)="H" S X="*** Eligible Hospital/CAH Clinical Quality Measures Report ***" D W^BGPMUPP(X,1,1,BGPPTYPE)
- S X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED) D W^BGPMUPP(X,1,1,BGPPTYPE)
- S X="Previous Period: "_$$FMTE^XLFDT(BGPPBD)_" to "_$$FMTE^XLFDT(BGPPED) D W^BGPMUPP(X,1,1,BGPPTYPE)
- I '$G(BGPPSUM) S X="Baseline Period: "_$$FMTE^XLFDT(BGPBBD)_" to "_$$FMTE^XLFDT(BGPBED) D W^BGPMUPP(X,1,1,BGPPTYPE)
- I $G(BGPIC) D
- .D W^BGPMUPP($TR($J("",80)," ","-"),0,1,BGPPTYPE)
- .S BGPZ=0 F S BGPZ=$O(^BGPMUIND(90595.11,BGPIC,20,BGPZ)) Q:BGPZ'=+BGPZ!(BGPQUIT) D
- ..D W^BGPMUPP(^BGPMUIND(90595.11,BGPIC,20,BGPZ,0),0,1,BGPPTYPE)
- .S X="" D W^BGPMUPP(X,0,1,BGPPTYPE)
- Q
- N BGPZ
- I BGPPTYPE="D" Q
- K DIR I $E(IOST)="C",IO=IO(0),'$D(ZTQUEUED) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BGPQUIT=1
- I $G(BGPGUI),BGPPTYPE="P" D W^BGPMUPP("ZZZZZZZ",0,1,BGPPTYPE),W^BGPMUPP("",0,1,BGPPTYPE) ;GUI
- I BGPPTYPE="P" W:$D(IOF) @IOF S BGPGPG=BGPGPG+1
- S X=$P(^VA(200,DUZ,0),U,2),$E(X,35)=$$FMTE^XLFDT(DT),$E(X,70)="Page "_BGPGPG D W^BGPMUPP(X,1,0,BGPPTYPE)
- S X="*** IHS Stage 1 Meaningful Use ***" D W^BGPMUPP(X,1,2,BGPPTYPE)
- I $G(BGPMUT)'="H" S X="*** Eligible Professional (EP) Clinical Quality Measures Report ***" D W^BGPMUPP(X,1,1,BGPPTYPE)
- I $G(BGPMUT)="H" S X="*** Eligible Hospital/CAH Clinical Quality Measures Report ***" D W^BGPMUPP(X,1,1,BGPPTYPE)
- ;S X=$P(^DIC(4,DUZ(2),0),U) D W^BGPMUPP(X,1,1,BGPPTYPE)
- ;I $G(BGPMUT)'="H" D W^BGPMUPP("Provider: "_$P(^VA(200,BGPPROV,0),U),1,1,BGPPTYPE)
- S X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED) D W^BGPMUPP(X,1,1,BGPPTYPE)
- S X="Previous Period: "_$$FMTE^XLFDT(BGPPBD)_" to "_$$FMTE^XLFDT(BGPPED) D W^BGPMUPP(X,1,1,BGPPTYPE)
- S X="Baseline Period: "_$$FMTE^XLFDT(BGPBBD)_" to "_$$FMTE^XLFDT(BGPBED) D W^BGPMUPP(X,1,1,BGPPTYPE)
- D W^BGPMUPP($TR($J("",80)," ","-"),0,1,BGPPTYPE)
- Q
- N BGPZ
- I BGPPTYPE="D" Q
- ;G:'BGPGPG HEADER1
- K DIR I $E(IOST)="C",IO=IO(0),'$D(ZTQUEUED) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BGPQUIT=1
- I $G(BGPGUI),BGPPTYPE="P" D W^BGPMUPP("ZZZZZZZ",0,1,BGPPTYPE),W^BGPMUPP("",0,1,BGPPTYPE) ;GUI
- I BGPPTYPE="P" W:$D(IOF) @IOF S BGPGPG=BGPGPG+1
- S X="**** CONFIDENTIAL PATIENT INFORMATION COVERED BY PRIVACY ACT ****" D W^BGPMUPP(X,1,0,BGPPTYPE)
- S X=$P(^VA(200,DUZ,0),U,2),$E(X,35)=$$FMTE^XLFDT(DT),$E(X,70)="Page "_BGPGPG D W^BGPMUPP(X,1,1,BGPPTYPE)
- S X="*** IHS 2011 Stage 1 Meaningful Use Clinical Quality Measure Patient List ***" D W^BGPMUPP(X,1,2,BGPPTYPE)
- S X=$$VER^BGPMUUTL() D W^BGPMUPP(X,1,1,BGPPTYPE)
- S X=$P(^DIC(4,DUZ(2),0),U) D W^BGPMUPP(X,1,1,BGPPTYPE)
- I $G(BGPMUT)'="H" D W^BGPMUPP("EP: "_$P(^VA(200,BGPPROV,0),U),1,1,BGPPTYPE)
- S X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED) D W^BGPMUPP(X,1,1,BGPPTYPE)
- S X=$S(BGPBEN=1:"Indian/Alaskan Native (Classification 01)",BGPBEN=2:"Not Indian Alaskan/Native (Not Classification 01)",1:"All patients") D W^BGPMUPP(X,1,1,BGPPTYPE)
- D W^BGPMUPP($TR($J("",80)," ","-"),0,1,BGPPTYPE)
- I $G(BGPIC) D
- .S BGPZ=0 F S BGPZ=$O(^BGPMUIND(90595.11,BGPIC,20,BGPZ)) Q:BGPZ'=+BGPZ!(BGPQUIT) D
- ..D W^BGPMUPP(^BGPMUIND(90595.11,BGPIC,20,BGPZ,0),0,1,BGPPTYPE)
- .S X="" D W^BGPMUPP(X,0,1,BGPPTYPE)
- 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"))
- NEW DIR
- K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
- S 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")
- ;----------
- HDRBLK ;
- W !,?33,"REPORT",?41,"%",?44,"PREV YR",?53,"%",?55,"CHG FROM",?64,"BASE",?70,"%",?74,"CHG"
- W !,?33,"PERIOD",?44,"PERIOD",?55,"PREV YR",?64,"YR",?74,"BASE %"
- Q
- BGPMUPH ; IHS/MSC/MGH - MU REPORT HEADER 01 Jul 2009 7:54 PM ;17-Mar-2011 16:51;DU
- +1 ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
- +2 ;
- +3 ;HEADERS FOR REPORTS
- CALC(N,O) ;ENTRY POINT
- +1 NEW Z
- +2 ;I O=0!(N=0)!(O="")!(N="") Q "**"
- +3 ;NEW X,X2,X3
- +4 ;S X=N,X2=1,X3=0 D COMMA^%DTC S N=X
- +5 ;S X=O,X2=1,X3=0 D COMMA^%DTC S O=X
- +6 ;I +O=0 Q "**"
- +7 ;S Z=(((N-O)/O)*100),Z=$FN(Z,"+,",1)
- +8 SET Z=N-O
- SET Z=$FNUMBER(Z,"+,",1)
- +9 QUIT Z
- C(X,X2,X3) ;
- +1 DO COMMA^%DTC
- +2 QUIT X
- +1 NEW BGPZ
- +2 IF BGPPTYPE="D"
- QUIT
- +3 KILL DIR
- IF $EXTRACT(IOST)="C"
- IF IO=IO(0)
- IF '$DATA(ZTQUEUED)
- WRITE !
- SET DIR(0)="EO"
- DO ^DIR
- KILL DIR
- IF Y=0!(Y="^")!($DATA(DTOUT))
- SET BGPQUIT=1
- +4 ;GUI
- IF $GET(BGPGUI)
- IF BGPPTYPE="P"
- DO W^BGPMUPP("ZZZZZZZ",0,1,BGPPTYPE)
- DO W^BGPMUPP("",0,1,BGPPTYPE)
- +5 IF BGPPTYPE="P"
- IF $DATA(IOF)
- WRITE @IOF
- SET BGPGPG=BGPGPG+1
- +6 SET X=$PIECE(^VA(200,DUZ,0),U,2)
- SET $EXTRACT(X,35)=$$FMTE^XLFDT(DT)
- SET $EXTRACT(X,70)="Page "_BGPGPG
- DO W^BGPMUPP(X,1,0,BGPPTYPE)
- +7 SET X="*** IHS Stage 1 Meaningful Use ***"
- DO W^BGPMUPP(X,1,2,BGPPTYPE)
- +8 IF $GET(BGPMUT)'="H"
- SET X="*** Eligible Professional (EP) Clinical Quality Measures Report ***"
- DO W^BGPMUPP(X,1,1,BGPPTYPE)
- +9 IF $GET(BGPMUT)="H"
- SET X="*** Eligible Hospital/CAH Clinical Quality Measures Report ***"
- DO W^BGPMUPP(X,1,1,BGPPTYPE)
- +10 SET X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED)
- DO W^BGPMUPP(X,1,1,BGPPTYPE)
- +11 SET X="Previous Period: "_$$FMTE^XLFDT(BGPPBD)_" to "_$$FMTE^XLFDT(BGPPED)
- DO W^BGPMUPP(X,1,1,BGPPTYPE)
- +12 IF '$GET(BGPPSUM)
- SET X="Baseline Period: "_$$FMTE^XLFDT(BGPBBD)_" to "_$$FMTE^XLFDT(BGPBED)
- DO W^BGPMUPP(X,1,1,BGPPTYPE)
- +13 IF $GET(BGPIC)
- Begin DoDot:1
- +14 DO W^BGPMUPP($TRANSLATE($JUSTIFY("",80)," ","-"),0,1,BGPPTYPE)
- +15 SET BGPZ=0
- FOR
- SET BGPZ=$ORDER(^BGPMUIND(90595.11,BGPIC,20,BGPZ))
- IF BGPZ'=+BGPZ!(BGPQUIT)
- QUIT
- Begin DoDot:2
- +16 DO W^BGPMUPP(^BGPMUIND(90595.11,BGPIC,20,BGPZ,0),0,1,BGPPTYPE)
- End DoDot:2
- +17 SET X=""
- DO W^BGPMUPP(X,0,1,BGPPTYPE)
- End DoDot:1
- +18 QUIT
- +1 NEW BGPZ
- +2 IF BGPPTYPE="D"
- QUIT
- +3 KILL DIR
- IF $EXTRACT(IOST)="C"
- IF IO=IO(0)
- IF '$DATA(ZTQUEUED)
- WRITE !
- SET DIR(0)="EO"
- DO ^DIR
- KILL DIR
- IF Y=0!(Y="^")!($DATA(DTOUT))
- SET BGPQUIT=1
- +4 ;GUI
- IF $GET(BGPGUI)
- IF BGPPTYPE="P"
- DO W^BGPMUPP("ZZZZZZZ",0,1,BGPPTYPE)
- DO W^BGPMUPP("",0,1,BGPPTYPE)
- +5 IF BGPPTYPE="P"
- IF $DATA(IOF)
- WRITE @IOF
- SET BGPGPG=BGPGPG+1
- +6 SET X=$PIECE(^VA(200,DUZ,0),U,2)
- SET $EXTRACT(X,35)=$$FMTE^XLFDT(DT)
- SET $EXTRACT(X,70)="Page "_BGPGPG
- DO W^BGPMUPP(X,1,0,BGPPTYPE)
- +7 SET X="*** IHS Stage 1 Meaningful Use ***"
- DO W^BGPMUPP(X,1,2,BGPPTYPE)
- +8 IF $GET(BGPMUT)'="H"
- SET X="*** Eligible Professional (EP) Clinical Quality Measures Report ***"
- DO W^BGPMUPP(X,1,1,BGPPTYPE)
- +9 IF $GET(BGPMUT)="H"
- SET X="*** Eligible Hospital/CAH Clinical Quality Measures Report ***"
- DO W^BGPMUPP(X,1,1,BGPPTYPE)
- +10 ;S X=$P(^DIC(4,DUZ(2),0),U) D W^BGPMUPP(X,1,1,BGPPTYPE)
- +11 ;I $G(BGPMUT)'="H" D W^BGPMUPP("Provider: "_$P(^VA(200,BGPPROV,0),U),1,1,BGPPTYPE)
- +12 SET X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED)
- DO W^BGPMUPP(X,1,1,BGPPTYPE)
- +13 SET X="Previous Period: "_$$FMTE^XLFDT(BGPPBD)_" to "_$$FMTE^XLFDT(BGPPED)
- DO W^BGPMUPP(X,1,1,BGPPTYPE)
- +14 SET X="Baseline Period: "_$$FMTE^XLFDT(BGPBBD)_" to "_$$FMTE^XLFDT(BGPBED)
- DO W^BGPMUPP(X,1,1,BGPPTYPE)
- +15 DO W^BGPMUPP($TRANSLATE($JUSTIFY("",80)," ","-"),0,1,BGPPTYPE)
- +16 QUIT
- +1 NEW BGPZ
- +2 IF BGPPTYPE="D"
- QUIT
- +3 ;G:'BGPGPG HEADER1
- +4 KILL DIR
- IF $EXTRACT(IOST)="C"
- IF IO=IO(0)
- IF '$DATA(ZTQUEUED)
- WRITE !
- SET DIR(0)="EO"
- DO ^DIR
- KILL DIR
- IF Y=0!(Y="^")!($DATA(DTOUT))
- SET BGPQUIT=1
- +5 ;GUI
- IF $GET(BGPGUI)
- IF BGPPTYPE="P"
- DO W^BGPMUPP("ZZZZZZZ",0,1,BGPPTYPE)
- DO W^BGPMUPP("",0,1,BGPPTYPE)
- +6 IF BGPPTYPE="P"
- IF $DATA(IOF)
- WRITE @IOF
- SET BGPGPG=BGPGPG+1
- +7 SET X="**** CONFIDENTIAL PATIENT INFORMATION COVERED BY PRIVACY ACT ****"
- DO W^BGPMUPP(X,1,0,BGPPTYPE)
- +8 SET X=$PIECE(^VA(200,DUZ,0),U,2)
- SET $EXTRACT(X,35)=$$FMTE^XLFDT(DT)
- SET $EXTRACT(X,70)="Page "_BGPGPG
- DO W^BGPMUPP(X,1,1,BGPPTYPE)
- +9 SET X="*** IHS 2011 Stage 1 Meaningful Use Clinical Quality Measure Patient List ***"
- DO W^BGPMUPP(X,1,2,BGPPTYPE)
- +10 SET X=$$VER^BGPMUUTL()
- DO W^BGPMUPP(X,1,1,BGPPTYPE)
- +11 SET X=$PIECE(^DIC(4,DUZ(2),0),U)
- DO W^BGPMUPP(X,1,1,BGPPTYPE)
- +12 IF $GET(BGPMUT)'="H"
- DO W^BGPMUPP("EP: "_$PIECE(^VA(200,BGPPROV,0),U),1,1,BGPPTYPE)
- +13 SET X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED)
- DO W^BGPMUPP(X,1,1,BGPPTYPE)
- +14 SET X=$SELECT(BGPBEN=1:"Indian/Alaskan Native (Classification 01)",BGPBEN=2:"Not Indian Alaskan/Native (Not Classification 01)",1:"All patients")
- DO W^BGPMUPP(X,1,1,BGPPTYPE)
- +15 DO W^BGPMUPP($TRANSLATE($JUSTIFY("",80)," ","-"),0,1,BGPPTYPE)
- +16 IF $GET(BGPIC)
- Begin DoDot:1
- +17 SET BGPZ=0
- FOR
- SET BGPZ=$ORDER(^BGPMUIND(90595.11,BGPIC,20,BGPZ))
- IF BGPZ'=+BGPZ!(BGPQUIT)
- QUIT
- Begin DoDot:2
- +18 DO W^BGPMUPP(^BGPMUIND(90595.11,BGPIC,20,BGPZ,0),0,1,BGPPTYPE)
- End DoDot:2
- +19 SET X=""
- DO W^BGPMUPP(X,0,1,BGPPTYPE)
- End DoDot:1
- +20 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 NEW DIR
- +4 KILL DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
- +5 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 ;----------
- HDRBLK ;
- +1 WRITE !,?33,"REPORT",?41,"%",?44,"PREV YR",?53,"%",?55,"CHG FROM",?64,"BASE",?70,"%",?74,"CHG"
- +2 WRITE !,?33,"PERIOD",?44,"PERIOD",?55,"PREV YR",?64,"YR",?74,"BASE %"
- +3 QUIT
