BUD2RP6K ; IHS/CMI/LAB - UDS REPORT DRIVER TABLE 6B 30 Dec 2012 8:09 PM 14 Dec 2012 1:24 PM ;
;;10.0;IHS/RPMS UNIFORM DATA SYSTEM;;FEB 04, 2016;Build 50
;
;
IVDLIST1 ;EP
D EOJ
S BUDIVD1L=1
D IVD1
G EN1^BUD2RP6B
IVDLIST2 ;EP
D EOJ
S BUDIVD2L=1
D IVD2
G EN1^BUD2RP6B
PAUSE ;
K DIR S DIR(0)="E",DIR("A")="PRESS ENTER" KILL DA D ^DIR KILL DIR
Q
GENI ;EP - general introductions
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 !
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 - 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")
;----------
IVD1 ;EP
W:$D(IOF) @IOF
W !,$$CTR($$LOC,80)
W !,$$CTR("UDS 2012",80)
W !!,"All IVD patients 18+ w/Aspirin or Antithrombotic Therapy (Table 6B)",!
D GENI
D PAUSE
W !!,"This report provides a list of patients 18 years of age and older who, "
W !,"in the current or prior report year, were diagnosed with Ischemic Vascular"
W !,"Disease (IVD) including acute myocardial infarction (AMI), or discharged"
W !,"alive after cardiovascular surgery (coronary artery bypass graft (CABG)"
W !,"or percutaneous transluminal coronary angioplasty (PTCA)) and were "
W !,"prescribed or dispensed aspirin or another anti-thrombotic medication"
W !,"or have documented evidence of use by patient of aspirin or another "
W !,"anti-thrombotic medication during the report period, and had a medical"
W !,"visit during the report period."
W !,"Age is calculated as of December 31."
W !
Q
IVD1L ;EP
S BUDP=0,BUDQUIT=0,BUDTOT=0
D IVD1H Q:BUDQUIT
I '$D(^XTMP("BUD2RP6B",BUDJ,BUDH,"IVD1")) W !!,"No patients to report.",! Q
D IVD1L1
I $Y>(IOSL-3) D IVD1H Q:BUDQUIT
W !!,"TOTAL IVD PATIENTS WITH ASPIRIN OR ANTITHROMBOTIC THERAPY: ",BUDTOT,!
Q
IVD1L1 ;
I $Y>(IOSL-7) D IVD1H Q:BUDQUIT
S BUDAGE="" F S BUDAGE=$O(^XTMP("BUD2RP6B",BUDJ,BUDH,"IVD1",BUDAGE)) Q:BUDAGE=""!(BUDQUIT) D
.S BUDNAME="" F S BUDNAME=$O(^XTMP("BUD2RP6B",BUDJ,BUDH,"IVD1",BUDAGE,BUDNAME)) Q:BUDNAME=""!(BUDQUIT) D
..S BUDCOM="" F S BUDCOM=$O(^XTMP("BUD2RP6B",BUDJ,BUDH,"IVD1",BUDAGE,BUDNAME,BUDCOM)) Q:BUDCOM=""!(BUDQUIT) D
...S DFN=0 F S DFN=$O(^XTMP("BUD2RP6B",BUDJ,BUDH,"IVD1",BUDAGE,BUDNAME,BUDCOM,DFN)) Q:DFN'=+DFN!(BUDQUIT) D
....I $Y>(IOSL-3) D IVD1H 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("BUD2RP6B",BUDJ,BUDH,"IVD1",BUDAGE,BUDNAME,BUDCOM,DFN)
....W ?5,$P(BUDALL,U,1),?30,$P(BUDALL,U,2)
Q
IVD1H ;
G:'BUDGPG IVD1H1
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
IVD1H1 ;
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 J, ",80),!,$$CTR("Ischemic Vascular Disease: Aspirin or Antithrombotic Therapy",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 patients 18 years of age and older who, "
.W !,"in the current or prior report year, were diagnosed with Ischemic Vascular"
.W !,"Disease (IVD) including acute myocardial infarction (AMI), or discharged"
.W !,"alive after cardiovascular surgery (coronary artery bypass graft (CABG)"
.W !,"or percutaneous transluminal coronary angioplasty (PTCA)) and were "
.W !,"prescribed or dispensed aspirin or another anti-thrombotic medication"
.W !,"or have documented evidence of use by patient of aspirin or another "
.W !,"anti-thrombotic medication during the report period, and had a medical"
.W !,"visit during the report period."
.W !,"Age is calculated as of December 31."
W !!,"PATIENT NAME",?34,"HRN",?41,"COMMUNITY",?70,"SEX",?75,"AGE"
W !?5,"Date of DX",?16,"DX or Svc CD",?30,"Medication"
W !,$TR($J("",80)," ","-"),!
S BUDP=1
Q
;
;----------
IVD2 ;EP
W:$D(IOF) @IOF
W !,$$CTR($$LOC,80)
W !,$$CTR("UDS 2012",80)
W !!,"All IVD patients 18+ w/o Aspirin or Antithrombotic Therapy (Table 6B)",!
D GENI
D PAUSE
W !!,"This report provides a list of patients 18 years of age and older who, "
W !,"in the current or prior report year, were diagnosed with Ischemic Vascular"
W !,"Disease (IVD) including acute myocardial infarction (AMI), or discharged"
W !,"alive after cardiovascular surgery (coronary artery bypass graft (CABG)"
W !,"or percutaneous transluminal coronary angioplasty (PTCA)) and were not"
W !,"prescribed or dispensed aspirin or another anti-thrombotic medication"
W !,"or have documented evidence of use by patient of aspirin or another "
W !,"anti-thrombotic medication during the report period, and had a medical"
W !,"visit during the report period."
W !,"Age is calculated as of December 31."
W !
Q
IVD2L ;EP
S BUDP=0,BUDQUIT=0,BUDTOT=0
D IVD2H Q:BUDQUIT
I '$D(^XTMP("BUD2RP6B",BUDJ,BUDH,"IVD2")) W !!,"No patients to report.",! Q
D IVD2L1
I $Y>(IOSL-3) D IVD2H Q:BUDQUIT
W !!,"TOTAL IVD PATIENTS WITHOUT ASPIRIN OR ANTITHROMBOTIC THERAPY: ",BUDTOT,!
Q
IVD2L1 ;
I $Y>(IOSL-7) D IVD2H Q:BUDQUIT
S BUDAGE="" F S BUDAGE=$O(^XTMP("BUD2RP6B",BUDJ,BUDH,"IVD2",BUDAGE)) Q:BUDAGE=""!(BUDQUIT) D
.S BUDNAME="" F S BUDNAME=$O(^XTMP("BUD2RP6B",BUDJ,BUDH,"IVD2",BUDAGE,BUDNAME)) Q:BUDNAME=""!(BUDQUIT) D
..S BUDCOM="" F S BUDCOM=$O(^XTMP("BUD2RP6B",BUDJ,BUDH,"IVD2",BUDAGE,BUDNAME,BUDCOM)) Q:BUDCOM=""!(BUDQUIT) D
...S DFN=0 F S DFN=$O(^XTMP("BUD2RP6B",BUDJ,BUDH,"IVD2",BUDAGE,BUDNAME,BUDCOM,DFN)) Q:DFN'=+DFN!(BUDQUIT) D
....I $Y>(IOSL-3) D IVD2H 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("BUD2RP6B",BUDJ,BUDH,"IVD2",BUDAGE,BUDNAME,BUDCOM,DFN)
....W ?5,$P(BUDALL,U,1),?30,$P(BUDALL,U,2)
Q
IVD2H ;
G:'BUDGPG IVD2H1
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
IVD2H1 ;
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 J, ",80),!,$$CTR("Ischemic Vascular Disease: Aspirin or Antithrombotic Therapy",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 patients 18 years of age and older who, "
.W !,"in the current or prior report year, were diagnosed with Ischemic Vascular"
.W !,"Disease (IVD) including acute myocardial infarction (AMI), or discharged"
.W !,"alive after cardiovascular surgery (coronary artery bypass graft (CABG)"
.W !,"or percutaneous transluminal coronary angioplasty (PTCA)) and were not"
.W !,"prescribed or dispensed aspirin or another anti-thrombotic medication"
.W !,"or have documented evidence of use by patient of aspirin or another "
.W !,"anti-thrombotic medication during the report period, and had a medical"
.W !,"visit during the report period."
.W !,"Age is calculated as of December 31."
W !!,"PATIENT NAME",?34,"HRN",?41,"COMMUNITY",?70,"SEX",?75,"AGE"
W !?5,"Date of DX",?16,"DX or Svc CD",?30,"Medication"
W !,$TR($J("",80)," ","-"),!
S BUDP=1
Q
;
BUD2RP6K ; IHS/CMI/LAB - UDS REPORT DRIVER TABLE 6B 30 Dec 2012 8:09 PM 14 Dec 2012 1:24 PM ;
+1 ;;10.0;IHS/RPMS UNIFORM DATA SYSTEM;;FEB 04, 2016;Build 50
+2 ;
+3 ;
IVDLIST1 ;EP
+1 DO EOJ
+2 SET BUDIVD1L=1
+3 DO IVD1
+4 GOTO EN1^BUD2RP6B
IVDLIST2 ;EP
+1 DO EOJ
+2 SET BUDIVD2L=1
+3 DO IVD2
+4 GOTO EN1^BUD2RP6B
PAUSE ;
+1 KILL DIR
SET DIR(0)="E"
SET DIR("A")="PRESS ENTER"
KILL DA
DO ^DIR
KILL DIR
+2 QUIT
GENI ;EP - general introductions
+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 !
+20 QUIT
+21 ;
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 - 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 ;----------
IVD1 ;EP
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,$$CTR($$LOC,80)
+3 WRITE !,$$CTR("UDS 2012",80)
+4 WRITE !!,"All IVD patients 18+ w/Aspirin or Antithrombotic Therapy (Table 6B)",!
+5 DO GENI
+6 DO PAUSE
+7 WRITE !!,"This report provides a list of patients 18 years of age and older who, "
+8 WRITE !,"in the current or prior report year, were diagnosed with Ischemic Vascular"
+9 WRITE !,"Disease (IVD) including acute myocardial infarction (AMI), or discharged"
+10 WRITE !,"alive after cardiovascular surgery (coronary artery bypass graft (CABG)"
+11 WRITE !,"or percutaneous transluminal coronary angioplasty (PTCA)) and were "
+12 WRITE !,"prescribed or dispensed aspirin or another anti-thrombotic medication"
+13 WRITE !,"or have documented evidence of use by patient of aspirin or another "
+14 WRITE !,"anti-thrombotic medication during the report period, and had a medical"
+15 WRITE !,"visit during the report period."
+16 WRITE !,"Age is calculated as of December 31."
+17 WRITE !
+18 QUIT
IVD1L ;EP
+1 SET BUDP=0
SET BUDQUIT=0
SET BUDTOT=0
+2 DO IVD1H
IF BUDQUIT
QUIT
+3 IF '$DATA(^XTMP("BUD2RP6B",BUDJ,BUDH,"IVD1"))
WRITE !!,"No patients to report.",!
QUIT
+4 DO IVD1L1
+5 IF $Y>(IOSL-3)
DO IVD1H
IF BUDQUIT
QUIT
+6 WRITE !!,"TOTAL IVD PATIENTS WITH ASPIRIN OR ANTITHROMBOTIC THERAPY: ",BUDTOT,!
+7 QUIT
IVD1L1 ;
+1 IF $Y>(IOSL-7)
DO IVD1H
IF BUDQUIT
QUIT
+2 SET BUDAGE=""
FOR
SET BUDAGE=$ORDER(^XTMP("BUD2RP6B",BUDJ,BUDH,"IVD1",BUDAGE))
IF BUDAGE=""!(BUDQUIT)
QUIT
Begin DoDot:1
+3 SET BUDNAME=""
FOR
SET BUDNAME=$ORDER(^XTMP("BUD2RP6B",BUDJ,BUDH,"IVD1",BUDAGE,BUDNAME))
IF BUDNAME=""!(BUDQUIT)
QUIT
Begin DoDot:2
+4 SET BUDCOM=""
FOR
SET BUDCOM=$ORDER(^XTMP("BUD2RP6B",BUDJ,BUDH,"IVD1",BUDAGE,BUDNAME,BUDCOM))
IF BUDCOM=""!(BUDQUIT)
QUIT
Begin DoDot:3
+5 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("BUD2RP6B",BUDJ,BUDH,"IVD1",BUDAGE,BUDNAME,BUDCOM,DFN))
IF DFN'=+DFN!(BUDQUIT)
QUIT
Begin DoDot:4
+6 IF $Y>(IOSL-3)
DO IVD1H
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("BUD2RP6B",BUDJ,BUDH,"IVD1",BUDAGE,BUDNAME,BUDCOM,DFN)
+10 WRITE ?5,$PIECE(BUDALL,U,1),?30,$PIECE(BUDALL,U,2)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+11 QUIT
IVD1H ;
+1 IF 'BUDGPG
GOTO IVD1H1
+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
IVD1H1 ;
+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 J, ",80),!,$$CTR("Ischemic Vascular Disease: Aspirin or Antithrombotic Therapy",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 patients 18 years of age and older who, "
+12 WRITE !,"in the current or prior report year, were diagnosed with Ischemic Vascular"
+13 WRITE !,"Disease (IVD) including acute myocardial infarction (AMI), or discharged"
+14 WRITE !,"alive after cardiovascular surgery (coronary artery bypass graft (CABG)"
+15 WRITE !,"or percutaneous transluminal coronary angioplasty (PTCA)) and were "
+16 WRITE !,"prescribed or dispensed aspirin or another anti-thrombotic medication"
+17 WRITE !,"or have documented evidence of use by patient of aspirin or another "
+18 WRITE !,"anti-thrombotic medication during the report period, and had a medical"
+19 WRITE !,"visit during the report period."
+20 WRITE !,"Age is calculated as of December 31."
End DoDot:1
+21 WRITE !!,"PATIENT NAME",?34,"HRN",?41,"COMMUNITY",?70,"SEX",?75,"AGE"
+22 WRITE !?5,"Date of DX",?16,"DX or Svc CD",?30,"Medication"
+23 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-"),!
+24 SET BUDP=1
+25 QUIT
+26 ;
+27 ;----------
IVD2 ;EP
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,$$CTR($$LOC,80)
+3 WRITE !,$$CTR("UDS 2012",80)
+4 WRITE !!,"All IVD patients 18+ w/o Aspirin or Antithrombotic Therapy (Table 6B)",!
+5 DO GENI
+6 DO PAUSE
+7 WRITE !!,"This report provides a list of patients 18 years of age and older who, "
+8 WRITE !,"in the current or prior report year, were diagnosed with Ischemic Vascular"
+9 WRITE !,"Disease (IVD) including acute myocardial infarction (AMI), or discharged"
+10 WRITE !,"alive after cardiovascular surgery (coronary artery bypass graft (CABG)"
+11 WRITE !,"or percutaneous transluminal coronary angioplasty (PTCA)) and were not"
+12 WRITE !,"prescribed or dispensed aspirin or another anti-thrombotic medication"
+13 WRITE !,"or have documented evidence of use by patient of aspirin or another "
+14 WRITE !,"anti-thrombotic medication during the report period, and had a medical"
+15 WRITE !,"visit during the report period."
+16 WRITE !,"Age is calculated as of December 31."
+17 WRITE !
+18 QUIT
IVD2L ;EP
+1 SET BUDP=0
SET BUDQUIT=0
SET BUDTOT=0
+2 DO IVD2H
IF BUDQUIT
QUIT
+3 IF '$DATA(^XTMP("BUD2RP6B",BUDJ,BUDH,"IVD2"))
WRITE !!,"No patients to report.",!
QUIT
+4 DO IVD2L1
+5 IF $Y>(IOSL-3)
DO IVD2H
IF BUDQUIT
QUIT
+6 WRITE !!,"TOTAL IVD PATIENTS WITHOUT ASPIRIN OR ANTITHROMBOTIC THERAPY: ",BUDTOT,!
+7 QUIT
IVD2L1 ;
+1 IF $Y>(IOSL-7)
DO IVD2H
IF BUDQUIT
QUIT
+2 SET BUDAGE=""
FOR
SET BUDAGE=$ORDER(^XTMP("BUD2RP6B",BUDJ,BUDH,"IVD2",BUDAGE))
IF BUDAGE=""!(BUDQUIT)
QUIT
Begin DoDot:1
+3 SET BUDNAME=""
FOR
SET BUDNAME=$ORDER(^XTMP("BUD2RP6B",BUDJ,BUDH,"IVD2",BUDAGE,BUDNAME))
IF BUDNAME=""!(BUDQUIT)
QUIT
Begin DoDot:2
+4 SET BUDCOM=""
FOR
SET BUDCOM=$ORDER(^XTMP("BUD2RP6B",BUDJ,BUDH,"IVD2",BUDAGE,BUDNAME,BUDCOM))
IF BUDCOM=""!(BUDQUIT)
QUIT
Begin DoDot:3
+5 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("BUD2RP6B",BUDJ,BUDH,"IVD2",BUDAGE,BUDNAME,BUDCOM,DFN))
IF DFN'=+DFN!(BUDQUIT)
QUIT
Begin DoDot:4
+6 IF $Y>(IOSL-3)
DO IVD2H
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("BUD2RP6B",BUDJ,BUDH,"IVD2",BUDAGE,BUDNAME,BUDCOM,DFN)
+10 WRITE ?5,$PIECE(BUDALL,U,1),?30,$PIECE(BUDALL,U,2)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+11 QUIT
IVD2H ;
+1 IF 'BUDGPG
GOTO IVD2H1
+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
IVD2H1 ;
+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 J, ",80),!,$$CTR("Ischemic Vascular Disease: Aspirin or Antithrombotic Therapy",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 patients 18 years of age and older who, "
+12 WRITE !,"in the current or prior report year, were diagnosed with Ischemic Vascular"
+13 WRITE !,"Disease (IVD) including acute myocardial infarction (AMI), or discharged"
+14 WRITE !,"alive after cardiovascular surgery (coronary artery bypass graft (CABG)"
+15 WRITE !,"or percutaneous transluminal coronary angioplasty (PTCA)) and were not"
+16 WRITE !,"prescribed or dispensed aspirin or another anti-thrombotic medication"
+17 WRITE !,"or have documented evidence of use by patient of aspirin or another "
+18 WRITE !,"anti-thrombotic medication during the report period, and had a medical"
+19 WRITE !,"visit during the report period."
+20 WRITE !,"Age is calculated as of December 31."
End DoDot:1
+21 WRITE !!,"PATIENT NAME",?34,"HRN",?41,"COMMUNITY",?70,"SEX",?75,"AGE"
+22 WRITE !?5,"Date of DX",?16,"DX or Svc CD",?30,"Medication"
+23 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-"),!
+24 SET BUDP=1
+25 QUIT
+26 ;
