- BGP1DS ; IHS/CMI/LAB - IHS gpra print ;
- ;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
- ;
- START ;
- Q:$G(BGPAREAA)
- Q:'$D(BGPLIST)
- I $G(BGPNPL) Q
- I $G(BGPCPPL) Q ;not on comprehensive pt
- S BGPQUIT="",BGPGPG=0
- ;D HEADER
- S BGPORDSE=0 F S BGPORDSE=$O(^BGPINDB("AOI",BGPORDSE)) Q:BGPORDSE'=+BGPORDSE!(BGPQUIT) S BGPL=$O(^BGPINDB("AOI",BGPORDSE,0)) I $D(BGPLIST(BGPL)) D
- .S BGPFIRSP=1 S BGPCOUNT=0,BGPPCNT=0
- .D HEADER Q:BGPQUIT
- .S BGPCNT=$G(BGPLIST(BGPL))
- .I 'BGPCNT S BGPCNT=0 G GO
- .I BGPCNT<100 S BGPCNT=1 G GO
- .I BGPLIST'="R" S BGPCNT=1 G GO
- .;I BGPCNT<100 S BGPCNT=BGPCNT\10 G GO
- .;I BGPCNT<100 G GO
- .S BGPCNT=10
- GO .;
- .D WTITLE^BGP1DP(BGPL) ;W !,$P(^BGPINDB(BGPL,0),U,3),!
- .D W^BGP1DP("Denominator(s):",0,1,BGPPTYPE)
- .S BGPNODE=$S(BGPRTYPE=1:81,BGPRTYPE=4:61,BGPRTYPE=7:83,BGPRTYPE=9:85,1:61)
- .I BGPRTYPE=4 S BGPNODE=$S(BGPINDB="D":87,BGPINDB="C":89,BGPINDB="W":92,BGPINDB="I":94,BGPINDB="P":96,1:BGPNODE)
- .S BGPX=0 F S BGPX=$O(^BGPINDB(BGPL,BGPNODE,"B",BGPX)) Q:BGPX'=+BGPX!(BGPQUIT) D
- ..S BGPY=0 F S BGPY=$O(^BGPINDB(BGPL,BGPNODE,"B",BGPX,BGPY)) Q:BGPY'=+BGPY!(BGPQUIT) D
- ...;I '$D(^BGPINDB(BGPL,BGPNODE,BGPY,11,"B",BGPRTYPE)) Q ;not this report type
- ...;I BGPRTYPE=4,'$D(^BGPINDB(BGPL,BGPNODE,BGPY,12,"B",BGPINDB)) Q ;not this measure type on selected
- ...D WP
- .I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER^BGP1DPH Q:BGPQUIT
- .D W^BGP1DP("Numerator(s):",0,2,BGPPTYPE)
- .S BGPNODE=$S(BGPRTYPE=1:82,BGPRTYPE=4:62,BGPRTYPE=7:84,BGPRTYPE=9:86,1:62)
- .I BGPRTYPE=4 S BGPNODE=$S(BGPINDB="D":88,BGPINDB="C":91,BGPINDB="W":93,BGPINDB="I":95,BGPINDB="P":97,1:BGPNODE)
- .S BGPX=0 F S BGPX=$O(^BGPINDB(BGPL,BGPNODE,"B",BGPX)) Q:BGPX'=+BGPX!(BGPQUIT) D
- ..S BGPY=0 F S BGPY=$O(^BGPINDB(BGPL,BGPNODE,"B",BGPX,BGPY)) Q:BGPY'=+BGPY!(BGPQUIT) D
- ...;I '$D(^BGPINDB(BGPL,62,BGPY,11,"B",BGPRTYPE)) Q ;not this report type
- ...;I BGPRTYPE=4,'$D(^BGPINDB(BGPL,BGPNODE,BGPY,12,"B",BGPINDB)) Q ;not this measure type on selected
- ...D WP
- .S BGPNODE=11
- .I BGPRTYPE=1,$O(^BGPINDB(BGPL,54,0)) S BGPNODE=54
- .I BGPRTYPE=7,$O(^BGPINDB(BGPL,56,0)) S BGPNODE=56
- .I BGPRTYPE=9,$O(^BGPINDB(BGPL,58,0)) S BGPNODE=58
- .D W^BGP1DP("Logic:",0,2,BGPPTYPE) S BGPX=0 F S BGPX=$O(^BGPINDB(BGPL,BGPNODE,BGPX)) Q:BGPX'=+BGPX D
- ..I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER^BGP1DPH Q:BGPQUIT
- ..D W^BGP1DP(^BGPINDB(BGPL,BGPNODE,BGPX,0),0,1,BGPPTYPE)
- .D W^BGP1DP("Performance Measure Description:",0,2,BGPPTYPE) S BGPX=0 F S BGPX=$O(^BGPINDB(BGPL,$S($G(BGPNGR09):57,1:51),BGPX)) Q:BGPX'=+BGPX D
- ..I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER^BGP1DPH Q:BGPQUIT
- ..D W^BGP1DP(^BGPINDB(BGPL,$S($G(BGPNGR09):57,1:51),BGPX,0),0,1,BGPPTYPE)
- .I $O(^BGPINDB(BGPL,52,0)) D W^BGP1DP("Past Performance and/or Target:",0,2,BGPPTYPE) S BGPX=0 F S BGPX=$O(^BGPINDB(BGPL,52,BGPX)) Q:BGPX'=+BGPX D
- ..I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER^BGP1DPH Q:BGPQUIT
- ..D W^BGP1DP(^BGPINDB(BGPL,52,BGPX,0),0,1,BGPPTYPE)
- .I $O(^BGPINDB(BGPL,55,0)) D W^BGP1DP("Source:",0,2,BGPPTYPE) S BGPX=0 F S BGPX=$O(^BGPINDB(BGPL,55,BGPX)) Q:BGPX'=+BGPX D
- ..I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER^BGP1DPH Q:BGPQUIT
- ..D W^BGP1DP(^BGPINDB(BGPL,55,BGPX,0),0,1,BGPPTYPE)
- .I '$O(^BGPINDB(BGPL,55,0)) D W^BGP1DP("",0,1,BGPPTYPE)
- .D H1
- .Q:BGPQUIT
- .S BGPCOM="" F S BGPCOM=$O(^XTMP("BGP1D",BGPJ,BGPH,"LIST",BGPL,BGPCOM)) Q:BGPCOM=""!(BGPQUIT) D
- ..S BGPSEX="" F S BGPSEX=$O(^XTMP("BGP1D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX)) Q:BGPSEX=""!(BGPQUIT) D
- ...S BGPAGE="" F S BGPAGE=$O(^XTMP("BGP1D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE)) Q:BGPAGE=""!(BGPQUIT) D
- ....S DFN=0 F S DFN=$O(^XTMP("BGP1D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN)) Q:DFN'=+DFN!(BGPQUIT) S BGPCOUNT=BGPCOUNT+1 D PRINTL
- ....Q
- ...Q
- ..Q
- .I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
- .D W^BGP1DP("Total # of Patients on list: "_+$G(BGPPCNT),0,2,BGPPTYPE)
- .D W^BGP1DP("",0,1,BGPPTYPE)
- D W^BGP1DP("",0,1,BGPPTYPE)
- Q
- WP ;
- K ^UTILITY($J,"W")
- S BGPZ=0,BGPLCNT=0
- S DIWL=1,DIWR=80,DIWF="",BGPZ=0 F S BGPZ=$O(^BGPINDB(BGPL,BGPNODE,BGPY,1,BGPZ)) Q:BGPZ'=+BGPZ D
- .S BGPLCNT=BGPLCNT+1
- .S X=^BGPINDB(BGPL,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 BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER^BGP1DPH Q:BGPQUIT
- .D W^BGP1DP(^UTILITY($J,"W",DIWL,Z,0),0,1,BGPPTYPE)
- K DIWL,DIWR,DIWF,Z
- K ^UTILITY($J,"W"),X
- Q
- ;
- PRINTL ;print one line
- Q:(BGPCOUNT#BGPCNT)
- I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER Q:BGPQUIT D
- .;S X=0 F S X=$O(^BGPINDB(BGPL,72,X)) Q:X'=+X W !,^BGPINDB(BGPL,72,X,0)
- .D H1
- Q:BGPQUIT
- S BGPPCNT=BGPPCNT+1
- I BGPPTYPE="P" W !,$E($P(^DPT(DFN,0),U),1,22),?24,$$HRN^AUPNPAT(DFN,DUZ(2)),?31,$E(BGPCOM,1,14),?46,BGPSEX,?49,BGPAGE D
- .W ?53,$P(^XTMP("BGP1D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",1)
- .W:BGPL=43 " NUMERATOR: "
- .W ?65,$P(^XTMP("BGP1D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",2)
- I BGPPTYPE="D" D
- .S X=$E($P(^DPT(DFN,0),U),1,22)_U_$$HRN^AUPNPAT(DFN,DUZ(2))_U_$E(BGPCOM,1,14)_U_BGPSEX_U_BGPAGE
- .S Y=$P(^XTMP("BGP1D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",1) S $P(X,U,6)=Y
- .S Y=$P(^XTMP("BGP1D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",2) S $P(X,U,7)=Y
- .D W^BGP1DP(X,0,1,BGPPTYPE)
- Q
- ;
- I BGPPTYPE'="P" G HEADER1
- 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 Q
- I BGPPTYPE="P" W:$D(IOF) @IOF S BGPGPG=BGPGPG+1
- I $G(BGPGUI),BGPPTYPE="P" D W^BGP1DP("ZZZZZZZ",0,1,BGPPTYPE) ;! ;maw
- D W^BGP1DP("***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****",1,1,BGPPTYPE)
- I BGPPTYPE="P" S X=$P(^VA(200,DUZ,0),U,2),$E(X,35)=$$FMTE^XLFDT(DT),$E(X,70)="Page "_BGPGPG D W^BGP1EOH(X,1,1,BGPPTYPE)
- I BGPPTYPE'="P" S X=$P(^VA(200,DUZ,0),U,2),$P(X,U,2)=$$FMTE^XLFDT(DT) D W^BGP1DP(X,0,1,BGPPTYPE)
- D W^BGP1DP("*** IHS 2011 Clinical Performance Measure Patient List ***",1,1,BGPPTYPE)
- D W^BGP1DP($P(^DIC(4,DUZ(2),0),U),1,1,BGPPTYPE)
- S X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED) D W^BGP1DP(X,1,1,BGPPTYPE)
- D W^BGP1DP($S(BGPLIST="A":"Entire Patient List",BGPLIST="R":"Random Patient List",1:"Patient List by Provider: "_BGPLPROV),1,1,BGPPTYPE)
- D W^BGP1DP($TR($J("",80)," ","-"),0,1,BGPPTYPE)
- Q
- H1 ;
- S BGPTSUB=$S(BGPFIRSP:71,1:72)
- S X=0,C=0 F S X=$O(^BGPINDB(BGPL,BGPTSUB,X)) Q:X'=+X S C=C+1
- I BGPPTYPE="P",$Y>(BGPIOSL-(C+6)) D HEADER Q:BGPQUIT
- D W^BGP1DP("UP=User Pop; AC=Active Clinical; AD=Active Diabetic; AAD=Active Adult Diabetic",0,1,BGPPTYPE)
- D W^BGP1DP("PREG=Pregnant Female; IMM=Active IMM Pkg Pt; IHD=Active Ischemic Heart Disease",0,1,BGPPTYPE)
- ;D W^BGP1DP("CHD=Active Coronary Heart Disease",0,1,BGPRTYPE)
- D W^BGP1DP("",0,1,BGPPTYPE)
- S X=0 F S X=$O(^BGPINDB(BGPL,BGPTSUB,X)) Q:X'=+X D W^BGP1DP(^BGPINDB(BGPL,BGPTSUB,X,0),0,1,BGPPTYPE)
- D W^BGP1DP("",0,1,BGPPTYPE)
- D W^BGP1DP("PATIENT NAME",0,1,BGPPTYPE,1)
- D W^BGP1DP("HRN",0,0,BGPPTYPE,2,24) ;,?24,"HRN",
- D W^BGP1DP("COMMUNITY",0,0,BGPPTYPE,3,31) ;?31,"COMMUNITY",
- D W^BGP1DP("SEX",0,0,BGPPTYPE,4,45) ;?45,"SEX",
- D W^BGP1DP("AGE",0,0,BGPPTYPE,5,49) ;?49,"AGE",
- D W^BGP1DP("DENOMINATOR",0,0,BGPPTYPE,6,53) ;?53,"DENOMINATOR",
- D W^BGP1DP("NUMERATOR",0,0,BGPPTYPE,7,65) ;?65,"NUMERATOR"
- D W^BGP1DP($TR($J("",80)," ","-"),0,1,BGPPTYPE)
- S BGPFIRSP=0
- Q
- BGP1DS ; IHS/CMI/LAB - IHS gpra print ;
- +1 ;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
- +2 ;
- START ;
- +1 IF $GET(BGPAREAA)
- QUIT
- +2 IF '$DATA(BGPLIST)
- QUIT
- +3 IF $GET(BGPNPL)
- QUIT
- +4 ;not on comprehensive pt
- IF $GET(BGPCPPL)
- QUIT
- +5 SET BGPQUIT=""
- SET BGPGPG=0
- +6 ;D HEADER
- +7 SET BGPORDSE=0
- FOR
- SET BGPORDSE=$ORDER(^BGPINDB("AOI",BGPORDSE))
- IF BGPORDSE'=+BGPORDSE!(BGPQUIT)
- QUIT
- SET BGPL=$ORDER(^BGPINDB("AOI",BGPORDSE,0))
- IF $DATA(BGPLIST(BGPL))
- Begin DoDot:1
- +8 SET BGPFIRSP=1
- SET BGPCOUNT=0
- SET BGPPCNT=0
- +9 DO HEADER
- IF BGPQUIT
- QUIT
- +10 SET BGPCNT=$GET(BGPLIST(BGPL))
- +11 IF 'BGPCNT
- SET BGPCNT=0
- GOTO GO
- +12 IF BGPCNT<100
- SET BGPCNT=1
- GOTO GO
- +13 IF BGPLIST'="R"
- SET BGPCNT=1
- GOTO GO
- +14 ;I BGPCNT<100 S BGPCNT=BGPCNT\10 G GO
- +15 ;I BGPCNT<100 G GO
- +16 SET BGPCNT=10
- GO ;
- +1 ;W !,$P(^BGPINDB(BGPL,0),U,3),!
- DO WTITLE^BGP1DP(BGPL)
- +2 DO W^BGP1DP("Denominator(s):",0,1,BGPPTYPE)
- +3 SET BGPNODE=$SELECT(BGPRTYPE=1:81,BGPRTYPE=4:61,BGPRTYPE=7:83,BGPRTYPE=9:85,1:61)
- +4 IF BGPRTYPE=4
- SET BGPNODE=$SELECT(BGPINDB="D":87,BGPINDB="C":89,BGPINDB="W":92,BGPINDB="I":94,BGPINDB="P":96,1:BGPNODE)
- +5 SET BGPX=0
- FOR
- SET BGPX=$ORDER(^BGPINDB(BGPL,BGPNODE,"B",BGPX))
- IF BGPX'=+BGPX!(BGPQUIT)
- QUIT
- Begin DoDot:2
- +6 SET BGPY=0
- FOR
- SET BGPY=$ORDER(^BGPINDB(BGPL,BGPNODE,"B",BGPX,BGPY))
- IF BGPY'=+BGPY!(BGPQUIT)
- QUIT
- Begin DoDot:3
- +7 ;I '$D(^BGPINDB(BGPL,BGPNODE,BGPY,11,"B",BGPRTYPE)) Q ;not this report type
- +8 ;I BGPRTYPE=4,'$D(^BGPINDB(BGPL,BGPNODE,BGPY,12,"B",BGPINDB)) Q ;not this measure type on selected
- +9 DO WP
- End DoDot:3
- End DoDot:2
- +10 IF BGPPTYPE="P"
- IF $Y>(BGPIOSL-3)
- DO HEADER^BGP1DPH
- IF BGPQUIT
- QUIT
- +11 DO W^BGP1DP("Numerator(s):",0,2,BGPPTYPE)
- +12 SET BGPNODE=$SELECT(BGPRTYPE=1:82,BGPRTYPE=4:62,BGPRTYPE=7:84,BGPRTYPE=9:86,1:62)
- +13 IF BGPRTYPE=4
- SET BGPNODE=$SELECT(BGPINDB="D":88,BGPINDB="C":91,BGPINDB="W":93,BGPINDB="I":95,BGPINDB="P":97,1:BGPNODE)
- +14 SET BGPX=0
- FOR
- SET BGPX=$ORDER(^BGPINDB(BGPL,BGPNODE,"B",BGPX))
- IF BGPX'=+BGPX!(BGPQUIT)
- QUIT
- Begin DoDot:2
- +15 SET BGPY=0
- FOR
- SET BGPY=$ORDER(^BGPINDB(BGPL,BGPNODE,"B",BGPX,BGPY))
- IF BGPY'=+BGPY!(BGPQUIT)
- QUIT
- Begin DoDot:3
- +16 ;I '$D(^BGPINDB(BGPL,62,BGPY,11,"B",BGPRTYPE)) Q ;not this report type
- +17 ;I BGPRTYPE=4,'$D(^BGPINDB(BGPL,BGPNODE,BGPY,12,"B",BGPINDB)) Q ;not this measure type on selected
- +18 DO WP
- End DoDot:3
- End DoDot:2
- +19 SET BGPNODE=11
- +20 IF BGPRTYPE=1
- IF $ORDER(^BGPINDB(BGPL,54,0))
- SET BGPNODE=54
- +21 IF BGPRTYPE=7
- IF $ORDER(^BGPINDB(BGPL,56,0))
- SET BGPNODE=56
- +22 IF BGPRTYPE=9
- IF $ORDER(^BGPINDB(BGPL,58,0))
- SET BGPNODE=58
- +23 DO W^BGP1DP("Logic:",0,2,BGPPTYPE)
- SET BGPX=0
- FOR
- SET BGPX=$ORDER(^BGPINDB(BGPL,BGPNODE,BGPX))
- IF BGPX'=+BGPX
- QUIT
- Begin DoDot:2
- +24 IF BGPPTYPE="P"
- IF $Y>(BGPIOSL-3)
- DO HEADER^BGP1DPH
- IF BGPQUIT
- QUIT
- +25 DO W^BGP1DP(^BGPINDB(BGPL,BGPNODE,BGPX,0),0,1,BGPPTYPE)
- End DoDot:2
- +26 DO W^BGP1DP("Performance Measure Description:",0,2,BGPPTYPE)
- SET BGPX=0
- FOR
- SET BGPX=$ORDER(^BGPINDB(BGPL,$SELECT($GET(BGPNGR09):57,1:51),BGPX))
- IF BGPX'=+BGPX
- QUIT
- Begin DoDot:2
- +27 IF BGPPTYPE="P"
- IF $Y>(BGPIOSL-3)
- DO HEADER^BGP1DPH
- IF BGPQUIT
- QUIT
- +28 DO W^BGP1DP(^BGPINDB(BGPL,$SELECT($GET(BGPNGR09):57,1:51),BGPX,0),0,1,BGPPTYPE)
- End DoDot:2
- +29 IF $ORDER(^BGPINDB(BGPL,52,0))
- DO W^BGP1DP("Past Performance and/or Target:",0,2,BGPPTYPE)
- SET BGPX=0
- FOR
- SET BGPX=$ORDER(^BGPINDB(BGPL,52,BGPX))
- IF BGPX'=+BGPX
- QUIT
- Begin DoDot:2
- +30 IF BGPPTYPE="P"
- IF $Y>(BGPIOSL-3)
- DO HEADER^BGP1DPH
- IF BGPQUIT
- QUIT
- +31 DO W^BGP1DP(^BGPINDB(BGPL,52,BGPX,0),0,1,BGPPTYPE)
- End DoDot:2
- +32 IF $ORDER(^BGPINDB(BGPL,55,0))
- DO W^BGP1DP("Source:",0,2,BGPPTYPE)
- SET BGPX=0
- FOR
- SET BGPX=$ORDER(^BGPINDB(BGPL,55,BGPX))
- IF BGPX'=+BGPX
- QUIT
- Begin DoDot:2
- +33 IF BGPPTYPE="P"
- IF $Y>(BGPIOSL-3)
- DO HEADER^BGP1DPH
- IF BGPQUIT
- QUIT
- +34 DO W^BGP1DP(^BGPINDB(BGPL,55,BGPX,0),0,1,BGPPTYPE)
- End DoDot:2
- +35 IF '$ORDER(^BGPINDB(BGPL,55,0))
- DO W^BGP1DP("",0,1,BGPPTYPE)
- +36 DO H1
- +37 IF BGPQUIT
- QUIT
- +38 SET BGPCOM=""
- FOR
- SET BGPCOM=$ORDER(^XTMP("BGP1D",BGPJ,BGPH,"LIST",BGPL,BGPCOM))
- IF BGPCOM=""!(BGPQUIT)
- QUIT
- Begin DoDot:2
- +39 SET BGPSEX=""
- FOR
- SET BGPSEX=$ORDER(^XTMP("BGP1D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX))
- IF BGPSEX=""!(BGPQUIT)
- QUIT
- Begin DoDot:3
- +40 SET BGPAGE=""
- FOR
- SET BGPAGE=$ORDER(^XTMP("BGP1D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE))
- IF BGPAGE=""!(BGPQUIT)
- QUIT
- Begin DoDot:4
- +41 SET DFN=0
- FOR
- SET DFN=$ORDER(^XTMP("BGP1D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN))
- IF DFN'=+DFN!(BGPQUIT)
- QUIT
- SET BGPCOUNT=BGPCOUNT+1
- DO PRINTL
- +42 QUIT
- End DoDot:4
- +43 QUIT
- End DoDot:3
- +44 QUIT
- End DoDot:2
- +45 IF BGPPTYPE="P"
- IF $Y>(BGPIOSL-3)
- DO HEADER
- IF BGPQUIT
- QUIT
- +46 DO W^BGP1DP("Total # of Patients on list: "_+$GET(BGPPCNT),0,2,BGPPTYPE)
- +47 DO W^BGP1DP("",0,1,BGPPTYPE)
- End DoDot:1
- +48 DO W^BGP1DP("",0,1,BGPPTYPE)
- +49 QUIT
- WP ;
- +1 KILL ^UTILITY($JOB,"W")
- +2 SET BGPZ=0
- SET BGPLCNT=0
- +3 SET DIWL=1
- SET DIWR=80
- SET DIWF=""
- SET BGPZ=0
- FOR
- SET BGPZ=$ORDER(^BGPINDB(BGPL,BGPNODE,BGPY,1,BGPZ))
- IF BGPZ'=+BGPZ
- QUIT
- Begin DoDot:1
- +4 SET BGPLCNT=BGPLCNT+1
- +5 SET X=^BGPINDB(BGPL,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 BGPPTYPE="P"
- IF $Y>(BGPIOSL-3)
- DO HEADER^BGP1DPH
- IF BGPQUIT
- QUIT
- +3 DO W^BGP1DP(^UTILITY($JOB,"W",DIWL,Z,0),0,1,BGPPTYPE)
- End DoDot:1
- +4 KILL DIWL,DIWR,DIWF,Z
- +5 KILL ^UTILITY($JOB,"W"),X
- +6 QUIT
- +7 ;
- PRINTL ;print one line
- +1 IF (BGPCOUNT#BGPCNT)
- QUIT
- +2 IF BGPPTYPE="P"
- IF $Y>(BGPIOSL-3)
- DO HEADER
- IF BGPQUIT
- QUIT
- Begin DoDot:1
- +3 ;S X=0 F S X=$O(^BGPINDB(BGPL,72,X)) Q:X'=+X W !,^BGPINDB(BGPL,72,X,0)
- +4 DO H1
- End DoDot:1
- +5 IF BGPQUIT
- QUIT
- +6 SET BGPPCNT=BGPPCNT+1
- +7 IF BGPPTYPE="P"
- WRITE !,$EXTRACT($PIECE(^DPT(DFN,0),U),1,22),?24,$$HRN^AUPNPAT(DFN,DUZ(2)),?31,$EXTRACT(BGPCOM,1,14),?46,BGPSEX,?49,BGPAGE
- Begin DoDot:1
- +8 WRITE ?53,$PIECE(^XTMP("BGP1D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",1)
- +9 IF BGPL=43
- WRITE " NUMERATOR: "
- +10 WRITE ?65,$PIECE(^XTMP("BGP1D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",2)
- End DoDot:1
- +11 IF BGPPTYPE="D"
- Begin DoDot:1
- +12 SET X=$EXTRACT($PIECE(^DPT(DFN,0),U),1,22)_U_$$HRN^AUPNPAT(DFN,DUZ(2))_U_$EXTRACT(BGPCOM,1,14)_U_BGPSEX_U_BGPAGE
- +13 SET Y=$PIECE(^XTMP("BGP1D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",1)
- SET $PIECE(X,U,6)=Y
- +14 SET Y=$PIECE(^XTMP("BGP1D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",2)
- SET $PIECE(X,U,7)=Y
- +15 DO W^BGP1DP(X,0,1,BGPPTYPE)
- End DoDot:1
- +16 QUIT
- +17 ;
- +1 IF BGPPTYPE'="P"
- GOTO HEADER1
- +2 IF 'BGPGPG
- GOTO HEADER1
- +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
- QUIT
- +1 IF BGPPTYPE="P"
- IF $DATA(IOF)
- WRITE @IOF
- SET BGPGPG=BGPGPG+1
- +2 ;! ;maw
- IF $GET(BGPGUI)
- IF BGPPTYPE="P"
- DO W^BGP1DP("ZZZZZZZ",0,1,BGPPTYPE)
- +3 DO W^BGP1DP("***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****",1,1,BGPPTYPE)
- +4 IF BGPPTYPE="P"
- SET X=$PIECE(^VA(200,DUZ,0),U,2)
- SET $EXTRACT(X,35)=$$FMTE^XLFDT(DT)
- SET $EXTRACT(X,70)="Page "_BGPGPG
- DO W^BGP1EOH(X,1,1,BGPPTYPE)
- +5 IF BGPPTYPE'="P"
- SET X=$PIECE(^VA(200,DUZ,0),U,2)
- SET $PIECE(X,U,2)=$$FMTE^XLFDT(DT)
- DO W^BGP1DP(X,0,1,BGPPTYPE)
- +6 DO W^BGP1DP("*** IHS 2011 Clinical Performance Measure Patient List ***",1,1,BGPPTYPE)
- +7 DO W^BGP1DP($PIECE(^DIC(4,DUZ(2),0),U),1,1,BGPPTYPE)
- +8 SET X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED)
- DO W^BGP1DP(X,1,1,BGPPTYPE)
- +9 DO W^BGP1DP($SELECT(BGPLIST="A":"Entire Patient List",BGPLIST="R":"Random Patient List",1:"Patient List by Provider: "_BGPLPROV),1,1,BGPPTYPE)
- +10 DO W^BGP1DP($TRANSLATE($JUSTIFY("",80)," ","-"),0,1,BGPPTYPE)
- +11 QUIT
- H1 ;
- +1 SET BGPTSUB=$SELECT(BGPFIRSP:71,1:72)
- +2 SET X=0
- SET C=0
- FOR
- SET X=$ORDER(^BGPINDB(BGPL,BGPTSUB,X))
- IF X'=+X
- QUIT
- SET C=C+1
- +3 IF BGPPTYPE="P"
- IF $Y>(BGPIOSL-(C+6))
- DO HEADER
- IF BGPQUIT
- QUIT
- +4 DO W^BGP1DP("UP=User Pop; AC=Active Clinical; AD=Active Diabetic; AAD=Active Adult Diabetic",0,1,BGPPTYPE)
- +5 DO W^BGP1DP("PREG=Pregnant Female; IMM=Active IMM Pkg Pt; IHD=Active Ischemic Heart Disease",0,1,BGPPTYPE)
- +6 ;D W^BGP1DP("CHD=Active Coronary Heart Disease",0,1,BGPRTYPE)
- +7 DO W^BGP1DP("",0,1,BGPPTYPE)
- +8 SET X=0
- FOR
- SET X=$ORDER(^BGPINDB(BGPL,BGPTSUB,X))
- IF X'=+X
- QUIT
- DO W^BGP1DP(^BGPINDB(BGPL,BGPTSUB,X,0),0,1,BGPPTYPE)
- +9 DO W^BGP1DP("",0,1,BGPPTYPE)
- +10 DO W^BGP1DP("PATIENT NAME",0,1,BGPPTYPE,1)
- +11 ;,?24,"HRN",
- DO W^BGP1DP("HRN",0,0,BGPPTYPE,2,24)
- +12 ;?31,"COMMUNITY",
- DO W^BGP1DP("COMMUNITY",0,0,BGPPTYPE,3,31)
- +13 ;?45,"SEX",
- DO W^BGP1DP("SEX",0,0,BGPPTYPE,4,45)
- +14 ;?49,"AGE",
- DO W^BGP1DP("AGE",0,0,BGPPTYPE,5,49)
- +15 ;?53,"DENOMINATOR",
- DO W^BGP1DP("DENOMINATOR",0,0,BGPPTYPE,6,53)
- +16 ;?65,"NUMERATOR"
- DO W^BGP1DP("NUMERATOR",0,0,BGPPTYPE,7,65)
- +17 DO W^BGP1DP($TRANSLATE($JUSTIFY("",80)," ","-"),0,1,BGPPTYPE)
- +18 SET BGPFIRSP=0
- +19 QUIT
