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

BUD2RP6K.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ;
  1. IVDLIST1 ;EP
  1.  D EOJ
  1.  S BUDIVD1L=1
  1.  D IVD1
  1.  G EN1^BUD2RP6B
  1. IVDLIST2 ;EP
  1.  D EOJ
  1.  S BUDIVD2L=1
  1.  D IVD2
  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. IVD1 ;EP
  1.  W:$D(IOF) @IOF
  1.  W !,$$CTR($$LOC,80)
  1.  W !,$$CTR("UDS 2012",80)
  1.  W !!,"All IVD patients 18+ w/Aspirin or Antithrombotic Therapy (Table 6B)",!
  1.  D GENI
  1.  D PAUSE
  1.  W !!,"This report provides a list of patients 18 years of age and older who, "
  1.  W !,"in the current or prior report year, were diagnosed with Ischemic Vascular"
  1.  W !,"Disease (IVD) including acute myocardial infarction (AMI), or discharged"
  1.  W !,"alive after cardiovascular surgery (coronary artery bypass graft (CABG)"
  1.  W !,"or percutaneous transluminal coronary angioplasty (PTCA)) and were "
  1.  W !,"prescribed or dispensed aspirin or another anti-thrombotic medication"
  1.  W !,"or have documented evidence of use by patient of aspirin or another "
  1.  W !,"anti-thrombotic medication during the report period, and had a medical"
  1.  W !,"visit during the report period."
  1.  W !,"Age is calculated as of December 31."
  1.  W !
  1.  Q
  1. IVD1L ;EP
  1.  S BUDP=0,BUDQUIT=0,BUDTOT=0
  1.  D IVD1H Q:BUDQUIT
  1.  I '$D(^XTMP("BUD2RP6B",BUDJ,BUDH,"IVD1")) W !!,"No patients to report.",! Q
  1.  D IVD1L1
  1.  I $Y>(IOSL-3) D IVD1H Q:BUDQUIT
  1.  W !!,"TOTAL IVD PATIENTS WITH ASPIRIN OR ANTITHROMBOTIC THERAPY:  ",BUDTOT,!
  1.  Q
  1. IVD1L1 ;
  1.  I $Y>(IOSL-7) D IVD1H Q:BUDQUIT
  1.  S BUDAGE="" F  S BUDAGE=$O(^XTMP("BUD2RP6B",BUDJ,BUDH,"IVD1",BUDAGE)) Q:BUDAGE=""!(BUDQUIT)  D
  1.  .S BUDNAME="" F  S BUDNAME=$O(^XTMP("BUD2RP6B",BUDJ,BUDH,"IVD1",BUDAGE,BUDNAME)) Q:BUDNAME=""!(BUDQUIT)  D
  1.  ..S BUDCOM="" F  S BUDCOM=$O(^XTMP("BUD2RP6B",BUDJ,BUDH,"IVD1",BUDAGE,BUDNAME,BUDCOM)) Q:BUDCOM=""!(BUDQUIT)  D
  1.  ...S DFN=0 F  S DFN=$O(^XTMP("BUD2RP6B",BUDJ,BUDH,"IVD1",BUDAGE,BUDNAME,BUDCOM,DFN)) Q:DFN'=+DFN!(BUDQUIT)  D
  1.  ....I $Y>(IOSL-3) D IVD1H 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,"IVD1",BUDAGE,BUDNAME,BUDCOM,DFN)
  1.  ....W ?5,$P(BUDALL,U,1),?30,$P(BUDALL,U,2)
  1.  Q
  1. IVD1H ;
  1.  G:'BUDGPG IVD1H1
  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. IVD1H1 ;
  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 J, ",80),!,$$CTR("Ischemic Vascular Disease: Aspirin or Antithrombotic 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 patients 18 years of age and older who, "
  1.  .W !,"in the current or prior report year, were diagnosed with Ischemic Vascular"
  1.  .W !,"Disease (IVD) including acute myocardial infarction (AMI), or discharged"
  1.  .W !,"alive after cardiovascular surgery (coronary artery bypass graft (CABG)"
  1.  .W !,"or percutaneous transluminal coronary angioplasty (PTCA)) and were "
  1.  .W !,"prescribed or dispensed aspirin or another anti-thrombotic medication"
  1.  .W !,"or have documented evidence of use by patient of aspirin or another "
  1.  .W !,"anti-thrombotic medication during the report period, and had a medical"
  1.  .W !,"visit during the report 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"
  1.  W !,$TR($J("",80)," ","-"),!
  1.  S BUDP=1
  1.  Q
  1.  ;
  1.  ;----------
  1. IVD2 ;EP
  1.  W:$D(IOF) @IOF
  1.  W !,$$CTR($$LOC,80)
  1.  W !,$$CTR("UDS 2012",80)
  1.  W !!,"All IVD patients 18+ w/o Aspirin or Antithrombotic Therapy (Table 6B)",!
  1.  D GENI
  1.  D PAUSE
  1.  W !!,"This report provides a list of patients 18 years of age and older who, "
  1.  W !,"in the current or prior report year, were diagnosed with Ischemic Vascular"
  1.  W !,"Disease (IVD) including acute myocardial infarction (AMI), or discharged"
  1.  W !,"alive after cardiovascular surgery (coronary artery bypass graft (CABG)"
  1.  W !,"or percutaneous transluminal coronary angioplasty (PTCA)) and were not"
  1.  W !,"prescribed or dispensed aspirin or another anti-thrombotic medication"
  1.  W !,"or have documented evidence of use by patient of aspirin or another "
  1.  W !,"anti-thrombotic medication during the report period, and had a medical"
  1.  W !,"visit during the report period."
  1.  W !,"Age is calculated as of December 31."
  1.  W !
  1.  Q
  1. IVD2L ;EP
  1.  S BUDP=0,BUDQUIT=0,BUDTOT=0
  1.  D IVD2H Q:BUDQUIT
  1.  I '$D(^XTMP("BUD2RP6B",BUDJ,BUDH,"IVD2")) W !!,"No patients to report.",! Q
  1.  D IVD2L1
  1.  I $Y>(IOSL-3) D IVD2H Q:BUDQUIT
  1.  W !!,"TOTAL IVD PATIENTS WITHOUT ASPIRIN OR ANTITHROMBOTIC THERAPY:  ",BUDTOT,!
  1.  Q
  1. IVD2L1 ;
  1.  I $Y>(IOSL-7) D IVD2H Q:BUDQUIT
  1.  S BUDAGE="" F  S BUDAGE=$O(^XTMP("BUD2RP6B",BUDJ,BUDH,"IVD2",BUDAGE)) Q:BUDAGE=""!(BUDQUIT)  D
  1.  .S BUDNAME="" F  S BUDNAME=$O(^XTMP("BUD2RP6B",BUDJ,BUDH,"IVD2",BUDAGE,BUDNAME)) Q:BUDNAME=""!(BUDQUIT)  D
  1.  ..S BUDCOM="" F  S BUDCOM=$O(^XTMP("BUD2RP6B",BUDJ,BUDH,"IVD2",BUDAGE,BUDNAME,BUDCOM)) Q:BUDCOM=""!(BUDQUIT)  D
  1.  ...S DFN=0 F  S DFN=$O(^XTMP("BUD2RP6B",BUDJ,BUDH,"IVD2",BUDAGE,BUDNAME,BUDCOM,DFN)) Q:DFN'=+DFN!(BUDQUIT)  D
  1.  ....I $Y>(IOSL-3) D IVD2H 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,"IVD2",BUDAGE,BUDNAME,BUDCOM,DFN)
  1.  ....W ?5,$P(BUDALL,U,1),?30,$P(BUDALL,U,2)
  1.  Q
  1. IVD2H ;
  1.  G:'BUDGPG IVD2H1
  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. IVD2H1 ;
  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 J, ",80),!,$$CTR("Ischemic Vascular Disease: Aspirin or Antithrombotic 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 patients 18 years of age and older who, "
  1.  .W !,"in the current or prior report year, were diagnosed with Ischemic Vascular"
  1.  .W !,"Disease (IVD) including acute myocardial infarction (AMI), or discharged"
  1.  .W !,"alive after cardiovascular surgery (coronary artery bypass graft (CABG)"
  1.  .W !,"or percutaneous transluminal coronary angioplasty (PTCA)) and were not"
  1.  .W !,"prescribed or dispensed aspirin or another anti-thrombotic medication"
  1.  .W !,"or have documented evidence of use by patient of aspirin or another "
  1.  .W !,"anti-thrombotic medication during the report period, and had a medical"
  1.  .W !,"visit during the report 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"
  1.  W !,$TR($J("",80)," ","-"),!
  1.  S BUDP=1
  1.  Q
  1.  ;