BDMDG1 ; IHS/CMI/LAB - IHS Diabetes Audit 2019 ;
;;2.0;DIABETES MANAGEMENT SYSTEM;**12**;JUN 14, 2007;Build 51
;
BEGIN ;EP - called from option
D TAXCHK^BDMDG19
W:$D(IOF) @IOF
REGASK ;
W !!!,$$CTR("ASSESSMENT OF DIABETES CARE, 2019")
W !!,$$CTR("DIABETES AUDIT")
W !!
S DIC="^ACM(41.1,",DIC(0)="AEMQ",DIC("A")="Enter the Official Diabetes Register: " D ^DIC K DIC
I X="^" D XIT Q
I Y=-1 S BDMDMRG="" W !,"NO Register Selected!!! The CMS register will not be used in retrieving",!,"any data."
S (BDMDMRG,BDMCMS)=$S(Y=-1:"",1:+Y)
S BDMJOB=$J,BDMBTH=$H
GETDATES ;
S BDMSTP=0 D TIME I BDMSTP D XIT1,XIT Q
TYPE ;
S BDMSTP=0
K ^XTMP("BDMDM19",BDMJOB,BDMBTH),^TMP($J,"PATS")
S BDMTYPE=""
S DIR(0)="S^P:Individual Patients;S:Search Template of Patients;C:Members of a CMS Register;E:E-Audit (predefined set of patients)",DIR("A")="Run the audit for",DIR("B")="P" KILL DA D ^DIR KILL DIR
G:$D(DIRUT) GETDATES
S BDMTYPE=Y
S BDMSTP=0
D @BDMTYPE
I BDMSTP G TYPE
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:Audit Report (Cumulative Audit);4:Both Individual and Cumulative Audits;5:SDPI RKM Report"
S DIR("A")="Enter Print option",DIR("B")="1" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G TYPE
S BDMPREP=Y
I BDMPREP=2 D FLAT Q:BDMSTP
;I BDMPREP=6 D QUALCHK^BDMDG1J G:BDMSTP IF
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 ;
DEMO ;
S BDMDEMO="I"
I BDMTYPE'="P" D DEMOCHK^BDMUTL(.BDMDEMO) I BDMDEMO=-1 G IF
I BDMTYPE="P" S BDMDEMO="I"
I BDMPREP=2 S XBRP="",XBRC="^BDMDG10",XBRX="XIT^BDMDG1",XBNS="BDM" D ^XBDBQUE,XIT Q
W ! S DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen",DIR("A")="Do you wish to",DIR("B")="P" K DA D ^DIR K DIR
I $D(DIRUT) D XIT Q
S BDMOPT=Y
I Y="B" D BROWSE,XIT Q
S XBRP="^BDMDG1P",XBRC="^BDMDG10",XBRX="XIT^BDMDG1",XBNS="BDM"
D ^XBDBQUE
D XIT
Q
BROWSE ;
S XBRP="VIEWR^XBLM(""^BDMDG1P"")"
S XBRC="^BDMDG10",XBRX="XIT^BDMDG1",XBIOP=0 D ^XBDBQUE
Q
IAEP ;EP
S BDMTYPE="P"
S BDMPREP=1
S BDMSTP=0
G IF2
P ;
S BDMSTP=0 K ^XTMP("BDMDM19",BDMJOB,BDMBTH),^TMP($J,"PATS")
S BDMBEN=3
P1 ;
K DIC S DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC K DIC
I Y=-1,'$D(^XTMP("BDMDM19",BDMJOB,BDMBTH,"PATS")) W !,"No patients selected" S BDMSTP=1 Q
I Y=-1 Q
S ^XTMP("BDMDM19",BDMJOB,BDMBTH,"PATS",+Y)=""
G P1
;
S ; Get patient name or cohort
K ^XTMP("BDMDM19",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 BEN
Q:BDMSTP
D PREG
Q:BDMSTP
D RAND
Q
E ;
D ^BDMDG2
Q
BENC(B) ;
I B=1 Q "Indian/Alaskan Native (Classification 01)"
I B=2 Q "Not Indian Alaskan/Native (Not Classification 01)"
I B=3 Q "All (both Indian/Alaskan Natives and Non 01)"
Q "BENEFICIARY NOT SELECTED"
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("BDMDM19",BDMJOB,BDMBTH),^TMP($J,"PATS")
I $G(BDMCMS) S BDMSTP=0 G C0
S BDMCMS="",BDMSTP=0
S DIC="^ACM(41.1,",DIC(0)="AEMQ",DIC("A")="Enter the Name of the Register: " D ^DIC K DIC
I Y=-1 W !,"No register selected." S BDMSTP=1 Q
S BDMCMS=+Y
C0 ;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) S BDMSTP=1 Q
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 BEN
Q:BDMSTP
D PREG
Q:BDMSTP
D RAND
Q
BEN ;
S BDMBEN="",BDMSTP=0
S DIR(0)="S^1:Indian/Alaskan Native (Classification 01);2:Not Indian Alaskan/Native (Not Classification 01);3:All (both Indian/Alaskan Natives and Non 01)",DIR("A")="Select Beneficiary Population to include in the audit"
S DIR("B")="1" KILL DA D ^DIR KILL DIR
I $D(DIRUT) S BDMSTP=1 Q
S BDMBEN=Y
S X=0 F S X=$O(^TMP($J,"PATS",X)) Q:X'=+X S P=$O(^TMP($J,"PATS",X,0)) D
.I BDMBEN=1,$$BEN^AUPNPAT(P,"C")'="01" K ^TMP($J,"PATS",X)
.I BDMBEN=2,$$BEN^AUPNPAT(P,"C")="01" K ^TMP($J,"PATS",X)
Q
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) S BDMSTP=1 Q
S BDMPREG=Y
Q:BDMPREG="I"
W !,"okay, hold on...this may take a few minutes.."
S X=0 F S X=$O(^TMP($J,"PATS",X)) Q:X'=+X S P=$O(^TMP($J,"PATS",X,0)) D
.Q:$P(^DPT(P,0),U,2)'="F"
.;W ".",P
.I $$PREG^BDMDG1B(P,BDMBDAT,BDMADAT,1,1,BDMBDAT,BDMADAT) K ^TMP($J,"PATS",X)
K ^XTMP("BDMTAX",BDMJOB,BDMBTH)
Q
PTAX ;
I '$D(^ICDS(0)) Q ;only in icd10 environment
K ^XTMP("BDMTAX",BDMJOB,BDMBTH)
S BDMTAX="BGP PREGNANCY DIAGNOSES 2"
S BDMFL=80
S BDMTYP=""
S BDMTAXI=$O(^ATXAX("B",BDMTAX,0))
S BDMTGT="^XTMP("_"""BDMTAX"""_","_BDMJOB_","_""""_BDMBTH_""""_","_""""_BDMTAX_""""_")"
D BLDTAX^BDMTAPI(BDMTAX,BDMTGT,BDMTAXI,BDMTYP)
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("BDMDM19",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("BDMDM19",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("BDMTAX",BDMJOB,BDMBTH) ;cmi/maw kill tmp storage of taxonomies
K ^XTMP("BDMDM19",BDMJOB,BDMBTH),BDMJOB,BDMBTH
XIT ;
I '$D(BDMGUI) D EN^XBVK("BDM"),EN^XBVK("AUPN")
D ^XBFMK,KILL^AUPNPAT
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 ;EP
W !!,"The file generated will be in a ""^"" delimited format. You can use",!,"this file to review your data in EXCEL if you so choose.",!!
S BDMFILE=""
S DIR(0)="F^3:20",DIR("A")="Enter the name of the FILE to be Created (3-20 characters)" K DA D ^DIR K DIR
I $D(DIRUT) S BDMSTP=1 Q
I Y["/" W !!,"You cannot use '/' in the filename." G FLAT
I Y["\" W !!,"You cannot use '\' in the filename." G FLAT
S BDMFILE=$$LOW^XLFSTR(Y)_".txt"
W !!,"I am going to create a file called ",BDMFILE," which will reside in ",!,"the "
W $S($P($G(^APCCCTRL($S($G(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0)),U,11)]"":$P(^APCCCTRL($S($G(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0),U,11),$P($G(^AUTTSITE(1,1)),U,2)]"":$P(^AUTTSITE(1,1),U,2),$P(^AUTTSITE(1,0),U,21)=1:"/usr/spool/uucppublic",1:"C:\EXPORT")
W " directory on your RPMS server. ",!
W "It is the same directory that the data export globals are placed."
W !,"See your site manager for assistance in finding the file",!,"after it is created. PLEASE jot down and remember the following file name:",!?15,"********** ",BDMFILE," **********",!
W "It may be several hours (or overnight) before your report and flat file are ",!,"finished.",!
W !,"The records that are generated and placed in file ",BDMFILE
W !,"are in a format readable by Excel. For a definition of the format",!,"please see your user manual.",!
S DIR(0)="Y",DIR("A")="Is everything ok? Do you want to continue",DIR("B")="Y" K DA D ^DIR K DIR
I $D(DIRUT) S BDMSTP=1 Q
I 'Y S BDMSTP=1 Q
Q
WRITEF ;EP write flat file
K ^BDMDATA($J)
Q:'$D(^BDMDATA("BDMEPI",$J))
;load in epi definition to ^BDMDATA($J,"BDM EPI"
S I=$O(^BDMRECD("B","DM AUDIT 2019 EXPORT RECORD",0))
S (X,O)=0,N="",T="" F S O=$O(^BDMRECD(I,11,"AC",O)) Q:O'=+O D
.S X=$O(^BDMRECD(I,11,"AC",O,0))
.S T=$P(^BDMRECD(I,11,X,0),U,1)
.S N=N_$S(N]"":U,1:"")_T
S ^BDMDATA($J,1)=N
S N=1
;MOVE RECORDS TO ^BDMDATA($J,"BDM EPI"
S X=0 F S X=$O(^BDMDATA("BDMEPI",$J,X)) Q:X'=+X S N=N+1,^BDMDATA($J,N)=^BDMDATA("BDMEPI",$J,X)
K ^BDMDATA("BDMEPI",$J)
S XBGL="BDMDATA("
K XBUF I $P($G(^APCCCTRL($S($G(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0)),U,11)]"" S XBUF=$P(^APCCCTRL($S($G(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0),U,11)
S XBMED="F",XBFN=BDMFILE,XBTLE="SAVE OF DM AUDIT 2019 EXPORT RECORDS GENERATED BY -"_$P(^VA(200,DUZ,0),U)
S XBQ="N",XBFLT=1,XBE=$J,XBF=$J
D ^XBGSAVE
;check for error
K ^BDMDATA("BDMEPI",$J)
K XBGL,XBMED,XBTLE,XBFN,XBF,XBQ,XBFLT,XBE
K ^BDMDATA($J)
K ^XTMP("BDMTAX",BDMJOB,BDMBTH)
K ^XTMP("BDMDM19",BDMJOB,BDMBTH),BDMJOB,BDMBTH
Q
BDMG(BDMJOB,BDMBTH,BDMDMRG,BDMADAT,BDMTYPE,BDMSTMP,BDMPDP,BDMCOM,BDMRAND,BDMRCNT,BDMCMS,BDMSTAT,BDMPREP,BDMFILE,BDMDSP,BDMGIEN,BDMSDPI,BDMSDPG,BDMPPN,BDMDUZ2,BDMDEMO,BDMBEN,BDMDQ,BDMACTI) ;PEP - gui call
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
I BDMTYPE="E" S BDMTAXI=BDMCOM D
. S X=0 F S X=$O(^ATXAX(BDMTAXI,21,X)) Q:'X D
.. S BDMTAX($P(^ATXAX(BDMTAXI,21,X,0),U))=""
S BDMDEMO=$E(BDMDEMO)
S BDMDUZ2=$G(BDMDUZ2)
S BDMQSRT=$G(BDMDQ)
I BDMFILE]"",$$UP^XLFSTR(BDMFILE)'[".TXT" S BDMFILE=BDMFILE_".txt"
I BDMPREP=2,BDMFILE="" S BDMIEN=-1 Q
I $G(BDMPPN)="" S BDMPPN=0
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)
S BDMGUI=1
I BDMTYPE="P" S BDMDEMO="I"
S X=0 F S X=$O(^TMP($J,"PATS",X)) Q:X'=+X S P=$O(^TMP($J,"PATS",X,0)) D
.I BDMBEN=1,$$BEN^AUPNPAT(P,"C")'="01" K ^TMP($J,"PATS",X)
.I BDMBEN=2,$$BEN^AUPNPAT(P,"C")="01" K ^TMP($J,"PATS",X)
I $G(BDMDSP) D GUIEP Q
;create entry in fileman file to hold output
N BDMOPT ;maw
S BDMOPT="2019 Diabetes Program Audit"
I BDMPREP=5 S BDMOPT="SDPI RKM Report"
I BDMPREP=6 S BDMOPT="SDPI Key Measures Rpt (2016)"
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
D ^XBFMK
K ZTSAVE S ZTSAVE("*")=""
S ZTIO="",ZTDTH=$$NOW^XLFDT,ZTRTN="GUIEP^BDMDG1",ZTDESC="GUI DM AUDIT" D ^%ZTLOAD
D XIT
Q
GUIEP ;EP - called from taskman
D ^BDMDG10
I BDMPREP=2,'$G(BDMDSP) D ENDLOG Q
K ^TMP($J,"BDMDM19")
I $G(BDMDSP),BDMPREP=2 Q
S IOM=80 ;cmi/maw added
D GUIR^XBLM("^BDMDG1P","^TMP($J,""BDMDM19"",")
Q:$G(BDMDSP) ;quit if to screen
S X=0,C=0 F S X=$O(^TMP($J,"BDMDM19",X)) Q:X'=+X D
.S BDMDATA=^TMP($J,"BDMDM19",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
K ^TMP($J,"BDMDM19")
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
BDMDG1 ; IHS/CMI/LAB - IHS Diabetes Audit 2019 ;
+1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**12**;JUN 14, 2007;Build 51
+2 ;
BEGIN ;EP - called from option
+1 DO TAXCHK^BDMDG19
+2 IF $DATA(IOF)
WRITE @IOF
REGASK ;
+1 WRITE !!!,$$CTR("ASSESSMENT OF DIABETES CARE, 2019")
+2 WRITE !!,$$CTR("DIABETES AUDIT")
+3 WRITE !!
+4 SET DIC="^ACM(41.1,"
SET DIC(0)="AEMQ"
SET DIC("A")="Enter the Official Diabetes Register: "
DO ^DIC
KILL DIC
+5 IF X="^"
DO XIT
QUIT
+6 IF Y=-1
SET BDMDMRG=""
WRITE !,"NO Register Selected!!! The CMS register will not be used in retrieving",!,"any data."
+7 SET (BDMDMRG,BDMCMS)=$SELECT(Y=-1:"",1:+Y)
+8 SET BDMJOB=$JOB
SET BDMBTH=$HOROLOG
GETDATES ;
+1 SET BDMSTP=0
DO TIME
IF BDMSTP
DO XIT1
DO XIT
QUIT
TYPE ;
+1 SET BDMSTP=0
+2 KILL ^XTMP("BDMDM19",BDMJOB,BDMBTH),^TMP($JOB,"PATS")
+3 SET BDMTYPE=""
+4 SET DIR(0)="S^P:Individual Patients;S:Search Template of Patients;C:Members of a CMS Register;E:E-Audit (predefined set of patients)"
SET DIR("A")="Run the audit for"
SET DIR("B")="P"
KILL DA
DO ^DIR
KILL DIR
+5 IF $DATA(DIRUT)
GOTO GETDATES
+6 SET BDMTYPE=Y
+7 SET BDMSTP=0
+8 DO @BDMTYPE
+9 IF BDMSTP
GOTO TYPE
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:Audit Report (Cumulative Audit);4:Both Individual and Cumulative Audits;5:SDPI RKM Report"
+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 TYPE
+6 SET BDMPREP=Y
+7 IF BDMPREP=2
DO FLAT
IF BDMSTP
QUIT
+8 ;I BDMPREP=6 D QUALCHK^BDMDG1J G:BDMSTP IF
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 ;
DEMO ;
+1 SET BDMDEMO="I"
+2 IF BDMTYPE'="P"
DO DEMOCHK^BDMUTL(.BDMDEMO)
IF BDMDEMO=-1
GOTO IF
+3 IF BDMTYPE="P"
SET BDMDEMO="I"
+4 IF BDMPREP=2
SET XBRP=""
SET XBRC="^BDMDG10"
SET XBRX="XIT^BDMDG1"
SET XBNS="BDM"
DO ^XBDBQUE
DO XIT
QUIT
+5 WRITE !
SET DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen"
SET DIR("A")="Do you wish to"
SET DIR("B")="P"
KILL DA
DO ^DIR
KILL DIR
+6 IF $DATA(DIRUT)
DO XIT
QUIT
+7 SET BDMOPT=Y
+8 IF Y="B"
DO BROWSE
DO XIT
QUIT
+9 SET XBRP="^BDMDG1P"
SET XBRC="^BDMDG10"
SET XBRX="XIT^BDMDG1"
SET XBNS="BDM"
+10 DO ^XBDBQUE
+11 DO XIT
+12 QUIT
BROWSE ;
+1 SET XBRP="VIEWR^XBLM(""^BDMDG1P"")"
+2 SET XBRC="^BDMDG10"
SET XBRX="XIT^BDMDG1"
SET XBIOP=0
DO ^XBDBQUE
+3 QUIT
IAEP ;EP
+1 SET BDMTYPE="P"
+2 SET BDMPREP=1
+3 SET BDMSTP=0
+4 GOTO IF2
P ;
+1 SET BDMSTP=0
KILL ^XTMP("BDMDM19",BDMJOB,BDMBTH),^TMP($JOB,"PATS")
+2 SET BDMBEN=3
P1 ;
+1 KILL DIC
SET DIC="^AUPNPAT("
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
+2 IF Y=-1
IF '$DATA(^XTMP("BDMDM19",BDMJOB,BDMBTH,"PATS"))
WRITE !,"No patients selected"
SET BDMSTP=1
QUIT
+3 IF Y=-1
QUIT
+4 SET ^XTMP("BDMDM19",BDMJOB,BDMBTH,"PATS",+Y)=""
+5 GOTO P1
+6 ;
S ; Get patient name or cohort
+1 KILL ^XTMP("BDMDM19",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 BEN
+12 IF BDMSTP
QUIT
+13 DO PREG
+14 IF BDMSTP
QUIT
+15 DO RAND
+16 QUIT
E ;
+1 DO ^BDMDG2
+2 QUIT
BENC(B) ;
+1 IF B=1
QUIT "Indian/Alaskan Native (Classification 01)"
+2 IF B=2
QUIT "Not Indian Alaskan/Native (Not Classification 01)"
+3 IF B=3
QUIT "All (both Indian/Alaskan Natives and Non 01)"
+4 QUIT "BENEFICIARY NOT SELECTED"
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("BDMDM19",BDMJOB,BDMBTH),^TMP($JOB,"PATS")
+2 IF $GET(BDMCMS)
SET BDMSTP=0
GOTO C0
+3 SET BDMCMS=""
SET BDMSTP=0
+4 SET DIC="^ACM(41.1,"
SET DIC(0)="AEMQ"
SET DIC("A")="Enter the Name of the Register: "
DO ^DIC
KILL DIC
+5 IF Y=-1
WRITE !,"No register selected."
SET BDMSTP=1
QUIT
+6 SET BDMCMS=+Y
C0 ;get status
+1 SET BDMSTAT=""
+2 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
+3 IF $DATA(DIRUT)
SET BDMSTP=1
QUIT
+4 IF Y=0
GOTO C1
+5 ;which status
+6 SET DIR(0)="9002241,1"
SET DIR("A")="Which status"
SET DIR("B")="A"
KILL DA
DO ^DIR
KILL DIR
+7 IF $DATA(DIRUT)
GOTO C
+8 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 BEN
+12 IF BDMSTP
QUIT
+13 DO PREG
+14 IF BDMSTP
QUIT
+15 DO RAND
+16 QUIT
BEN ;
+1 SET BDMBEN=""
SET BDMSTP=0
+2 SET DIR(0)="S^1:Indian/Alaskan Native (Classification 01);2:Not Indian Alaskan/Native (Not Classification 01);3:All (both Indian/Alaskan Natives and Non 01)"
SET DIR("A")="Select Beneficiary Population to include in the audit"
+3 SET DIR("B")="1"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
SET BDMSTP=1
QUIT
+5 SET BDMBEN=Y
+6 SET X=0
FOR
SET X=$ORDER(^TMP($JOB,"PATS",X))
IF X'=+X
QUIT
SET P=$ORDER(^TMP($JOB,"PATS",X,0))
Begin DoDot:1
+7 IF BDMBEN=1
IF $$BEN^AUPNPAT(P,"C")'="01"
KILL ^TMP($JOB,"PATS",X)
+8 IF BDMBEN=2
IF $$BEN^AUPNPAT(P,"C")="01"
KILL ^TMP($JOB,"PATS",X)
End DoDot:1
+9 QUIT
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)
SET BDMSTP=1
QUIT
+5 SET BDMPREG=Y
+6 IF BDMPREG="I"
QUIT
+7 WRITE !,"okay, hold on...this may take a few minutes.."
+8 SET X=0
FOR
SET X=$ORDER(^TMP($JOB,"PATS",X))
IF X'=+X
QUIT
SET P=$ORDER(^TMP($JOB,"PATS",X,0))
Begin DoDot:1
+9 IF $PIECE(^DPT(P,0),U,2)'="F"
QUIT
+10 ;W ".",P
+11 IF $$PREG^BDMDG1B(P,BDMBDAT,BDMADAT,1,1,BDMBDAT,BDMADAT)
KILL ^TMP($JOB,"PATS",X)
End DoDot:1
+12 KILL ^XTMP("BDMTAX",BDMJOB,BDMBTH)
+13 QUIT
PTAX ;
+1 ;only in icd10 environment
IF '$DATA(^ICDS(0))
QUIT
+2 KILL ^XTMP("BDMTAX",BDMJOB,BDMBTH)
+3 SET BDMTAX="BGP PREGNANCY DIAGNOSES 2"
+4 SET BDMFL=80
+5 SET BDMTYP=""
+6 SET BDMTAXI=$ORDER(^ATXAX("B",BDMTAX,0))
+7 SET BDMTGT="^XTMP("_"""BDMTAX"""_","_BDMJOB_","_""""_BDMBTH_""""_","_""""_BDMTAX_""""_")"
+8 DO BLDTAX^BDMTAPI(BDMTAX,BDMTGT,BDMTAXI,BDMTYP)
+9 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("BDMDM19",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("BDMDM19",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 ;cmi/maw kill tmp storage of taxonomies
KILL ^XTMP("BDMTAX",BDMJOB,BDMBTH)
+3 KILL ^XTMP("BDMDM19",BDMJOB,BDMBTH),BDMJOB,BDMBTH
XIT ;
+1 IF '$DATA(BDMGUI)
DO EN^XBVK("BDM")
DO EN^XBVK("AUPN")
+2 DO ^XBFMK
DO KILL^AUPNPAT
+3 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 ;EP
+1 WRITE !!,"The file generated will be in a ""^"" delimited format. You can use",!,"this file to review your data in EXCEL if you so choose.",!!
+2 SET BDMFILE=""
+3 SET DIR(0)="F^3:20"
SET DIR("A")="Enter the name of the FILE to be Created (3-20 characters)"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
SET BDMSTP=1
QUIT
+5 IF Y["/"
WRITE !!,"You cannot use '/' in the filename."
GOTO FLAT
+6 IF Y["\"
WRITE !!,"You cannot use '\' in the filename."
GOTO FLAT
+7 SET BDMFILE=$$LOW^XLFSTR(Y)_".txt"
+8 WRITE !!,"I am going to create a file called ",BDMFILE," which will reside in ",!,"the "
+9 WRITE $SELECT($PIECE(...
WRITE $GET(^APCCCTRL($SELECT($GET(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0)),U,11)]"":$PIECE(^APCCCTRL($SELECT(...
... $GET(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0),U,11),$PIECE($GET(^AUTTSITE(1,1)),U,2)]"":$PIECE(^AUTTSITE(1,1),U,2),$PIECE(^AUTTSITE(1,0),U,21)=1:"/usr/spool/uucppublic",1:"C:\EXPORT")
+10 WRITE " directory on your RPMS server. ",!
+11 WRITE "It is the same directory that the data export globals are placed."
+12 WRITE !,"See your site manager for assistance in finding the file",!,"after it is created. PLEASE jot down and remember the following file name:",!?15,"********** ",BDMFILE," **********",!
+13 WRITE "It may be several hours (or overnight) before your report and flat file are ",!,"finished.",!
+14 WRITE !,"The records that are generated and placed in file ",BDMFILE
+15 WRITE !,"are in a format readable by Excel. For a definition of the format",!,"please see your user manual.",!
+16 SET DIR(0)="Y"
SET DIR("A")="Is everything ok? Do you want to continue"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+17 IF $DATA(DIRUT)
SET BDMSTP=1
QUIT
+18 IF 'Y
SET BDMSTP=1
QUIT
+19 QUIT
WRITEF ;EP write flat file
+1 KILL ^BDMDATA($JOB)
+2 IF '$DATA(^BDMDATA("BDMEPI",$JOB))
QUIT
+3 ;load in epi definition to ^BDMDATA($J,"BDM EPI"
+4 SET I=$ORDER(^BDMRECD("B","DM AUDIT 2019 EXPORT RECORD",0))
+5 SET (X,O)=0
SET N=""
SET T=""
FOR
SET O=$ORDER(^BDMRECD(I,11,"AC",O))
IF O'=+O
QUIT
Begin DoDot:1
+6 SET X=$ORDER(^BDMRECD(I,11,"AC",O,0))
+7 SET T=$PIECE(^BDMRECD(I,11,X,0),U,1)
+8 SET N=N_$SELECT(N]"":U,1:"")_T
End DoDot:1
+9 SET ^BDMDATA($JOB,1)=N
+10 SET N=1
+11 ;MOVE RECORDS TO ^BDMDATA($J,"BDM EPI"
+12 SET X=0
FOR
SET X=$ORDER(^BDMDATA("BDMEPI",$JOB,X))
IF X'=+X
QUIT
SET N=N+1
SET ^BDMDATA($JOB,N)=^BDMDATA("BDMEPI",$JOB,X)
+13 KILL ^BDMDATA("BDMEPI",$JOB)
+14 SET XBGL="BDMDATA("
+15 KILL XBUF
IF $PIECE($GET(^APCCCTRL($SELECT($GET(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0)),U,11)]""
SET XBUF=$PIECE(^APCCCTRL($SELECT($GET(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0),U,11)
+16 SET XBMED="F"
SET XBFN=BDMFILE
SET XBTLE="SAVE OF DM AUDIT 2019 EXPORT RECORDS GENERATED BY -"_$PIECE(^VA(200,DUZ,0),U)
+17 SET XBQ="N"
SET XBFLT=1
SET XBE=$JOB
SET XBF=$JOB
+18 DO ^XBGSAVE
+19 ;check for error
+20 KILL ^BDMDATA("BDMEPI",$JOB)
+21 KILL XBGL,XBMED,XBTLE,XBFN,XBF,XBQ,XBFLT,XBE
+22 KILL ^BDMDATA($JOB)
+23 KILL ^XTMP("BDMTAX",BDMJOB,BDMBTH)
+24 KILL ^XTMP("BDMDM19",BDMJOB,BDMBTH),BDMJOB,BDMBTH
+25 QUIT
BDMG(BDMJOB,BDMBTH,BDMDMRG,BDMADAT,BDMTYPE,BDMSTMP,BDMPDP,BDMCOM,BDMRAND,BDMRCNT,BDMCMS,BDMSTAT,BDMPREP,BDMFILE,BDMDSP,BDMGIEN,BDMSDPI,BDMSDPG,BDMPPN,BDMDUZ2,BDMDEMO,BDMBEN,BDMDQ,BDMACTI) ;PEP - gui call
+1 IF $GET(BDMJOB)=""
SET BDMIEN=-1
QUIT
+2 IF $GET(BDMBTH)=""
SET BDMIEN=-1
QUIT
+3 IF $GET(BDMADAT)=""
SET BDMIEN=-1
QUIT
+4 IF $GET(BDMTYPE)=""
SET BDMIEN=-1
QUIT
+5 IF $GET(BDMPREP)=""
SET BDMIEN=-1
QUIT
+6 IF BDMTYPE="E"
SET BDMTAXI=BDMCOM
Begin DoDot:1
+7 SET X=0
FOR
SET X=$ORDER(^ATXAX(BDMTAXI,21,X))
IF 'X
QUIT
Begin DoDot:2
+8 SET BDMTAX($PIECE(^ATXAX(BDMTAXI,21,X,0),U))=""
End DoDot:2
End DoDot:1
+9 SET BDMDEMO=$EXTRACT(BDMDEMO)
+10 SET BDMDUZ2=$GET(BDMDUZ2)
+11 SET BDMQSRT=$GET(BDMDQ)
+12 IF BDMFILE]""
IF $$UP^XLFSTR(BDMFILE)'[".TXT"
SET BDMFILE=BDMFILE_".txt"
+13 IF BDMPREP=2
IF BDMFILE=""
SET BDMIEN=-1
QUIT
+14 IF $GET(BDMPPN)=""
SET BDMPPN=0
+15 SET BDMRED=$$FMTE^XLFDT(BDMADAT)
+16 SET BDMBDAT=($EXTRACT(BDMADAT,1,3)-1)_$EXTRACT(BDMADAT,4,7)
SET BDMBDAT=$$FMADD^XLFDT(BDMBDAT,1)
+17 SET BDMRBD=$$FMTE^XLFDT(BDMBDAT)
+18 SET BDMGUI=1
+19 IF BDMTYPE="P"
SET BDMDEMO="I"
+20 SET X=0
FOR
SET X=$ORDER(^TMP($JOB,"PATS",X))
IF X'=+X
QUIT
SET P=$ORDER(^TMP($JOB,"PATS",X,0))
Begin DoDot:1
+21 IF BDMBEN=1
IF $$BEN^AUPNPAT(P,"C")'="01"
KILL ^TMP($JOB,"PATS",X)
+22 IF BDMBEN=2
IF $$BEN^AUPNPAT(P,"C")="01"
KILL ^TMP($JOB,"PATS",X)
End DoDot:1
+23 IF $GET(BDMDSP)
DO GUIEP
QUIT
+24 ;create entry in fileman file to hold output
+25 ;maw
NEW BDMOPT
+26 SET BDMOPT="2019 Diabetes Program Audit"
+27 IF BDMPREP=5
SET BDMOPT="SDPI RKM Report"
+28 IF BDMPREP=6
SET BDMOPT="SDPI Key Measures Rpt (2016)"
+29 DO NOW^%DTC
+30 SET BDMNOW=$GET(%)
+31 KILL DD,D0,DIC
+32 SET X=DUZ_"."_BDMBTH
+33 SET DIC("DR")=".02////"_DUZ_";.03////"_BDMNOW_";.05////"_$GET(BDMPREP)_";.06///"_$GET(BDMOPT)_";.07////R"
+34 SET DIC="^BDMGUI("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=9003201.4
+35 DO FILE^DICN
+36 KILL DIADD,DLAYGO,DIC,DA
+37 IF Y=-1
SET BDMIEN=-1
QUIT
+38 SET BDMIEN=+Y
+39 SET BDMGIEN=BDMIEN
+40 DO ^XBFMK
+41 KILL ZTSAVE
SET ZTSAVE("*")=""
+42 SET ZTIO=""
SET ZTDTH=$$NOW^XLFDT
SET ZTRTN="GUIEP^BDMDG1"
SET ZTDESC="GUI DM AUDIT"
DO ^%ZTLOAD
+43 DO XIT
+44 QUIT
GUIEP ;EP - called from taskman
+1 DO ^BDMDG10
+2 IF BDMPREP=2
IF '$GET(BDMDSP)
DO ENDLOG
QUIT
+3 KILL ^TMP($JOB,"BDMDM19")
+4 IF $GET(BDMDSP)
IF BDMPREP=2
QUIT
+5 ;cmi/maw added
SET IOM=80
+6 DO GUIR^XBLM("^BDMDG1P","^TMP($J,""BDMDM19"",")
+7 ;quit if to screen
IF $GET(BDMDSP)
QUIT
+8 SET X=0
SET C=0
FOR
SET X=$ORDER(^TMP($JOB,"BDMDM19",X))
IF X'=+X
QUIT
Begin DoDot:1
+9 SET BDMDATA=^TMP($JOB,"BDMDM19",X)
+10 ;I BDMDATA="ZZZZZZZ" ;S BDMDATA=$C(12)
+11 SET ^BDMGUI(BDMIEN,11,X,0)=BDMDATA
SET C=C+1
End DoDot:1
+12 SET ^BDMGUI(BDMIEN,11,0)="^^"_C_"^"_C_"^"_DT_"^"
+13 SET DA=BDMIEN
SET DIK="^BDMGUI("
DO IX1^DIK
+14 DO ENDLOG
+15 KILL ^TMP($JOB,"BDMDM19")
+16 SET ZTREQ="@"
+17 QUIT
+18 ;
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
