BDMDR5 ; IHS/CMI/LAB - patients w/o dm on problem list ;
;;2.0;DIABETES MANAGEMENT SYSTEM;**2,3,8,9,10**;JUN 14, 2007;Build 12
;
;
START ;
D INFORM
D EXIT
R ;
S BDMREG=""
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." D EXIT Q
S BDMREG=+Y
STAT ;get status
W !!,"Select the Patient Status for this report"
S BDMSTAT=""
K DIR
S DIR(0)="S^"_$P(^DD(9002241,1,0),U,3)_";0:All Register Patients",DIR("A")="Which Status",DIR("B")="A" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G R
I Y=0 S BDMSTAT="" G CLINIC
S BDMSTAT=Y
CLINIC ;
W !!,"Enter the list of clinics that you have determined to be primary care clinics."
W !,"You can enter them 1 at a time or enter a taxonomy using the '[' notation."
K BDMCLIN
S X="CLINIC",DIC="^AMQQ(5,",DIC(0)="FM",DIC("S")="I $P(^(0),U,14)" D ^DIC K DIC,DA
D PEP^AMQQGTX0(+Y,"BDMCLIN(")
I '$D(BDMCLIN) W !,"NO CLINICS SELECTED" K BDMCLIN G STAT
I $D(BDMCLIN("*")) W !,"ALL (ANY) CLINIC WILL BE INCLUDED" K BDMCLIN
GETDATES ;
BD ;
W !!!,"Enter the time frame to look for visits.",! S DIR(0)="D^::EP",DIR("A")="Enter Beginning Visit Date",DIR("?")="Enter the beginning visit date for the search." D ^DIR K DIR S:$D(DUOUT) DIRUT=1
G:$D(DIRUT) CLINIC
S BDMBD=Y
ED ;
S DIR(0)="DA^::EP",DIR("A")="Enter Ending Visit Date: " D ^DIR K DIR S:$D(DUOUT) DIRUT=1
G:$D(DIRUT) GETDATES
I Y<BDMBD W !,"Ending date must be greater than or equal to beginning date!" G ED
S BDMED=Y
S X1=BDMBD,X2=-1 D C^%DTC S BDMSD=X
ZIS ;
S BDMTEMP=""
S DIR(0)="S^P:PRINT the List;B:BROWSE the List on the Screen",DIR("A")="Output Type",DIR("B")="P" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G GETDATES
S BDMTEMP=Y
;call to XBDBQUE
DEMO ;
D DEMOCHK^BDMUTL(.BDMDEMO)
I BDMDEMO=-1 D EXIT Q
I BDMTEMP="B" D BROWSE,EXIT Q
S XBRP="PRINT^BDMDR5",XBRC="PROC^BDMDR5",XBRX="EXIT^BDMDR5",XBNS="BDM"
D ^XBDBQUE
D EXIT
Q
BROWSE ;
S XBRP="VIEWR^XBLM(""PRINT^BDMDR5"")"
S XBRC="PROC^BDMDR5",XBRX="EXIT^BDMDR5",XBIOP=0 D ^XBDBQUE
Q
EXIT ;clean up and exit
I '$D(BDMGUI) D EN^XBVK("BDM")
D ^XBFMK
D KILL^AUPNPAT
Q
INFORM ;
W:$D(IOF) @IOF
W !,$$CTR($$LOC)
W !,$$CTR($$USR)
W !!,"This report will list patients who are on the diabetes register who have not",!
W "had a visit to a set of primary care clinics in a date range defined by the ",!,"user.",!
W "The report provides a way to identify patients who could possibly be inactivated",!
W "in the register.",!!
Q
PROC ;EP - called from XBDBQUE
S BDMJOB=$J,BDMBTH=$H
K ^XTMP("BDMDR5",BDMJOB,BDMBTH)
D XTMP^BDMOSUT("BDMDR5","DM ON REGISTER NOT ACTIVE")
S BDMP=0 F S BDMP=$O(^ACM(41,"B",BDMREG,BDMP)) Q:BDMP'=+BDMP D
.Q:'$D(^ACM(41,BDMP))
.S BDMPAT=$P(^ACM(41,BDMP,0),U,2)
.Q:$$DEMO^BDMUTL(BDMPAT,$G(BDMDEMO))
.I $G(BDMSTAT)]"",$P($G(^ACM(41,BDMP,"DT")),U,1)'=BDMSTAT Q
.;LOOP VISITS UNTIL FIND ONE THAT FITS DEFINITION
.K BDMV
.D ALLV^APCLAPIU(BDMPAT,BDMBD,BDMED,"BDMV")
.S BDMG=0,BDMX=0
.F S BDMX=$O(BDMV(BDMX)) Q:BDMX'=+BDMX!(BDMG) D
..S BDMVST=$P(BDMV(BDMX),U,5)
..S BDMC=$$GET1^DIQ(9000010,BDMVST,.08,"I")
..Q:'BDMC
..I $D(BDMCLIN),'$D(BDMCLIN(BDMC)) Q ;not a clinic of interest
..S BDMG=1
.I 'BDMG S ^XTMP("BDMDR5",BDMJOB,BDMBTH,"PATIENTS",$$GET1^DIQ(2,BDMPAT,.01),BDMPAT)=""
Q
PRINT ;EP - called from xbdbque
S BDMIOSL=$S($G(BDMGUI):55,1:IOSL)
S BDM80D="-------------------------------------------------------------------------------"
S BDMPG=0 D HEAD
I '$D(^XTMP("BDMDR5",BDMJOB,BDMBTH)) W !!,"NO PATIENTS TO REPORT" G DONE
S BDMNAME="" K BDMQ
F S BDMNAME=$O(^XTMP("BDMDR5",BDMJOB,BDMBTH,"PATIENTS",BDMNAME)) Q:BDMNAME=""!($D(BDMQ)) D
.S DFN="" F S DFN=$O(^XTMP("BDMDR5",BDMJOB,BDMBTH,"PATIENTS",BDMNAME,DFN)) Q:DFN=""!($D(BDMQ)) S BDMX=^XTMP("BDMDR5",BDMJOB,BDMBTH,"PATIENTS",BDMNAME,DFN) D
..I $Y>(BDMIOSL-4) D HEAD Q:$D(BDMQ)
..W !,$E(BDMNAME,1,20),?22,$$HRN^AUPNPAT(DFN,$S($G(BDMDUZ2):BDMDUZ2,1:DUZ(2))),?29,$E($$RSTAT(BDMREG,DFN),1,8)
..W ?38,$E($$CM(BDMREG,DFN),1,10)
..S V=$$LASTV(DFN)
..W ?49,$$DATE^BDMS9B1($P(V,U,1))
..W ?61,$$LBLK^BDMUTL($$NUMDXS(DFN),5)
..W ?68,$$DATE^BDMS9B1($$LASTDMDX(DFN))
DONE ;
I $E(IOST)="C",IO=IO(0) S DIR(0)="EO",DIR("A")="End of report. HIT RETURN" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
W:$D(IOF) @IOF
K ^XTMP("BDMDR5",BDMJOB,BDMBTH),BDMJOB,BDMBTH
Q
HEAD I 'BDMPG G HEAD1
I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BDMQ="" Q
HEAD1 ;
W:$D(IOF) @IOF S BDMPG=BDMPG+1
I $G(BDMGUI),BDMPG'=1 W !,"ZZZZZZZ"
W !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"
W !,$P(^VA(200,DUZ,0),U,2),?72,"Page ",BDMPG,!
W ?(80-$L($P(^DIC(4,$S($G(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0),U))/2),$P(^DIC(4,$S($G(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0),U),!
W $$CTR("Patients on the "_$P(^ACM(41.1,BDMREG,0),U)_" Register",80),!
W $$CTR("without a visit between "_$$FMTE^XLFDT(BDMBD)_" and "_$$FMTE^XLFDT(BDMED),80),!
PIH W !,"PATIENT NAME",?22,"HRN",?29,"STATUS",?38,"CASE ",?49,"LAST VISIT",?61,"# DM",?68,"LAST DM DX",!,?38,"MANAGER",?61,"DXS",!,BDM80D
Q
NUMDXS(P) ;
I '$G(P) Q ""
NEW X,E,BDM,Y
S Y="BDM("
S X=P_"^ALL DX [SURVEILLANCE DIABETES" S E=$$START1^APCLDF(X,Y)
S (X,Y)=0
F S X=$O(BDM(X)) Q:X'=+X S Y=Y+1
Q Y
LASTV(P) ;
NEW X,Y,Z,V,D
S V=""
S D=0 F S D=$O(^AUPNVSIT("AA",P,D)) Q:D'=+D!(V) D
.S X=0 F S X=$O(^AUPNVSIT("AA",P,D,X)) Q:X'=+X!(V) D
..Q:'$D(^AUPNVSIT(X,0))
..Q:$P(^AUPNVSIT(X,0),U,11) ;deleted
..Q:'$P(^AUPNVSIT(X,0),U,9) ;ZERO DEP
..Q:"CTNEDX"[$P(^AUPNVSIT(X,0),U,7)
..S V=X
I V="" Q ""
Q $$GET1^DIQ(9000010,V,.01,"I")_U_$$GET1^DIQ(9000010,V,.08,"I")
LASTDMDX(P) ;
I '$G(P) Q ""
NEW X,E,BDM,Y
S Y="BDM("
S X=P_"^LAST DX [SURVEILLANCE DIABETES" S E=$$START1^APCLDF(X,Y)
I $D(BDM(1)) Q $P(BDM(1),U)
Q ""
CM(REG,PAT) ;
NEW X
S X=$G(^ACM(41,"AC",PAT,REG))
I X="" Q ""
Q $$GET1^DIQ(9002241,X,6)
RSTAT(REG,PAT) ;
NEW X
S X=$G(^ACM(41,"AC",PAT,REG))
I X="" Q ""
Q $$GET1^DIQ(9002241,X,1)
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;----------
EOP ;EP - End of page.
Q:$E(IOST)'="C"
Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))
NEW DIR
K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
S DIR(0)="E" D ^DIR
Q
;----------
USR() ;EP - Return name of current user from ^VA(200.
Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
;----------
TEST ;
D BDMG("R",1,"A")
Q
BDMG(BDMTR,BDMREG,BDMSTAT,BDMND,BDMLDAT) ;EP - GUI DMS Entry Point
S BDMND=$G(BDMND)
S BDMGUI=1
S BDMLDAT=$G(BDMLDAT)
NEW BDMNOW,BDMOPT,BDMIEN
S BDMOPT="Patients w/no Diagnosis of DM on Problem Lis"
D NOW^%DTC
S BDMNOW=$G(%)
K DD,DO,DIC
S X=DUZ_BDMNOW
S DIC("DR")=".02////"_DUZ_";.03////"_BDMNOW_";.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^BDMDR5",ZTDESC="GUI DM PTS NO DX PL" D ^%ZTLOAD
D EXIT
Q
GUIEP ;EP
D PROC
K ^TMP($J,"BDMDR5")
S IOM=80
D GUIR^XBLM("PRINT^BDMDR5","^TMP($J,""BDMDR5"",")
S X=0,C=0 F S X=$O(^TMP($J,"BDMDR5",X)) Q:X'=+X D
.S BDMDATA=^TMP($J,"BDMDR5",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,"BDMDR5")
D EXIT
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
BDMDR5 ; IHS/CMI/LAB - patients w/o dm on problem list ;
+1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**2,3,8,9,10**;JUN 14, 2007;Build 12
+2 ;
+3 ;
START ;
+1 DO INFORM
+2 DO EXIT
R ;
+1 SET BDMREG=""
+2 SET DIC="^ACM(41.1,"
SET DIC(0)="AEMQ"
SET DIC("A")="Enter the Name of the Register: "
DO ^DIC
+3 IF Y=-1
WRITE !,"No register selected."
DO EXIT
QUIT
+4 SET BDMREG=+Y
STAT ;get status
+1 WRITE !!,"Select the Patient Status for this report"
+2 SET BDMSTAT=""
+3 KILL DIR
+4 SET DIR(0)="S^"_$PIECE(^DD(9002241,1,0),U,3)_";0:All Register Patients"
SET DIR("A")="Which Status"
SET DIR("B")="A"
KILL DA
DO ^DIR
KILL DIR
+5 IF $DATA(DIRUT)
GOTO R
+6 IF Y=0
SET BDMSTAT=""
GOTO CLINIC
+7 SET BDMSTAT=Y
CLINIC ;
+1 WRITE !!,"Enter the list of clinics that you have determined to be primary care clinics."
+2 WRITE !,"You can enter them 1 at a time or enter a taxonomy using the '[' notation."
+3 KILL BDMCLIN
+4 SET X="CLINIC"
SET DIC="^AMQQ(5,"
SET DIC(0)="FM"
SET DIC("S")="I $P(^(0),U,14)"
DO ^DIC
KILL DIC,DA
+5 DO PEP^AMQQGTX0(+Y,"BDMCLIN(")
+6 IF '$DATA(BDMCLIN)
WRITE !,"NO CLINICS SELECTED"
KILL BDMCLIN
GOTO STAT
+7 IF $DATA(BDMCLIN("*"))
WRITE !,"ALL (ANY) CLINIC WILL BE INCLUDED"
KILL BDMCLIN
GETDATES ;
BD ;
+1 WRITE !!!,"Enter the time frame to look for visits.",!
SET DIR(0)="D^::EP"
SET DIR("A")="Enter Beginning Visit Date"
SET DIR("?")="Enter the beginning visit date for the search."
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO CLINIC
+3 SET BDMBD=Y
ED ;
+1 SET DIR(0)="DA^::EP"
SET DIR("A")="Enter Ending Visit Date: "
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO GETDATES
+3 IF Y<BDMBD
WRITE !,"Ending date must be greater than or equal to beginning date!"
GOTO ED
+4 SET BDMED=Y
+5 SET X1=BDMBD
SET X2=-1
DO C^%DTC
SET BDMSD=X
ZIS ;
+1 SET BDMTEMP=""
+2 SET DIR(0)="S^P:PRINT the List;B:BROWSE the List on the Screen"
SET DIR("A")="Output Type"
SET DIR("B")="P"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
GOTO GETDATES
+4 SET BDMTEMP=Y
+5 ;call to XBDBQUE
DEMO ;
+1 DO DEMOCHK^BDMUTL(.BDMDEMO)
+2 IF BDMDEMO=-1
DO EXIT
QUIT
+3 IF BDMTEMP="B"
DO BROWSE
DO EXIT
QUIT
+4 SET XBRP="PRINT^BDMDR5"
SET XBRC="PROC^BDMDR5"
SET XBRX="EXIT^BDMDR5"
SET XBNS="BDM"
+5 DO ^XBDBQUE
+6 DO EXIT
+7 QUIT
BROWSE ;
+1 SET XBRP="VIEWR^XBLM(""PRINT^BDMDR5"")"
+2 SET XBRC="PROC^BDMDR5"
SET XBRX="EXIT^BDMDR5"
SET XBIOP=0
DO ^XBDBQUE
+3 QUIT
EXIT ;clean up and exit
+1 IF '$DATA(BDMGUI)
DO EN^XBVK("BDM")
+2 DO ^XBFMK
+3 DO KILL^AUPNPAT
+4 QUIT
INFORM ;
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,$$CTR($$LOC)
+3 WRITE !,$$CTR($$USR)
+4 WRITE !!,"This report will list patients who are on the diabetes register who have not",!
+5 WRITE "had a visit to a set of primary care clinics in a date range defined by the ",!,"user.",!
+6 WRITE "The report provides a way to identify patients who could possibly be inactivated",!
+7 WRITE "in the register.",!!
+8 QUIT
PROC ;EP - called from XBDBQUE
+1 SET BDMJOB=$JOB
SET BDMBTH=$HOROLOG
+2 KILL ^XTMP("BDMDR5",BDMJOB,BDMBTH)
+3 DO XTMP^BDMOSUT("BDMDR5","DM ON REGISTER NOT ACTIVE")
+4 SET BDMP=0
FOR
SET BDMP=$ORDER(^ACM(41,"B",BDMREG,BDMP))
IF BDMP'=+BDMP
QUIT
Begin DoDot:1
+5 IF '$DATA(^ACM(41,BDMP))
QUIT
+6 SET BDMPAT=$PIECE(^ACM(41,BDMP,0),U,2)
+7 IF $$DEMO^BDMUTL(BDMPAT,$GET(BDMDEMO))
QUIT
+8 IF $GET(BDMSTAT)]""
IF $PIECE($GET(^ACM(41,BDMP,"DT")),U,1)'=BDMSTAT
QUIT
+9 ;LOOP VISITS UNTIL FIND ONE THAT FITS DEFINITION
+10 KILL BDMV
+11 DO ALLV^APCLAPIU(BDMPAT,BDMBD,BDMED,"BDMV")
+12 SET BDMG=0
SET BDMX=0
+13 FOR
SET BDMX=$ORDER(BDMV(BDMX))
IF BDMX'=+BDMX!(BDMG)
QUIT
Begin DoDot:2
+14 SET BDMVST=$PIECE(BDMV(BDMX),U,5)
+15 SET BDMC=$$GET1^DIQ(9000010,BDMVST,.08,"I")
+16 IF 'BDMC
QUIT
+17 ;not a clinic of interest
IF $DATA(BDMCLIN)
IF '$DATA(BDMCLIN(BDMC))
QUIT
+18 SET BDMG=1
End DoDot:2
+19 IF 'BDMG
SET ^XTMP("BDMDR5",BDMJOB,BDMBTH,"PATIENTS",$$GET1^DIQ(2,BDMPAT,.01),BDMPAT)=""
End DoDot:1
+20 QUIT
PRINT ;EP - called from xbdbque
+1 SET BDMIOSL=$SELECT($GET(BDMGUI):55,1:IOSL)
+2 SET BDM80D="-------------------------------------------------------------------------------"
+3 SET BDMPG=0
DO HEAD
+4 IF '$DATA(^XTMP("BDMDR5",BDMJOB,BDMBTH))
WRITE !!,"NO PATIENTS TO REPORT"
GOTO DONE
+5 SET BDMNAME=""
KILL BDMQ
+6 FOR
SET BDMNAME=$ORDER(^XTMP("BDMDR5",BDMJOB,BDMBTH,"PATIENTS",BDMNAME))
IF BDMNAME=""!($DATA(BDMQ))
QUIT
Begin DoDot:1
+7 SET DFN=""
FOR
SET DFN=$ORDER(^XTMP("BDMDR5",BDMJOB,BDMBTH,"PATIENTS",BDMNAME,DFN))
IF DFN=""!($DATA(BDMQ))
QUIT
SET BDMX=^XTMP("BDMDR5",BDMJOB,BDMBTH,"PATIENTS",BDMNAME,DFN)
Begin DoDot:2
+8 IF $Y>(BDMIOSL-4)
DO HEAD
IF $DATA(BDMQ)
QUIT
+9 WRITE !,$EXTRACT(BDMNAME,1,20),?22,$$HRN^AUPNPAT(DFN,$SELECT($GET(BDMDUZ2):BDMDUZ2,1:DUZ(2))),?29,$EXTRACT($$RSTAT(BDMREG,DFN),1,8)
+10 WRITE ?38,$EXTRACT($$CM(BDMREG,DFN),1,10)
+11 SET V=$$LASTV(DFN)
+12 WRITE ?49,$$DATE^BDMS9B1($PIECE(V,U,1))
+13 WRITE ?61,$$LBLK^BDMUTL($$NUMDXS(DFN),5)
+14 WRITE ?68,$$DATE^BDMS9B1($$LASTDMDX(DFN))
End DoDot:2
End DoDot:1
DONE ;
+1 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
SET DIR(0)="EO"
SET DIR("A")="End of report. HIT RETURN"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(IOF)
WRITE @IOF
+3 KILL ^XTMP("BDMDR5",BDMJOB,BDMBTH),BDMJOB,BDMBTH
+4 QUIT
HEAD IF 'BDMPG
GOTO HEAD1
+1 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET BDMQ=""
QUIT
HEAD1 ;
+1 IF $DATA(IOF)
WRITE @IOF
SET BDMPG=BDMPG+1
+2 IF $GET(BDMGUI)
IF BDMPG'=1
WRITE !,"ZZZZZZZ"
+3 WRITE !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"
+4 WRITE !,$PIECE(^VA(200,DUZ,0),U,2),?72,"Page ",BDMPG,!
+5 WRITE ?(80-$LENGTH($PIECE(^DIC(4,$SELECT($GET(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0),U))/2),$PIECE(^DIC(4,$SELECT($GET(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0),U),!
+6 WRITE $$CTR("Patients on the "_$PIECE(^ACM(41.1,BDMREG,0),U)_" Register",80),!
+7 WRITE $$CTR("without a visit between "_$$FMTE^XLFDT(BDMBD)_" and "_$$FMTE^XLFDT(BDMED),80),!
PIH WRITE !,"PATIENT NAME",?22,"HRN",?29,"STATUS",?38,"CASE ",?49,"LAST VISIT",?61,"# DM",?68,"LAST DM DX",!,?38,"MANAGER",?61,"DXS",!,BDM80D
+1 QUIT
NUMDXS(P) ;
+1 IF '$GET(P)
QUIT ""
+2 NEW X,E,BDM,Y
+3 SET Y="BDM("
+4 SET X=P_"^ALL DX [SURVEILLANCE DIABETES"
SET E=$$START1^APCLDF(X,Y)
+5 SET (X,Y)=0
+6 FOR
SET X=$ORDER(BDM(X))
IF X'=+X
QUIT
SET Y=Y+1
+7 QUIT Y
LASTV(P) ;
+1 NEW X,Y,Z,V,D
+2 SET V=""
+3 SET D=0
FOR
SET D=$ORDER(^AUPNVSIT("AA",P,D))
IF D'=+D!(V)
QUIT
Begin DoDot:1
+4 SET X=0
FOR
SET X=$ORDER(^AUPNVSIT("AA",P,D,X))
IF X'=+X!(V)
QUIT
Begin DoDot:2
+5 IF '$DATA(^AUPNVSIT(X,0))
QUIT
+6 ;deleted
IF $PIECE(^AUPNVSIT(X,0),U,11)
QUIT
+7 ;ZERO DEP
IF '$PIECE(^AUPNVSIT(X,0),U,9)
QUIT
+8 IF "CTNEDX"[$PIECE(^AUPNVSIT(X,0),U,7)
QUIT
+9 SET V=X
End DoDot:2
End DoDot:1
+10 IF V=""
QUIT ""
+11 QUIT $$GET1^DIQ(9000010,V,.01,"I")_U_$$GET1^DIQ(9000010,V,.08,"I")
LASTDMDX(P) ;
+1 IF '$GET(P)
QUIT ""
+2 NEW X,E,BDM,Y
+3 SET Y="BDM("
+4 SET X=P_"^LAST DX [SURVEILLANCE DIABETES"
SET E=$$START1^APCLDF(X,Y)
+5 IF $DATA(BDM(1))
QUIT $PIECE(BDM(1),U)
+6 QUIT ""
CM(REG,PAT) ;
+1 NEW X
+2 SET X=$GET(^ACM(41,"AC",PAT,REG))
+3 IF X=""
QUIT ""
+4 QUIT $$GET1^DIQ(9002241,X,6)
RSTAT(REG,PAT) ;
+1 NEW X
+2 SET X=$GET(^ACM(41,"AC",PAT,REG))
+3 IF X=""
QUIT ""
+4 QUIT $$GET1^DIQ(9002241,X,1)
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 ;----------
EOP ;EP - End of page.
+1 IF $EXTRACT(IOST)'="C"
QUIT
+2 IF $DATA(ZTQUEUED)!'(IOT="TRM")!$DATA(IO("S"))
QUIT
+3 NEW DIR
+4 KILL DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
+5 SET DIR(0)="E"
DO ^DIR
+6 QUIT
+7 ;----------
USR() ;EP - Return name of current user from ^VA(200.
+1 QUIT $SELECT($GET(DUZ):$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
+2 ;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
+1 QUIT $SELECT($GET(DUZ(2)):$SELECT($DATA(^DIC(4,DUZ(2),0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
+2 ;----------
TEST ;
+1 DO BDMG("R",1,"A")
+2 QUIT
BDMG(BDMTR,BDMREG,BDMSTAT,BDMND,BDMLDAT) ;EP - GUI DMS Entry Point
+1 SET BDMND=$GET(BDMND)
+2 SET BDMGUI=1
+3 SET BDMLDAT=$GET(BDMLDAT)
+4 NEW BDMNOW,BDMOPT,BDMIEN
+5 SET BDMOPT="Patients w/no Diagnosis of DM on Problem Lis"
+6 DO NOW^%DTC
+7 SET BDMNOW=$GET(%)
+8 KILL DD,DO,DIC
+9 SET X=DUZ_BDMNOW
+10 SET DIC("DR")=".02////"_DUZ_";.03////"_BDMNOW_";.06///"_$GET(BDMOPT)_";.07////R"
+11 SET DIC="^BDMGUI("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=9003201.4
+12 DO FILE^DICN
+13 KILL DIADD,DLAYGO,DIC,DA
+14 IF Y=-1
SET BDMIEN=-1
QUIT
+15 SET BDMIEN=+Y
+16 ;cmi/maw added
SET BDMGIEN=BDMIEN
+17 DO ^XBFMK
+18 KILL ZTSAVE
SET ZTSAVE("*")=""
+19 ;D GUIEP for interactive testing
+20 SET ZTIO=""
SET ZTDTH=$$NOW^XLFDT
SET ZTRTN="GUIEP^BDMDR5"
SET ZTDESC="GUI DM PTS NO DX PL"
DO ^%ZTLOAD
+21 DO EXIT
+22 QUIT
GUIEP ;EP
+1 DO PROC
+2 KILL ^TMP($JOB,"BDMDR5")
+3 SET IOM=80
+4 DO GUIR^XBLM("PRINT^BDMDR5","^TMP($J,""BDMDR5"",")
+5 SET X=0
SET C=0
FOR
SET X=$ORDER(^TMP($JOB,"BDMDR5",X))
IF X'=+X
QUIT
Begin DoDot:1
+6 SET BDMDATA=^TMP($JOB,"BDMDR5",X)
+7 ;I BDMDATA="ZZZZZZZ" ;S BDMDATA=$C(12)
+8 SET ^BDMGUI(BDMIEN,11,X,0)=BDMDATA
SET C=C+1
End DoDot:1
+9 SET ^BDMGUI(BDMIEN,11,0)="^^"_C_"^"_C_"^"_DT_"^"
+10 SET DA=BDMIEN
SET DIK="^BDMGUI("
DO IX1^DIK
+11 DO ENDLOG
+12 KILL ^TMP($JOB,"BDMDR5")
+13 DO EXIT
+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
