BDMD61.m

BDMD61 ; IHS/CMI/LAB - IHS Diabetes Audit 2006 ;

 ;;2.0;DIABETES MANAGEMENT SYSTEM;**2,10**;JUN 14, 2007;Build 12

 ;

BEGIN ;EP - called from option

 D TAXCHK^BDMD619

 W:$D(IOF) @IOF

REGASK ;

 W !!!,$$CTR("ASSESSMENT OF DIABETES CARE, 2006")

 W !!,$$CTR("PCC 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=$S(Y=-1:"",1:+Y)

 S BDMJOB=$J,BDMBTH=$H

SDPI ;

 S BDMSDPI="",BDMSDPG=""

 S DIR(0)="S^1:Yes;2:No;3:Don't know",DIR("A")="Does your community receive SDPI grant funds" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) G REGASK

 S BDMSDPI=Y

 I BDMSDPI=1 D

 .S DIR(0)="FO^1:11",DIR("A")="Enter the SDPI Grant #" KILL DA D ^DIR KILL DIR

 .I $D(DIRUT) Q

 .S BDMSDPG=Y

 .Q

GETDATES ;

 S BDMSTP=0 D TIME I BDMSTP D XIT1,XIT Q

TYPE ;

 S BDMSTP=0

 K ^XTMP("BDMDM61",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",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 EPI INFO file;3:Cumulative Audit Only;4:Both Individual and Cumulative Audits",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

ZIS ;

DEMO ;

 D DEMOCHK^BDMUTL(.BDMDEMO)

 I BDMDEMO=-1 G IF

 I BDMPREP'=2 S XBRP="^BDMD61P",XBRC="^BDMD610",XBRX="XIT^BDMD61",XBNS="BDM"

 I BDMPREP=2 S XBRP="",XBRC="^BDMD610",XBRX="XIT^BDMD61",XBNS="BDM"

 D ^XBDBQUE

 D XIT

 Q

P ;

 S BDMSTP=0 K ^XTMP("BDMDM61",BDMJOB,BDMBTH),^TMP($J,"PATS")

P1 ;

 K DIC S DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC K DIC

 I Y=-1,'$D(^XTMP("BDMDM61",BDMJOB,BDMBTH,"PATS")) W !,"No patients selected" S BDMSTP=1 Q

 I Y=-1 Q

 S ^XTMP("BDMDM61",BDMJOB,BDMBTH,"PATS",+Y)=""

 G P1

 Q

S ; Get patient name or cohort

 K ^XTMP("BDMDM61",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 BDMPCP=+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)'=BDMPCP 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("BDMDM61",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 K 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("BDMDM61",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("BDMDM61",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=$$FMADD^XLFDT(BDMADAT,-365)

 S BDMRBD=$$FMTE^XLFDT(BDMBDAT)

 Q

 ;

XIT1 ;

 K ^BDMDATA($J),^BDMDATA("BDMEPI",$J)

 K ^XTMP("BDMDM61",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 ;

 S BDMFILE=""

 S DIR(0)="F^3:8",DIR("A")="Enter the name of the FILE to be Created (3-8 characters)" K DA D ^DIR K DIR

 I $D(DIRUT) S BDMSTP=1 Q

 I X'?1.8AN W !!,"Invalid format, must be letters and numbers",! G FLAT

 S BDMFILE=$$LOW^XLFSTR(Y)_".rec"

 W !!,"I am going to create a file called ",BDMFILE," which will reside in ",!,"the ",$S($P(^AUTTSITE(1,0),U,21)=1:"/usr/spool/uucppublic",$P($G(^AUTTSITE(1,1)),U,2)]"":$P(^AUTTSITE(1,1),U,2),1:"C:\EXPORT")," 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 EPI INFO.  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 2006 EPI REC 1",0))

 S (X,N)=0 F  S X=$O(^BDMRECD(I,13,X)) Q:X'=+X  S N=N+1,^BDMDATA($J,N)=^BDMRECD(I,13,X,0)

 ;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(DUZ(2),0)),U,11)]"" S XBUF=$P(^APCCCTRL(DUZ(2),0),U,11)

 S XBMED="F",XBFN=BDMFILE,XBTLE="SAVE OF DM AUDIT 2006 EPI INFO 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("BDMDM61",BDMJOB,BDMBTH),BDMJOB,BDMBTH

 Q

BDMG(BDMJOB,BDMBTH,BDMDMRG,BDMADAT,BDMTYPE,BDMSTMP,BDMPCP,BDMCOM,BDMRAND,BDMRCNT,BDMCMS,BDMSTAT,BDMPREP,BDMFILE,BDMDSP,BDMGIEN,BDMSDPI,BDMSDPG) ;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 BDMPREP=2,BDMFILE="" S BDMIEN=-1 Q

 S BDMRED=$$FMTE^XLFDT(BDMADAT)

 S BDMBDAT=$$FMADD^XLFDT(BDMADAT,-365)

 S BDMRBD=$$FMTE^XLFDT(BDMBDAT)

 S BDMGUI=1

 I $G(BDMDSP) D GUIEP Q

 ;create entry in fileman file to hold output

 N BDMOPT  ;maw

 S BDMOPT="2006 Diabetes Program Audit"

 D NOW^%DTC

 S BDMNOW=$G(%)

 K DD,D0,DIC

 S X=BDMJOB_"."_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^BDMD61",ZTDESC="GUI DM AUDIT" D ^%ZTLOAD

 D XIT

 Q

