APCLD61 ; IHS/CMI/LAB - IHS Diabetes Audit 2006 ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;
BEGIN ;EP - called from option
D TAXCHK^APCLD619
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 APCLDMRG="" W !,"NO Register Selected!!! The CMS register will not be used in retrieving",!,"any data."
S APCLDMRG=$S(Y=-1:"",1:+Y)
S APCLJOB=$J,APCLBTH=$H
SDPI ;
S APCLSDPI="",APCLSDPG=""
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 APCLSDPI=Y
I APCLSDPI=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 APCLSDPG=Y
.Q
GETDATES ;
S APCLSTP=0 D TIME I APCLSTP D XIT1,XIT Q
TYPE ;
S APCLSTP=0
K ^XTMP("APCLDM61",APCLJOB,APCLBTH),^TMP($J,"PATS")
S APCLTYPE=""
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 APCLTYPE=Y
S APCLSTP=0 D @APCLTYPE
I APCLSTP G TYPE
IF ;PEP - called from BDM indivdual or epi
S APCLSTP=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 APCLPREP=Y
I APCLPREP=2 D FLAT Q:APCLSTP
ZIS ;
DEMO ;
D DEMOCHK^APCLUTL(.APCLDEMO)
I APCLDEMO=-1 G IF
I APCLPREP'=2 S XBRP="^APCLD61P",XBRC="^APCLD610",XBRX="XIT^APCLD61",XBNS="APCL"
I APCLPREP=2 S XBRP="",XBRC="^APCLD610",XBRX="XIT^APCLD61",XBNS="APCL"
D ^XBDBQUE
D XIT
Q
P ;
S APCLSTP=0 K ^XTMP("APCLDM61",APCLJOB,APCLBTH),^TMP($J,"PATS")
P1 ;
K DIC S DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC K DIC
I Y=-1,'$D(^XTMP("APCLDM61",APCLJOB,APCLBTH,"PATS")) W !,"No patients selected" S APCLSTP=1 Q
I Y=-1 Q
S ^XTMP("APCLDM61",APCLJOB,APCLBTH,"PATS",+Y)=""
G P1
Q
S ; Get patient name or cohort
K ^XTMP("APCLDM61",APCLJOB,APCLBTH),^TMP($J,"PATS") S APCLSTP=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 APCLSTP=1 W !,"No template selected." Q
S APCLCNT=0 F APCLPD=0:0 S APCLPD=$O(^DIBT(+Y,1,APCLPD)) Q:'APCLPD S APCLCNT=APCLCNT+1,^TMP($J,"PATS",APCLCNT,APCLPD)=""
W !!,"There are ",APCLCNT," patients in the ",$P(^DIBT(+Y,0),U)," template/cohort.",!
D PCP
Q:APCLSTP
D CC
Q:APCLSTP
D RAND
Q
PCP ;
S APCLSTP=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 APCLSTP=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 APCLPCP=+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)'=APCLPCP 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 APCLSTP=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 APCLSTP=1 Q
Q:'Y
K DIC S DIC="^AUTTCOM(",DIC(0)="AEMQ" D ^DIC K DIC
I Y=-1 G CC
S APCLCOM=$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)'=APCLCOM 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("APCLDM61",APCLJOB,APCLBTH),^TMP($J,"PATS")
S APCLCMS="",APCLSTP=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 APCLSTP=1 Q
S APCLCMS=+Y
;get status
S APCLSTAT=""
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 APCLSTAT=Y
C1 ;
;gather up patients from register in ^XTMP
K ^TMP($J,"PATS") S APCLCNT=0,X=0 F S X=$O(^ACM(41,"B",APCLCMS,X)) Q:X'=+X D
.I APCLSTAT]"",$P($G(^ACM(41,X,"DT")),U,1)=APCLSTAT S APCLCNT=APCLCNT+1,^TMP($J,"PATS",APCLCNT,$P(^ACM(41,X,0),U,2))="" Q
.I APCLSTAT="" S APCLCNT=APCLCNT+1,^TMP($J,"PATS",APCLCNT,$P(^ACM(41,X,0),U,2))=""
I '$D(^TMP($J,"PATS")) W !,"No patients with that status in that register!" S APCLSTP=1 G C
W !!,"There are ",APCLCNT," patients in the ",$P(^ACM(41.1,APCLCMS,0),U)," register with a status of ",APCLSTAT,".",!!
D PCP
Q:APCLSTP
D CC
Q:APCLSTP
D RAND
Q
RAND ;random sample or not
S (X,APCLCNT)=0 F S X=$O(^TMP($J,"PATS",X)) Q:X'=+X S APCLCNT=APCLCNT+1
W !!,"There are ",APCLCNT," 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("APCLDM61",APCLJOB,APCLBTH,"PATS",X)=""
I Y="A" K ^TMP($J,"PATS") Q
S DIR(0)="N^2:"_APCLCNT_":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 APCLSTP=1 Q
S C=0 F N=1:1:APCLCNT Q:C=Y S I=$R(APCLCNT) I I,$D(^TMP($J,"PATS",I)) S X=$O(^TMP($J,"PATS",I,0)),^XTMP("APCLDM61",APCLJOB,APCLBTH,"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 APCLSTP=0
S (APCLRBD,APCLRED,APCLADAT)=""
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 APCLSTP=1 Q
S APCLADAT=Y
S APCLRED=$$FMTE^XLFDT(APCLADAT)
S APCLBDAT=$$FMADD^XLFDT(APCLADAT,-365)
S APCLRBD=$$FMTE^XLFDT(APCLBDAT)
Q
;
XIT1 ;
K ^APCLDATA($J),^APCLDATA("APCLEPI",$J)
K ^XTMP("APCLDM61",APCLJOB,APCLBTH),APCLJOB,APCLBTH
XIT ;
D EN^XBVK("APCL"),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 APCLFILE=""
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 APCLSTP=1 Q
I X'?1.8AN W !!,"Invalid format, must be letters and numbers",! G FLAT
S APCLFILE=$$LOW^XLFSTR(Y)_".rec"
W !!,"I am going to create a file called ",APCLFILE," 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,"********** ",APCLFILE," **********",!
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 ",APCLFILE
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 APCLSTP=1 Q
I 'Y S APCLSTP=1 Q
Q
WRITEF ;EP write flat file
K ^APCLDATA($J)
Q:'$D(^APCLDATA("APCLEPI",$J))
;load in epi definition to ^APCLDATA($J,"APCL EPI"
S I=$O(^APCLRECD("B","DM AUDIT 2006 EPI REC 1",0))
S (X,N)=0 F S X=$O(^APCLRECD(I,13,X)) Q:X'=+X S N=N+1,^APCLDATA($J,N)=^APCLRECD(I,13,X,0)
;MOVE RECORDS TO ^APCLDATA($J,"APCL EPI"
S X=0 F S X=$O(^APCLDATA("APCLEPI",$J,X)) Q:X'=+X S N=N+1,^APCLDATA($J,N)=^APCLDATA("APCLEPI",$J,X)
K ^APCLDATA("APCLEPI",$J)
S XBGL="APCLDATA("
K XBUF I $P($G(^APCCCTRL(DUZ(2),0)),U,11)]"" S XBUF=$P(^APCCCTRL(DUZ(2),0),U,11)
S XBMED="F",XBFN=APCLFILE,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 ^APCLDATA("APCLEPI",$J)
K XBGL,XBMED,XBTLE,XBFN,XBF,XBQ,XBFLT,XBE
K ^APCLDATA($J)
K ^XTMP("APCLDM61",APCLJOB,APCLBTH),APCLJOB,APCLBTH
Q
BDMG(APCLJOB,APCLBTH,APCLDMRG,APCLADAT,APCLTYPE,APCLSTMP,APCLPCP,APCLCOM,APCLRAND,APCLRCNT,APCLCMS,APCLSTAT,APCLPREP,APCLFILE,APCLDSP,BDMGIEN,APCLSDPI,APCLSDPG) ;PEP - gui call
I $G(APCLJOB)="" S APCLIEN=-1 Q
I $G(APCLBTH)="" S APCLIEN=-1 Q
I $G(APCLADAT)="" S APCLIEN=-1 Q
I $G(APCLTYPE)="" S APCLIEN=-1 Q
I $G(APCLPREP)="" S APCLIEN=-1 Q
I APCLPREP=2,APCLFILE="" S APCLIEN=-1 Q
S APCLRED=$$FMTE^XLFDT(APCLADAT)
S APCLBDAT=$$FMADD^XLFDT(APCLADAT,-365)
S APCLRBD=$$FMTE^XLFDT(APCLBDAT)
S APCLGUI=1
I $G(APCLDSP) D GUIEP Q
;create entry in fileman file to hold output
N APCLOPT ;maw
S APCLOPT="2006 Diabetes Program Audit"
D NOW^%DTC
S APCLNOW=$G(%)
K DD,D0,DIC
S X=APCLJOB_"."_APCLBTH
S DIC("DR")=".02////"_DUZ_";.03////"_APCLNOW_";.05////"_$G(APCLPREP)_";.06///"_$G(APCLOPT)_";.07////R"
S DIC="^APCLGUIR(",DIC(0)="L",DIADD=1,DLAYGO=9001004.4
D FILE^DICN
K DIADD,DLAYGO,DIC,DA
I Y=-1 S APCLIEN=-1 Q
S APCLIEN=+Y
S BDMGIEN=APCLIEN ;cmi/maw added
D ^XBFMK
K ZTSAVE S ZTSAVE("*")=""
;D GUIEP for interactive testing
S ZTIO="",ZTDTH=$$NOW^XLFDT,ZTRTN="GUIEP^APCLD61",ZTDESC="GUI DM AUDIT" D ^%ZTLOAD
D XIT
Q
GUIEP ;EP - called from taskman
D ^APCLD610
I APCLPREP=2,'$G(APCLDSP) D ENDLOG Q
K ^TMP($J,"APCLDM61")
S IOM=80 ;cmi/maw added
D GUIR^XBLM("^APCLD61P","^TMP($J,""APCLDM61"",")
Q:$G(APCLDSP) ;quit if to screen
S X=0,C=0 F S X=$O(^TMP($J,"APCLDM61",X)) Q:X'=+X D
.S APCLDATA=^TMP($J,"APCLDM61",X)
.I APCLDATA="ZZZZZZZ" S APCLDATA=$C(12)
.S ^APCLGUIR(APCLIEN,11,X,0)=APCLDATA,C=C+1
S ^APCLGUIR(APCLIEN,11,0)="^^"_C_"^"_C_"^"_DT_"^"
S DA=APCLIEN,DIK="^APCLGUIR(" D IX1^DIK
D ENDLOG
K ^TMP($J,"APCLDM61")
S ZTREQ="@"
Q
;
ENDLOG ;-- write the end of the log
D NOW^%DTC
S APCLNOW=$G(%)
S DIE="^APCLGUIR(",DA=APCLIEN,DR=".04////"_APCLNOW_";.07////C"
D ^DIE
K DIE,DR,DA
Q
;
TEST ;
S APCLJOB=7,APCLBTH="59812,48383"
F X=1:1:10 S ^XTMP("APCLDM61",APCLJOB,APCLBTH,"PATS",X)=""
D BDMG^APCLD61(APCLJOB,APCLBTH,1,DT,"P","","","","","","","",4,"TESTEPI",.APCLIEN)
Q
APCLD61 ; IHS/CMI/LAB - IHS Diabetes Audit 2006 ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;
BEGIN ;EP - called from option
+1 DO TAXCHK^APCLD619
+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 APCLDMRG=""
WRITE !,"NO Register Selected!!! The CMS register will not be used in retrieving",!,"any data."
+7 SET APCLDMRG=$SELECT(Y=-1:"",1:+Y)
+8 SET APCLJOB=$JOB
SET APCLBTH=$HOROLOG
SDPI ;
+1 SET APCLSDPI=""
SET APCLSDPG=""
+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 APCLSDPI=Y
+5 IF APCLSDPI=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 APCLSDPG=Y
+9 QUIT
End DoDot:1
GETDATES ;
+1 SET APCLSTP=0
DO TIME
IF APCLSTP
DO XIT1
DO XIT
QUIT
TYPE ;
+1 SET APCLSTP=0
+2 KILL ^XTMP("APCLDM61",APCLJOB,APCLBTH),^TMP($JOB,"PATS")
+3 SET APCLTYPE=""
+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 APCLTYPE=Y
+7 SET APCLSTP=0
DO @APCLTYPE
+8 IF APCLSTP
GOTO TYPE
IF ;PEP - called from BDM indivdual or epi
+1 SET APCLSTP=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 APCLPREP=Y
+5 IF APCLPREP=2
DO FLAT
IF APCLSTP
QUIT
ZIS ;
DEMO ;
+1 DO DEMOCHK^APCLUTL(.APCLDEMO)
+2 IF APCLDEMO=-1
GOTO IF
+3 IF APCLPREP'=2
SET XBRP="^APCLD61P"
SET XBRC="^APCLD610"
SET XBRX="XIT^APCLD61"
SET XBNS="APCL"
+4 IF APCLPREP=2
SET XBRP=""
SET XBRC="^APCLD610"
SET XBRX="XIT^APCLD61"
SET XBNS="APCL"
+5 DO ^XBDBQUE
+6 DO XIT
+7 QUIT
P ;
+1 SET APCLSTP=0
KILL ^XTMP("APCLDM61",APCLJOB,APCLBTH),^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("APCLDM61",APCLJOB,APCLBTH,"PATS"))
WRITE !,"No patients selected"
SET APCLSTP=1
QUIT
+3 IF Y=-1
QUIT
+4 SET ^XTMP("APCLDM61",APCLJOB,APCLBTH,"PATS",+Y)=""
+5 GOTO P1
+6 QUIT
S ; Get patient name or cohort
+1 KILL ^XTMP("APCLDM61",APCLJOB,APCLBTH),^TMP($JOB,"PATS")
SET APCLSTP=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 APCLSTP=1
WRITE !,"No template selected."
QUIT
+5 SET APCLCNT=0
FOR APCLPD=0:0
SET APCLPD=$ORDER(^DIBT(+Y,1,APCLPD))
IF 'APCLPD
QUIT
SET APCLCNT=APCLCNT+1
SET ^TMP($JOB,"PATS",APCLCNT,APCLPD)=""
+6 WRITE !!,"There are ",APCLCNT," patients in the ",$PIECE(^DIBT(+Y,0),U)," template/cohort.",!
+7 DO PCP
+8 IF APCLSTP
QUIT
+9 DO CC
+10 IF APCLSTP
QUIT
+11 DO RAND
+12 QUIT
PCP ;
+1 SET APCLSTP=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 APCLSTP=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 APCLPCP=+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)'=APCLPCP
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 APCLSTP=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 APCLSTP=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 APCLCOM=$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)'=APCLCOM
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("APCLDM61",APCLJOB,APCLBTH),^TMP($JOB,"PATS")
+2 SET APCLCMS=""
SET APCLSTP=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 APCLSTP=1
QUIT
+5 SET APCLCMS=+Y
+6 ;get status
+7 SET APCLSTAT=""
+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 APCLSTAT=Y
C1 ;
+1 ;gather up patients from register in ^XTMP
+2 KILL ^TMP($JOB,"PATS")
SET APCLCNT=0
SET X=0
FOR
SET X=$ORDER(^ACM(41,"B",APCLCMS,X))
IF X'=+X
QUIT
Begin DoDot:1
+3 IF APCLSTAT]""
IF $PIECE($GET(^ACM(41,X,"DT")),U,1)=APCLSTAT
SET APCLCNT=APCLCNT+1
SET ^TMP($JOB,"PATS",APCLCNT,$PIECE(^ACM(41,X,0),U,2))=""
QUIT
+4 IF APCLSTAT=""
SET APCLCNT=APCLCNT+1
SET ^TMP($JOB,"PATS",APCLCNT,$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 APCLSTP=1
GOTO C
+6 WRITE !!,"There are ",APCLCNT," patients in the ",$PIECE(^ACM(41.1,APCLCMS,0),U)," register with a status of ",APCLSTAT,".",!!
+7 DO PCP
+8 IF APCLSTP
QUIT
+9 DO CC
+10 IF APCLSTP
QUIT
+11 DO RAND
+12 QUIT
RAND ;random sample or not
+1 SET (X,APCLCNT)=0
FOR
SET X=$ORDER(^TMP($JOB,"PATS",X))
IF X'=+X
QUIT
SET APCLCNT=APCLCNT+1
+2 WRITE !!,"There are ",APCLCNT," 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("APCLDM61",APCLJOB,APCLBTH,"PATS",X)=""
+6 IF Y="A"
KILL ^TMP($JOB,"PATS")
QUIT
+7 SET DIR(0)="N^2:"_APCLCNT_":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 APCLSTP=1
QUIT
+10 SET C=0
FOR N=1:1:APCLCNT
IF C=Y
QUIT
SET I=$RANDOM(APCLCNT)
IF I
IF $DATA(^TMP($JOB,"PATS",I))
SET X=$ORDER(^TMP($JOB,"PATS",I,0))
SET ^XTMP("APCLDM61",APCLJOB,APCLBTH,"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 APCLSTP=0
+2 SET (APCLRBD,APCLRED,APCLADAT)=""
+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 APCLSTP=1
QUIT
+6 SET APCLADAT=Y
+7 SET APCLRED=$$FMTE^XLFDT(APCLADAT)
+8 SET APCLBDAT=$$FMADD^XLFDT(APCLADAT,-365)
+9 SET APCLRBD=$$FMTE^XLFDT(APCLBDAT)
+10 QUIT
+11 ;
XIT1 ;
+1 KILL ^APCLDATA($JOB),^APCLDATA("APCLEPI",$JOB)
+2 KILL ^XTMP("APCLDM61",APCLJOB,APCLBTH),APCLJOB,APCLBTH
XIT ;
+1 DO EN^XBVK("APCL")
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 APCLFILE=""
+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)
SET APCLSTP=1
QUIT
+4 IF X'?1.8AN
WRITE !!,"Invalid format, must be letters and numbers",!
GOTO FLAT
+5 SET APCLFILE=$$LOW^XLFSTR(Y)_".rec"
+6 WRITE !!,"I am going to create a file called ",APCLFILE," which will reside in ",!,"the ",$SELECT(...
... $PIECE(^AUTTSITE(1,0),U,21)=1:"/usr/spool/uucppublic",$PIECE($GET(^AUTTSITE(1,1)),U,2)]"":$PIECE(^AUTTSITE(1,1),U,2),1:"C:\EXPORT")," directory on your RPMS server. ",!
+7 WRITE "It is the same directory that the data export globals are placed."
+8 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,"********** ",APCLFILE," **********",!
+9 WRITE "It may be several hours (or overnight) before your report and flat file are ",!,"finished.",!
+10 WRITE !,"The records that are generated and placed in file ",APCLFILE
+11 WRITE !,"are in a format readable by EPI INFO. For a definition of the format",!,"please see your user manual.",!
+12 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
+13 IF $DATA(DIRUT)
SET APCLSTP=1
QUIT
+14 IF 'Y
SET APCLSTP=1
QUIT
+15 QUIT
WRITEF ;EP write flat file
+1 KILL ^APCLDATA($JOB)
+2 IF '$DATA(^APCLDATA("APCLEPI",$JOB))
QUIT
+3 ;load in epi definition to ^APCLDATA($J,"APCL EPI"
+4 SET I=$ORDER(^APCLRECD("B","DM AUDIT 2006 EPI REC 1",0))
+5 SET (X,N)=0
FOR
SET X=$ORDER(^APCLRECD(I,13,X))
IF X'=+X
QUIT
SET N=N+1
SET ^APCLDATA($JOB,N)=^APCLRECD(I,13,X,0)
+6 ;MOVE RECORDS TO ^APCLDATA($J,"APCL EPI"
+7 SET X=0
FOR
SET X=$ORDER(^APCLDATA("APCLEPI",$JOB,X))
IF X'=+X
QUIT
SET N=N+1
SET ^APCLDATA($JOB,N)=^APCLDATA("APCLEPI",$JOB,X)
+8 KILL ^APCLDATA("APCLEPI",$JOB)
+9 SET XBGL="APCLDATA("
+10 KILL XBUF
IF $PIECE($GET(^APCCCTRL(DUZ(2),0)),U,11)]""
SET XBUF=$PIECE(^APCCCTRL(DUZ(2),0),U,11)
+11 SET XBMED="F"
SET XBFN=APCLFILE
SET XBTLE="SAVE OF DM AUDIT 2006 EPI INFO RECORDS GENERATED BY -"_$PIECE(^VA(200,DUZ,0),U)
+12 SET XBQ="N"
SET XBFLT=1
SET XBE=$JOB
SET XBF=$JOB
+13 DO ^XBGSAVE
+14 ;check for error
+15 KILL ^APCLDATA("APCLEPI",$JOB)
+16 KILL XBGL,XBMED,XBTLE,XBFN,XBF,XBQ,XBFLT,XBE
+17 KILL ^APCLDATA($JOB)
+18 KILL ^XTMP("APCLDM61",APCLJOB,APCLBTH),APCLJOB,APCLBTH
+19 QUIT
BDMG(APCLJOB,APCLBTH,APCLDMRG,APCLADAT,APCLTYPE,APCLSTMP,APCLPCP,APCLCOM,APCLRAND,APCLRCNT,APCLCMS,APCLSTAT,APCLPREP,APCLFILE,APCLDSP,BDMGIEN,APCLSDPI,APCLSDPG) ;PEP - gui call
+1 IF $GET(APCLJOB)=""
SET APCLIEN=-1
QUIT
+2 IF $GET(APCLBTH)=""
SET APCLIEN=-1
QUIT
+3 IF $GET(APCLADAT)=""
SET APCLIEN=-1
QUIT
+4 IF $GET(APCLTYPE)=""
SET APCLIEN=-1
QUIT
+5 IF $GET(APCLPREP)=""
SET APCLIEN=-1
QUIT
+6 IF APCLPREP=2
IF APCLFILE=""
SET APCLIEN=-1
QUIT
+7 SET APCLRED=$$FMTE^XLFDT(APCLADAT)
+8 SET APCLBDAT=$$FMADD^XLFDT(APCLADAT,-365)
+9 SET APCLRBD=$$FMTE^XLFDT(APCLBDAT)
+10 SET APCLGUI=1
+11 IF $GET(APCLDSP)
DO GUIEP
QUIT
+12 ;create entry in fileman file to hold output
+13 ;maw
NEW APCLOPT
+14 SET APCLOPT="2006 Diabetes Program Audit"
+15 DO NOW^%DTC
+16 SET APCLNOW=$GET(%)
+17 KILL DD,D0,DIC
+18 SET X=APCLJOB_"."_APCLBTH
+19 SET DIC("DR")=".02////"_DUZ_";.03////"_APCLNOW_";.05////"_$GET(APCLPREP)_";.06///"_$GET(APCLOPT)_";.07////R"
+20 SET DIC="^APCLGUIR("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=9001004.4
+21 DO FILE^DICN
+22 KILL DIADD,DLAYGO,DIC,DA
+23 IF Y=-1
SET APCLIEN=-1
QUIT
+24 SET APCLIEN=+Y
+25 ;cmi/maw added
SET BDMGIEN=APCLIEN
+26 DO ^XBFMK
+27 KILL ZTSAVE
SET ZTSAVE("*")=""
+28 ;D GUIEP for interactive testing
+29 SET ZTIO=""
SET ZTDTH=$$NOW^XLFDT
SET ZTRTN="GUIEP^APCLD61"
SET ZTDESC="GUI DM AUDIT"
DO ^%ZTLOAD
+30 DO XIT
+31 QUIT
GUIEP ;EP - called from taskman
+1 DO ^APCLD610
+2 IF APCLPREP=2
IF '$GET(APCLDSP)
DO ENDLOG
QUIT
+3 KILL ^TMP($JOB,"APCLDM61")
+4 ;cmi/maw added
SET IOM=80
+5 DO GUIR^XBLM("^APCLD61P","^TMP($J,""APCLDM61"",")
+6 ;quit if to screen
IF $GET(APCLDSP)
QUIT
+7 SET X=0
SET C=0
FOR
SET X=$ORDER(^TMP($JOB,"APCLDM61",X))
IF X'=+X
QUIT
Begin DoDot:1
+8 SET APCLDATA=^TMP($JOB,"APCLDM61",X)
+9 IF APCLDATA="ZZZZZZZ"
SET APCLDATA=$CHAR(12)
+10 SET ^APCLGUIR(APCLIEN,11,X,0)=APCLDATA
SET C=C+1
End DoDot:1
+11 SET ^APCLGUIR(APCLIEN,11,0)="^^"_C_"^"_C_"^"_DT_"^"
+12 SET DA=APCLIEN
SET DIK="^APCLGUIR("
DO IX1^DIK
+13 DO ENDLOG
+14 KILL ^TMP($JOB,"APCLDM61")
+15 SET ZTREQ="@"
+16 QUIT
+17 ;
ENDLOG ;-- write the end of the log
+1 DO NOW^%DTC
+2 SET APCLNOW=$GET(%)
+3 SET DIE="^APCLGUIR("
SET DA=APCLIEN
SET DR=".04////"_APCLNOW_";.07////C"
+4 DO ^DIE
+5 KILL DIE,DR,DA
+6 QUIT
+7 ;
TEST ;
+1 SET APCLJOB=7
SET APCLBTH="59812,48383"
+2 FOR X=1:1:10
SET ^XTMP("APCLDM61",APCLJOB,APCLBTH,"PATS",X)=""
+3 DO BDMG^APCLD61(APCLJOB,APCLBTH,1,DT,"P","","","","","","","",4,"TESTEPI",.APCLIEN)
+4 QUIT
