BDMDR1 ; IHS/CMI/LAB - patients w/o dm on problem list ;
;;2.0;DIABETES MANAGEMENT SYSTEM;**2,3,8,10**;JUN 14, 2007;Build 12
;
;
START ;
D INFORM
D EXIT
D GETINFO
I $D(BDMQUIT) D EXIT Q
Q
INFORM ;
W:$D(IOF) @IOF
W !,$$CTR($$LOC)
W !,$$CTR($$USR)
W !!,"This report will list patients who do not have Diabetes on their Problem List ",!,"but who are on a Diabetes Register or who have had at least N diagnoses of ",!,"diabetes.",!!
Q
;
GETINFO ;
S (BDMTR,BDMREG,BDMSTAT,BDMND)=""
S DIR(0)="S^R:Those who are members of a Register;D:Those with at least N Diabetes Diagnoses",DIR("A")="List which subset of patients",DIR("B")="R" KILL DA D ^DIR KILL DIR
I $D(DIRUT) S BDMQUIT="" Q
S BDMTR=Y
D @Y
I $D(BDMQUIT) D EXIT Q
D ZIS
Q
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." S BDMQUIT="" Q
S BDMREG=+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 R
I Y=0 S BDMSTAT="" Q
;which status
S DIR(0)="9002241,1",DIR("A")="Which status",DIR("B")="A" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G R
S BDMSTAT=Y
Q
D ;
;how many
S BDMND=""
S DIR(0)="N^1:999:0",DIR("A")="How many diagnoses must the patient have had",DIR("B")="3" KILL DA D ^DIR KILL DIR
I $D(DIRUT) S BDMQUIT="" Q
S BDMND=Y
DATE ;
W !!,"If you are interested in restricting your list to only those patients",!,"whose most recent Diabetes diagnosis is since a certain date, enter that date.",!
W "If not, press enter or return to list all patients with at least ",BDMND," diagnoses.",!
S DIR(0)="DO^::EP",DIR("A")="Enter Date" KILL DA D ^DIR KILL DIR
I $D(DUOUT) G D
I X="^" G D
S BDMLDAT=Y
Q
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) D EXIT Q
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^BDMDR1",XBRC="PROC^BDMDR1",XBRX="EXIT^BDMDR1",XBNS="BDM"
D ^XBDBQUE
D EXIT
Q
BROWSE ;
S XBRP="VIEWR^XBLM(""PRINT^BDMDR1"")"
S XBRC="PROC^BDMDR1",XBRX="EXIT^BDMDR1",XBIOP=0 D ^XBDBQUE
Q
EXIT ;clean up and exit
I '$D(BDMGUI) D EN^XBVK("BDM")
D ^XBFMK
D KILL^AUPNPAT
Q
PROC ;EP - called from XBDBQUE
S BDMJOB=$J,BDMBTH=$H
K ^XTMP("BDMDR1",BDMJOB,BDMBTH)
D XTMP^BDMOSUT("BDMDR1","DM NOT ON PROBLEM LIST")
I BDMTR="R" D REGPROC Q
I BDMTR="D" D DXPROC Q
Q
DXPROC ;
;get last dm dx, if less than last date, Q
;if null Q
;get # of dxs, if less than BDMnd q
S DFN=0 F S DFN=$O(^AUPNPAT(DFN)) Q:DFN'=+DFN D CHK1SET
Q
CHK1SET ;
Q:$$DEMO^BDMUTL(DFN,$G(BDMDEMO))
Q:$$DOD^AUPNPAT(DFN)]""
Q:$P($G(^AUPNPAT(DFN,41,$S($G(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0)),U,5)]"" ;IHS/CMI/GRL
Q:$P($G(^AUPNPAT(DFN,41,$S($G(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0)),U,2)="" ;IHS/CMI/GRL
I $$DMPROB(DFN) Q
S BDMN=$$LASTDMDX(DFN)
I BDMN="" Q
I BDMN<BDMLDAT Q
S BDMN1=$$NUMDXS(DFN)
I BDMN1<BDMND Q
S ^XTMP("BDMDR1",BDMJOB,BDMBTH,"PATIENTS",$P(^DPT(DFN,0),U),DFN)=BDMN_U_BDMN1
Q
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 ""
;
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
;
REGPROC ;
;$o through register, check status, if no DM on problem list
;set xtmp
;gather up patients from register in ^XTMP
S X=0 F S X=$O(^ACM(41,"B",BDMREG,X)) Q:X'=+X D
.I BDMSTAT]"",$P($G(^ACM(41,X,"DT")),U,1)=BDMSTAT S DFN=$P(^ACM(41,X,0),U,2) D CHKSET Q
.I BDMSTAT="" S DFN=$P(^ACM(41,X,0),U,2) D CHKSET Q
.Q
Q
CHKSET ;
Q:$$DOD^AUPNPAT(DFN)]""
Q:$P($G(^AUPNPAT(DFN,41,$S($G(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0)),U,5)]"" ;IHS/CMI/GRL
Q:$P($G(^AUPNPAT(DFN,41,$S($G(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0)),U,2)="" ;IHS/CMI/GRL
I $$DMPROB(DFN) Q
S ^XTMP("BDMDR1",BDMJOB,BDMBTH,"PATIENTS",$P(^DPT(DFN,0),U),DFN)=$$LASTDMDX(DFN)_U_$$NUMDXS(DFN)
Q
DMPROB(P) ;is DM on problem list 1=yes 0=no
I '$G(P) Q 0
I '$D(^AUPNPROB("AC",P)) Q 0
NEW T S T=$O(^ATXAX("B","SURVEILLANCE DIABETES",0))
I 'T Q ""
NEW G,D,Y,I S D="",(Y,G)=0 F S Y=$O(^AUPNPROB("AC",P,Y)) Q:Y'=+Y!(G) D
.Q:$P(^AUPNPROB(Y,0),U,12)="D"
.S I=$P(^AUPNPROB(Y,0),U)
.I $$ICD^ATXCHK(I,T,9) S G=1
.Q
Q G
PRINT ;EP - called from xbdbque
S BDMIOSL=$S($G(BDMGUI):55,1:IOSL)
S BDM80D="-------------------------------------------------------------------------------"
S BDMPG=0 D HEAD
I '$D(^XTMP("BDMDR1",BDMJOB,BDMBTH)) W !!,"NO PATIENTS TO REPORT" G DONE
S BDMNAME="" K BDMQ
F S BDMNAME=$O(^XTMP("BDMDR1",BDMJOB,BDMBTH,"PATIENTS",BDMNAME)) Q:BDMNAME=""!($D(BDMQ)) D
.S DFN="" F S DFN=$O(^XTMP("BDMDR1",BDMJOB,BDMBTH,"PATIENTS",BDMNAME,DFN)) Q:DFN=""!($D(BDMQ)) S BDMX=^XTMP("BDMDR1",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,$$DOB^AUPNPAT(DFN,"E"),?43,$P(^DPT(DFN,0),U,2),?47,$$FMTE^XLFDT($P(BDMX,U)),?63,$P(BDMX,U,2)
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("BDMDR1",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 WITH NO DIAGNOSIS OF DIABETES ON PROBLEM LIST",80),!
I BDMTR="R" W $$CTR("Patients on the "_$P(^ACM(41.1,BDMREG,0),U)_" Register",80),!
I BDMTR="D" W $$CTR("Patients w/at least "_BDMND_" diabetes diagnoses",80),!
PIH W !,"PATIENT NAME",?22,"HRN",?29,"DOB",?47,"LAST DM DX",?63,"# OF DM DXS",!,BDM80D
Q
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^BDMDR1",ZTDESC="GUI DM PTS NO DX PL" D ^%ZTLOAD
D EXIT
Q
GUIEP ;EP
D PROC
K ^TMP($J,"BDMDR1")
S IOM=80
D GUIR^XBLM("PRINT^BDMDR1","^TMP($J,""BDMDR1"",")
S X=0,C=0 F S X=$O(^TMP($J,"BDMDR1",X)) Q:X'=+X D
.S BDMDATA=^TMP($J,"BDMDR1",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,"BDMDR1")
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
BDMDR1 ; IHS/CMI/LAB - patients w/o dm on problem list ;
+1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**2,3,8,10**;JUN 14, 2007;Build 12
+2 ;
+3 ;
START ;
+1 DO INFORM
+2 DO EXIT
+3 DO GETINFO
+4 IF $DATA(BDMQUIT)
DO EXIT
QUIT
+5 QUIT
INFORM ;
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,$$CTR($$LOC)
+3 WRITE !,$$CTR($$USR)
+4 WRITE !!,"This report will list patients who do not have Diabetes on their Problem List ",!,"but who are on a Diabetes Register or who have had at least N diagnoses of ",!,"diabetes.",!!
+5 QUIT
+6 ;
GETINFO ;
+1 SET (BDMTR,BDMREG,BDMSTAT,BDMND)=""
+2 SET DIR(0)="S^R:Those who are members of a Register;D:Those with at least N Diabetes Diagnoses"
SET DIR("A")="List which subset of patients"
SET DIR("B")="R"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
SET BDMQUIT=""
QUIT
+4 SET BDMTR=Y
+5 DO @Y
+6 IF $DATA(BDMQUIT)
DO EXIT
QUIT
+7 DO ZIS
+8 QUIT
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."
SET BDMQUIT=""
QUIT
+4 SET BDMREG=+Y
+5 ;get status
+6 SET BDMSTAT=""
+7 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
+8 IF $DATA(DIRUT)
GOTO R
+9 IF Y=0
SET BDMSTAT=""
QUIT
+10 ;which status
+11 SET DIR(0)="9002241,1"
SET DIR("A")="Which status"
SET DIR("B")="A"
KILL DA
DO ^DIR
KILL DIR
+12 IF $DATA(DIRUT)
GOTO R
+13 SET BDMSTAT=Y
+14 QUIT
D ;
+1 ;how many
+2 SET BDMND=""
+3 SET DIR(0)="N^1:999:0"
SET DIR("A")="How many diagnoses must the patient have had"
SET DIR("B")="3"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
SET BDMQUIT=""
QUIT
+5 SET BDMND=Y
DATE ;
+1 WRITE !!,"If you are interested in restricting your list to only those patients",!,"whose most recent Diabetes diagnosis is since a certain date, enter that date.",!
+2 WRITE "If not, press enter or return to list all patients with at least ",BDMND," diagnoses.",!
+3 SET DIR(0)="DO^::EP"
SET DIR("A")="Enter Date"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DUOUT)
GOTO D
+5 IF X="^"
GOTO D
+6 SET BDMLDAT=Y
+7 QUIT
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)
DO EXIT
QUIT
+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^BDMDR1"
SET XBRC="PROC^BDMDR1"
SET XBRX="EXIT^BDMDR1"
SET XBNS="BDM"
+5 DO ^XBDBQUE
+6 DO EXIT
+7 QUIT
BROWSE ;
+1 SET XBRP="VIEWR^XBLM(""PRINT^BDMDR1"")"
+2 SET XBRC="PROC^BDMDR1"
SET XBRX="EXIT^BDMDR1"
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
PROC ;EP - called from XBDBQUE
+1 SET BDMJOB=$JOB
SET BDMBTH=$HOROLOG
+2 KILL ^XTMP("BDMDR1",BDMJOB,BDMBTH)
+3 DO XTMP^BDMOSUT("BDMDR1","DM NOT ON PROBLEM LIST")
+4 IF BDMTR="R"
DO REGPROC
QUIT
+5 IF BDMTR="D"
DO DXPROC
QUIT
+6 QUIT
DXPROC ;
+1 ;get last dm dx, if less than last date, Q
+2 ;if null Q
+3 ;get # of dxs, if less than BDMnd q
+4 SET DFN=0
FOR
SET DFN=$ORDER(^AUPNPAT(DFN))
IF DFN'=+DFN
QUIT
DO CHK1SET
+5 QUIT
CHK1SET ;
+1 IF $$DEMO^BDMUTL(DFN,$GET(BDMDEMO))
QUIT
+2 IF $$DOD^AUPNPAT(DFN)]""
QUIT
+3 ;IHS/CMI/GRL
IF $PIECE($GET(^AUPNPAT(DFN,41,$SELECT($GET(BDMDUZ2)
QUIT
+4 ;IHS/CMI/GRL
IF $PIECE($GET(^AUPNPAT(DFN,41,$SELECT($GET(BDMDUZ2)
QUIT
+5 IF $$DMPROB(DFN)
QUIT
+6 SET BDMN=$$LASTDMDX(DFN)
+7 IF BDMN=""
QUIT
+8 IF BDMN<BDMLDAT
QUIT
+9 SET BDMN1=$$NUMDXS(DFN)
+10 IF BDMN1<BDMND
QUIT
+11 SET ^XTMP("BDMDR1",BDMJOB,BDMBTH,"PATIENTS",$PIECE(^DPT(DFN,0),U),DFN)=BDMN_U_BDMN1
+12 QUIT
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 ""
+7 ;
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
+8 ;
REGPROC ;
+1 ;$o through register, check status, if no DM on problem list
+2 ;set xtmp
+3 ;gather up patients from register in ^XTMP
+4 SET X=0
FOR
SET X=$ORDER(^ACM(41,"B",BDMREG,X))
IF X'=+X
QUIT
Begin DoDot:1
+5 IF BDMSTAT]""
IF $PIECE($GET(^ACM(41,X,"DT")),U,1)=BDMSTAT
SET DFN=$PIECE(^ACM(41,X,0),U,2)
DO CHKSET
QUIT
+6 IF BDMSTAT=""
SET DFN=$PIECE(^ACM(41,X,0),U,2)
DO CHKSET
QUIT
+7 QUIT
End DoDot:1
+8 QUIT
CHKSET ;
+1 IF $$DOD^AUPNPAT(DFN)]""
QUIT
+2 ;IHS/CMI/GRL
IF $PIECE($GET(^AUPNPAT(DFN,41,$SELECT($GET(BDMDUZ2)
QUIT
+3 ;IHS/CMI/GRL
IF $PIECE($GET(^AUPNPAT(DFN,41,$SELECT($GET(BDMDUZ2)
QUIT
+4 IF $$DMPROB(DFN)
QUIT
+5 SET ^XTMP("BDMDR1",BDMJOB,BDMBTH,"PATIENTS",$PIECE(^DPT(DFN,0),U),DFN)=$$LASTDMDX(DFN)_U_$$NUMDXS(DFN)
+6 QUIT
DMPROB(P) ;is DM on problem list 1=yes 0=no
+1 IF '$GET(P)
QUIT 0
+2 IF '$DATA(^AUPNPROB("AC",P))
QUIT 0
+3 NEW T
SET T=$ORDER(^ATXAX("B","SURVEILLANCE DIABETES",0))
+4 IF 'T
QUIT ""
+5 NEW G,D,Y,I
SET D=""
SET (Y,G)=0
FOR
SET Y=$ORDER(^AUPNPROB("AC",P,Y))
IF Y'=+Y!(G)
QUIT
Begin DoDot:1
+6 IF $PIECE(^AUPNPROB(Y,0),U,12)="D"
QUIT
+7 SET I=$PIECE(^AUPNPROB(Y,0),U)
+8 IF $$ICD^ATXCHK(I,T,9)
SET G=1
+9 QUIT
End DoDot:1
+10 QUIT G
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("BDMDR1",BDMJOB,BDMBTH))
WRITE !!,"NO PATIENTS TO REPORT"
GOTO DONE
+5 SET BDMNAME=""
KILL BDMQ
+6 FOR
SET BDMNAME=$ORDER(^XTMP("BDMDR1",BDMJOB,BDMBTH,"PATIENTS",BDMNAME))
IF BDMNAME=""!($DATA(BDMQ))
QUIT
Begin DoDot:1
+7 SET DFN=""
FOR
SET DFN=$ORDER(^XTMP("BDMDR1",BDMJOB,BDMBTH,"PATIENTS",BDMNAME,DFN))
IF DFN=""!($DATA(BDMQ))
QUIT
SET BDMX=^XTMP("BDMDR1",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,$$DOB^AUPNPAT(DFN,"E"),?43,$PIECE(^DPT(DFN,0),U,2),?47,$$FMTE^XLFDT($PIECE(BDMX,U)),?63,$PIECE(BDMX,U,2)
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("BDMDR1",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 WITH NO DIAGNOSIS OF DIABETES ON PROBLEM LIST",80),!
+7 IF BDMTR="R"
WRITE $$CTR("Patients on the "_$PIECE(^ACM(41.1,BDMREG,0),U)_" Register",80),!
+8 IF BDMTR="D"
WRITE $$CTR("Patients w/at least "_BDMND_" diabetes diagnoses",80),!
PIH WRITE !,"PATIENT NAME",?22,"HRN",?29,"DOB",?47,"LAST DM DX",?63,"# OF DM DXS",!,BDM80D
+1 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 ;----------
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^BDMDR1"
SET ZTDESC="GUI DM PTS NO DX PL"
DO ^%ZTLOAD
+21 DO EXIT
+22 QUIT
GUIEP ;EP
+1 DO PROC
+2 KILL ^TMP($JOB,"BDMDR1")
+3 SET IOM=80
+4 DO GUIR^XBLM("PRINT^BDMDR1","^TMP($J,""BDMDR1"",")
+5 SET X=0
SET C=0
FOR
SET X=$ORDER(^TMP($JOB,"BDMDR1",X))
IF X'=+X
QUIT
Begin DoDot:1
+6 SET BDMDATA=^TMP($JOB,"BDMDR1",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,"BDMDR1")
+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