GUIEP ;EP - called from taskman

 D ^BDMD610

 I BDMPREP=2,'$G(BDMDSP) D ENDLOG Q

 K ^TMP($J,"BDMDM61")

 S IOM=80  ;cmi/maw added

 D GUIR^XBLM("^BDMD61P","^TMP($J,""BDMDM61"",")

 Q:$G(BDMDSP)  ;quit if to screen

 S X=0,C=0 F  S X=$O(^TMP($J,"BDMDM61",X)) Q:X'=+X  D

 .S BDMDATA=^TMP($J,"BDMDM61",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,"BDMDM61")

 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("BDMDM61",BDMJOB,BDMBTH,"PATS",X)=""

 D BDMG^BDMD61(BDMJOB,BDMBTH,1,DT,"P","","","","","","","",4,"TESTEPI",.BDMIEN)

 Q

BDMD61    ; IHS/CMI/LAB - IHS Diabetes Audit 2006 ;

 +1       ;;2.0;DIABETES MANAGEMENT SYSTEM;**2,10**;JUN 14, 2007;Build 12

 +2       ;

BEGIN     ;EP - called from option

 +1        DO TAXCHK^BDMD619

 +2        IF $DATA(IOF)

               WRITE @IOF

REGASK    ;

 +1        WRITE !!!,$$CTR("ASSESSMENT OF DIABETES CARE, 2006")

 +2        WRITE !!,$$CTR("PCC 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=$SELECT(Y=-1:"",1:+Y)

 +8        SET BDMJOB=$JOB

           SET BDMBTH=$HOROLOG

SDPI      ;

 +1        SET BDMSDPI=""

           SET BDMSDPG=""

 +2        SET DIR(0)="S^1:Yes;2:No;3:Don't know"

           SET DIR("A")="Does your community receive SDPI grant funds"

           KILL DA

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               GOTO REGASK

 +4        SET BDMSDPI=Y

 +5        IF BDMSDPI=1

               Begin DoDot:1

 +6                SET DIR(0)="FO^1:11"

                   SET DIR("A")="Enter the SDPI Grant #"

                   KILL DA

                   DO ^DIR

                   KILL DIR

 +7                IF $DATA(DIRUT)

                       QUIT 

 +8                SET BDMSDPG=Y

 +9                QUIT 

               End DoDot:1

GETDATES  ;

 +1        SET BDMSTP=0

           DO TIME

           IF BDMSTP

               DO XIT1

               DO XIT

               QUIT 

TYPE      ;

 +1        SET BDMSTP=0

 +2        KILL ^XTMP("BDMDM61",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"

           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

           DO @BDMTYPE

 +8        IF BDMSTP

               GOTO TYPE

IF        ;PEP - called from BDM indivdual or epi

 +1        SET BDMSTP=0

 +2        KILL DIR

           SET DIR(0)="S^1:Print Individual Reports;2:Create EPI INFO file;3:Cumulative Audit Only;4:Both Individual and Cumulative Audits"

           SET DIR("A")="Enter Print option"

           SET DIR("B")="1"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +3        IF $DATA(DIRUT)

               GOTO TYPE

 +4        SET BDMPREP=Y

 +5        IF BDMPREP=2

               DO FLAT

               IF BDMSTP

                   QUIT 

ZIS       ;

DEMO      ;

 +1        DO DEMOCHK^BDMUTL(.BDMDEMO)

 +2        IF BDMDEMO=-1

               GOTO IF

 +3        IF BDMPREP'=2

               SET XBRP="^BDMD61P"

               SET XBRC="^BDMD610"

               SET XBRX="XIT^BDMD61"

               SET XBNS="BDM"

 +4        IF BDMPREP=2

               SET XBRP=""

               SET XBRC="^BDMD610"

               SET XBRX="XIT^BDMD61"

               SET XBNS="BDM"

 +5        DO ^XBDBQUE

 +6        DO XIT

 +7        QUIT 

P         ;

 +1        SET BDMSTP=0

           KILL ^XTMP("BDMDM61",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("BDMDM61",BDMJOB,BDMBTH,"PATS"))

                   WRITE !,"No patients selected"

                   SET BDMSTP=1

                   QUIT 

 +3        IF Y=-1

               QUIT 

 +4        SET ^XTMP("BDMDM61",BDMJOB,BDMBTH,"PATS",+Y)=""

 +5        GOTO P1

 +6        QUIT 

S         ; Get patient name or cohort

 +1        KILL ^XTMP("BDMDM61",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 BDMPCP=+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)'=BDMPCP

                   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("BDMDM61",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

           KILL 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("BDMDM61",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("BDMDM61",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=$$FMADD^XLFDT(BDMADAT,-365)

 +9        SET BDMRBD=$$FMTE^XLFDT(BDMBDAT)

 +10       QUIT 

 +11      ;

XIT1      ;

 +1        KILL ^BDMDATA($JOB),^BDMDATA("BDMEPI",$JOB)

 +2        KILL ^XTMP("BDMDM61",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        SET BDMFILE=""

 +2        SET DIR(0)="F^3:8"

           SET DIR("A")="Enter the name of the FILE to be Created (3-8 characters)"

           KILL DA

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)