BDMDE1E ; IHS/CMI/LAB - IHS Diabetes Audit 2017 ;
;;2.0;DIABETES MANAGEMENT SYSTEM;**10,11**;JUN 14, 2007;Build 30
;
BEGIN ;EP - called from option
D TAXCHK^BDMDE19
W:$D(IOF) @IOF
REGASK ;
W !,$$CTR("ASSESSMENT OF DIABETES CARE, 2017")
W !,$$CTR("PCC DIABETES E-AUDIT")
W !!,"This option is used to run the 2017 Electronic Diabetes Audit for a"
W !,"predefined set of patients. The patients selected are 'Active Diabetic"
W !,"Patients' as defined by the Clinical Reporting system (GPRA). In "
W !,"addition you can optionally only include the patient if they are an"
W !,"active member of the Diabetes register."
W !,"The definition used to select patients is the following:"
W !?3,"1. Must reside in a community specified in the official GPRA "
W !?6,"community taxonomy."
W !?3,"2. Must be alive on the audit date."
W !?3,"3. Indian/Alaska Natives Only - based on Classification of 01."
W !?3,"4. Must have 2 visits to medical clinics in the 3 years prior to the"
W !?6,"audit date. At least one visit must include: 01 General,"
W !?6,"06 Diabetic, 10 GYN, 12 Immunization, 13 Internal Med,"
W !?6,"20 Pediatrics, 24 Well Child, 28 Family Practice, 57 EPSDT,"
W !?6,"70 Women's Health, 80 Urgent, 89 Evening."
W !?3,"5. The patient must have been diagnosed with diabetes at"
W !?6,"least 1 year prior to the audit date."
W !?3,"6. The patient must have had at least 2 visits during the"
W !?6,"year prior to the Audit date, AND 2 DM-related visits ever."
W !
K DIR S DIR(0)="E",DIR("A")="Please press enter to continue" D ^DIR K DIR
W !!
S BDMDMRG=""
S DIC="^ACM(41.1,",DIC(0)="AEMQ",DIC("A")="Enter the Official Diabetes Register: " D ^DIC K DIC
I Y=-1 S BDMDMRG="" W !,"NO Register Selected!!! The CMS register will not be used in retrieving",!,"any data."
S BDMDMRG=$S(Y=-1:"",1:+Y)
S BDMJOB=$J,BDMBTH=$H
SDPI ;
S BDMSDPI="",BDMSDPG=""
;
GETDATES ;
S BDMSTP=0 D TIME I BDMSTP D XIT1,XIT Q
COMM ;get gpra community taxonomy
W !!,"Specify the community taxonomy to determine which patients will be",!,"included in the report. You should have created this taxonomy using QMAN.",!
K BDMTAX
S BDMTAXI=""
D ^XBFMK
S DIC("S")="I $P(^(0),U,15)=9999999.05",DIC="^ATXAX(",DIC(0)="AEMQ",DIC("A")="Enter the Name of the Community Taxonomy: "
S B=$P($G(^BGPSITE(DUZ(2),0)),U,5) I B S DIC("B")=$P(^ATXAX(B,0),U)
D ^DIC K DIC
I Y=-1 Q
S BDMTAXI=+Y
COM1 S X=0
F S X=$O(^ATXAX(BDMTAXI,21,X)) Q:'X D
.S BDMTAX($P(^ATXAX(BDMTAXI,21,X,0),U))=""
.Q
I '$D(BDMTAX) W !!,"There are no communities in that taxonomy." G COMM
BEN ;
S BDMBEN=1
ACT ;
S BDMACTI=0 I BDMDMRG="" G IF
S DIR(0)="Y",DIR("A")="Include only ACTIVE members of the "_$P(^ACM(41.1,BDMDMRG,0),U)_" register",DIR("B")="N" KILL DA
D ^DIR KILL DIR
I $D(DIRUT) G COMM
S BDMACTI=Y
PREG ;
S BDMPREG="",BDMSTP=0
S DIR(0)="S^I:Include Pregnant Patients;E:Exclude Pregnant Patients",DIR("A")="Select whether to include or exclude pregnant patients in the audit"
S DIR("B")="E" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G ACT
S BDMPREG=Y
IF ;PEP - called from BDM indivdual or epi
S BDMSTP=0
K DIR
S DIR(0)="S^1:Print Individual Reports;2:Create AUDIT EXPORT file;3:Cumulative Audit Only;4:Both Individual and Cumulative Audits;5:SDPI Key Measures Report (2015 Version);6:SDPI Key Measures Report (2017 Version)"
S DIR("A")="Enter Print option",DIR("B")="1" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G GETDATES
S BDMPREP=Y
I BDMPREP=2 D FLAT Q:BDMSTP
IF2 ;
I BDMPREP=1!(BDMPREP=4) S BDMPPN="" D G:BDMSTP IF
.K DIR S DIR(0)="Y",DIR("A")="Do you wish to print the Patient's Name on the audit sheet",DIR("B")="N" KILL DA D ^DIR KILL DIR
.I $D(DIRUT) S BDMSTP=1
.S BDMPPN=Y
ZIS ;
D DEMOCHK^BDMUTL(.BDMDEMO) I BDMDEMO=-1 G IF
I BDMPREP'=2 S XBRP="^BDMDE1P",XBRC="EAUDIT^BDMDE10",XBRX="XIT^BDMDE1",XBNS="BDM"
I BDMPREP=2 S XBRP="",XBRC="EAUDIT^BDMDE10",XBRX="XIT^BDMDE1",XBNS="BDM"
D ^XBDBQUE
D XIT
Q
P ;
S BDMSTP=0 K ^XTMP("BDMDM17",BDMJOB,BDMBTH),^TMP($J,"PATS")
P1 ;
K DIC S DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC K DIC
I Y=-1,'$D(^XTMP("BDMDM17",BDMJOB,BDMBTH,"PATS")) W !,"No patients selected" S BDMSTP=1 Q
I Y=-1 Q
S ^XTMP("BDMDM17",BDMJOB,BDMBTH,"PATS",+Y)=""
G P1
Q
S ; Get patient name or cohort
K ^XTMP("BDMDM17",BDMJOB,BDMBTH),^TMP($J,"PATS") S BDMSTP=0
K DIC S DIC("A")="Enter Search Template Name: ",DIC("S")="I $P(^(0),U,4)=2!($P(^(0),U,4)=9000001)"
S DIC="^DIBT(",DIC(0)="AEMQ" D ^DIC K DIC
I Y=-1 S BDMSTP=1 W !,"No template selected." Q
S BDMCNT=0 F BDMPD=0:0 S BDMPD=$O(^DIBT(+Y,1,BDMPD)) Q:'BDMPD S BDMCNT=BDMCNT+1,^TMP($J,"PATS",BDMCNT,BDMPD)=""
W !!,"There are ",BDMCNT," patients in the ",$P(^DIBT(+Y,0),U)," template/cohort.",!
D PCP
Q:BDMSTP
D CC
Q:BDMSTP
D RAND
Q
PCP ;
S BDMSTP=0
W !,"You have selected a register or template/cohort of patients. ",!,"You can run the audit just for the subset of patients in the cohort or register",!,"who live in a particular community or have a particular primary care provider.",!
S DIR(0)="Y",DIR("A")="Limit the audit to a particular primary care provider ",DIR("B")="N" KILL DA D ^DIR KILL DIR
I $D(DIRUT) S BDMSTP=1 Q
Q:'Y
K DIC S DIC=$S($P(^DD(9000001,.14,0),U,2)[200:200,1:6),DIC(0)="AEMQ" D ^DIC K DIC
I Y=-1 G PCP
S BDMPDP=+Y
S X=0 F S X=$O(^TMP($J,"PATS",X)) Q:X'=+X S P=$O(^TMP($J,"PATS",X,0)) I $P(^AUPNPAT(P,0),U,14)'=BDMPDP K ^TMP($J,"PATS",X,P)
S (X,C)=0 F S X=$O(^TMP($J,"PATS",X)) Q:X'=+X S C=C+1
W !!,C," patients will be used in the audit.",!
Q
CC ;current community
S BDMSTP=0
W ! K DIR S DIR(0)="Y",DIR("A")="Limit the patients who live in a particular community ",DIR("B")="N" KILL DA D ^DIR K DIR
I $D(DIRUT) S BDMSTP=1 Q
Q:'Y
K DIC S DIC="^AUTTCOM(",DIC(0)="AEMQ" D ^DIC K DIC
I Y=-1 G CC
S BDMCOM=$P(^AUTTCOM(+Y,0),U)
S X=0 F S X=$O(^TMP($J,"PATS",X)) Q:X'=+X S P=$O(^TMP($J,"PATS",X,0)) I $P($G(^AUPNPAT(P,11)),U,18)'=BDMCOM K ^TMP($J,"PATS",X,P)
S (X,C)=0 F S X=$O(^TMP($J,"PATS",X)) Q:X'=+X S C=C+1
W !!,C," patients will be used in the audit.",!
Q
C ;get register, status, random or not
K ^XTMP("BDMDM17",BDMJOB,BDMBTH),^TMP($J,"PATS")
S BDMCMS="",BDMSTP=0
S DIC="^ACM(41.1,",DIC(0)="AEMQ",DIC("A")="Enter the Name of the Register: " D ^DIC
I Y=-1 W !,"No register selected." S BDMSTP=1 Q
S BDMCMS=+Y
;get status
S BDMSTAT=""
S DIR(0)="Y",DIR("A")="Do you want to select register patients with a particular status",DIR("B")="Y" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G C
I Y=0 G C1
;which status
S DIR(0)="9002241,1",DIR("A")="Which status",DIR("B")="A" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G C
S BDMSTAT=Y
C1 ;
;gather up patients from register in ^XTMP
K ^TMP($J,"PATS") S BDMCNT=0,X=0 F S X=$O(^ACM(41,"B",BDMCMS,X)) Q:X'=+X D
.I BDMSTAT]"",$P($G(^ACM(41,X,"DT")),U,1)=BDMSTAT S BDMCNT=BDMCNT+1,^TMP($J,"PATS",BDMCNT,$P(^ACM(41,X,0),U,2))="" Q
.I BDMSTAT="" S BDMCNT=BDMCNT+1,^TMP($J,"PATS",BDMCNT,$P(^ACM(41,X,0),U,2))=""
I '$D(^TMP($J,"PATS")) W !,"No patients with that status in that register!" S BDMSTP=1 G C
W !!,"There are ",BDMCNT," patients in the ",$P(^ACM(41.1,BDMCMS,0),U)," register with a status of ",BDMSTAT,".",!!
D PCP
Q:BDMSTP
D CC
Q:BDMSTP
D RAND
Q
RAND ;random sample or not
S (X,BDMCNT)=0 F S X=$O(^TMP($J,"PATS",X)) Q:X'=+X S BDMCNT=BDMCNT+1
W !!,"There are ",BDMCNT," patients selected so far to be used in the audit.",!
S DIR(0)="S^A:ALL Patients selected so far;R:RANDOM Sample of the patients selected so far",DIR("A")="Do you want to select",DIR("B")="A" KILL DA D ^DIR KILL DIR
G:$D(DIRUT) C
I Y="A" S C=0 F S C=$O(^TMP($J,"PATS",C)) Q:C'=+C S X=$O(^TMP($J,"PATS",C,0)),^XTMP("BDMDM17",BDMJOB,BDMBTH,"PATS",X)=""
I Y="A" K ^TMP($J,"PATS") Q
S DIR(0)="N^2:"_BDMCNT_":0",DIR("A")="How many patients do you want in your random sample" KILL DA D ^DIR KILL DIR
;get random sample AND set xtmp
I $D(DIRUT) S BDMSTP=1 Q
S C=0 F N=1:1:BDMCNT Q:C=Y S I=$R(BDMCNT) I I,$D(^TMP($J,"PATS",I)) S X=$O(^TMP($J,"PATS",I,0)),^XTMP("BDMDM17",BDMJOB,BDMBTH,"PATS",X)="",C=C+1 K ^TMP($J,"PATS",I,X)
K ^TMP($J,"PATS")
Q
TIME ;PEP - called from BDM Get fiscal year or time frame
S BDMSTP=0
S (BDMRBD,BDMRED,BDMADAT)=""
W !!,"Enter the date of the audit. This date will be considered the ending",!,"date of the audit period. For most data items all data for the period one",!,"year prior to this date will be reviewed.",!
S DIR(0)="D^::EPX",DIR("A")="Enter the Audit Date" KILL DA D ^DIR KILL DIR
I $D(DIRUT) S BDMSTP=1 Q
S BDMADAT=Y
S BDMRED=$$FMTE^XLFDT(BDMADAT)
S BDMBDAT=($E(BDMADAT,1,3)-1)_$E(BDMADAT,4,7),BDMBDAT=$$FMADD^XLFDT(BDMBDAT,1)
S BDMRBD=$$FMTE^XLFDT(BDMBDAT)
Q
;
XIT1 ;
K ^BDMDATA($J),^BDMDATA("BDMEPI",$J)
K ^XTMP("BDMDM17",BDMJOB,BDMBTH),BDMJOB,BDMBTH
XIT ;
I '$D(BDMGUI) D EN^XBVK("BDM"),EN^XBVK("AUPN")
D ^XBFMK,KILL^AUPNPAT
K ^TMP($J,"PATS")
Q
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;----------
FLAT ;
D FLAT^BDMDE1
Q
WRITEF ;EP write flat file
D WRITEF^BDMDE1
Q
BDMG(BDMJOB,BDMBTH,BDMDMRG,BDMADAT,BDMTYPE,BDMSTMP,BDMPDP,BDMCOM,BDMRAND,BDMRCNT,BDMCMS,BDMSTAT,BDMPREP,BDMFILE,BDMDSP,BDMGIEN,BDMSDPI,BDMSDPG,BDMDUZ2,BDMDEMO) ;PEP - gui call
F X="BDMJOB","BDMBTH","BDMDMRG","BDMADAT","BDMTYPE","BDMSTMP","BDMPDP","BDMCOM","BDMRAND","BDMRCNT","BDMCMS","BDMSTAT","BDMPREP","BDMFILE","BDMDSP","BDMDUZ2","BDMDEMO" S @X=$G(@X)
I $G(BDMJOB)="" S BDMIEN=-1 Q
I $G(BDMBTH)="" S BDMIEN=-1 Q
I $G(BDMADAT)="" S BDMIEN=-1 Q
;I $G(BDMTYPE)="" S BDMIEN=-1 Q
I $G(BDMPREP)="" S BDMIEN=-1 Q
S BDMDEMO=$E($G(BDMDEMO))
;using variable BDMRAND as taxonomy
S BDMGUI=1
S BDMTAXI=BDMRAND
S BDMACTI=0
S BDMBEN=1
I BDMSTAT="1" D
. S BDMACTI=1
S X=0
F S X=$O(^ATXAX(BDMTAXI,21,X)) Q:'X D
.S BDMTAX($P(^ATXAX(BDMTAXI,21,X,0),U))=""
.Q
I BDMPREP=2,BDMFILE="" S BDMIEN=-1 Q
S BDMRED=$$FMTE^XLFDT(BDMADAT)
S BDMBDAT=$$FMADD^XLFDT(BDMADAT,-365)
S BDMRBD=$$FMTE^XLFDT(BDMBDAT)
I $G(BDMDSP) D GUIEP Q
;create entry in fileman file to hold output
N BDMOPT ;maw
S BDMOPT="Run the 2017 Audit w/predefined set of Pts" ;maw
D NOW^%DTC
S BDMNOW=$G(%)
K DD,D0,DIC
S X=DUZ_"."_BDMBTH
S DIC("DR")=".02////"_DUZ_";.03////"_BDMNOW_";.05////"_$G(BDMPREP)_";.06///"_$G(BDMOPT)_";.07////R"
S DIC="^BDMGUI(",DIC(0)="L",DIADD=1,DLAYGO=9003201.4
D FILE^DICN
K DIADD,DLAYGO,DIC,DA
I Y=-1 S BDMIEN=-1 Q
S BDMIEN=+Y
S BDMGIEN=BDMIEN ;cmi/maw added
D ^XBFMK
K ZTSAVE S ZTSAVE("*")=""
;D GUIEP for interactive testing
S ZTIO="",ZTDTH=$$NOW^XLFDT,ZTRTN="GUIEP^BDMDE1E",ZTDESC="GUI DM AUDIT" D ^%ZTLOAD
D XIT
Q
GUIEP ;EP - called from taskman
D EAUDIT^BDMDE10
I BDMPREP=2,'$G(BDMDSP) D ENDLOG Q
K ^TMP($J,"BDMDM17")
S IOM=80 ;cmi/maw added
D GUIR^XBLM("^BDMDE1P","^TMP($J,""BDMDM17"",")
Q:$G(BDMDSP) ;quit if to screen
S X=0,C=0 F S X=$O(^TMP($J,"BDMDM17",X)) Q:X'=+X D
.S BDMDATA=^TMP($J,"BDMDM17",X)
.;I BDMDATA="ZZZZZZZ" ;S BDMDATA=$C(12)
.S ^BDMGUI(BDMIEN,11,X,0)=BDMDATA,C=C+1
S ^BDMGUI(BDMIEN,11,0)="^^"_C_"^"_C_"^"_DT_"^"
S DA=BDMIEN,DIK="^BDMGUI(" D IX1^DIK
D ENDLOG
S ZTREQ="@"
Q
;
ENDLOG ;-- write the end of the log
D NOW^%DTC
S BDMNOW=$G(%)
S DIE="^BDMGUI(",DA=BDMIEN,DR=".04////"_BDMNOW_";.07////C"
D ^DIE
K DIE,DR,DA
Q
;
TEST ;
S BDMJOB=7,BDMBTH="59812,48383"
F X=1:1:10 S ^XTMP("BDMDM17",BDMJOB,BDMBTH,"PATS",X)=""
D BDMG^BDMDE1(BDMJOB,BDMBTH,1,DT,"P","","","","","","","",4,"TESTEPI",.BDMIEN)
Q
BDMDE1E ; IHS/CMI/LAB - IHS Diabetes Audit 2017 ;
+1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**10,11**;JUN 14, 2007;Build 30
+2 ;
BEGIN ;EP - called from option
+1 DO TAXCHK^BDMDE19
+2 IF $DATA(IOF)
WRITE @IOF
REGASK ;
+1 WRITE !,$$CTR("ASSESSMENT OF DIABETES CARE, 2017")
+2 WRITE !,$$CTR("PCC DIABETES E-AUDIT")
+3 WRITE !!,"This option is used to run the 2017 Electronic Diabetes Audit for a"
+4 WRITE !,"predefined set of patients. The patients selected are 'Active Diabetic"
+5 WRITE !,"Patients' as defined by the Clinical Reporting system (GPRA). In "
+6 WRITE !,"addition you can optionally only include the patient if they are an"
+7 WRITE !,"active member of the Diabetes register."
+8 WRITE !,"The definition used to select patients is the following:"
+9 WRITE !?3,"1. Must reside in a community specified in the official GPRA "
+10 WRITE !?6,"community taxonomy."
+11 WRITE !?3,"2. Must be alive on the audit date."
+12 WRITE !?3,"3. Indian/Alaska Natives Only - based on Classification of 01."
+13 WRITE !?3,"4. Must have 2 visits to medical clinics in the 3 years prior to the"
+14 WRITE !?6,"audit date. At least one visit must include: 01 General,"
+15 WRITE !?6,"06 Diabetic, 10 GYN, 12 Immunization, 13 Internal Med,"
+16 WRITE !?6,"20 Pediatrics, 24 Well Child, 28 Family Practice, 57 EPSDT,"
+17 WRITE !?6,"70 Women's Health, 80 Urgent, 89 Evening."
+18 WRITE !?3,"5. The patient must have been diagnosed with diabetes at"
+19 WRITE !?6,"least 1 year prior to the audit date."
+20 WRITE !?3,"6. The patient must have had at least 2 visits during the"
+21 WRITE !?6,"year prior to the Audit date, AND 2 DM-related visits ever."
+22 WRITE !
+23 KILL DIR
SET DIR(0)="E"
SET DIR("A")="Please press enter to continue"
DO ^DIR
KILL DIR
+24 WRITE !!
+25 SET BDMDMRG=""
+26 SET DIC="^ACM(41.1,"
SET DIC(0)="AEMQ"
SET DIC("A")="Enter the Official Diabetes Register: "
DO ^DIC
KILL DIC
+27 IF Y=-1
SET BDMDMRG=""
WRITE !,"NO Register Selected!!! The CMS register will not be used in retrieving",!,"any data."
+28 SET BDMDMRG=$SELECT(Y=-1:"",1:+Y)
+29 SET BDMJOB=$JOB
SET BDMBTH=$HOROLOG
SDPI ;
+1 SET BDMSDPI=""
SET BDMSDPG=""
+2 ;
GETDATES ;
+1 SET BDMSTP=0
DO TIME
IF BDMSTP
DO XIT1
DO XIT
QUIT
COMM ;get gpra community taxonomy
+1 WRITE !!,"Specify the community taxonomy to determine which patients will be",!,"included in the report. You should have created this taxonomy using QMAN.",!
+2 KILL BDMTAX
+3 SET BDMTAXI=""
+4 DO ^XBFMK
+5 SET DIC("S")="I $P(^(0),U,15)=9999999.05"
SET DIC="^ATXAX("
SET DIC(0)="AEMQ"
SET DIC("A")="Enter the Name of the Community Taxonomy: "
+6 SET B=$PIECE($GET(^BGPSITE(DUZ(2),0)),U,5)
IF B
SET DIC("B")=$PIECE(^ATXAX(B,0),U)
+7 DO ^DIC
KILL DIC
+8 IF Y=-1
QUIT
+9 SET BDMTAXI=+Y
COM1 SET X=0
+1 FOR
SET X=$ORDER(^ATXAX(BDMTAXI,21,X))
IF 'X
QUIT
Begin DoDot:1
+2 SET BDMTAX($PIECE(^ATXAX(BDMTAXI,21,X,0),U))=""
+3 QUIT
End DoDot:1
+4 IF '$DATA(BDMTAX)
WRITE !!,"There are no communities in that taxonomy."
GOTO COMM
BEN ;
+1 SET BDMBEN=1
ACT ;
+1 SET BDMACTI=0
IF BDMDMRG=""
GOTO IF
+2 SET DIR(0)="Y"
SET DIR("A")="Include only ACTIVE members of the "_$PIECE(^ACM(41.1,BDMDMRG,0),U)_" register"
SET DIR("B")="N"
KILL DA
+3 DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
GOTO COMM
+5 SET BDMACTI=Y
PREG ;
+1 SET BDMPREG=""
SET BDMSTP=0
+2 SET DIR(0)="S^I:Include Pregnant Patients;E:Exclude Pregnant Patients"
SET DIR("A")="Select whether to include or exclude pregnant patients in the audit"
+3 SET DIR("B")="E"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
GOTO ACT
+5 SET BDMPREG=Y
IF ;PEP - called from BDM indivdual or epi
+1 SET BDMSTP=0
+2 KILL DIR
+3 SET DIR(0)="S^1:Print Individual Reports;2:Create AUDIT EXPORT file;3:Cumulative Audit Only;4:Both Individual and Cumulative Audits;5:SDPI Key Measures Report (2015 Version);6:SDPI Key Measures Report (2017 Version)"
+4 SET DIR("A")="Enter Print option"
SET DIR("B")="1"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+5 IF $DATA(DIRUT)
GOTO GETDATES
+6 SET BDMPREP=Y
+7 IF BDMPREP=2
DO FLAT
IF BDMSTP
QUIT
IF2 ;
+1 IF BDMPREP=1!(BDMPREP=4)
SET BDMPPN=""
Begin DoDot:1
+2 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Do you wish to print the Patient's Name on the audit sheet"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
SET BDMSTP=1
+4 SET BDMPPN=Y
End DoDot:1
IF BDMSTP
GOTO IF
ZIS ;
+1 DO DEMOCHK^BDMUTL(.BDMDEMO)
IF BDMDEMO=-1
GOTO IF
+2 IF BDMPREP'=2
SET XBRP="^BDMDE1P"
SET XBRC="EAUDIT^BDMDE10"
SET XBRX="XIT^BDMDE1"
SET XBNS="BDM"
+3 IF BDMPREP=2
SET XBRP=""
SET XBRC="EAUDIT^BDMDE10"
SET XBRX="XIT^BDMDE1"
SET XBNS="BDM"
+4 DO ^XBDBQUE
+5 DO XIT
+6 QUIT
P ;
+1 SET BDMSTP=0
KILL ^XTMP("BDMDM17",BDMJOB,BDMBTH),^TMP($JOB,"PATS")
P1 ;
+1 KILL DIC
SET DIC="^AUPNPAT("
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
+2 IF Y=-1
IF '$DATA(^XTMP("BDMDM17",BDMJOB,BDMBTH,"PATS"))
WRITE !,"No patients selected"
SET BDMSTP=1
QUIT
+3 IF Y=-1
QUIT
+4 SET ^XTMP("BDMDM17",BDMJOB,BDMBTH,"PATS",+Y)=""
+5 GOTO P1
+6 QUIT
S ; Get patient name or cohort
+1 KILL ^XTMP("BDMDM17",BDMJOB,BDMBTH),^TMP($JOB,"PATS")
SET BDMSTP=0
+2 KILL DIC
SET DIC("A")="Enter Search Template Name: "
SET DIC("S")="I $P(^(0),U,4)=2!($P(^(0),U,4)=9000001)"
+3 SET DIC="^DIBT("
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
+4 IF Y=-1
SET BDMSTP=1
WRITE !,"No template selected."
QUIT
+5 SET BDMCNT=0
FOR BDMPD=0:0
SET BDMPD=$ORDER(^DIBT(+Y,1,BDMPD))
IF 'BDMPD
QUIT
SET BDMCNT=BDMCNT+1
SET ^TMP($JOB,"PATS",BDMCNT,BDMPD)=""
+6 WRITE !!,"There are ",BDMCNT," patients in the ",$PIECE(^DIBT(+Y,0),U)," template/cohort.",!
+7 DO PCP
+8 IF BDMSTP
QUIT
+9 DO CC
+10 IF BDMSTP
QUIT
+11 DO RAND
+12 QUIT
PCP ;
+1 SET BDMSTP=0
+2 WRITE !,"You have selected a register or template/cohort of patients. ",!,"You can run the audit just for the subset of patients in the cohort or register",!,"who live in a particular community or have a particular primary care provider.",!
+3 SET DIR(0)="Y"
SET DIR("A")="Limit the audit to a particular primary care provider "
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
SET BDMSTP=1
QUIT
+5 IF 'Y
QUIT
+6 KILL DIC
SET DIC=$SELECT($PIECE(^DD(9000001,.14,0),U,2)[200:200,1:6)
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
+7 IF Y=-1
GOTO PCP
+8 SET BDMPDP=+Y
+9 SET X=0
FOR
SET X=$ORDER(^TMP($JOB,"PATS",X))
IF X'=+X
QUIT
SET P=$ORDER(^TMP($JOB,"PATS",X,0))
IF $PIECE(^AUPNPAT(P,0),U,14)'=BDMPDP
KILL ^TMP($JOB,"PATS",X,P)
+10 SET (X,C)=0
FOR
SET X=$ORDER(^TMP($JOB,"PATS",X))
IF X'=+X
QUIT
SET C=C+1
+11 WRITE !!,C," patients will be used in the audit.",!
+12 QUIT
CC ;current community
+1 SET BDMSTP=0
+2 WRITE !
KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Limit the patients who live in a particular community "
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
SET BDMSTP=1
QUIT
+4 IF 'Y
QUIT
+5 KILL DIC
SET DIC="^AUTTCOM("
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
+6 IF Y=-1
GOTO CC
+7 SET BDMCOM=$PIECE(^AUTTCOM(+Y,0),U)
+8 SET X=0
FOR
SET X=$ORDER(^TMP($JOB,"PATS",X))
IF X'=+X
QUIT
SET P=$ORDER(^TMP($JOB,"PATS",X,0))
IF $PIECE($GET(^AUPNPAT(P,11)),U,18)'=BDMCOM
KILL ^TMP($JOB,"PATS",X,P)
+9 SET (X,C)=0
FOR
SET X=$ORDER(^TMP($JOB,"PATS",X))
IF X'=+X
QUIT
SET C=C+1
+10 WRITE !!,C," patients will be used in the audit.",!
+11 QUIT
C ;get register, status, random or not
+1 KILL ^XTMP("BDMDM17",BDMJOB,BDMBTH),^TMP($JOB,"PATS")
+2 SET BDMCMS=""
SET BDMSTP=0
+3 SET DIC="^ACM(41.1,"
SET DIC(0)="AEMQ"
SET DIC("A")="Enter the Name of the Register: "
DO ^DIC
+4 IF Y=-1
WRITE !,"No register selected."
SET BDMSTP=1
QUIT
+5 SET BDMCMS=+Y
+6 ;get status
+7 SET BDMSTAT=""
+8 SET DIR(0)="Y"
SET DIR("A")="Do you want to select register patients with a particular status"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+9 IF $DATA(DIRUT)
GOTO C
+10 IF Y=0
GOTO C1
+11 ;which status
+12 SET DIR(0)="9002241,1"
SET DIR("A")="Which status"
SET DIR("B")="A"
KILL DA
DO ^DIR
KILL DIR
+13 IF $DATA(DIRUT)
GOTO C
+14 SET BDMSTAT=Y
C1 ;
+1 ;gather up patients from register in ^XTMP
+2 KILL ^TMP($JOB,"PATS")
SET BDMCNT=0
SET X=0
FOR
SET X=$ORDER(^ACM(41,"B",BDMCMS,X))
IF X'=+X
QUIT
Begin DoDot:1
+3 IF BDMSTAT]""
IF $PIECE($GET(^ACM(41,X,"DT")),U,1)=BDMSTAT
SET BDMCNT=BDMCNT+1
SET ^TMP($JOB,"PATS",BDMCNT,$PIECE(^ACM(41,X,0),U,2))=""
QUIT
+4 IF BDMSTAT=""
SET BDMCNT=BDMCNT+1
SET ^TMP($JOB,"PATS",BDMCNT,$PIECE(^ACM(41,X,0),U,2))=""
End DoDot:1
+5 IF '$DATA(^TMP($JOB,"PATS"))
WRITE !,"No patients with that status in that register!"
SET BDMSTP=1
GOTO C
+6 WRITE !!,"There are ",BDMCNT," patients in the ",$PIECE(^ACM(41.1,BDMCMS,0),U)," register with a status of ",BDMSTAT,".",!!
+7 DO PCP
+8 IF BDMSTP
QUIT
+9 DO CC
+10 IF BDMSTP
QUIT
+11 DO RAND
+12 QUIT
RAND ;random sample or not
+1 SET (X,BDMCNT)=0
FOR
SET X=$ORDER(^TMP($JOB,"PATS",X))
IF X'=+X
QUIT
SET BDMCNT=BDMCNT+1
+2 WRITE !!,"There are ",BDMCNT," patients selected so far to be used in the audit.",!
+3 SET DIR(0)="S^A:ALL Patients selected so far;R:RANDOM Sample of the patients selected so far"
SET DIR("A")="Do you want to select"
SET DIR("B")="A"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
GOTO C
+5 IF Y="A"
SET C=0
FOR
SET C=$ORDER(^TMP($JOB,"PATS",C))
IF C'=+C
QUIT
SET X=$ORDER(^TMP($JOB,"PATS",C,0))
SET ^XTMP("BDMDM17",BDMJOB,BDMBTH,"PATS",X)=""
+6 IF Y="A"
KILL ^TMP($JOB,"PATS")
QUIT
+7 SET DIR(0)="N^2:"_BDMCNT_":0"
SET DIR("A")="How many patients do you want in your random sample"
KILL DA
DO ^DIR
KILL DIR
+8 ;get random sample AND set xtmp
+9 IF $DATA(DIRUT)
SET BDMSTP=1
QUIT
+10 SET C=0
FOR N=1:1:BDMCNT
IF C=Y
QUIT
SET I=$RANDOM(BDMCNT)
IF I
IF $DATA(^TMP($JOB,"PATS",I))
SET X=$ORDER(^TMP($JOB,"PATS",I,0))
SET ^XTMP("BDMDM17",BDMJOB,BDMBTH,"PATS",X)=""
SET C=C+1
KILL ^TMP($JOB,"PATS",I,X)
+11 KILL ^TMP($JOB,"PATS")
+12 QUIT
TIME ;PEP - called from BDM Get fiscal year or time frame
+1 SET BDMSTP=0
+2 SET (BDMRBD,BDMRED,BDMADAT)=""
+3 WRITE !!,"Enter the date of the audit. This date will be considered the ending",!,"date of the audit period. For most data items all data for the period one",!,"year prior to this date will be reviewed.",!
+4 SET DIR(0)="D^::EPX"
SET DIR("A")="Enter the Audit Date"
KILL DA
DO ^DIR
KILL DIR
+5 IF $DATA(DIRUT)
SET BDMSTP=1
QUIT
+6 SET BDMADAT=Y
+7 SET BDMRED=$$FMTE^XLFDT(BDMADAT)
+8 SET BDMBDAT=($EXTRACT(BDMADAT,1,3)-1)_$EXTRACT(BDMADAT,4,7)
SET BDMBDAT=$$FMADD^XLFDT(BDMBDAT,1)
+9 SET BDMRBD=$$FMTE^XLFDT(BDMBDAT)
+10 QUIT
+11 ;
XIT1 ;
+1 KILL ^BDMDATA($JOB),^BDMDATA("BDMEPI",$JOB)
+2 KILL ^XTMP("BDMDM17",BDMJOB,BDMBTH),BDMJOB,BDMBTH
XIT ;
+1 IF '$DATA(BDMGUI)
DO EN^XBVK("BDM")
DO EN^XBVK("AUPN")
+2 DO ^XBFMK
DO KILL^AUPNPAT
+3 KILL ^TMP($JOB,"PATS")
+4 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 ;----------
FLAT ;
+1 DO FLAT^BDMDE1
+2 QUIT
WRITEF ;EP write flat file
+1 DO WRITEF^BDMDE1
+2 QUIT
BDMG(BDMJOB,BDMBTH,BDMDMRG,BDMADAT,BDMTYPE,BDMSTMP,BDMPDP,BDMCOM,BDMRAND,BDMRCNT,BDMCMS,BDMSTAT,BDMPREP,BDMFILE,BDMDSP,BDMGIEN,BDMSDPI,BDMSDPG,BDMDUZ2,BDMDEMO) ;PEP - gui call
+1 FOR X="BDMJOB","BDMBTH","BDMDMRG","BDMADAT","BDMTYPE","BDMSTMP","BDMPDP","BDMCOM","BDMRAND","BDMRCNT","BDMCMS","BDMSTAT","BDMPREP","BDMFILE","BDMDSP","BDMDUZ2","BDMDEMO"
SET @X=$GET(@X)
+2 IF $GET(BDMJOB)=""
SET BDMIEN=-1
QUIT
+3 IF $GET(BDMBTH)=""
SET BDMIEN=-1
QUIT
+4 IF $GET(BDMADAT)=""
SET BDMIEN=-1
QUIT
+5 ;I $G(BDMTYPE)="" S BDMIEN=-1 Q
+6 IF $GET(BDMPREP)=""
SET BDMIEN=-1
QUIT
+7 SET BDMDEMO=$EXTRACT($GET(BDMDEMO))
+8 ;using variable BDMRAND as taxonomy
+9 SET BDMGUI=1
+10 SET BDMTAXI=BDMRAND
+11 SET BDMACTI=0
+12 SET BDMBEN=1
+13 IF BDMSTAT="1"
Begin DoDot:1
+14 SET BDMACTI=1
End DoDot:1
+15 SET X=0
+16 FOR
SET X=$ORDER(^ATXAX(BDMTAXI,21,X))
IF 'X
QUIT
Begin DoDot:1
+17 SET BDMTAX($PIECE(^ATXAX(BDMTAXI,21,X,0),U))=""
+18 QUIT
End DoDot:1
+19 IF BDMPREP=2
IF BDMFILE=""
SET BDMIEN=-1
QUIT
+20 SET BDMRED=$$FMTE^XLFDT(BDMADAT)
+21 SET BDMBDAT=$$FMADD^XLFDT(BDMADAT,-365)
+22 SET BDMRBD=$$FMTE^XLFDT(BDMBDAT)
+23 IF $GET(BDMDSP)
DO GUIEP
QUIT
+24 ;create entry in fileman file to hold output
+25 ;maw
NEW BDMOPT
+26 ;maw
SET BDMOPT="Run the 2017 Audit w/predefined set of Pts"
+27 DO NOW^%DTC
+28 SET BDMNOW=$GET(%)
+29 KILL DD,D0,DIC
+30 SET X=DUZ_"."_BDMBTH
+31 SET DIC("DR")=".02////"_DUZ_";.03////"_BDMNOW_";.05////"_$GET(BDMPREP)_";.06///"_$GET(BDMOPT)_";.07////R"
+32 SET DIC="^BDMGUI("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=9003201.4
+33 DO FILE^DICN
+34 KILL DIADD,DLAYGO,DIC,DA
+35 IF Y=-1
SET BDMIEN=-1
QUIT
+36 SET BDMIEN=+Y
+37 ;cmi/maw added
SET BDMGIEN=BDMIEN
+38 DO ^XBFMK
+39 KILL ZTSAVE
SET ZTSAVE("*")=""
+40 ;D GUIEP for interactive testing
+41 SET ZTIO=""
SET ZTDTH=$$NOW^XLFDT
SET ZTRTN="GUIEP^BDMDE1E"
SET ZTDESC="GUI DM AUDIT"
DO ^%ZTLOAD
+42 DO XIT
+43 QUIT
GUIEP ;EP - called from taskman
+1 DO EAUDIT^BDMDE10
+2 IF BDMPREP=2
IF '$GET(BDMDSP)
DO ENDLOG
QUIT
+3 KILL ^TMP($JOB,"BDMDM17")
+4 ;cmi/maw added
SET IOM=80
+5 DO GUIR^XBLM("^BDMDE1P","^TMP($J,""BDMDM17"",")
+6 ;quit if to screen
IF $GET(BDMDSP)
QUIT
+7 SET X=0
SET C=0
FOR
SET X=$ORDER(^TMP($JOB,"BDMDM17",X))
IF X'=+X
QUIT
Begin DoDot:1
+8 SET BDMDATA=^TMP($JOB,"BDMDM17",X)
+9 ;I BDMDATA="ZZZZZZZ" ;S BDMDATA=$C(12)
+10 SET ^BDMGUI(BDMIEN,11,X,0)=BDMDATA
SET C=C+1
End DoDot:1
+11 SET ^BDMGUI(BDMIEN,11,0)="^^"_C_"^"_C_"^"_DT_"^"
+12 SET DA=BDMIEN
SET DIK="^BDMGUI("
DO IX1^DIK
+13 DO ENDLOG
+14 SET ZTREQ="@"
+15 QUIT
+16 ;
ENDLOG ;-- write the end of the log
+1 DO NOW^%DTC
+2 SET BDMNOW=$GET(%)
+3 SET DIE="^BDMGUI("
SET DA=BDMIEN
SET DR=".04////"_BDMNOW_";.07////C"
+4 DO ^DIE
+5 KILL DIE,DR,DA
+6 QUIT
+7 ;
TEST ;
+1 SET BDMJOB=7
SET BDMBTH="59812,48383"
+2 FOR X=1:1:10
SET ^XTMP("BDMDM17",BDMJOB,BDMBTH,"PATS",X)=""
+3 DO BDMG^BDMDE1(BDMJOB,BDMBTH,1,DT,"P","","","","","","","",4,"TESTEPI",.BDMIEN)
+4 QUIT
