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

BUDERP6J.m

Go to the documentation of this file.
  1. BUDERP6J ;IHS/CMI/LAB - UDS REPORT T6B PROCESS;
  1. ;;12.0;IHS/RPMS UNIFORM DATA SYSTEM;;NOV 22, 2017;Build 75
  1. ;
  1. ;
  1. S(V) ;
  1. S BUDDECNT=BUDDECNT+1
  1. S ^TMP($J,"BUDDEL",BUDDECNT)=$G(V)
  1. Q
  1. ;------
  1. CADLIST1 ;EP
  1. D EOJ
  1. S BUDCAD1L=1
  1. D CAD1
  1. G EN1^BUDERP6B
  1. CAD2LIST ;EP
  1. D EOJ
  1. S BUDCAD2L=1
  1. D CAD2
  1. G EN1^BUDERP6B
  1. PAUSE ;
  1. K DIR S DIR(0)="E",DIR("A")="PRESS ENTER" KILL DA D ^DIR KILL DIR
  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. D IN6B^BUDEDU("CAD1")
  1. Q
  1. CAD1L ;EP
  1. S BUDP=0,BUDQUIT=0,BUDTOT=0
  1. D CAD1H Q:BUDQUIT
  1. I '$D(^XTMP("BUDERP6B",BUDJ,BUDH,"CAD1")) W:BUDROT="P" !!,"No patients to report." D:BUDROT="D" S() D:BUDROT="D" S("No patients to report.") Q
  1. D CAD1L1
  1. I BUDROT="P",$Y>(IOSL-3) D CAD1H Q:BUDQUIT
  1. I BUDROT="P" W !!,"TOTAL CAD PATIENTS WITH LIPID-LOWERING THERAPY: ",BUDTOT,!
  1. I BUDROT="D" D S(),S("TOTAL CAD PATIENTS WITH LIPID-LOWERING THERAPY: "_BUDTOT)
  1. Q
  1. CAD1L1 ;
  1. I BUDROT="P",$Y>(IOSL-7) D CAD1H Q:BUDQUIT
  1. S BUDAGE="" F S BUDAGE=$O(^XTMP("BUDERP6B",BUDJ,BUDH,"CAD1",BUDAGE)) Q:BUDAGE=""!(BUDQUIT) D
  1. .S BUDNAME="" F S BUDNAME=$O(^XTMP("BUDERP6B",BUDJ,BUDH,"CAD1",BUDAGE,BUDNAME)) Q:BUDNAME=""!(BUDQUIT) D
  1. ..S BUDCCOM="" F S BUDCCOM=$O(^XTMP("BUDERP6B",BUDJ,BUDH,"CAD1",BUDAGE,BUDNAME,BUDCCOM)) Q:BUDCCOM=""!(BUDQUIT) D
  1. ...S DFN=0 F S DFN=$O(^XTMP("BUDERP6B",BUDJ,BUDH,"CAD1",BUDAGE,BUDNAME,BUDCCOM,DFN)) Q:DFN'=+DFN!(BUDQUIT) D
  1. ....I BUDROT="P",$Y>(IOSL-3) D CAD1H Q:BUDQUIT
  1. ....I BUDROT="P" 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(BUDCCOM,1,25),?70,$P(^DPT(DFN,0),U,2),?75,BUDAGE,!
  1. ....S BUDTOT=BUDTOT+1
  1. ....S BUDALL=^XTMP("BUDERP6B",BUDJ,BUDH,"CAD1",BUDAGE,BUDNAME,BUDCCOM,DFN)
  1. ....I BUDROT="P" W ?5,$P(BUDALL,U,1),?30,$P(BUDALL,U,2),!?5,"LDL: ",$P(BUDALL,U,3)," ","MED: ",$P(BUDALL,U,4)
  1. ....I BUDROT="D" S X=$P(^DPT(DFN,0),U,1)_U_$S($$HRN^AUPNPAT(DFN,BUDSITE)]"":$$HRN^AUPNPAT(DFN,BUDSITE,2),1:$$HRN^AUPNPAT(DFN,DUZ(2),2))_U_BUDCCOM_U_$P(^DPT(DFN,0),U,2)_U_$$AGE^AUPNPAT(DFN,BUDCCAD) D
  1. .....S X=X_U_$P(BUDALL,U,1)_U_$P(BUDALL,U,2)_U_"LDL: "_$P(BUDALL,U,3)_U_$P(BUDALL,U,4) D S(X)
  1. Q
  1. CAD1HD ;
  1. D S(),S(),S()
  1. D S("***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****")
  1. D S($P(^VA(200,DUZ,0),U,2)_" "_$$FMTE^XLFDT(DT))
  1. D S("*** RPMS Uniform Data System (UDS) ***")
  1. D S("Patient List for Table 6B, Section I, With Lipid Therapy")
  1. D S($P(^DIC(4,BUDSITE,0),U))
  1. S X="Reporting Period: "_$$FMTE^XLFDT(BUDBD)_" to "_$$FMTE^XLFDT(BUDED) D S(X)
  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:"") D S(X)
  1. D HT6B^BUDEDU("CAD1")
  1. D S("PATIENT NAME^HRN^COMMUNITY^SEX^AGE^Date of DX^DX or Svc CD^LDL^Medication")
  1. Q
  1. CAD1H ;
  1. I BUDROT="D" D CAD1HD Q
  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, With Lipid Therapy ",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. .D HT6B^BUDEDU("CAD1")
  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. D IN6B^BUDEDU("CAD2")
  1. Q
  1. CAD2L ;EP
  1. S BUDP=0,BUDQUIT=0,BUDTOT=0,BUDX2ALG=0
  1. D CAD2H Q:BUDQUIT
  1. I '$D(^XTMP("BUDERP6B",BUDJ,BUDH,"CAD2")),'$D(^XTMP("BUDERP6B",BUDJ,BUDH,"ALG","CAD2")) W:BUDROT="P" !!,"No patients to report." D:BUDROT="D" S() D:BUDROT="D" S("No patients to report.") Q
  1. D CAD2L1
  1. I BUDROT="P",$Y>(IOSL-3) D CAD2H Q:BUDQUIT
  1. I BUDROT="P" W !!,"TOTAL CAD PATIENTS WITHOUT LIPID-LOWERING THERAPY: ",BUDTOT,!
  1. I BUDROT="D" D S(),S("TOTAL CAD PATIENTS WITHOUT LIPID-LOWERING THERAPY: "_BUDTOT)
  1. S BUDP=0,BUDQUIT=0,BUDTOT=0,BUDX2ALG=1
  1. ;D CAD2H Q:BUDQUIT
  1. ;I '$D(^XTMP("BUDERP6B",BUDJ,BUDH,"ALG","CAD2")) D Q
  1. ;.I BUDROT="P" W !!,"TOTAL CAD PATIENTS WITH ALG OR ADV REACTION TO LIPID-LOWERING THERAPY: 0",! Q
  1. ;.I BUDROT="D" D S(),S("TOTAL CAD PATIENTS WITH ALG OR ADV REACTION TO LIPID-LOWERING THERAPY: 0")
  1. ;D CAD2ALG
  1. ;I BUDROT="P",$Y>(IOSL-3) D CAD2H Q:BUDQUIT
  1. ;I BUDROT="P" W !!,"TOTAL CAD PATIENTS WITH ALG OR ADV REACTION TO LIPID-LOWERING THERAPY: ",BUDTOT,!
  1. ;I BUDROT="D" D S(),S("TOTAL CAD PATIENTS WITH ALG OR ADV REACTION TO LIPID-LOWERING THERAPY: "_BUDTOT)
  1. Q
  1. CAD2ALG ;
  1. I BUDROT="P",$Y>(IOSL-7) D CAD2H Q:BUDQUIT
  1. S BUDAGE="" F S BUDAGE=$O(^XTMP("BUDERP6B",BUDJ,BUDH,"ALG","CAD2",BUDAGE)) Q:BUDAGE=""!(BUDQUIT) D
  1. .S BUDNAME="" F S BUDNAME=$O(^XTMP("BUDERP6B",BUDJ,BUDH,"ALG","CAD2",BUDAGE,BUDNAME)) Q:BUDNAME=""!(BUDQUIT) D
  1. ..S BUDCCOM="" F S BUDCCOM=$O(^XTMP("BUDERP6B",BUDJ,BUDH,"ALG","CAD2",BUDAGE,BUDNAME,BUDCCOM)) Q:BUDCCOM=""!(BUDQUIT) D
  1. ...S DFN=0 F S DFN=$O(^XTMP("BUDERP6B",BUDJ,BUDH,"ALG","CAD2",BUDAGE,BUDNAME,BUDCCOM,DFN)) Q:DFN'=+DFN!(BUDQUIT) D
  1. ....I BUDROT="P",$Y>(IOSL-3) D CAD2H Q:BUDQUIT
  1. ....I BUDROT="P" 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(BUDCCOM,1,25),?70,$P(^DPT(DFN,0),U,2),?75,BUDAGE,!
  1. ....S BUDTOT=BUDTOT+1
  1. ....S BUDALL=^XTMP("BUDERP6B",BUDJ,BUDH,"ALG","CAD2",BUDAGE,BUDNAME,BUDCCOM,DFN)
  1. ....I BUDROT="P" W ?5,$P(BUDALL,U,1),?30,$P(BUDALL,U,2),!?5,"LDL: ",$P(BUDALL,U,3)," ",$$FMTE^XLFDT($P(BUDALL,U,4))
  1. ....I BUDROT="D" S X=$P(^DPT(DFN,0),U,1)_U_$S($$HRN^AUPNPAT(DFN,BUDSITE)]"":$$HRN^AUPNPAT(DFN,BUDSITE,2),1:$$HRN^AUPNPAT(DFN,DUZ(2),2))_U_BUDCCOM_U_$P(^DPT(DFN,0),U,2)_U_$$AGE^AUPNPAT(DFN,BUDCCAD)_U_X D
  1. .....S X=X_U_$P(BUDALL,U,1)_U_$P(BUDALL,U,2)_U_"LDL: "_$P(BUDALL,U,3)_U_$P(BUDALL,U,4) D S(X)
  1. Q
  1. CAD2L1 ;
  1. I BUDROT="P",$Y>(IOSL-7) D CAD2H Q:BUDQUIT
  1. S BUDAGE="" F S BUDAGE=$O(^XTMP("BUDERP6B",BUDJ,BUDH,"CAD2",BUDAGE)) Q:BUDAGE=""!(BUDQUIT) D
  1. .S BUDNAME="" F S BUDNAME=$O(^XTMP("BUDERP6B",BUDJ,BUDH,"CAD2",BUDAGE,BUDNAME)) Q:BUDNAME=""!(BUDQUIT) D
  1. ..S BUDCCOM="" F S BUDCCOM=$O(^XTMP("BUDERP6B",BUDJ,BUDH,"CAD2",BUDAGE,BUDNAME,BUDCCOM)) Q:BUDCCOM=""!(BUDQUIT) D
  1. ...S DFN=0 F S DFN=$O(^XTMP("BUDERP6B",BUDJ,BUDH,"CAD2",BUDAGE,BUDNAME,BUDCCOM,DFN)) Q:DFN'=+DFN!(BUDQUIT) D
  1. ....I BUDROT="P",$Y>(IOSL-3) D CAD2H Q:BUDQUIT
  1. ....I BUDROT="P" 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(BUDCCOM,1,25),?70,$P(^DPT(DFN,0),U,2),?75,BUDAGE,!
  1. ....S BUDTOT=BUDTOT+1
  1. ....S BUDALL=^XTMP("BUDERP6B",BUDJ,BUDH,"CAD2",BUDAGE,BUDNAME,BUDCCOM,DFN)
  1. ....I BUDROT="P" W ?5,$P(BUDALL,U,1),?30,$P(BUDALL,U,2),!?5,"LDL: ",$P(BUDALL,U,3)," ","MED: ",$P(BUDALL,U,4)
  1. ....I BUDROT="D" I BUDROT="D" S X=$P(^DPT(DFN,0),U,1)_U_$S($$HRN^AUPNPAT(DFN,BUDSITE)]"":$$HRN^AUPNPAT(DFN,BUDSITE,2),1:$$HRN^AUPNPAT(DFN,DUZ(2),2))_U_BUDCCOM_U_$P(^DPT(DFN,0),U,2)_U_$$AGE^AUPNPAT(DFN,BUDCCAD) D
  1. .....S X=X_U_$P(BUDALL,U,1)_U_$P(BUDALL,U,2)_U_"LDL: "_$P(BUDALL,U,3)_U_$P(BUDALL,U,4) D S(X)
  1. Q
  1. CAD2HD ;
  1. D S(),S(),S()
  1. D S("***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****")
  1. D S($P(^VA(200,DUZ,0),U,2)_" "_$$DATE^BUDEUTL1(DT))
  1. D S("*** RPMS Uniform Data System (UDS) ***")
  1. D S("Patient List for Table 6B, Section I, Without Lipid Therapy")
  1. ;D S("Coronary Artery Disease: Lipid Therapy")
  1. D S($P(^DIC(4,BUDSITE,0),U))
  1. S X="Reporting Period: "_$$FMTE^XLFDT(BUDBD)_" to "_$$FMTE^XLFDT(BUDED) D S(X)
  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:"") D S(X)
  1. D HT6B^BUDEDU("CAD2")
  1. D S("PATIENT NAME^HRN^COMMUNITY^SEX^AGE^Date of DX^DX or Svc CD^LDL^Medication")
  1. I BUDROT="P" W "CAD Patients w/o Lipid Lowering Medication",!
  1. ;I BUDROT="P",BUDX2ALG W "CAD Patients w/LDL =>130 and an ALG or ADV Reaction to Lipid Lowering Medication"
  1. ;I BUDROT="D" D S("CAD Patients with w/o Lipid Lowering Medication")
  1. ;I BUDROT="D",BUDX2ALG D S("CAD Patients w/LDL =>130 and an ALG or ADV Reaction to Lipid Lowering Medication")
  1. Q
  1. CAD2H ;
  1. I BUDROT="D" D CAD2HD Q
  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, Without Lipid Therapy",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. .D HT6B^BUDEDU("CAD2")
  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. ;I 'BUDX2ALG W "CAD Patients with LDL >=130 w/o Lipid Lowering Medication",!
  1. ;I BUDX2ALG W "CAD Patients w/LDL =>130 and an ALG or ADV Reaction to Lipid Lowering Medication"
  1. S BUDP=1
  1. Q
  1. ;