BUDBRP6T ; IHS/CMI/LAB - UDS REPORT DRIVER TABLE 6B ;
;;10.0;IHS/RPMS UNIFORM DATA SYSTEM;;FEB 04, 2016;Build 50
;
;
TUALIST1 ;EP
D EOJ
S BUDTUA1L=1
D TUA1
G EN1^BUDBRP6B
TUALIST2 ;EP
D EOJ
S BUDTUA2L=1
D TUA2
G EN1^BUDBRP6B
PAUSE ;
K DIR S DIR(0)="E",DIR("A")="PRESS ENTER" KILL DA D ^DIR KILL DIR
Q
GENI ;EP
W !,"NOTE: Patient lists may be hundreds of pages long, depending on the size of your"
W !,"patient population. It is recommended that you run these reports at night and"
W !,"print to an electronic file, not directly to a printer.",!
K DIR S DIR(0)="E",DIR("A")="Press Enter to Continue" D ^DIR K DIR
W !!,"This Patient List option documents the individual patients and visits"
W !,"that are counted and summarized on each Table report (main menu"
W !,"option REP). The summary Table report is included at the beginning of each"
W !,"List report."
W !,"UDS searches your database to find all visits and related patients"
W !,"during the time period selected. Based on the UDS definition, to be counted"
W !,"as a patient, the patient must have had at least one visit meeting the "
W !,"following criteria:"
W !?4,"- must be to a location specified in your visit location setup"
W !?4,"- must be to Service Category Ambulatory (A), Hospitalization (H), Day"
W !?6,"Surgery (S), Observation (O), Telemedicine (M), Nursing home visit (R), "
W !?6,"or In-Hospital (I) visit"
W !?4,"- must NOT have an excluded clinic code (see User Manual for a list)"
W !?4,"- must have a primary provider and a coded purpose of visit"
W !?4,"- the patient must NOT have a gender of 'Unknown'"
W !
Q
;
EOJ ;
D EN^XBVK("BUD")
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
Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
;----------
TUA1 ;EP
W:$D(IOF) @IOF
W !,$$CTR($$LOC,80)
W !,$$CTR("UDS 2014",80)
W !!,"All Patients 18+ w/tobacco use scrn & cessation intervention (Table 6B)",!
D GENI
D PAUSE
W !!,"This report provides a list of all patients 18 years and older who were"
W !,"queried/screened about any and all forms tobacco use AND received documented"
W !,"cessation counseling intervention (counseling) or medication (smoking"
W !,"(cessation agents) if identified as a tobacco user one or more times during the "
W !,"report period or the prior year, had at least one medical during the report"
W !,"period, and with at least two medical visits ever, and were ever seen after"
W !,"their 18th birthday."
W !
Q
TUA1L ;EP
S BUDP=0,BUDQUIT=0,BUDTOT=0
D TUA1H Q:BUDQUIT
I '$D(^XTMP("BUDBRP6B",BUDJ,BUDH,"TUA1")) W !!,"No patients to report.",! Q
D TUA1L1
I $Y>(IOSL-3) D TUA1H Q:BUDQUIT
W !!,"TOTAL PATIENTS WITH TOBACCO USE SCREEN AND CESSATION INTERVENTION: ",BUDTOT,!
Q
TUA1L1 ;
I $Y>(IOSL-7) D TUA1H Q:BUDQUIT
S BUDAGE="" F S BUDAGE=$O(^XTMP("BUDBRP6B",BUDJ,BUDH,"TUA1",BUDAGE)) Q:BUDAGE=""!(BUDQUIT) D
.S BUDNAME="" F S BUDNAME=$O(^XTMP("BUDBRP6B",BUDJ,BUDH,"TUA1",BUDAGE,BUDNAME)) Q:BUDNAME=""!(BUDQUIT) D
..S BUDCOM="" F S BUDCOM=$O(^XTMP("BUDBRP6B",BUDJ,BUDH,"TUA1",BUDAGE,BUDNAME,BUDCOM)) Q:BUDCOM=""!(BUDQUIT) D
...S DFN=0 F S DFN=$O(^XTMP("BUDBRP6B",BUDJ,BUDH,"TUA1",BUDAGE,BUDNAME,BUDCOM,DFN)) Q:DFN'=+DFN!(BUDQUIT) D
....I $Y>(IOSL-3) D TUA1H 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,"TUA1",BUDAGE,BUDNAME,BUDCOM,DFN)
....I BUDALL="" W ?5,"Never" Q
....S BUDSCR=$P(BUDALL,"|"),BUDUSER=$P(BUDALL,"|",2),BUDCESS=$P(BUDALL,"|",3)
....W ?5,$P(BUDSCR,U,2),?20,$E($P(BUDSCR,U,1),1,18) I BUDUSER]"" W ?40,"USER: ",BUDUSER," CESS: ",$P(BUDCESS,U,1)_" "_$P(BUDCESS,U,2)
....;S %=$P(BUDALL,"|",2)
....;W ?60,$P(%,U)
Q
TUA1H ;
G:'BUDGPG TUA1H1
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
TUA1H1 ;
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 G, Tobacco Screening and Cessation Intervention",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 were "
.W !,"queried/screened about any and all forms tobacco use AND received documented"
.W !,"cessation counseling intervention (counseling) or medication (smoking "
.W !,"cessation agents) if identified as a tobacco user one or more times during the"
.W !,"report period or the prior year, had at least one medical visit during the"
.W !,"report period, and with at least two medical visits ever, and were ever"
.W !,"seen after their 18th birthday. "
.W !,"Age is calculated as of December 31."
W !!,"PATIENT NAME",?34,"HRN",?41,"COMMUNITY",?70,"SEX",?75,"AGE"
W !?5,"SCREEN DATE",?20,"TOBACCO STATUS",?40,"CESSATION"
W !,$TR($J("",80)," ","-"),!
S BUDP=1
Q
;
;----------
TUA2 ;EP
W:$D(IOF) @IOF
W !,$$CTR($$LOC,80)
W !,$$CTR("UDS 2014",80)
W !!,"All Patients 18 and older w/o tobacco use scrn or cessation intervention (Table 6B)",!
D GENI
D PAUSE
W !!,"This report provides a list of all patients 18 years and older who were"
W !,"not queried/screened about any and all forms tobacco use or did not "
W !,"receive a documented cessation counseling intervention (counseling) or"
W !,"medication (smoking cessation agents) if identified as a tobacco user"
W !,"one or more times during the report period or the prior year, had at "
W !,"least one medical during the report period, and with at least two medical"
W !,"visits ever, and were ever seen after their 18th birthday."
W !
Q
TUA2L ;EP
S BUDP=0,BUDQUIT=0,BUDTOT=0
D TUA2H Q:BUDQUIT
I '$D(^XTMP("BUDBRP6B",BUDJ,BUDH,"TUA2")) W !!,"No patients to report.",! Q
D TUA2L1
I $Y>(IOSL-3) D TUA2H Q:BUDQUIT
W !!,"TOTAL PATIENTS WITHOUT TOBACCO USE SCREEN OR CESSATION INERVENTION: ",BUDTOT,!
Q
TUA2L1 ;
I $Y>(IOSL-7) D TUA2H Q:BUDQUIT
S BUDAGE="" F S BUDAGE=$O(^XTMP("BUDBRP6B",BUDJ,BUDH,"TUA2",BUDAGE)) Q:BUDAGE=""!(BUDQUIT) D
.S BUDNAME="" F S BUDNAME=$O(^XTMP("BUDBRP6B",BUDJ,BUDH,"TUA2",BUDAGE,BUDNAME)) Q:BUDNAME=""!(BUDQUIT) D
..S BUDCOM="" F S BUDCOM=$O(^XTMP("BUDBRP6B",BUDJ,BUDH,"TUA2",BUDAGE,BUDNAME,BUDCOM)) Q:BUDCOM=""!(BUDQUIT) D
...S DFN=0 F S DFN=$O(^XTMP("BUDBRP6B",BUDJ,BUDH,"TUA2",BUDAGE,BUDNAME,BUDCOM,DFN)) Q:DFN'=+DFN!(BUDQUIT) D
....I $Y>(IOSL-3) D TUA2H 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,"TUA2",BUDAGE,BUDNAME,BUDCOM,DFN)
....I BUDALL="" W ?5,"Never" Q
....S BUDSCR=$P(BUDALL,"|"),BUDUSER=$P(BUDALL,"|",2),BUDCESS=$P(BUDALL,"|",3)
....W ?5,$P(BUDSCR,U,2),?20,$E($P(BUDSCR,U,1),1,18) I BUDUSER]"" W ?40,"USER: ",BUDUSER," CESS: ",$P(BUDCESS,U,1)_" "_$P(BUDCESS,U,2)
....;S %=$P(BUDALL,"|",2)
....;W ?60,$P(%,U)
Q
TUA2H ;
G:'BUDGPG TUA2H1
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
TUA2H1 ;
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 G, Tobacco Use Screening and Cessation Intervention",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 were"
.W !,"not queried/screened about any and all forms tobacco use or did not "
.W !,"receive a documented cessation counseling intervention (counseling)"
.W !,"or medication (smoking cessation agents) if identified as a tobacco"
.W !,"user one or more times during the report period or the prior year,"
.W !,"had at least one medical visit during the report period, and with at"
.W !,"least two medical visits ever, and were ever seen after their 18th"
.W !,"birthday. "
.W !,"Age is calculated as of December 31st."
W !!,"PATIENT NAME",?34,"HRN",?41,"COMMUNITY",?70,"SEX",?75,"AGE"
W !?5,"SCREEN DATE",?30,"TOBACCO STATUS",?60,"CESSATION"
W !,$TR($J("",80)," ","-"),!
S BUDP=1
Q
;
;----------
;
BUDBRP6T ; IHS/CMI/LAB - UDS REPORT DRIVER TABLE 6B ;
+1 ;;10.0;IHS/RPMS UNIFORM DATA SYSTEM;;FEB 04, 2016;Build 50
+2 ;
+3 ;
TUALIST1 ;EP
+1 DO EOJ
+2 SET BUDTUA1L=1
+3 DO TUA1
+4 GOTO EN1^BUDBRP6B
TUALIST2 ;EP
+1 DO EOJ
+2 SET BUDTUA2L=1
+3 DO TUA2
+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 WRITE !,"NOTE: Patient lists may be hundreds of pages long, depending on the size of your"
+2 WRITE !,"patient population. It is recommended that you run these reports at night and"
+3 WRITE !,"print to an electronic file, not directly to a printer.",!
+4 KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Enter to Continue"
DO ^DIR
KILL DIR
+5 WRITE !!,"This Patient List option documents the individual patients and visits"
+6 WRITE !,"that are counted and summarized on each Table report (main menu"
+7 WRITE !,"option REP). The summary Table report is included at the beginning of each"
+8 WRITE !,"List report."
+9 WRITE !,"UDS searches your database to find all visits and related patients"
+10 WRITE !,"during the time period selected. Based on the UDS definition, to be counted"
+11 WRITE !,"as a patient, the patient must have had at least one visit meeting the "
+12 WRITE !,"following criteria:"
+13 WRITE !?4,"- must be to a location specified in your visit location setup"
+14 WRITE !?4,"- must be to Service Category Ambulatory (A), Hospitalization (H), Day"
+15 WRITE !?6,"Surgery (S), Observation (O), Telemedicine (M), Nursing home visit (R), "
+16 WRITE !?6,"or In-Hospital (I) visit"
+17 WRITE !?4,"- must NOT have an excluded clinic code (see User Manual for a list)"
+18 WRITE !?4,"- must have a primary provider and a coded purpose of visit"
+19 WRITE !?4,"- the patient must NOT have a gender of 'Unknown'"
+20 WRITE !
+21 QUIT
+22 ;
EOJ ;
+1 DO EN^XBVK("BUD")
+2 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
+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 ;----------
TUA1 ;EP
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,$$CTR($$LOC,80)
+3 WRITE !,$$CTR("UDS 2014",80)
+4 WRITE !!,"All Patients 18+ w/tobacco use scrn & cessation intervention (Table 6B)",!
+5 DO GENI
+6 DO PAUSE
+7 WRITE !!,"This report provides a list of all patients 18 years and older who were"
+8 WRITE !,"queried/screened about any and all forms tobacco use AND received documented"
+9 WRITE !,"cessation counseling intervention (counseling) or medication (smoking"
+10 WRITE !,"(cessation agents) if identified as a tobacco user one or more times during the "
+11 WRITE !,"report period or the prior year, had at least one medical during the report"
+12 WRITE !,"period, and with at least two medical visits ever, and were ever seen after"
+13 WRITE !,"their 18th birthday."
+14 WRITE !
+15 QUIT
TUA1L ;EP
+1 SET BUDP=0
SET BUDQUIT=0
SET BUDTOT=0
+2 DO TUA1H
IF BUDQUIT
QUIT
+3 IF '$DATA(^XTMP("BUDBRP6B",BUDJ,BUDH,"TUA1"))
WRITE !!,"No patients to report.",!
QUIT
+4 DO TUA1L1
+5 IF $Y>(IOSL-3)
DO TUA1H
IF BUDQUIT
QUIT
+6 WRITE !!,"TOTAL PATIENTS WITH TOBACCO USE SCREEN AND CESSATION INTERVENTION: ",BUDTOT,!
+7 QUIT
TUA1L1 ;
+1 IF $Y>(IOSL-7)
DO TUA1H
IF BUDQUIT
QUIT
+2 SET BUDAGE=""
FOR
SET BUDAGE=$ORDER(^XTMP("BUDBRP6B",BUDJ,BUDH,"TUA1",BUDAGE))
IF BUDAGE=""!(BUDQUIT)
QUIT
Begin DoDot:1
+3 SET BUDNAME=""
FOR
SET BUDNAME=$ORDER(^XTMP("BUDBRP6B",BUDJ,BUDH,"TUA1",BUDAGE,BUDNAME))
IF BUDNAME=""!(BUDQUIT)
QUIT
Begin DoDot:2
+4 SET BUDCOM=""
FOR
SET BUDCOM=$ORDER(^XTMP("BUDBRP6B",BUDJ,BUDH,"TUA1",BUDAGE,BUDNAME,BUDCOM))
IF BUDCOM=""!(BUDQUIT)
QUIT
Begin DoDot:3
+5 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("BUDBRP6B",BUDJ,BUDH,"TUA1",BUDAGE,BUDNAME,BUDCOM,DFN))
IF DFN'=+DFN!(BUDQUIT)
QUIT
Begin DoDot:4
+6 IF $Y>(IOSL-3)
DO TUA1H
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,"TUA1",BUDAGE,BUDNAME,BUDCOM,DFN)
+10 IF BUDALL=""
WRITE ?5,"Never"
QUIT
+11 SET BUDSCR=$PIECE(BUDALL,"|")
SET BUDUSER=$PIECE(BUDALL,"|",2)
SET BUDCESS=$PIECE(BUDALL,"|",3)
+12 WRITE ?5,$PIECE(BUDSCR,U,2),?20,$EXTRACT($PIECE(BUDSCR,U,1),1,18)
IF BUDUSER]""
WRITE ?40,"USER: ",BUDUSER," CESS: ",$PIECE(BUDCESS,U,1)_" "_$PIECE(BUDCESS,U,2)
+13 ;S %=$P(BUDALL,"|",2)
+14 ;W ?60,$P(%,U)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+15 QUIT
TUA1H ;
+1 IF 'BUDGPG
GOTO TUA1H1
+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
TUA1H1 ;
+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 G, Tobacco Screening and Cessation Intervention",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 18 years and older who were "
+12 WRITE !,"queried/screened about any and all forms tobacco use AND received documented"
+13 WRITE !,"cessation counseling intervention (counseling) or medication (smoking "
+14 WRITE !,"cessation agents) if identified as a tobacco user one or more times during the"
+15 WRITE !,"report period or the prior year, had at least one medical visit during the"
+16 WRITE !,"report period, and with at least two medical visits ever, and were ever"
+17 WRITE !,"seen after their 18th birthday. "
+18 WRITE !,"Age is calculated as of December 31."
End DoDot:1
+19 WRITE !!,"PATIENT NAME",?34,"HRN",?41,"COMMUNITY",?70,"SEX",?75,"AGE"
+20 WRITE !?5,"SCREEN DATE",?20,"TOBACCO STATUS",?40,"CESSATION"
+21 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-"),!
+22 SET BUDP=1
+23 QUIT
+24 ;
+25 ;----------
TUA2 ;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 tobacco use scrn or cessation intervention (Table 6B)",!
+5 DO GENI
+6 DO PAUSE
+7 WRITE !!,"This report provides a list of all patients 18 years and older who were"
+8 WRITE !,"not queried/screened about any and all forms tobacco use or did not "
+9 WRITE !,"receive a documented cessation counseling intervention (counseling) or"
+10 WRITE !,"medication (smoking cessation agents) if identified as a tobacco user"
+11 WRITE !,"one or more times during the report period or the prior year, had at "
+12 WRITE !,"least one medical during the report period, and with at least two medical"
+13 WRITE !,"visits ever, and were ever seen after their 18th birthday."
+14 WRITE !
+15 QUIT
TUA2L ;EP
+1 SET BUDP=0
SET BUDQUIT=0
SET BUDTOT=0
+2 DO TUA2H
IF BUDQUIT
QUIT
+3 IF '$DATA(^XTMP("BUDBRP6B",BUDJ,BUDH,"TUA2"))
WRITE !!,"No patients to report.",!
QUIT
+4 DO TUA2L1
+5 IF $Y>(IOSL-3)
DO TUA2H
IF BUDQUIT
QUIT
+6 WRITE !!,"TOTAL PATIENTS WITHOUT TOBACCO USE SCREEN OR CESSATION INERVENTION: ",BUDTOT,!
+7 QUIT
TUA2L1 ;
+1 IF $Y>(IOSL-7)
DO TUA2H
IF BUDQUIT
QUIT
+2 SET BUDAGE=""
FOR
SET BUDAGE=$ORDER(^XTMP("BUDBRP6B",BUDJ,BUDH,"TUA2",BUDAGE))
IF BUDAGE=""!(BUDQUIT)
QUIT
Begin DoDot:1
+3 SET BUDNAME=""
FOR
SET BUDNAME=$ORDER(^XTMP("BUDBRP6B",BUDJ,BUDH,"TUA2",BUDAGE,BUDNAME))
IF BUDNAME=""!(BUDQUIT)
QUIT
Begin DoDot:2
+4 SET BUDCOM=""
FOR
SET BUDCOM=$ORDER(^XTMP("BUDBRP6B",BUDJ,BUDH,"TUA2",BUDAGE,BUDNAME,BUDCOM))
IF BUDCOM=""!(BUDQUIT)
QUIT
Begin DoDot:3
+5 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("BUDBRP6B",BUDJ,BUDH,"TUA2",BUDAGE,BUDNAME,BUDCOM,DFN))
IF DFN'=+DFN!(BUDQUIT)
QUIT
Begin DoDot:4
+6 IF $Y>(IOSL-3)
DO TUA2H
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,"TUA2",BUDAGE,BUDNAME,BUDCOM,DFN)
+10 IF BUDALL=""
WRITE ?5,"Never"
QUIT
+11 SET BUDSCR=$PIECE(BUDALL,"|")
SET BUDUSER=$PIECE(BUDALL,"|",2)
SET BUDCESS=$PIECE(BUDALL,"|",3)
+12 WRITE ?5,$PIECE(BUDSCR,U,2),?20,$EXTRACT($PIECE(BUDSCR,U,1),1,18)
IF BUDUSER]""
WRITE ?40,"USER: ",BUDUSER," CESS: ",$PIECE(BUDCESS,U,1)_" "_$PIECE(BUDCESS,U,2)
+13 ;S %=$P(BUDALL,"|",2)
+14 ;W ?60,$P(%,U)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+15 QUIT
TUA2H ;
+1 IF 'BUDGPG
GOTO TUA2H1
+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
TUA2H1 ;
+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 G, Tobacco Use Screening and Cessation Intervention",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 18 years and older who were"
+12 WRITE !,"not queried/screened about any and all forms tobacco use or did not "
+13 WRITE !,"receive a documented cessation counseling intervention (counseling)"
+14 WRITE !,"or medication (smoking cessation agents) if identified as a tobacco"
+15 WRITE !,"user one or more times during the report period or the prior year,"
+16 WRITE !,"had at least one medical visit during the report period, and with at"
+17 WRITE !,"least two medical visits ever, and were ever seen after their 18th"
+18 WRITE !,"birthday. "
+19 WRITE !,"Age is calculated as of December 31st."
End DoDot:1
+20 WRITE !!,"PATIENT NAME",?34,"HRN",?41,"COMMUNITY",?70,"SEX",?75,"AGE"
+21 WRITE !?5,"SCREEN DATE",?30,"TOBACCO STATUS",?60,"CESSATION"
+22 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-"),!
+23 SET BUDP=1
+24 QUIT
+25 ;
+26 ;----------
+27 ;
