Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BUD2RP6J

BUD2RP6J.m

Go to the documentation of this file. 
  1. BUD2RP6J ; 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
  1.  ;
  1.  ;
  1. CADLIST1 ;EP
  1.  D EOJ
  1.  S BUDCAD1L=1
  1.  D CAD1
  1.  G EN1^BUD2RP6B
  1. CAD2LIST ;EP
  1.  D EOJ
  1.  S BUDCAD2L=1
  1.  D CAD2
  1.  G EN1^BUD2RP6B
  1. PAUSE ;
  1.  K DIR S DIR(0)="E",DIR("A")="PRESS ENTER" KILL DA D ^DIR KILL DIR
  1.  Q
  1. GENI ;EP - general introductions
  1.  W !,"NOTE: Patient lists may be hundreds of pages long, depending on the size of your"
  1.  W !,"patient population.  It is recommended that you run these reports at night and"
  1.  W !,"print to an electronic file, not directly to a printer.",!
  1.  K DIR S DIR(0)="E",DIR("A")="Press Enter to Continue" D ^DIR K DIR
  1.  W !!,"This Patient List option documents the individual patients and visits"
  1.  W !,"that are counted and summarized on each Table report (main menu"
  1.  W !,"option REP).  The summary Table report is included at the beginning of each"
  1.  W !,"List report."
  1.  W !,"UDS searches your database to find all visits and related patients"
  1.  W !,"during the time period selected. Based on the UDS definition, to be counted"
  1.  W !,"as a patient, the patient must have had at least one visit meeting the "
  1.  W !,"following criteria:"
  1.  W !?4,"- must be to a location specified in your visit location setup"
  1.  W !?4,"- must be to Service Category Ambulatory (A), Hospitalization (H), Day"
  1.  W !?6,"Surgery (S), Observation (O), Telemedicine (M), Nursing home visit (R), "
  1.  W !?6,"or In-Hospital (I) visit"
  1.  W !?4,"- must NOT have an excluded clinic code (see User Manual for a list)"
  1.  W !?4,"- must have a primary provider and a coded purpose of visit"
  1.  W !
  1.  Q
  1.  ;
  1. EOJ ;
  1.  D EN^XBVK("BUD")
  1.  Q
  1. CTR(X,Y) ;EP - Center X in a field Y wide.
  1.  Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
  1.  ;----------
  1. USR() ;EP - Return name of current user from ^VA(200.
  1.  Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
  1.  ;----------
  1. LOC() ;EP - Return location name from file 4 based on DUZ(2).
  1.  Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
  1.  ;----------
  1. CAD1 ;EP
  1.  W:$D(IOF) @IOF
  1.  W !,$$CTR($$LOC,80)
  1.  W !,$$CTR("UDS 2012",80)
  1.  W !!,"All CAD patients 18+ w/Lipid Therapy (Table 6B)",!
  1.  D GENI
  1.  D PAUSE
  1.  W !!,"This report provides a list of all patients 18 years of age and older"
  1.  W !,"with an active diagnosis of Coronary Artery Disease (CAD) including "
  1.  W !,"myocardial infarction (MI),or have had cardiac surgery, and whose last LDL"
  1.  W !,"was greater than or equal to 130 who were prescribed a lipid-lowering "
  1.  W !,"therapy medication or have documented evidence of use by patient of lipid"
  1.  W !,"lowering medication during the report period, does not have an allergy or"
  1.  W !,"adverse reaction to lipid-lowering therapy medications, had at least two"
  1.  W !,"medical visits ever, and had a medical visit during the report period. "
  1.  W !,"Age is calculated as of December 31."
  1.  W !
  1.  Q
  1. CAD1L ;EP
  1.  S BUDP=0,BUDQUIT=0,BUDTOT=0
  1.  D CAD1H Q:BUDQUIT
  1.  I '$D(^XTMP("BUD2RP6B",BUDJ,BUDH,"CAD1")) W !!,"No patients to report.",! Q
  1.  D CAD1L1
  1.  I $Y>(IOSL-3) D CAD1H Q:BUDQUIT
  1.  W !!,"TOTAL CAD PATIENTS WITH LIPID-LOWERING THERAPY:  ",BUDTOT,!
  1.  Q
  1. CAD1L1 ;
  1.  I $Y>(IOSL-7) D CAD1H Q:BUDQUIT
  1.  S BUDAGE="" F  S BUDAGE=$O(^XTMP("BUD2RP6B",BUDJ,BUDH,"CAD1",BUDAGE)) Q:BUDAGE=""!(BUDQUIT)  D
  1.  .S BUDNAME="" F  S BUDNAME=$O(^XTMP("BUD2RP6B",BUDJ,BUDH,"CAD1",BUDAGE,BUDNAME)) Q:BUDNAME=""!(BUDQUIT)  D
  1.  ..S BUDCOM="" F  S BUDCOM=$O(^XTMP("BUD2RP6B",BUDJ,BUDH,"CAD1",BUDAGE,BUDNAME,BUDCOM)) Q:BUDCOM=""!(BUDQUIT)  D
  1.  ...S DFN=0 F  S DFN=$O(^XTMP("BUD2RP6B",BUDJ,BUDH,"CAD1",BUDAGE,BUDNAME,BUDCOM,DFN)) Q:DFN'=+DFN!(BUDQUIT)  D
  1.  ....I $Y>(IOSL-3) D CAD1H Q:BUDQUIT
  1.  ....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,!
  1.  ....S BUDTOT=BUDTOT+1
  1.  ....S BUDALL=^XTMP("BUD2RP6B",BUDJ,BUDH,"CAD1",BUDAGE,BUDNAME,BUDCOM,DFN)
  1.  ....W ?5,$P(BUDALL,U,1),?30,$P(BUDALL,U,2),!?5,"LDL: ",$P(BUDALL,U,3)," ",$$FMTE^XLFDT($P(BUDALL,U,4))
  1.  Q
  1. CAD1H ;
  1.  G:'BUDGPG CAD1H1
  1.  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
  1. CAD1H1 ;
  1.  W:$D(IOF) @IOF S BUDGPG=BUDGPG+1
  1.  W !,"***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****"
  1.  W !?3,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BUDGPG,!
  1.  W !,$$CTR("***  RPMS Uniform Data System (UDS)  ***",80)
  1.  W !,$$CTR("Patient List for Table 6B, Section I, ",80)
  1.  W !,$$CTR("Coronary Artery Disease: Lipid Therapy",80),!
  1.  W $$CTR($P(^DIC(4,BUDSITE,0),U),80),!
  1.  S X="Reporting Period: "_$$FMTE^XLFDT(BUDBD)_" to "_$$FMTE^XLFDT(BUDED) W $$CTR(X,80),!
  1.  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),!
  1.  W $TR($J("",80)," ","-")
  1.  I BUDP=0 D
  1.  .W !,"This report provides a list of all patients 18 years of age and older"
  1.  .W !,"with an active diagnosis of Coronary Artery Disease (CAD) including "
  1.  .W !,"myocardial infarction (MI),or have had cardiac surgery, and whose last LDL"
  1.  .W !,"was greater than or equal to 130 who were prescribed a lipid-lowering "
  1.  .W !,"therapy medication or have documented evidence of use by patient of lipid"
  1.  .W !,"lowering medication during the report period, does not have an allergy or"
  1.  .W !,"adverse reaction to lipid-lowering therapy medications, had at least two"
  1.  .W !,"medical visits ever, and had a medical visit during the report period. "
  1.  .W !,"Age is calculated as of December 31."
  1.  .W !
  1.  W !!,"PATIENT NAME",?34,"HRN",?41,"COMMUNITY",?70,"SEX",?75,"AGE"
  1.  W !?5,"Date of DX",?16,"DX or Svc CD",?30,"Medication"
  1.  W !,$TR($J("",80)," ","-"),!
  1.  S BUDP=1
  1.  Q
  1.  ;
  1.  ;----------
  1. CAD2 ;EP
  1.  W:$D(IOF) @IOF
  1.  W !,$$CTR($$LOC,80)
  1.  W !,$$CTR("UDS 2012",80)
  1.  W !!,"All CAD patients 18+ w/o Lipid Therapy (Table 6B)",!
  1.  D GENI
  1.  D PAUSE
  1.  W !!,"This report provides a list of all patients 18 years of age and older"
  1.  W !,"with an active diagnosis of Coronary Artery Disease (CAD) including "
  1.  W !,"myocardial infarction (MI) or have had cardiac surgery and whose last "
  1.  W !,"LDL was greater than or equal to 130 or last recorded LDL is greater than"
  1.  W !,"1yr from last visit in the report year who were not prescribed a "
  1.  W !,"lipid-lowering therapy medication or has no documented evidence of use by"
  1.  W !,"patient of lipid lowering medication during the report period or has an "
  1.  W !,"allergy or adverse reaction to lipid-lowering therapy medications, had at"
  1.  W !,"least two medical visits ever, and had a medical visit during the report"
  1.  W !,"period."
  1.  W !,"Age is calculated as of December 31."
  1.  W !
  1.  Q
  1. CAD2L ;EP
  1.  S BUDP=0,BUDQUIT=0,BUDTOT=0,BUD2ALG=0
  1.  D CAD2H Q:BUDQUIT
  1.  I '$D(^XTMP("BUD2RP6B",BUDJ,BUDH,"CAD2")),'$D(^XTMP("BUD2RP6B",BUDJ,BUDH,"ALG","CAD2")) W !!,"No patients to report.",! Q
  1.  D CAD2L1
  1.  I $Y>(IOSL-3) D CAD2H Q:BUDQUIT
  1.  W !!,"TOTAL CAD PATIENTS WITHOUT LIPID-LOWERING THERAPY:  ",BUDTOT,!
  1.  S BUDP=0,BUDQUIT=0,BUDTOT=0,BUD2ALG=1
  1.  D CAD2H Q:BUDQUIT
  1.  I '$D(^XTMP("BUD2RP6B",BUDJ,BUDH,"ALG","CAD2")) W !!,"TOTAL CAD PATIENTS WITH ALG OR ADV REACTION TO LIPID-LOWERING THERAPY: 0",! Q
  1.  D CAD2ALG
  1.  I $Y>(IOSL-3) D CAD2H Q:BUDQUIT
  1.  W !!,"TOTAL CAD PATIENTS WITH ALG OR ADV REACTION TO LIPID-LOWERING THERAPY:  ",BUDTOT,!
  1.  Q
  1. CAD2ALG ;
  1.  I $Y>(IOSL-7) D CAD2H Q:BUDQUIT
  1.  S BUDAGE="" F  S BUDAGE=$O(^XTMP("BUD2RP6B",BUDJ,BUDH,"ALG","CAD2",BUDAGE)) Q:BUDAGE=""!(BUDQUIT)  D
  1.  .S BUDNAME="" F  S BUDNAME=$O(^XTMP("BUD2RP6B",BUDJ,BUDH,"ALG","CAD2",BUDAGE,BUDNAME)) Q:BUDNAME=""!(BUDQUIT)  D
  1.  ..S BUDCOM="" F  S BUDCOM=$O(^XTMP("BUD2RP6B",BUDJ,BUDH,"ALG","CAD2",BUDAGE,BUDNAME,BUDCOM)) Q:BUDCOM=""!(BUDQUIT)  D
  1.  ...S DFN=0 F  S DFN=$O(^XTMP("BUD2RP6B",BUDJ,BUDH,"ALG","CAD2",BUDAGE,BUDNAME,BUDCOM,DFN)) Q:DFN'=+DFN!(BUDQUIT)  D
  1.  ....I $Y>(IOSL-3) D CAD2H Q:BUDQUIT
  1.  ....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,!
  1.  ....S BUDTOT=BUDTOT+1
  1.  ....S BUDALL=^XTMP("BUD2RP6B",BUDJ,BUDH,"ALG","CAD2",BUDAGE,BUDNAME,BUDCOM,DFN)
  1.  ....W ?5,$P(BUDALL,U,1),?30,$P(BUDALL,U,2),!?5,"LDL: ",$P(BUDALL,U,3)," ",$$FMTE^XLFDT($P(BUDALL,U,4))
  1.  Q
  1. CAD2L1 ;
  1.  I $Y>(IOSL-7) D CAD2H Q:BUDQUIT
  1.  S BUDAGE="" F  S BUDAGE=$O(^XTMP("BUD2RP6B",BUDJ,BUDH,"CAD2",BUDAGE)) Q:BUDAGE=""!(BUDQUIT)  D
  1.  .S BUDNAME="" F  S BUDNAME=$O(^XTMP("BUD2RP6B",BUDJ,BUDH,"CAD2",BUDAGE,BUDNAME)) Q:BUDNAME=""!(BUDQUIT)  D
  1.  ..S BUDCOM="" F  S BUDCOM=$O(^XTMP("BUD2RP6B",BUDJ,BUDH,"CAD2",BUDAGE,BUDNAME,BUDCOM)) Q:BUDCOM=""!(BUDQUIT)  D
  1.  ...S DFN=0 F  S DFN=$O(^XTMP("BUD2RP6B",BUDJ,BUDH,"CAD2",BUDAGE,BUDNAME,BUDCOM,DFN)) Q:DFN'=+DFN!(BUDQUIT)  D
  1.  ....I $Y>(IOSL-3) D CAD2H Q:BUDQUIT
  1.  ....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,!
  1.  ....S BUDTOT=BUDTOT+1
  1.  ....S BUDALL=^XTMP("BUD2RP6B",BUDJ,BUDH,"CAD2",BUDAGE,BUDNAME,BUDCOM,DFN)
  1.  ....W ?5,$P(BUDALL,U,1),?30,$P(BUDALL,U,2),!?5,"LDL: ",$P(BUDALL,U,3)," ",$$FMTE^XLFDT($P(BUDALL,U,4))
  1.  Q
  1. CAD2H ;
  1.  G:'BUDGPG CAD2H1
  1.  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
  1. CAD2H1 ;
  1.  W:$D(IOF) @IOF S BUDGPG=BUDGPG+1
  1.  W !,"***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****"
  1.  W !?3,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BUDGPG,!
  1.  W !,$$CTR("***  RPMS Uniform Data System (UDS)  ***",80)
  1.  W !,$$CTR("Patient List for Table 6B, Section I, ",80)
  1.  W !,$$CTR("Coronary Artery Disease: Lipid Therapy",80),!
  1.  W $$CTR($P(^DIC(4,BUDSITE,0),U),80),!
  1.  S X="Reporting Period: "_$$FMTE^XLFDT(BUDBD)_" to "_$$FMTE^XLFDT(BUDED) W $$CTR(X,80),!
  1.  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),!
  1.  W $TR($J("",80)," ","-")
  1.  I BUDP=0 D
  1.  .W !!,"This report provides a list of all patients 18 years of age and older"
  1.  W !,"with an active diagnosis of Coronary Artery Disease (CAD) including "
  1.  W !,"myocardial infarction (MI) or have had cardiac surgery and whose last "
  1.  W !,"LDL was greater than or equal to 130 or last recorded LDL is greater than"
  1.  W !,"1yr from last visit in the report year who were not prescribed a "
  1.  W !,"lipid-lowering therapy medication or has no documented evidence of use by"
  1.  W !,"patient of lipid lowering medication during the report period or has an "
  1.  W !,"allergy or adverse reaction to lipid-lowering therapy medications, had at"
  1.  W !,"least two medical visits ever, and had a medical visit during the report"
  1.  W !,"period."
  1.  W !,"Age is calculated as of December 31."
  1.  W !!,"PATIENT NAME",?34,"HRN",?41,"COMMUNITY",?70,"SEX",?75,"AGE"
  1.  W !?5,"Date of DX",?16,"DX or Svc CD",?30,"Medication",?72,"LDL"
  1.  W !,$TR($J("",80)," ","-"),!
  1.  I 'BUD2ALG W "CAD Patients with LDL >=130 w/o Lipid Lowering Medication",!
  1.  I BUD2ALG W "CAD Patients w/LDL =>130 and an ALG or ADV Reaction to Lipid Lowering Medication"
  1.  S BUDP=1
  1.  Q
  1.  ;