- BGP9DS ; IHS/CMI/LAB - IHS gpra print ;
- ;;9.0;IHS CLINICAL REPORTING;;JUL 1, 2009
- ;
- 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 BGPL=0 F S BGPL=$O(BGPLIST(BGPL)) Q:BGPL'=+BGPL!(BGPQUIT) 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 ;W !,$P(^BGPINDN(BGPL,0),U,3),!
- .W !,"Denominator(s):"
- .S BGPX=0 F S BGPX=$O(^BGPINDN(BGPL,61,"B",BGPX)) Q:BGPX'=+BGPX!(BGPQUIT) D
- ..S BGPY=0 F S BGPY=$O(^BGPINDN(BGPL,61,"B",BGPX,BGPY)) Q:BGPY'=+BGPY!(BGPQUIT) D
- ...;I $P(^BGPINDN(BGPL,61,BGPY,0),U,2)'[BGPRTYPE Q ;not a denom def for this report
- ...;I BGPRTYPE=4,$P(^BGPINDN(BGPL,61,BGPY,0),U,3)'[BGPINDT Q ;don't display
- ...I '$D(^BGPINDN(BGPL,61,BGPY,11,"B",BGPRTYPE)) Q ;not this report type
- ...I BGPRTYPE=4,'$D(^BGPINDN(BGPL,61,BGPY,12,"B",BGPINDT))
- ...S BGPZ=0 F S BGPZ=$O(^BGPINDN(BGPL,61,BGPY,1,BGPZ)) Q:BGPZ'=+BGPZ!(BGPQUIT) D
- ....I $Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
- ....W !,^BGPINDN(BGPL,61,BGPY,1,BGPZ,0)
- ....Q
- ...;W !
- ...Q
- ..Q
- .I $Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
- .W !!,"Numerator(s):"
- .S BGPX=0 F S BGPX=$O(^BGPINDN(BGPL,62,"B",BGPX)) Q:BGPX'=+BGPX!(BGPQUIT) D
- ..S BGPY=0 F S BGPY=$O(^BGPINDN(BGPL,62,"B",BGPX,BGPY)) Q:BGPY'=+BGPY!(BGPQUIT) D
- ...;I $P(^BGPINDN(BGPL,62,BGPY,0),U,2)'[BGPRTYPE Q ;not a denom def for this report
- ...;I BGPRTYPE=4,BGPINDT'="S",$P(^BGPINDN(BGPL,62,BGPY,0),U,3)'[BGPINDT Q ;don't display
- ...I '$D(^BGPINDN(BGPL,62,BGPY,11,"B",BGPRTYPE)) Q ;not this report type
- ...I BGPRTYPE=4,'$D(^BGPINDN(BGPL,62,BGPY,12,"B",BGPINDT)) Q ;not this measure type on selected
- ...S BGPZ=0 F S BGPZ=$O(^BGPINDN(BGPL,62,BGPY,1,BGPZ)) Q:BGPZ'=+BGPZ!(BGPQUIT) D
- ....I $Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
- ....W !,^BGPINDN(BGPL,62,BGPY,1,BGPZ,0)
- ....Q
- ...;W !
- ...Q
- ..Q
- .S BGPNODE=11
- .I BGPRTYPE=1,$O(^BGPINDN(BGPL,54,0)) S BGPNODE=54
- .I BGPRTYPE=7,$O(^BGPINDN(BGPL,56,0)) S BGPNODE=56
- .W !!,"Logic" S BGPX=0 F S BGPX=$O(^BGPINDN(BGPL,BGPNODE,BGPX)) Q:BGPX'=+BGPX D
- ..I $Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
- ..W !,^BGPINDN(BGPL,BGPNODE,BGPX,0)
- .W !!,"Performance Measure Description" S BGPX=0 F S BGPX=$O(^BGPINDN(BGPL,51,BGPX)) Q:BGPX'=+BGPX D
- ..I $Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
- ..W !,^BGPINDN(BGPL,51,BGPX,0)
- .I $O(^BGPINDN(BGPL,52,0)) W !,"Past Performance and/or Target" S BGPX=0 F S BGPX=$O(^BGPINDN(BGPL,52,BGPX)) Q:BGPX'=+BGPX D
- ..I $Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
- ..W !,^BGPINDN(BGPL,52,BGPX,0)
- .I $O(^BGPINDN(BGPL,55,0)) W !,"Source" S BGPX=0 F S BGPX=$O(^BGPINDN(BGPL,55,BGPX)) Q:BGPX'=+BGPX D
- ..I $Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
- ..W !,^BGPINDN(BGPL,55,BGPX,0)
- .I $Y>(BGPIOSL-2) D HEADER Q:BGPQUIT
- .W !
- .D H1
- .Q:BGPQUIT
- .S BGPCOM="" F S BGPCOM=$O(^XTMP("BGP9D",BGPJ,BGPH,"LIST",BGPL,BGPCOM)) Q:BGPCOM=""!(BGPQUIT) D
- ..S BGPSEX="" F S BGPSEX=$O(^XTMP("BGP9D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX)) Q:BGPSEX=""!(BGPQUIT) D
- ...S BGPAGE="" F S BGPAGE=$O(^XTMP("BGP9D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE)) Q:BGPAGE=""!(BGPQUIT) D
- ....S DFN=0 F S DFN=$O(^XTMP("BGP9D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN)) Q:DFN'=+DFN!(BGPQUIT) S BGPCOUNT=BGPCOUNT+1 D PRINTL
- ....Q
- ...Q
- ..Q
- .I $Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
- .W !!,"Total # of Patients on list: ",+$G(BGPPCNT)
- Q
- WTITLE ;EP - write title line
- NEW T,X,Y,S
- S T=$P(^BGPINDN(BGPL,0),U,3)
- I $L(T)<81 W !,T,! Q
- F X=$E(T,1,80)
- S S=""
- F Y=80:-1:1 Q:S S I=$E(X,Y) I I=" " S S=Y
- W !,$E(T,1,S)
- W !,$E(T,(S+1),$L(T)),!
- Q
- ;
- PRINTL ;print one line
- Q:(BGPCOUNT#BGPCNT)
- I $Y>(BGPIOSL-3) D HEADER Q:BGPQUIT D
- .;S X=0 F S X=$O(^BGPINDN(BGPL,72,X)) Q:X'=+X W !,^BGPINDN(BGPL,72,X,0)
- .D H1
- Q:BGPQUIT
- S BGPPCNT=BGPPCNT+1
- W !,$E($P(^DPT(DFN,0),U),1,22),?24,$$HRN^AUPNPAT(DFN,DUZ(2)),?31,$E(BGPCOM,1,14),?46,BGPSEX,?49,BGPAGE
- W ?53,$P(^XTMP("BGP9D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",1)
- W:BGPL=43 " NUMERATOR: "
- W ?65,$P(^XTMP("BGP9D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",2)
- 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 Q
- W:$D(IOF) @IOF S BGPGPG=BGPGPG+1
- I $G(BGPGUI) W "ZZZZZZZ",! ;maw
- W !,"***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****"
- W !?3,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BGPGPG,!
- W !,$$CTR("*** IHS 2009 Clinical Performance Measure Patient List ***",80),!
- W $$CTR($P(^DIC(4,DUZ(2),0),U),80),!
- S X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED) W $$CTR(X,80),!
- W $$CTR($S(BGPLIST="A":"Entire Patient List",BGPLIST="R":"Random Patient List",1:"Patient List by Provider: "_BGPLPROV),80),!
- W !,$TR($J("",80)," ","-")
- Q
- H1 ;
- S BGPTSUB=$S(BGPFIRSP:71,1:72)
- S X=0,C=0 F S X=$O(^BGPINDN(BGPL,BGPTSUB,X)) Q:X'=+X S C=C+1
- I $Y>(BGPIOSL-(C+6)) D HEADER Q:BGPQUIT
- W !,"UP=User Pop; AC=Active Clinical; AD=Active Diabetic; AAD=Active Adult Diabetic",!,"PREG=Pregnant Female; IMM=Active IMM Pkg Pt; IHD=Active Ischemic Heart Disease",!
- S X=0 F S X=$O(^BGPINDN(BGPL,BGPTSUB,X)) Q:X'=+X W !,^BGPINDN(BGPL,BGPTSUB,X,0)
- W !,"PATIENT NAME",?24,"HRN",?31,"COMMUNITY",?45,"SEX",?49,"AGE",?53,"DENOMINATOR",?65,"NUMERATOR"
- W !,$TR($J("",80)," ","-")
- S BGPFIRSP=0
- 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")
- ;----------
- LOC() ;EP - Return location name from file 4 based on DUZ(2).
- Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
- ;----------
- BGP9DS ; IHS/CMI/LAB - IHS gpra print ;
- +1 ;;9.0;IHS CLINICAL REPORTING;;JUL 1, 2009
- +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 BGPL=0
- FOR
- SET BGPL=$ORDER(BGPLIST(BGPL))
- IF BGPL'=+BGPL!(BGPQUIT)
- QUIT
- 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(^BGPINDN(BGPL,0),U,3),!
- DO WTITLE
- +2 WRITE !,"Denominator(s):"
- +3 SET BGPX=0
- FOR
- SET BGPX=$ORDER(^BGPINDN(BGPL,61,"B",BGPX))
- IF BGPX'=+BGPX!(BGPQUIT)
- QUIT
- Begin DoDot:2
- +4 SET BGPY=0
- FOR
- SET BGPY=$ORDER(^BGPINDN(BGPL,61,"B",BGPX,BGPY))
- IF BGPY'=+BGPY!(BGPQUIT)
- QUIT
- Begin DoDot:3
- +5 ;I $P(^BGPINDN(BGPL,61,BGPY,0),U,2)'[BGPRTYPE Q ;not a denom def for this report
- +6 ;I BGPRTYPE=4,$P(^BGPINDN(BGPL,61,BGPY,0),U,3)'[BGPINDT Q ;don't display
- +7 ;not this report type
- IF '$DATA(^BGPINDN(BGPL,61,BGPY,11,"B",BGPRTYPE))
- QUIT
- +8 IF BGPRTYPE=4
- IF '$DATA(^BGPINDN(BGPL,61,BGPY,12,"B",BGPINDT))
- +9 SET BGPZ=0
- FOR
- SET BGPZ=$ORDER(^BGPINDN(BGPL,61,BGPY,1,BGPZ))
- IF BGPZ'=+BGPZ!(BGPQUIT)
- QUIT
- Begin DoDot:4
- +10 IF $Y>(BGPIOSL-3)
- DO HEADER
- IF BGPQUIT
- QUIT
- +11 WRITE !,^BGPINDN(BGPL,61,BGPY,1,BGPZ,0)
- +12 QUIT
- End DoDot:4
- +13 ;W !
- +14 QUIT
- End DoDot:3
- +15 QUIT
- End DoDot:2
- +16 IF $Y>(BGPIOSL-3)
- DO HEADER
- IF BGPQUIT
- QUIT
- +17 WRITE !!,"Numerator(s):"
- +18 SET BGPX=0
- FOR
- SET BGPX=$ORDER(^BGPINDN(BGPL,62,"B",BGPX))
- IF BGPX'=+BGPX!(BGPQUIT)
- QUIT
- Begin DoDot:2
- +19 SET BGPY=0
- FOR
- SET BGPY=$ORDER(^BGPINDN(BGPL,62,"B",BGPX,BGPY))
- IF BGPY'=+BGPY!(BGPQUIT)
- QUIT
- Begin DoDot:3
- +20 ;I $P(^BGPINDN(BGPL,62,BGPY,0),U,2)'[BGPRTYPE Q ;not a denom def for this report
- +21 ;I BGPRTYPE=4,BGPINDT'="S",$P(^BGPINDN(BGPL,62,BGPY,0),U,3)'[BGPINDT Q ;don't display
- +22 ;not this report type
- IF '$DATA(^BGPINDN(BGPL,62,BGPY,11,"B",BGPRTYPE))
- QUIT
- +23 ;not this measure type on selected
- IF BGPRTYPE=4
- IF '$DATA(^BGPINDN(BGPL,62,BGPY,12,"B",BGPINDT))
- QUIT
- +24 SET BGPZ=0
- FOR
- SET BGPZ=$ORDER(^BGPINDN(BGPL,62,BGPY,1,BGPZ))
- IF BGPZ'=+BGPZ!(BGPQUIT)
- QUIT
- Begin DoDot:4
- +25 IF $Y>(BGPIOSL-3)
- DO HEADER
- IF BGPQUIT
- QUIT
- +26 WRITE !,^BGPINDN(BGPL,62,BGPY,1,BGPZ,0)
- +27 QUIT
- End DoDot:4
- +28 ;W !
- +29 QUIT
- End DoDot:3
- +30 QUIT
- End DoDot:2
- +31 SET BGPNODE=11
- +32 IF BGPRTYPE=1
- IF $ORDER(^BGPINDN(BGPL,54,0))
- SET BGPNODE=54
- +33 IF BGPRTYPE=7
- IF $ORDER(^BGPINDN(BGPL,56,0))
- SET BGPNODE=56
- +34 WRITE !!,"Logic"
- SET BGPX=0
- FOR
- SET BGPX=$ORDER(^BGPINDN(BGPL,BGPNODE,BGPX))
- IF BGPX'=+BGPX
- QUIT
- Begin DoDot:2
- +35 IF $Y>(BGPIOSL-3)
- DO HEADER
- IF BGPQUIT
- QUIT
- +36 WRITE !,^BGPINDN(BGPL,BGPNODE,BGPX,0)
- End DoDot:2
- +37 WRITE !!,"Performance Measure Description"
- SET BGPX=0
- FOR
- SET BGPX=$ORDER(^BGPINDN(BGPL,51,BGPX))
- IF BGPX'=+BGPX
- QUIT
- Begin DoDot:2
- +38 IF $Y>(BGPIOSL-3)
- DO HEADER
- IF BGPQUIT
- QUIT
- +39 WRITE !,^BGPINDN(BGPL,51,BGPX,0)
- End DoDot:2
- +40 IF $ORDER(^BGPINDN(BGPL,52,0))
- WRITE !,"Past Performance and/or Target"
- SET BGPX=0
- FOR
- SET BGPX=$ORDER(^BGPINDN(BGPL,52,BGPX))
- IF BGPX'=+BGPX
- QUIT
- Begin DoDot:2
- +41 IF $Y>(BGPIOSL-3)
- DO HEADER
- IF BGPQUIT
- QUIT
- +42 WRITE !,^BGPINDN(BGPL,52,BGPX,0)
- End DoDot:2
- +43 IF $ORDER(^BGPINDN(BGPL,55,0))
- WRITE !,"Source"
- SET BGPX=0
- FOR
- SET BGPX=$ORDER(^BGPINDN(BGPL,55,BGPX))
- IF BGPX'=+BGPX
- QUIT
- Begin DoDot:2
- +44 IF $Y>(BGPIOSL-3)
- DO HEADER
- IF BGPQUIT
- QUIT
- +45 WRITE !,^BGPINDN(BGPL,55,BGPX,0)
- End DoDot:2
- +46 IF $Y>(BGPIOSL-2)
- DO HEADER
- IF BGPQUIT
- QUIT
- +47 WRITE !
- +48 DO H1
- +49 IF BGPQUIT
- QUIT
- +50 SET BGPCOM=""
- FOR
- SET BGPCOM=$ORDER(^XTMP("BGP9D",BGPJ,BGPH,"LIST",BGPL,BGPCOM))
- IF BGPCOM=""!(BGPQUIT)
- QUIT
- Begin DoDot:2
- +51 SET BGPSEX=""
- FOR
- SET BGPSEX=$ORDER(^XTMP("BGP9D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX))
- IF BGPSEX=""!(BGPQUIT)
- QUIT
- Begin DoDot:3
- +52 SET BGPAGE=""
- FOR
- SET BGPAGE=$ORDER(^XTMP("BGP9D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE))
- IF BGPAGE=""!(BGPQUIT)
- QUIT
- Begin DoDot:4
- +53 SET DFN=0
- FOR
- SET DFN=$ORDER(^XTMP("BGP9D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN))
- IF DFN'=+DFN!(BGPQUIT)
- QUIT
- SET BGPCOUNT=BGPCOUNT+1
- DO PRINTL
- +54 QUIT
- End DoDot:4
- +55 QUIT
- End DoDot:3
- +56 QUIT
- End DoDot:2
- +57 IF $Y>(BGPIOSL-3)
- DO HEADER
- IF BGPQUIT
- QUIT
- +58 WRITE !!,"Total # of Patients on list: ",+$GET(BGPPCNT)
- End DoDot:1
- +59 QUIT
- WTITLE ;EP - write title line
- +1 NEW T,X,Y,S
- +2 SET T=$PIECE(^BGPINDN(BGPL,0),U,3)
- +3 IF $LENGTH(T)<81
- WRITE !,T,!
- QUIT
- +4 FOR X=$EXTRACT(T,1,80)
- +5 SET S=""
- +6 FOR Y=80:-1:1
- IF S
- QUIT
- SET I=$EXTRACT(X,Y)
- IF I=" "
- SET S=Y
- +7 WRITE !,$EXTRACT(T,1,S)
- +8 WRITE !,$EXTRACT(T,(S+1),$LENGTH(T)),!
- +9 QUIT
- +10 ;
- PRINTL ;print one line
- +1 IF (BGPCOUNT#BGPCNT)
- QUIT
- +2 IF $Y>(BGPIOSL-3)
- DO HEADER
- IF BGPQUIT
- QUIT
- Begin DoDot:1
- +3 ;S X=0 F S X=$O(^BGPINDN(BGPL,72,X)) Q:X'=+X W !,^BGPINDN(BGPL,72,X,0)
- +4 DO H1
- End DoDot:1
- +5 IF BGPQUIT
- QUIT
- +6 SET BGPPCNT=BGPPCNT+1
- +7 WRITE !,$EXTRACT($PIECE(^DPT(DFN,0),U),1,22),?24,$$HRN^AUPNPAT(DFN,DUZ(2)),?31,$EXTRACT(BGPCOM,1,14),?46,BGPSEX,?49,BGPAGE
- +8 WRITE ?53,$PIECE(^XTMP("BGP9D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",1)
- +9 IF BGPL=43
- WRITE " NUMERATOR: "
- +10 WRITE ?65,$PIECE(^XTMP("BGP9D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",2)
- +11 QUIT
- +12 ;
- +1 IF 'BGPGPG
- GOTO HEADER1
- +2 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 $DATA(IOF)
- WRITE @IOF
- SET BGPGPG=BGPGPG+1
- +2 ;maw
- IF $GET(BGPGUI)
- WRITE "ZZZZZZZ",!
- +3 WRITE !,"***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****"
- +4 WRITE !?3,$PIECE(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BGPGPG,!
- +5 WRITE !,$$CTR("*** IHS 2009 Clinical Performance Measure Patient List ***",80),!
- +6 WRITE $$CTR($PIECE(^DIC(4,DUZ(2),0),U),80),!
- +7 SET X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED)
- WRITE $$CTR(X,80),!
- +8 WRITE $$CTR($SELECT(BGPLIST="A":"Entire Patient List",BGPLIST="R":"Random Patient List",1:"Patient List by Provider: "_BGPLPROV),80),!
- +9 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-")
- +10 QUIT
- H1 ;
- +1 SET BGPTSUB=$SELECT(BGPFIRSP:71,1:72)
- +2 SET X=0
- SET C=0
- FOR
- SET X=$ORDER(^BGPINDN(BGPL,BGPTSUB,X))
- IF X'=+X
- QUIT
- SET C=C+1
- +3 IF $Y>(BGPIOSL-(C+6))
- DO HEADER
- IF BGPQUIT
- QUIT
- +4 WRITE !,"UP=User Pop; AC=Active Clinical; AD=Active Diabetic; AAD=Active Adult Diabetic",!,"PREG=Pregnant Female; IMM=Active IMM Pkg Pt; IHD=Active Ischemic Heart Disease",!
- +5 SET X=0
- FOR
- SET X=$ORDER(^BGPINDN(BGPL,BGPTSUB,X))
- IF X'=+X
- QUIT
- WRITE !,^BGPINDN(BGPL,BGPTSUB,X,0)
- +6 WRITE !,"PATIENT NAME",?24,"HRN",?31,"COMMUNITY",?45,"SEX",?49,"AGE",?53,"DENOMINATOR",?65,"NUMERATOR"
- +7 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-")
- +8 SET BGPFIRSP=0
- +9 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 ;----------
- LOC() ;EP - Return location name from file 4 based on DUZ(2).
- +1 QUIT $SELECT($GET(DUZ(2)):$SELECT($DATA(^DIC(4,DUZ(2),0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
- +2 ;----------
