BUDBRP6G ; IHS/CMI/LAB - UDS REPORT DRIVER TABLE 6B ;
;;10.0;IHS/RPMS UNIFORM DATA SYSTEM;;FEB 04, 2016;Build 50
;
;
;----------
AWS2 ;EP
W:$D(IOF) @IOF
W !,$$CTR($$LOC,80)
W !,$$CTR("UDS 2014",80)
W !!,"All Patients 18 and older w/o BMI or does not have a follow-up plan (Table 6B)",!
D GENI^BUDBRP6F
D PAUSE^BUDBRP6F
W !!,"This report provides a list of all patients 18 years and older who do"
W !,"not have documente BMI percentile on the last visit during the report"
W !,"period or on any visit within the last 6 months of the last visit during"
W !,"the report period, or who are not overweight or underweight, or does not"
W !,"have a follow-up plan documented, had a medical visit during the report"
W !,"period, and were ever seen after their 18th birthday."
W !
Q
AWS2L ;EP
S BUDP=0,BUDQUIT=0,BUDTOT=0
D AWS2H Q:BUDQUIT
I '$D(^XTMP("BUDBRP6B",BUDJ,BUDH,"AWS2")) W !!,"No patients to report.",! Q
D AWS2L1
I $Y>(IOSL-3) D AWS2H Q:BUDQUIT
W !!,"TOTAL PATIENTS WITHOUT ADULT WEIGHT SCREEN OR FOLLOW-UP PLAN: ",BUDTOT,!
Q
AWS2L1 ;
I $Y>(IOSL-7) D AWS2H Q:BUDQUIT
S BUDAGE="" F S BUDAGE=$O(^XTMP("BUDBRP6B",BUDJ,BUDH,"AWS2",BUDAGE)) Q:BUDAGE=""!(BUDQUIT) D
.S BUDNAME="" F S BUDNAME=$O(^XTMP("BUDBRP6B",BUDJ,BUDH,"AWS2",BUDAGE,BUDNAME)) Q:BUDNAME=""!(BUDQUIT) D
..S BUDCOM="" F S BUDCOM=$O(^XTMP("BUDBRP6B",BUDJ,BUDH,"AWS2",BUDAGE,BUDNAME,BUDCOM)) Q:BUDCOM=""!(BUDQUIT) D
...S DFN=0 F S DFN=$O(^XTMP("BUDBRP6B",BUDJ,BUDH,"AWS2",BUDAGE,BUDNAME,BUDCOM,DFN)) Q:DFN'=+DFN!(BUDQUIT) D
....I $Y>(IOSL-3) D AWS2H Q:BUDQUIT
....W !,$E($P(^DPT(DFN,0),U,1),1,25),?29,$S($$HRN^AUPNPAT(DFN,BUDSITE)]"":$$HRN^AUPNPAT(DFN,BUDSITE,2),1:$$HRN^AUPNPAT(DFN,DUZ(2),2)),?41,$E(BUDCOM,1,25),?70,$P(^DPT(DFN,0),U,2),?75,BUDAGE,!
....S BUDTOT=BUDTOT+1
....S BUDALL=^XTMP("BUDBRP6B",BUDJ,BUDH,"AWS2",BUDAGE,BUDNAME,BUDCOM,DFN)
....W ?5,$S($P(BUDALL,U,1)]"":$J($P(BUDALL,U,1),6,2),1:""),?25,$P(BUDALL,U,2),?51,$P(BUDALL,U,3)
Q
AWS2H ;
G:'BUDGPG AWS2H1
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 BUDQUIT=1 Q
AWS2H1 ;
W:$D(IOF) @IOF S BUDGPG=BUDGPG+1
W !,"***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****"
W !?3,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BUDGPG,!
W !,$$CTR("*** RPMS Uniform Data System (UDS) ***",80)
W !,$$CTR("Patient List for Table 6B, Section F",80)
W !,$$CTR("Adult Weight Screen and Follow-up",80),!
W $$CTR($P(^DIC(4,BUDSITE,0),U),80),!
S X="Reporting Period: "_$$FMTE^XLFDT(BUDBD)_" to "_$$FMTE^XLFDT(BUDED) W $$CTR(X,80),!
S X="Population: "_$S($G(BUDBEN)=1:"Indian/Alaskan Native (Classification 01)",$G(BUDBEN)=2:"Not Indian Alaskan/Native (Not Classification 01)",$G(BUDBEN)=3:"All (both Indian/Alaskan Natives and Non 01)",1:"") W $$CTR(X,80),!
W $TR($J("",80)," ","-")
I BUDP=0 D
.W !,"This report provides a list of all patients 18 years and older who do not"
.W !,"have documented BMI percentile on the last visit during the report"
.W !,"period or on any visit within the last 6 months of the last visit during"
.W !,"the report period, or who are not overweight or underweight, or does not"
.W !,"have a follow-up plan documented, had a medical visit during the report"
.W !,"period, and were ever seen after their 18th birthday."
.W !,"Age is calulated as of December 31."
W !!,"PATIENT NAME",?34,"HRN",?41,"COMMUNITY",?70,"SEX",?75,"AGE"
W !?5,"BMI PERCENTILE",?25,"WEIGHT STATUS",?51,"FOLLOW-UP PLAN"
W !,$TR($J("",80)," ","-"),!
S BUDP=1
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")
BUDBRP6G ; IHS/CMI/LAB - UDS REPORT DRIVER TABLE 6B ;
+1 ;;10.0;IHS/RPMS UNIFORM DATA SYSTEM;;FEB 04, 2016;Build 50
+2 ;
+3 ;
+4 ;----------
AWS2 ;EP
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,$$CTR($$LOC,80)
+3 WRITE !,$$CTR("UDS 2014",80)
+4 WRITE !!,"All Patients 18 and older w/o BMI or does not have a follow-up plan (Table 6B)",!
+5 DO GENI^BUDBRP6F
+6 DO PAUSE^BUDBRP6F
+7 WRITE !!,"This report provides a list of all patients 18 years and older who do"
+8 WRITE !,"not have documente BMI percentile on the last visit during the report"
+9 WRITE !,"period or on any visit within the last 6 months of the last visit during"
+10 WRITE !,"the report period, or who are not overweight or underweight, or does not"
+11 WRITE !,"have a follow-up plan documented, had a medical visit during the report"
+12 WRITE !,"period, and were ever seen after their 18th birthday."
+13 WRITE !
+14 QUIT
AWS2L ;EP
+1 SET BUDP=0
SET BUDQUIT=0
SET BUDTOT=0
+2 DO AWS2H
IF BUDQUIT
QUIT
+3 IF '$DATA(^XTMP("BUDBRP6B",BUDJ,BUDH,"AWS2"))
WRITE !!,"No patients to report.",!
QUIT
+4 DO AWS2L1
+5 IF $Y>(IOSL-3)
DO AWS2H
IF BUDQUIT
QUIT
+6 WRITE !!,"TOTAL PATIENTS WITHOUT ADULT WEIGHT SCREEN OR FOLLOW-UP PLAN: ",BUDTOT,!
+7 QUIT
AWS2L1 ;
+1 IF $Y>(IOSL-7)
DO AWS2H
IF BUDQUIT
QUIT
+2 SET BUDAGE=""
FOR
SET BUDAGE=$ORDER(^XTMP("BUDBRP6B",BUDJ,BUDH,"AWS2",BUDAGE))
IF BUDAGE=""!(BUDQUIT)
QUIT
Begin DoDot:1
+3 SET BUDNAME=""
FOR
SET BUDNAME=$ORDER(^XTMP("BUDBRP6B",BUDJ,BUDH,"AWS2",BUDAGE,BUDNAME))
IF BUDNAME=""!(BUDQUIT)
QUIT
Begin DoDot:2
+4 SET BUDCOM=""
FOR
SET BUDCOM=$ORDER(^XTMP("BUDBRP6B",BUDJ,BUDH,"AWS2",BUDAGE,BUDNAME,BUDCOM))
IF BUDCOM=""!(BUDQUIT)
QUIT
Begin DoDot:3
+5 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("BUDBRP6B",BUDJ,BUDH,"AWS2",BUDAGE,BUDNAME,BUDCOM,DFN))
IF DFN'=+DFN!(BUDQUIT)
QUIT
Begin DoDot:4
+6 IF $Y>(IOSL-3)
DO AWS2H
IF BUDQUIT
QUIT
+7 WRITE !,$EXTRACT($PIECE(^DPT(DFN,0),U,1),1,25),?29,$SELECT($$HRN^AUPNPAT(DFN,BUDSITE)]"":$$HRN^AUPNPAT(DFN,BUDSITE,2),1:$$HRN^AUPNPAT(DFN,DUZ(2),2)),?41,$EXTRACT(BUDCOM,1,25),?70,$PIECE(^DPT(DFN,0),U,2),?75,BUDAG
E,!
+8 SET BUDTOT=BUDTOT+1
+9 SET BUDALL=^XTMP("BUDBRP6B",BUDJ,BUDH,"AWS2",BUDAGE,BUDNAME,BUDCOM,DFN)
+10 WRITE ?5,$SELECT($PIECE(BUDALL,U,1)]"":$JUSTIFY($PIECE(BUDALL,U,1),6,2),1:""),?25,$PIECE(BUDALL,U,2),?51,$PIECE(BUDALL,U,3)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+11 QUIT
AWS2H ;
+1 IF 'BUDGPG
GOTO AWS2H1
+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 BUDQUIT=1
QUIT
AWS2H1 ;
+1 IF $DATA(IOF)
WRITE @IOF
SET BUDGPG=BUDGPG+1
+2 WRITE !,"***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****"
+3 WRITE !?3,$PIECE(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BUDGPG,!
+4 WRITE !,$$CTR("*** RPMS Uniform Data System (UDS) ***",80)
+5 WRITE !,$$CTR("Patient List for Table 6B, Section F",80)
+6 WRITE !,$$CTR("Adult Weight Screen and Follow-up",80),!
+7 WRITE $$CTR($PIECE(^DIC(4,BUDSITE,0),U),80),!
+8 SET X="Reporting Period: "_$$FMTE^XLFDT(BUDBD)_" to "_$$FMTE^XLFDT(BUDED)
WRITE $$CTR(X,80),!
+9 SET X="Population: "_$SELECT($GET(BUDBEN)=1:"Indian/Alaskan Native (Classification 01)",$GET(BUDBEN)=2:"Not Indian Alaskan/Native (Not Classification 01)",$GET(BUDBEN)=3:"All (both Indian/Alaskan Natives and Non 01)",1:"")
WRITE $$CTR(X,80),!
+10 WRITE $TRANSLATE($JUSTIFY("",80)," ","-")
+11 IF BUDP=0
Begin DoDot:1
+12 WRITE !,"This report provides a list of all patients 18 years and older who do not"
+13 WRITE !,"have documented BMI percentile on the last visit during the report"
+14 WRITE !,"period or on any visit within the last 6 months of the last visit during"
+15 WRITE !,"the report period, or who are not overweight or underweight, or does not"
+16 WRITE !,"have a follow-up plan documented, had a medical visit during the report"
+17 WRITE !,"period, and were ever seen after their 18th birthday."
+18 WRITE !,"Age is calulated as of December 31."
End DoDot:1
+19 WRITE !!,"PATIENT NAME",?34,"HRN",?41,"COMMUNITY",?70,"SEX",?75,"AGE"
+20 WRITE !?5,"BMI PERCENTILE",?25,"WEIGHT STATUS",?51,"FOLLOW-UP PLAN"
+21 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-"),!
+22 SET BUDP=1
+23 QUIT
+24 ;
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")
