CIMGAGPE ; CMI/TUCSON/LAB - aberdeen gpra print ; [ 03/14/00 9:31 AM ]
;;1.0;ABERDEEN GPRA REPORT;;JAN 22, 2000
;
;
PHN ;
D HEADER Q:CIMQUIT
W !,"19/2000 Public Health Nursing",!,"Assure the total number of public health nursing services provided to ",!,"individuals in all settings and the total number of home visits are",!,"increased by 5% over the FY 1998 workload baselines",!
W !,"Public Health Nursing"
W !?38,"BASELINE",?45," %",?56,"REPORT",?64," %",?71,"% CHANGE",!?38,"PERIOD",?56,"PERIOD"
S CIMGX=$$V(1,1),CIMGY=$$V(12,1)
S CIMG1=$$V(19,25),CIMG1B=$$V(20,25)
S CIMG1P=$S(CIMGX:((CIMG1/CIMGX)*100),1:""),CIMG1BP=$S(CIMGY:((CIMG1B/CIMGY)*100),1:"")
W !?3,"# active users",?36,$$C(CIMGY,0,9),?54,$$C(CIMGX,0,9)
W !?3,"# of Persons served by PHN's",!?5,"in any setting",?36,$$C(CIMG1B,0,9),?44,$J(CIMG1BP,6,1),?54,$$C(CIMG1,0,9),?62,$J(CIMG1P,6,1),?72,$J($$CALC(CIMG1P,CIMG1BP),7)
S CIMG1=$$V(19,26),CIMG1B=$$V(20,26)
S CIMG1P=$S(CIMGX:((CIMG1/CIMGX)*100),1:""),CIMG1BP=$S(CIMGY:((CIMG1B/CIMGY)*100),1:"")
W !?3,"# of Persons Served by PHN's",!?5,"in a Home Setting",?36,$$C(CIMG1B,0,9),?44,$J(CIMG1BP,6,1),?54,$$C(CIMG1,0,9),?62,$J(CIMG1P,6,1),?72,$J($$CALC(CIMG1P,CIMG1BP),7)
W !!?3,"# of PHN Visits - any Setting",?36,$$C($$V(20,18),0,9),?54,$$C($$V(19,18),0,9)
S X=$$V(20,18),Y=$$V(19,18),%=$S(X:((Y-X)/X)*100,1:"") W ?72,$J(%,5,1)
W !!?3,"# of PHN Visits - Home",?36,$$C($$V(20,19),0,9),?54,$$C($$V(19,19),0,9)
S X=$$V(20,19),Y=$$V(19,19),%=$S(X:((Y-X)/X)*100,1:"") W ?72,$J(%,5,1)
FLUPNEU ;
D HEADER Q:CIMQUIT
W !,"21/2000 Adult Immunization",!,"Produce an overall pneumoccal and influenza vaccination level of at least 60%",!,"for adults aged 65 and older.",!
W !,"Adult Immunizations"
;W !?38,"BASELINE",?45," %",?56,"REPORT",?64," %",?71,"% CHANGE",!?38,"PERIOD",?56,"PERIOD"
W !?56,"REPORT",?64," %",!?56,"PERIOD"
S CIMGX=$$V(19,20),CIMGY=$$V(20,20)
S CIMG1=$$V(19,21),CIMG1B=$$V(20,21)
S CIMG1P=$S(CIMGX:((CIMG1/CIMGX)*100),1:""),CIMG1BP=$S(CIMGY:((CIMG1B/CIMGY)*100),1:"")
W !?3,"# patients 65 yrs and older",?54,$$C(CIMGX,0,9)
W !?3,"# w/Pneumovax ever",?54,$$C(CIMG1,0,9),?62,$J(CIMG1P,6,1)
S CIMG1=$$V(19,22),CIMG1B=$$V(20,22)
S CIMG1P=$S(CIMGX:((CIMG1/CIMGX)*100),1:""),CIMG1BP=$S(CIMGY:((CIMG1B/CIMGY)*100),1:"")
W !?3,"# with Flu Vaccine within",!?5,"1 year prior to end of time period",?54,$$C(CIMG1,0,9),?62,$J(CIMG1P,6,1)
SMOKER ;
D HEADER Q:CIMQUIT
W !!,"24/2000 Smoking",!,"Determine Area-age specific prevalance rates for the",!,"usage of tobacco products.",!
I $Y>(IOSL-5) D HEADER Q:CIMQUIT
W !,"Prevalance of Usage of Tobacco Products"
W !?38,"BASELINE",?45," %",?56,"REPORT",?64," %",?71,"% CHANGE",!?38,"PERIOD",?56,"PERIOD"
S CIMGX=$$V(1,1),CIMGY=$$V(12,1)
S CIMG1=$$V(22,10),CIMG1B=$$V(23,10)
S CIMG1P=$S(CIMGX:((CIMG1/CIMGX)*100),1:""),CIMG1BP=$S(CIMGY:((CIMG1B/CIMGY)*100),1:"")
W !?3,"# active users",?36,$$C(CIMGY,0,9),?54,$$C(CIMGX,0,9)
W !!?3,"# w/ Tobacco Status documented",?36,$$C(CIMG1B,0,9),?44,$J(CIMG1BP,6,1),?54,$$C(CIMG1,0,9),?62,$J(CIMG1P,6,1),?72,$J($$CALC(CIMG1P,CIMG1BP),7)
S CIMGX=$$V(22,10),CIMGY=$$V(23,10)
S CIMG1=$$V(22,1),CIMG1B=$$V(23,1)
S CIMG1P=$S(CIMGX:((CIMG1/CIMGX)*100),1:""),CIMG1BP=$S(CIMGY:((CIMG1B/CIMGY)*100),1:"")
W !!?3,"# documented Tobacco Users",?36,$$C(CIMG1B,0,9),?44,$J(CIMG1BP,6,1),?54,$$C(CIMG1,0,9),?62,$J(CIMG1P,6,1),?72,$J($$CALC(CIMG1P,CIMG1BP),7)
AGE11 ;age distribution 1/1
D HEADER Q:CIMQUIT
W !,"Age specific Tobacco Usage Prevalance"
W !?40,"Age Distribution"
W !?23,"<1 yr",?30,"1-4",?37,"5-14",?44,"15-19",?51,"20-24",?56,"25-44",?65,"45-64",?72,">64 yrs",!
W !," BASELINE"
W !?2,"# active users"
S T=23 F X=2:1:9 S Y=$$V(12,X) W ?T,$$C(Y,0,6) S T=T+7
W !?2,"# Tobacco Use"
S T=23 F X=2:1:9 S Y=$$V(23,X) W ?T,$$C(Y,0,6) S T=T+7
K CIMX W !?2,"% tobacco use" S T=23 F X=2:1:9 S N=$$V(23,X),D=$$V(12,X),%=$S('D:"",1:(N/D)*100) W ?T,$S(%="":" .",1:$J(%,5,1)) S T=T+7 S $P(CIMX(X),U,2)=%
I $Y>(IOSL-7) D HEADER Q:CIMQUIT
W !,"CURRENT PERIOD"
W !?2,"# active users"
S T=23 F X=2:1:9 S Y=$$V(1,X) W ?T,$$C(Y,0,6) S T=T+7
W !?2,"# Tobacco Users"
S T=23 F X=2:1:9 S Y=$$V(22,X) W ?T,$$C(Y,0,6) S T=T+7
W !?2,"% Tobacco Users" S T=23 F X=2:1:9 S N=$$V(22,X),D=$$V(1,X),%=$S('D:"",1:(N/D)*100) W ?T,$S(%="":" .",1:$J(%,5,1)) S T=T+7 S $P(CIMX(X),U)=%
S T=23 W !!,"% Change" S X=0 F S X=$O(CIMX(X)) Q:X'=+X S N=$P(CIMX(X),U),O=$P(CIMX(X),U,2) W ?T,$J($$CALC(N,O),6) S T=T+7
D ^CIMGAGPF
Q
CALC(N,O) ;ENTRY POINT
;N is new
;O is old
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)
Q Z
V(N,P) ;
NEW X,C S (X,C)=0 F S X=$O(CIMSUL(X)) Q:X'=+X S C=C+$P($G(^CIMAGP(X,N)),U,P)
Q C
C(X,X2,X3) ;
D COMMA^%DTC
Q X
G:'CIMGPG 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 CIMQUIT=1 Q
W:$D(IOF) @IOF S CIMGPG=CIMGPG+1
W !?3,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",CIMGPG,!
W !,$$CTR("*** ABERDEEN AREA GPRA INDICATORS ***",80),!
W $S(CIMSUCNT=1:$$CTR(CIMSUNM),1:$$CTR("AREA AGGREGATE")),!
S X="Reporting Period: "_$$FMTE^XLFDT(CIMBD)_" to "_$$FMTE^XLFDT(CIMED) W $$CTR(X,80),!
S X="Baseline Period: "_$$FMTE^XLFDT(CIM98B)_" to "_$$FMTE^XLFDT(CIM98E) W $$CTR(X,80),!
W !,$TR($J("",80)," ","-")
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")
;----------
CIMGAGPE ; CMI/TUCSON/LAB - aberdeen gpra print ; [ 03/14/00 9:31 AM ]
+1 ;;1.0;ABERDEEN GPRA REPORT;;JAN 22, 2000
+2 ;
+3 ;
PHN ;
+1 DO HEADER
IF CIMQUIT
QUIT
+2 WRITE !,"19/2000 Public Health Nursing",!,"Assure the total number of public health nursing services provided to ",!,"individuals in all settings and the total number of home visits are",!,"increased by 5% over the FY 1998 workload baselines",!
+3 WRITE !,"Public Health Nursing"
+4 WRITE !?38,"BASELINE",?45," %",?56,"REPORT",?64," %",?71,"% CHANGE",!?38,"PERIOD",?56,"PERIOD"
+5 SET CIMGX=$$V(1,1)
SET CIMGY=$$V(12,1)
+6 SET CIMG1=$$V(19,25)
SET CIMG1B=$$V(20,25)
+7 SET CIMG1P=$SELECT(CIMGX:((CIMG1/CIMGX)*100),1:"")
SET CIMG1BP=$SELECT(CIMGY:((CIMG1B/CIMGY)*100),1:"")
+8 WRITE !?3,"# active users",?36,$$C(CIMGY,0,9),?54,$$C(CIMGX,0,9)
+9 WRITE !?3,"# of Persons served by PHN's",!?5,"in any setting",?36,$$C(CIMG1B,0,9),?44,$JUSTIFY(CIMG1BP,6,1),?54,$$C(CIMG1,0,9),?62,$JUSTIFY(CIMG1P,6,1),?72,$JUSTIFY($$CALC(CIMG1P,CIMG1BP),7)
+10 SET CIMG1=$$V(19,26)
SET CIMG1B=$$V(20,26)
+11 SET CIMG1P=$SELECT(CIMGX:((CIMG1/CIMGX)*100),1:"")
SET CIMG1BP=$SELECT(CIMGY:((CIMG1B/CIMGY)*100),1:"")
+12 WRITE !?3,"# of Persons Served by PHN's",!?5,"in a Home Setting",?36,$$C(CIMG1B,0,9),?44,$JUSTIFY(CIMG1BP,6,1),?54,$$C(CIMG1,0,9),?62,$JUSTIFY(CIMG1P,6,1),?72,$JUSTIFY($$CALC(CIMG1P,CIMG1BP),7)
+13 WRITE !!?3,"# of PHN Visits - any Setting",?36,$$C($$V(20,18),0,9),?54,$$C($$V(19,18),0,9)
+14 SET X=$$V(20,18)
SET Y=$$V(19,18)
SET %=$SELECT(X:((Y-X)/X)*100,1:"")
WRITE ?72,$JUSTIFY(%,5,1)
+15 WRITE !!?3,"# of PHN Visits - Home",?36,$$C($$V(20,19),0,9),?54,$$C($$V(19,19),0,9)
+16 SET X=$$V(20,19)
SET Y=$$V(19,19)
SET %=$SELECT(X:((Y-X)/X)*100,1:"")
WRITE ?72,$JUSTIFY(%,5,1)
FLUPNEU ;
+1 DO HEADER
IF CIMQUIT
QUIT
+2 WRITE !,"21/2000 Adult Immunization",!,"Produce an overall pneumoccal and influenza vaccination level of at least 60%",!,"for adults aged 65 and older.",!
+3 WRITE !,"Adult Immunizations"
+4 ;W !?38,"BASELINE",?45," %",?56,"REPORT",?64," %",?71,"% CHANGE",!?38,"PERIOD",?56,"PERIOD"
+5 WRITE !?56,"REPORT",?64," %",!?56,"PERIOD"
+6 SET CIMGX=$$V(19,20)
SET CIMGY=$$V(20,20)
+7 SET CIMG1=$$V(19,21)
SET CIMG1B=$$V(20,21)
+8 SET CIMG1P=$SELECT(CIMGX:((CIMG1/CIMGX)*100),1:"")
SET CIMG1BP=$SELECT(CIMGY:((CIMG1B/CIMGY)*100),1:"")
+9 WRITE !?3,"# patients 65 yrs and older",?54,$$C(CIMGX,0,9)
+10 WRITE !?3,"# w/Pneumovax ever",?54,$$C(CIMG1,0,9),?62,$JUSTIFY(CIMG1P,6,1)
+11 SET CIMG1=$$V(19,22)
SET CIMG1B=$$V(20,22)
+12 SET CIMG1P=$SELECT(CIMGX:((CIMG1/CIMGX)*100),1:"")
SET CIMG1BP=$SELECT(CIMGY:((CIMG1B/CIMGY)*100),1:"")
+13 WRITE !?3,"# with Flu Vaccine within",!?5,"1 year prior to end of time period",?54,$$C(CIMG1,0,9),?62,$JUSTIFY(CIMG1P,6,1)
SMOKER ;
+1 DO HEADER
IF CIMQUIT
QUIT
+2 WRITE !!,"24/2000 Smoking",!,"Determine Area-age specific prevalance rates for the",!,"usage of tobacco products.",!
+3 IF $Y>(IOSL-5)
DO HEADER
IF CIMQUIT
QUIT
+4 WRITE !,"Prevalance of Usage of Tobacco Products"
+5 WRITE !?38,"BASELINE",?45," %",?56,"REPORT",?64," %",?71,"% CHANGE",!?38,"PERIOD",?56,"PERIOD"
+6 SET CIMGX=$$V(1,1)
SET CIMGY=$$V(12,1)
+7 SET CIMG1=$$V(22,10)
SET CIMG1B=$$V(23,10)
+8 SET CIMG1P=$SELECT(CIMGX:((CIMG1/CIMGX)*100),1:"")
SET CIMG1BP=$SELECT(CIMGY:((CIMG1B/CIMGY)*100),1:"")
+9 WRITE !?3,"# active users",?36,$$C(CIMGY,0,9),?54,$$C(CIMGX,0,9)
+10 WRITE !!?3,"# w/ Tobacco Status documented",?36,$$C(CIMG1B,0,9),?44,$JUSTIFY(CIMG1BP,6,1),?54,$$C(CIMG1,0,9),?62,$JUSTIFY(CIMG1P,6,1),?72,$JUSTIFY($$CALC(CIMG1P,CIMG1BP),7)
+11 SET CIMGX=$$V(22,10)
SET CIMGY=$$V(23,10)
+12 SET CIMG1=$$V(22,1)
SET CIMG1B=$$V(23,1)
+13 SET CIMG1P=$SELECT(CIMGX:((CIMG1/CIMGX)*100),1:"")
SET CIMG1BP=$SELECT(CIMGY:((CIMG1B/CIMGY)*100),1:"")
+14 WRITE !!?3,"# documented Tobacco Users",?36,$$C(CIMG1B,0,9),?44,$JUSTIFY(CIMG1BP,6,1),?54,$$C(CIMG1,0,9),?62,$JUSTIFY(CIMG1P,6,1),?72,$JUSTIFY($$CALC(CIMG1P,CIMG1BP),7)
AGE11 ;age distribution 1/1
+1 DO HEADER
IF CIMQUIT
QUIT
+2 WRITE !,"Age specific Tobacco Usage Prevalance"
+3 WRITE !?40,"Age Distribution"
+4 WRITE !?23,"<1 yr",?30,"1-4",?37,"5-14",?44,"15-19",?51,"20-24",?56,"25-44",?65,"45-64",?72,">64 yrs",!
+5 WRITE !," BASELINE"
+6 WRITE !?2,"# active users"
+7 SET T=23
FOR X=2:1:9
SET Y=$$V(12,X)
WRITE ?T,$$C(Y,0,6)
SET T=T+7
+8 WRITE !?2,"# Tobacco Use"
+9 SET T=23
FOR X=2:1:9
SET Y=$$V(23,X)
WRITE ?T,$$C(Y,0,6)
SET T=T+7
+10 KILL CIMX
WRITE !?2,"% tobacco use"
SET T=23
FOR X=2:1:9
SET N=$$V(23,X)
SET D=$$V(12,X)
SET %=$SELECT('D:"",1:(N/D)*100)
WRITE ?T,$SELECT(%="":" .",1:$JUSTIFY(%,5,1))
SET T=T+7
SET $PIECE(CIMX(X),U,2)=%
+11 IF $Y>(IOSL-7)
DO HEADER
IF CIMQUIT
QUIT
+12 WRITE !,"CURRENT PERIOD"
+13 WRITE !?2,"# active users"
+14 SET T=23
FOR X=2:1:9
SET Y=$$V(1,X)
WRITE ?T,$$C(Y,0,6)
SET T=T+7
+15 WRITE !?2,"# Tobacco Users"
+16 SET T=23
FOR X=2:1:9
SET Y=$$V(22,X)
WRITE ?T,$$C(Y,0,6)
SET T=T+7
+17 WRITE !?2,"% Tobacco Users"
SET T=23
FOR X=2:1:9
SET N=$$V(22,X)
SET D=$$V(1,X)
SET %=$SELECT('D:"",1:(N/D)*100)
WRITE ?T,$SELECT(%="":" .",1:$JUSTIFY(%,5,1))
SET T=T+7
SET $PIECE(CIMX(X),U)=%
+18 SET T=23
WRITE !!,"% Change"
SET X=0
FOR
SET X=$ORDER(CIMX(X))
IF X'=+X
QUIT
SET N=$PIECE(CIMX(X),U)
SET O=$PIECE(CIMX(X),U,2)
WRITE ?T,$JUSTIFY($$CALC(N,O),6)
SET T=T+7
+19 DO ^CIMGAGPF
+20 QUIT
CALC(N,O) ;ENTRY POINT
+1 ;N is new
+2 ;O is old
+3 NEW Z
+4 IF O=0!(N=0)!(O="")!(N="")
QUIT "**"
+5 NEW X,X2,X3
+6 SET X=N
SET X2=1
SET X3=0
DO COMMA^%DTC
SET N=X
+7 SET X=O
SET X2=1
SET X3=0
DO COMMA^%DTC
SET O=X
+8 IF +O=0
QUIT "**"
+9 SET Z=(((N-O)/O)*100)
SET Z=$FNUMBER(Z,"+,",1)
+10 QUIT Z
V(N,P) ;
+1 NEW X,C
SET (X,C)=0
FOR
SET X=$ORDER(CIMSUL(X))
IF X'=+X
QUIT
SET C=C+$PIECE($GET(^CIMAGP(X,N)),U,P)
+2 QUIT C
C(X,X2,X3) ;
+1 DO COMMA^%DTC
+2 QUIT X
+1 IF 'CIMGPG
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 CIMQUIT=1
QUIT
+1 IF $DATA(IOF)
WRITE @IOF
SET CIMGPG=CIMGPG+1
+2 WRITE !?3,$PIECE(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",CIMGPG,!
+3 WRITE !,$$CTR("*** ABERDEEN AREA GPRA INDICATORS ***",80),!
+4 WRITE $SELECT(CIMSUCNT=1:$$CTR(CIMSUNM),1:$$CTR("AREA AGGREGATE")),!
+5 SET X="Reporting Period: "_$$FMTE^XLFDT(CIMBD)_" to "_$$FMTE^XLFDT(CIMED)
WRITE $$CTR(X,80),!
+6 SET X="Baseline Period: "_$$FMTE^XLFDT(CIM98B)_" to "_$$FMTE^XLFDT(CIM98E)
WRITE $$CTR(X,80),!
+7 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-")
+8 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 ;----------
