BUDBRP6A ; IHS/CMI/LAB - HIV/DEP ;
;;10.0;IHS/RPMS UNIFORM DATA SYSTEM;;FEB 04, 2016;Build 50
;
;
HIVLIST1 ;EP
D EOJ
S BUDHIV1L=1
D HIV1
G EN1^BUDBRP6B
HIVLIST2 ;EP
D EOJ
S BUDHIV2L=1
D HIV2
G EN1^BUDBRP6B
PAUSE ;
K DIR S DIR(0)="E",DIR("A")="PRESS ENTER" KILL DA D ^DIR KILL DIR
Q
GENI ;EP
D GENI^BUDBRP6I
Q
;
EOJ ;
D EN^XBVK("BUD")
Q
CTR(X,Y) ;
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
LOC() ;
Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
HIV1 ;EP
W:$D(IOF) @IOF
W !,$$CTR($$LOC,80)
W !,$$CTR("UDS 2014",80)
W !!,"Newly Idenitifed HIV Cases with Timely Follow-Up (Table 6B)",!
D GENI
D PAUSE
W !!,"This report provides a list of all patients whose first ever HIV"
W !,"diagnosis occurred between October 1 of the prior year through"
W !,"September 30th of the current report year and had a medical visit for"
W !,"HIV care within 90 days of the first-ever HIV diagnosis, and had at "
W !,"least one medical visit during the report year."
W !,"Age is calculated as of December 31."
W !
Q
HIV1L ;EP
S BUDP=0,BUDQUIT=0,BUDTOT=0
D HIV1H Q:BUDQUIT
I '$D(^XTMP("BUDBRP6B",BUDJ,BUDH,"HIV1")) W !!,"No patients to report.",! Q
D HIV1L1
I $Y>(IOSL-3) D HIV1H Q:BUDQUIT
W !,"TOTAL PATIENTS WITH FIRST HIV DX & TIMELY FOLLOW-UP: ",BUDTOT,!
Q
HIV1L1 ;
I $Y>(IOSL-7) D HIV1H Q:BUDQUIT
S BUDAGE="" F S BUDAGE=$O(^XTMP("BUDBRP6B",BUDJ,BUDH,"HIV1",BUDAGE)) Q:BUDAGE=""!(BUDQUIT) D
.S BUDNAME="" F S BUDNAME=$O(^XTMP("BUDBRP6B",BUDJ,BUDH,"HIV1",BUDAGE,BUDNAME)) Q:BUDNAME=""!(BUDQUIT) D
..S BUDCOM="" F S BUDCOM=$O(^XTMP("BUDBRP6B",BUDJ,BUDH,"HIV1",BUDAGE,BUDNAME,BUDCOM)) Q:BUDCOM=""!(BUDQUIT) D
...S DFN=0 F S DFN=$O(^XTMP("BUDBRP6B",BUDJ,BUDH,"HIV1",BUDAGE,BUDNAME,BUDCOM,DFN)) Q:DFN'=+DFN!(BUDQUIT) D
....I $Y>(IOSL-3) D HIV1H 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,"HIV1",BUDAGE,BUDNAME,BUDCOM,DFN)
....W ?5,$P(BUDALL,"|",1),?35,$S($P(BUDALL,"|",3)]"":$P(BUDALL,"|",3),1:"None"),?46,$P(BUDALL,"|",2)
HIV1H ;
G:'BUDGPG HIV1H1
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
HIV1H1 ;
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 L,",80),!,$$CTR("Newly Identified HIV Cases with Timely 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 whose first ever HIV"
.W !,"diagnosis occurred between October 1 of the prior year through"
.W !,"September 30th of the current report year and had a medical visit for"
.W !,"HIV care within 90 days of the first-ever HIV diagnosis, and had at "
.W !,"least one medical visit during the report year."
.W !,"Age is calculated as of December 31."
W !!,"PATIENT NAME",?34,"HRN",?41,"COMMUNITY",?70,"SEX",?75,"AGE"
W !?5,"First HIV DX: Date",?35,"Date of Onset",?50,"HIV Follow-up: Date"
W !,$TR($J("",80)," ","-"),!
S BUDP=1
Q
;----------
HIV2 ;EP
W:$D(IOF) @IOF
W !,$$CTR($$LOC,80)
W !,$$CTR("UDS 2014",80)
W !!,"Newly Idenitifed HIV Cases with Timely Follow-Up (Table 6B)",!
D GENI
D PAUSE
W !!,"This report provides a list of all patients whose first ever HIV"
W !,"diagnosis occurred between October 1 of the prior year through"
W !,"September 30th of the current report year and did not have a medical visit"
W !,"for HIV care within 90 days of the first-ever HIV diagnosis, and had at "
W !,"least one medical visit during the report year."
W !,"Age is calculated as of December 31."
W !
Q
HIV2L ;EP
S BUDP=0,BUDQUIT=0,BUDTOT=0
D HIV2H Q:BUDQUIT
I '$D(^XTMP("BUDBRP6B",BUDJ,BUDH,"HIV2")) W !!,"No patients to report.",! Q
D HIV2L1
I $Y>(IOSL-3) D HIV2H Q:BUDQUIT
W !,"TOTAL PATIENTS WITH FIRST HIV DX & TIMELY FOLLOW-UP: ",BUDTOT,!
Q
HIV2L1 ;
I $Y>(IOSL-7) D HIV2H Q:BUDQUIT
S BUDAGE="" F S BUDAGE=$O(^XTMP("BUDBRP6B",BUDJ,BUDH,"HIV2",BUDAGE)) Q:BUDAGE=""!(BUDQUIT) D
.S BUDNAME="" F S BUDNAME=$O(^XTMP("BUDBRP6B",BUDJ,BUDH,"HIV2",BUDAGE,BUDNAME)) Q:BUDNAME=""!(BUDQUIT) D
..S BUDCOM="" F S BUDCOM=$O(^XTMP("BUDBRP6B",BUDJ,BUDH,"HIV2",BUDAGE,BUDNAME,BUDCOM)) Q:BUDCOM=""!(BUDQUIT) D
...S DFN=0 F S DFN=$O(^XTMP("BUDBRP6B",BUDJ,BUDH,"HIV2",BUDAGE,BUDNAME,BUDCOM,DFN)) Q:DFN'=+DFN!(BUDQUIT) D
....I $Y>(IOSL-3) D HIV2H 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,"HIV2",BUDAGE,BUDNAME,BUDCOM,DFN)
....W ?5,$P(BUDALL,"|",1),?35,$S($P(BUDALL,"|",3)]"":$P(BUDALL,"|",3),1:"None"),?46,$P(BUDALL,"|",2)
HIV2H ;
G:'BUDGPG HIV2H1
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
HIV2H1 ;
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 L,",80),!,$$CTR("Newly Identified HIV Cases without Timely 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 whose first ever HIV"
.W !,"diagnosis occurred between October 1 of the prior year through"
.W !,"September 30th of the current report year and did not have a medical visit"
.W !,"for HIV care within 90 days of the first-ever HIV diagnosis, and had at "
.W !,"least one medical visit during the report year."
.W !,"Age is calculated as of December 31."
W !!,"PATIENT NAME",?34,"HRN",?41,"COMMUNITY",?70,"SEX",?75,"AGE"
W !?5,"First HIV DX: Date",?35,"Date of Onset",?50,"HIV Follow-up: Date"
W !,$TR($J("",80)," ","-"),!
S BUDP=1
Q
DEPLIST1 ;EP
D EOJ
S BUDDEP1L=1
D DEP1
G EN1^BUDBRP6B
DEPLIST2 ;EP
D EOJ
S BUDDEP2L=1
D DEP2
G EN1^BUDBRP6B
DEP1 ;EP
W:$D(IOF) @IOF
W !,$$CTR($$LOC,80)
W !,$$CTR("UDS 2014",80)
W !!,"All Patients 12+ w/Depression Scrn & if Positive a Follow-up Plan (Table 6B)",!
D GENI
D PAUSE
W !!,"This report provides a list of all patients 12 years and older who were "
W !,"screened for depression with a standardized tool during the report year"
W !,"and had a follow-up plan documented if screened positive, and had at"
W !,"least one medical visit during the report year."
W !
Q
DEP1L ;EP
S BUDP=0,BUDQUIT=0,BUDTOT=0
D DEP1H Q:BUDQUIT
I '$D(^XTMP("BUDBRP6B",BUDJ,BUDH,"DEP1")) W !!,"No patients to report.",! Q
D DEP1L1
I $Y>(IOSL-3) D DEP1H Q:BUDQUIT
W !,"TOTAL PATIENTS WITH DEP SCRN & IF POSITIVE, FOLLOW-UP: ",BUDTOT,!
Q
DEP1L1 ;
I $Y>(IOSL-7) D DEP1H Q:BUDQUIT
S BUDAGE="" F S BUDAGE=$O(^XTMP("BUDBRP6B",BUDJ,BUDH,"DEP1",BUDAGE)) Q:BUDAGE=""!(BUDQUIT) D
.S BUDNAME="" F S BUDNAME=$O(^XTMP("BUDBRP6B",BUDJ,BUDH,"DEP1",BUDAGE,BUDNAME)) Q:BUDNAME=""!(BUDQUIT) D
..S BUDCOM="" F S BUDCOM=$O(^XTMP("BUDBRP6B",BUDJ,BUDH,"DEP1",BUDAGE,BUDNAME,BUDCOM)) Q:BUDCOM=""!(BUDQUIT) D
...S DFN=0 F S DFN=$O(^XTMP("BUDBRP6B",BUDJ,BUDH,"DEP1",BUDAGE,BUDNAME,BUDCOM,DFN)) Q:DFN'=+DFN!(BUDQUIT) D
....I $Y>(IOSL-3) D DEP1H 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,"DEP1",BUDAGE,BUDNAME,BUDCOM,DFN)
....S BUD1=$P(BUDALL,"|",1),BUD2=$P(BUDALL,"|",2)
....I BUD1]"" W ?5,$P(BUD1,U,2),": ",$P(BUD1,U,3),": ",$$FMTE^XLFDT($P(BUD1,U,1),5)
....W ?35,"Follow-up: " I BUD2]"" W $P(BUD2,U,2),": ",$$FMTE^XLFDT($P(BUD2,U,1),5)
DEP1H ;
G:'BUDGPG DEP1H1
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
DEP1H1 ;
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 M,",80),!,$$CTR("Patients Screened for Depression and Followed Up if Appropriate",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 12 years and older who were "
.W !,"screened for depression with a standardized tool during the report year and"
.W !,"had a follow-up plan documented if screened positive, and had at least one"
.W !,"medical visit during the report year. "
.W !,"Age is calculated as of December 31."
W !!,"PATIENT NAME",?34,"HRN",?41,"COMMUNITY",?70,"SEX",?75,"AGE"
W !?5,"Depression Scrn: Date/Result",?35,"Follow-up Plan: Date"
W !,$TR($J("",80)," ","-"),!
S BUDP=1
Q
DEP2 ;EP
W:$D(IOF) @IOF
W !,$$CTR($$LOC,80)
W !,$$CTR("UDS 2014",80)
W !!,"All Patients 12+ w/o Depression Scrn or w/o Follow-up (Table 6B)",!
D GENI
D PAUSE
W !!,"This report provides a list of all patients 12 years and older not"
W !,"screened for depression or who were screened for depression with a"
W !,"standardized tool during the report year and does not have a follow-up"
W !,"plan documented if screened positive, and had at least one medical visit"
W !,"during the report year."
W !
Q
DEP2L ;EP
S BUDP=0,BUDQUIT=0,BUDTOT=0
D DEP2H Q:BUDQUIT
I '$D(^XTMP("BUDBRP6B",BUDJ,BUDH,"DEP2")) W !!,"No patients to report.",! Q
D DEP2L1
I $Y>(IOSL-3) D DEP2H Q:BUDQUIT
W !,"TOTAL PATIENTS W/O DEP SCRN OR W/O FOLLOW-UP IF POSITIVE: ",BUDTOT,!
Q
DEP2L1 ;
I $Y>(IOSL-7) D DEP2H Q:BUDQUIT
S BUDAGE="" F S BUDAGE=$O(^XTMP("BUDBRP6B",BUDJ,BUDH,"DEP2",BUDAGE)) Q:BUDAGE=""!(BUDQUIT) D
.S BUDNAME="" F S BUDNAME=$O(^XTMP("BUDBRP6B",BUDJ,BUDH,"DEP2",BUDAGE,BUDNAME)) Q:BUDNAME=""!(BUDQUIT) D
..S BUDCOM="" F S BUDCOM=$O(^XTMP("BUDBRP6B",BUDJ,BUDH,"DEP2",BUDAGE,BUDNAME,BUDCOM)) Q:BUDCOM=""!(BUDQUIT) D
...S DFN=0 F S DFN=$O(^XTMP("BUDBRP6B",BUDJ,BUDH,"DEP2",BUDAGE,BUDNAME,BUDCOM,DFN)) Q:DFN'=+DFN!(BUDQUIT) D
....I $Y>(IOSL-3) D DEP2H 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,"DEP2",BUDAGE,BUDNAME,BUDCOM,DFN)
....S BUD1=$P(BUDALL,"|",1),BUD2=$P(BUDALL,"|",2)
....I BUD1]"" W ?5,$P(BUD1,U,2),": ",$P(BUD1,U,3),": ",$$FMTE^XLFDT($P(BUD1,U,1),5)
....W ?35,"Follow-up: " I BUD2]"" W $P(BUD2,U,2),": ",$$FMTE^XLFDT($P(BUD2,U,1),5)
DEP2H ;
G:'BUDGPG DEP2H1
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
DEP2H1 ;
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 M,",80),!,$$CTR("Patients not Screened for Depression or w/o 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 12 years and older not"
.W !,"screened for depression or who were screened for depression with a"
.W !,"standardized tool during the report year and does not have a follow-up"
.W !,"plan documented if screened positive, and had at least one medical visit"
.W !,"during the report year."
.W !,"Age is calculated as of December 31."
W !!,"PATIENT NAME",?34,"HRN",?41,"COMMUNITY",?70,"SEX",?75,"AGE"
W !?5,"Depression Scrn: Date/Result",?35,"Follow-up Plan: Date"
W !,$TR($J("",80)," ","-"),!
S BUDP=1
Q
BUDBRP6A ; IHS/CMI/LAB - HIV/DEP ;
+1 ;;10.0;IHS/RPMS UNIFORM DATA SYSTEM;;FEB 04, 2016;Build 50
+2 ;
+3 ;
HIVLIST1 ;EP
+1 DO EOJ
+2 SET BUDHIV1L=1
+3 DO HIV1
+4 GOTO EN1^BUDBRP6B
HIVLIST2 ;EP
+1 DO EOJ
+2 SET BUDHIV2L=1
+3 DO HIV2
+4 GOTO EN1^BUDBRP6B
PAUSE ;
+1 KILL DIR
SET DIR(0)="E"
SET DIR("A")="PRESS ENTER"
KILL DA
DO ^DIR
KILL DIR
+2 QUIT
GENI ;EP
+1 DO GENI^BUDBRP6I
+2 QUIT
+3 ;
EOJ ;
+1 DO EN^XBVK("BUD")
+2 QUIT
CTR(X,Y) ;
+1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
LOC() ;
+1 QUIT $SELECT($GET(DUZ(2)):$SELECT($DATA(^DIC(4,DUZ(2),0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
HIV1 ;EP
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,$$CTR($$LOC,80)
+3 WRITE !,$$CTR("UDS 2014",80)
+4 WRITE !!,"Newly Idenitifed HIV Cases with Timely Follow-Up (Table 6B)",!
+5 DO GENI
+6 DO PAUSE
+7 WRITE !!,"This report provides a list of all patients whose first ever HIV"
+8 WRITE !,"diagnosis occurred between October 1 of the prior year through"
+9 WRITE !,"September 30th of the current report year and had a medical visit for"
+10 WRITE !,"HIV care within 90 days of the first-ever HIV diagnosis, and had at "
+11 WRITE !,"least one medical visit during the report year."
+12 WRITE !,"Age is calculated as of December 31."
+13 WRITE !
+14 QUIT
HIV1L ;EP
+1 SET BUDP=0
SET BUDQUIT=0
SET BUDTOT=0
+2 DO HIV1H
IF BUDQUIT
QUIT
+3 IF '$DATA(^XTMP("BUDBRP6B",BUDJ,BUDH,"HIV1"))
WRITE !!,"No patients to report.",!
QUIT
+4 DO HIV1L1
+5 IF $Y>(IOSL-3)
DO HIV1H
IF BUDQUIT
QUIT
+6 WRITE !,"TOTAL PATIENTS WITH FIRST HIV DX & TIMELY FOLLOW-UP: ",BUDTOT,!
+7 QUIT
HIV1L1 ;
+1 IF $Y>(IOSL-7)
DO HIV1H
IF BUDQUIT
QUIT
+2 SET BUDAGE=""
FOR
SET BUDAGE=$ORDER(^XTMP("BUDBRP6B",BUDJ,BUDH,"HIV1",BUDAGE))
IF BUDAGE=""!(BUDQUIT)
QUIT
Begin DoDot:1
+3 SET BUDNAME=""
FOR
SET BUDNAME=$ORDER(^XTMP("BUDBRP6B",BUDJ,BUDH,"HIV1",BUDAGE,BUDNAME))
IF BUDNAME=""!(BUDQUIT)
QUIT
Begin DoDot:2
+4 SET BUDCOM=""
FOR
SET BUDCOM=$ORDER(^XTMP("BUDBRP6B",BUDJ,BUDH,"HIV1",BUDAGE,BUDNAME,BUDCOM))
IF BUDCOM=""!(BUDQUIT)
QUIT
Begin DoDot:3
+5 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("BUDBRP6B",BUDJ,BUDH,"HIV1",BUDAGE,BUDNAME,BUDCOM,DFN))
IF DFN'=+DFN!(BUDQUIT)
QUIT
Begin DoDot:4
+6 IF $Y>(IOSL-3)
DO HIV1H
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,"HIV1",BUDAGE,BUDNAME,BUDCOM,DFN)
+10 WRITE ?5,$PIECE(BUDALL,"|",1),?35,$SELECT($PIECE(BUDALL,"|",3)]"":$PIECE(BUDALL,"|",3),1:"None"),?46,$PIECE(BUDALL,"|",2)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
HIV1H ;
+1 IF 'BUDGPG
GOTO HIV1H1
+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
HIV1H1 ;
+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 L,",80),!,$$CTR("Newly Identified HIV Cases with Timely Follow-Up",80),!
+6 WRITE $$CTR($PIECE(^DIC(4,BUDSITE,0),U),80),!
+7 SET X="Reporting Period: "_$$FMTE^XLFDT(BUDBD)_" to "_$$FMTE^XLFDT(BUDED)
WRITE $$CTR(X,80),!
+8 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),!
+9 WRITE $TRANSLATE($JUSTIFY("",80)," ","-")
+10 IF BUDP=0
Begin DoDot:1
+11 WRITE !!,"This report provides a list of all patients whose first ever HIV"
+12 WRITE !,"diagnosis occurred between October 1 of the prior year through"
+13 WRITE !,"September 30th of the current report year and had a medical visit for"
+14 WRITE !,"HIV care within 90 days of the first-ever HIV diagnosis, and had at "
+15 WRITE !,"least one medical visit during the report year."
+16 WRITE !,"Age is calculated as of December 31."
End DoDot:1
+17 WRITE !!,"PATIENT NAME",?34,"HRN",?41,"COMMUNITY",?70,"SEX",?75,"AGE"
+18 WRITE !?5,"First HIV DX: Date",?35,"Date of Onset",?50,"HIV Follow-up: Date"
+19 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-"),!
+20 SET BUDP=1
+21 QUIT
+22 ;----------
HIV2 ;EP
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,$$CTR($$LOC,80)
+3 WRITE !,$$CTR("UDS 2014",80)
+4 WRITE !!,"Newly Idenitifed HIV Cases with Timely Follow-Up (Table 6B)",!
+5 DO GENI
+6 DO PAUSE
+7 WRITE !!,"This report provides a list of all patients whose first ever HIV"
+8 WRITE !,"diagnosis occurred between October 1 of the prior year through"
+9 WRITE !,"September 30th of the current report year and did not have a medical visit"
+10 WRITE !,"for HIV care within 90 days of the first-ever HIV diagnosis, and had at "
+11 WRITE !,"least one medical visit during the report year."
+12 WRITE !,"Age is calculated as of December 31."
+13 WRITE !
+14 QUIT
HIV2L ;EP
+1 SET BUDP=0
SET BUDQUIT=0
SET BUDTOT=0
+2 DO HIV2H
IF BUDQUIT
QUIT
+3 IF '$DATA(^XTMP("BUDBRP6B",BUDJ,BUDH,"HIV2"))
WRITE !!,"No patients to report.",!
QUIT
+4 DO HIV2L1
+5 IF $Y>(IOSL-3)
DO HIV2H
IF BUDQUIT
QUIT
+6 WRITE !,"TOTAL PATIENTS WITH FIRST HIV DX & TIMELY FOLLOW-UP: ",BUDTOT,!
+7 QUIT
HIV2L1 ;
+1 IF $Y>(IOSL-7)
DO HIV2H
IF BUDQUIT
QUIT
+2 SET BUDAGE=""
FOR
SET BUDAGE=$ORDER(^XTMP("BUDBRP6B",BUDJ,BUDH,"HIV2",BUDAGE))
IF BUDAGE=""!(BUDQUIT)
QUIT
Begin DoDot:1
+3 SET BUDNAME=""
FOR
SET BUDNAME=$ORDER(^XTMP("BUDBRP6B",BUDJ,BUDH,"HIV2",BUDAGE,BUDNAME))
IF BUDNAME=""!(BUDQUIT)
QUIT
Begin DoDot:2
+4 SET BUDCOM=""
FOR
SET BUDCOM=$ORDER(^XTMP("BUDBRP6B",BUDJ,BUDH,"HIV2",BUDAGE,BUDNAME,BUDCOM))
IF BUDCOM=""!(BUDQUIT)
QUIT
Begin DoDot:3
+5 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("BUDBRP6B",BUDJ,BUDH,"HIV2",BUDAGE,BUDNAME,BUDCOM,DFN))
IF DFN'=+DFN!(BUDQUIT)
QUIT
Begin DoDot:4
+6 IF $Y>(IOSL-3)
DO HIV2H
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,"HIV2",BUDAGE,BUDNAME,BUDCOM,DFN)
+10 WRITE ?5,$PIECE(BUDALL,"|",1),?35,$SELECT($PIECE(BUDALL,"|",3)]"":$PIECE(BUDALL,"|",3),1:"None"),?46,$PIECE(BUDALL,"|",2)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
HIV2H ;
+1 IF 'BUDGPG
GOTO HIV2H1
+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
HIV2H1 ;
+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 L,",80),!,$$CTR("Newly Identified HIV Cases without Timely Follow-Up",80),!
+6 WRITE $$CTR($PIECE(^DIC(4,BUDSITE,0),U),80),!
+7 SET X="Reporting Period: "_$$FMTE^XLFDT(BUDBD)_" to "_$$FMTE^XLFDT(BUDED)
WRITE $$CTR(X,80),!
+8 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),!
+9 WRITE $TRANSLATE($JUSTIFY("",80)," ","-")
+10 IF BUDP=0
Begin DoDot:1
+11 WRITE !!,"This report provides a list of all patients whose first ever HIV"
+12 WRITE !,"diagnosis occurred between October 1 of the prior year through"
+13 WRITE !,"September 30th of the current report year and did not have a medical visit"
+14 WRITE !,"for HIV care within 90 days of the first-ever HIV diagnosis, and had at "
+15 WRITE !,"least one medical visit during the report year."
+16 WRITE !,"Age is calculated as of December 31."
End DoDot:1
+17 WRITE !!,"PATIENT NAME",?34,"HRN",?41,"COMMUNITY",?70,"SEX",?75,"AGE"
+18 WRITE !?5,"First HIV DX: Date",?35,"Date of Onset",?50,"HIV Follow-up: Date"
+19 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-"),!
+20 SET BUDP=1
+21 QUIT
DEPLIST1 ;EP
+1 DO EOJ
+2 SET BUDDEP1L=1
+3 DO DEP1
+4 GOTO EN1^BUDBRP6B
DEPLIST2 ;EP
+1 DO EOJ
+2 SET BUDDEP2L=1
+3 DO DEP2
+4 GOTO EN1^BUDBRP6B
DEP1 ;EP
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,$$CTR($$LOC,80)
+3 WRITE !,$$CTR("UDS 2014",80)
+4 WRITE !!,"All Patients 12+ w/Depression Scrn & if Positive a Follow-up Plan (Table 6B)",!
+5 DO GENI
+6 DO PAUSE
+7 WRITE !!,"This report provides a list of all patients 12 years and older who were "
+8 WRITE !,"screened for depression with a standardized tool during the report year"
+9 WRITE !,"and had a follow-up plan documented if screened positive, and had at"
+10 WRITE !,"least one medical visit during the report year."
+11 WRITE !
+12 QUIT
DEP1L ;EP
+1 SET BUDP=0
SET BUDQUIT=0
SET BUDTOT=0
+2 DO DEP1H
IF BUDQUIT
QUIT
+3 IF '$DATA(^XTMP("BUDBRP6B",BUDJ,BUDH,"DEP1"))
WRITE !!,"No patients to report.",!
QUIT
+4 DO DEP1L1
+5 IF $Y>(IOSL-3)
DO DEP1H
IF BUDQUIT
QUIT
+6 WRITE !,"TOTAL PATIENTS WITH DEP SCRN & IF POSITIVE, FOLLOW-UP: ",BUDTOT,!
+7 QUIT
DEP1L1 ;
+1 IF $Y>(IOSL-7)
DO DEP1H
IF BUDQUIT
QUIT
+2 SET BUDAGE=""
FOR
SET BUDAGE=$ORDER(^XTMP("BUDBRP6B",BUDJ,BUDH,"DEP1",BUDAGE))
IF BUDAGE=""!(BUDQUIT)
QUIT
Begin DoDot:1
+3 SET BUDNAME=""
FOR
SET BUDNAME=$ORDER(^XTMP("BUDBRP6B",BUDJ,BUDH,"DEP1",BUDAGE,BUDNAME))
IF BUDNAME=""!(BUDQUIT)
QUIT
Begin DoDot:2
+4 SET BUDCOM=""
FOR
SET BUDCOM=$ORDER(^XTMP("BUDBRP6B",BUDJ,BUDH,"DEP1",BUDAGE,BUDNAME,BUDCOM))
IF BUDCOM=""!(BUDQUIT)
QUIT
Begin DoDot:3
+5 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("BUDBRP6B",BUDJ,BUDH,"DEP1",BUDAGE,BUDNAME,BUDCOM,DFN))
IF DFN'=+DFN!(BUDQUIT)
QUIT
Begin DoDot:4
+6 IF $Y>(IOSL-3)
DO DEP1H
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,"DEP1",BUDAGE,BUDNAME,BUDCOM,DFN)
+10 SET BUD1=$PIECE(BUDALL,"|",1)
SET BUD2=$PIECE(BUDALL,"|",2)
+11 IF BUD1]""
WRITE ?5,$PIECE(BUD1,U,2),": ",$PIECE(BUD1,U,3),": ",$$FMTE^XLFDT($PIECE(BUD1,U,1),5)
+12 WRITE ?35,"Follow-up: "
IF BUD2]""
WRITE $PIECE(BUD2,U,2),": ",$$FMTE^XLFDT($PIECE(BUD2,U,1),5)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
DEP1H ;
+1 IF 'BUDGPG
GOTO DEP1H1
+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
DEP1H1 ;
+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 M,",80),!,$$CTR("Patients Screened for Depression and Followed Up if Appropriate",80),!
+6 WRITE $$CTR($PIECE(^DIC(4,BUDSITE,0),U),80),!
+7 SET X="Reporting Period: "_$$FMTE^XLFDT(BUDBD)_" to "_$$FMTE^XLFDT(BUDED)
WRITE $$CTR(X,80),!
+8 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),!
+9 WRITE $TRANSLATE($JUSTIFY("",80)," ","-")
+10 IF BUDP=0
Begin DoDot:1
+11 WRITE !!,"This report provides a list of all patients 12 years and older who were "
+12 WRITE !,"screened for depression with a standardized tool during the report year and"
+13 WRITE !,"had a follow-up plan documented if screened positive, and had at least one"
+14 WRITE !,"medical visit during the report year. "
+15 WRITE !,"Age is calculated as of December 31."
End DoDot:1
+16 WRITE !!,"PATIENT NAME",?34,"HRN",?41,"COMMUNITY",?70,"SEX",?75,"AGE"
+17 WRITE !?5,"Depression Scrn: Date/Result",?35,"Follow-up Plan: Date"
+18 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-"),!
+19 SET BUDP=1
+20 QUIT
DEP2 ;EP
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,$$CTR($$LOC,80)
+3 WRITE !,$$CTR("UDS 2014",80)
+4 WRITE !!,"All Patients 12+ w/o Depression Scrn or w/o Follow-up (Table 6B)",!
+5 DO GENI
+6 DO PAUSE
+7 WRITE !!,"This report provides a list of all patients 12 years and older not"
+8 WRITE !,"screened for depression or who were screened for depression with a"
+9 WRITE !,"standardized tool during the report year and does not have a follow-up"
+10 WRITE !,"plan documented if screened positive, and had at least one medical visit"
+11 WRITE !,"during the report year."
+12 WRITE !
+13 QUIT
DEP2L ;EP
+1 SET BUDP=0
SET BUDQUIT=0
SET BUDTOT=0
+2 DO DEP2H
IF BUDQUIT
QUIT
+3 IF '$DATA(^XTMP("BUDBRP6B",BUDJ,BUDH,"DEP2"))
WRITE !!,"No patients to report.",!
QUIT
+4 DO DEP2L1
+5 IF $Y>(IOSL-3)
DO DEP2H
IF BUDQUIT
QUIT
+6 WRITE !,"TOTAL PATIENTS W/O DEP SCRN OR W/O FOLLOW-UP IF POSITIVE: ",BUDTOT,!
+7 QUIT
DEP2L1 ;
+1 IF $Y>(IOSL-7)
DO DEP2H
IF BUDQUIT
QUIT
+2 SET BUDAGE=""
FOR
SET BUDAGE=$ORDER(^XTMP("BUDBRP6B",BUDJ,BUDH,"DEP2",BUDAGE))
IF BUDAGE=""!(BUDQUIT)
QUIT
Begin DoDot:1
+3 SET BUDNAME=""
FOR
SET BUDNAME=$ORDER(^XTMP("BUDBRP6B",BUDJ,BUDH,"DEP2",BUDAGE,BUDNAME))
IF BUDNAME=""!(BUDQUIT)
QUIT
Begin DoDot:2
+4 SET BUDCOM=""
FOR
SET BUDCOM=$ORDER(^XTMP("BUDBRP6B",BUDJ,BUDH,"DEP2",BUDAGE,BUDNAME,BUDCOM))
IF BUDCOM=""!(BUDQUIT)
QUIT
Begin DoDot:3
+5 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("BUDBRP6B",BUDJ,BUDH,"DEP2",BUDAGE,BUDNAME,BUDCOM,DFN))
IF DFN'=+DFN!(BUDQUIT)
QUIT
Begin DoDot:4
+6 IF $Y>(IOSL-3)
DO DEP2H
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,"DEP2",BUDAGE,BUDNAME,BUDCOM,DFN)
+10 SET BUD1=$PIECE(BUDALL,"|",1)
SET BUD2=$PIECE(BUDALL,"|",2)
+11 IF BUD1]""
WRITE ?5,$PIECE(BUD1,U,2),": ",$PIECE(BUD1,U,3),": ",$$FMTE^XLFDT($PIECE(BUD1,U,1),5)
+12 WRITE ?35,"Follow-up: "
IF BUD2]""
WRITE $PIECE(BUD2,U,2),": ",$$FMTE^XLFDT($PIECE(BUD2,U,1),5)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
DEP2H ;
+1 IF 'BUDGPG
GOTO DEP2H1
+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
DEP2H1 ;
+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 M,",80),!,$$CTR("Patients not Screened for Depression or w/o Follow-up",80),!
+6 WRITE $$CTR($PIECE(^DIC(4,BUDSITE,0),U),80),!
+7 SET X="Reporting Period: "_$$FMTE^XLFDT(BUDBD)_" to "_$$FMTE^XLFDT(BUDED)
WRITE $$CTR(X,80),!
+8 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),!
+9 WRITE $TRANSLATE($JUSTIFY("",80)," ","-")
+10 IF BUDP=0
Begin DoDot:1
+11 WRITE !!,"This report provides a list of all patients 12 years and older not"
+12 WRITE !,"screened for depression or who were screened for depression with a"
+13 WRITE !,"standardized tool during the report year and does not have a follow-up"
+14 WRITE !,"plan documented if screened positive, and had at least one medical visit"
+15 WRITE !,"during the report year."
+16 WRITE !,"Age is calculated as of December 31."
End DoDot:1
+17 WRITE !!,"PATIENT NAME",?34,"HRN",?41,"COMMUNITY",?70,"SEX",?75,"AGE"
+18 WRITE !?5,"Depression Scrn: Date/Result",?35,"Follow-up Plan: Date"
+19 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-"),!
+20 SET BUDP=1
+21 QUIT
