BDMDR2 ; IHS/CMI/LAB - patients w/o dm on problem list ; 05 Mar 2015 1:15 PM
;;2.0;DIABETES MANAGEMENT SYSTEM;**2,3,8,9,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 are on the Diabetes Register who do not",!,"have a date of diagnosis recorded in either the Register or on the problem list.",!!
Q
;
GETINFO ;
S (BDMTR,BDMREG,BDMSTAT,BDMND)=""
D R
S BDMTR="R" 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
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^BDMDR2",XBRC="PROC^BDMDR2",XBRX="EXIT^BDMDR2",XBNS="BDM"
D ^XBDBQUE
D EXIT
Q
BROWSE ;
S XBRP="VIEWR^XBLM(""PRINT^BDMDR2"")"
S XBRC="PROC^BDMDR2",XBRX="EXIT^BDMDR2",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("BDMDR2",BDMJOB,BDMBTH)
D XTMP^BDMOSUT("BDMDR2","DM NOT ON PROBLEM LIST")
I BDMTR="R" D REGPROC Q
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:$$DEMO^BDMUTL(DFN,$G(BDMDEMO))
I $$DODX^BDMDD16(DFN,BDMREG,"E")]"" Q
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
S BDMPLDX=$$DMPROB(DFN)
S ^XTMP("BDMDR2",BDMJOB,BDMBTH,"PATIENTS",$P(^DPT(DFN,0),U),DFN)=$$LASTDMDX(DFN)_U_$$NUMDXS(DFN)_U_BDMPLDX
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 BDM80D="-------------------------------------------------------------------------------"
S BDMPG=0,BDMIOSL=$S($G(BDMGUI):55,1:IOSL)
D HEAD
I '$D(^XTMP("BDMDR2",BDMJOB,BDMBTH)) W !!,"NO PATIENTS TO REPORT" G DONE
S BDMNAME="" K BDMQ
F S BDMNAME=$O(^XTMP("BDMDR2",BDMJOB,BDMBTH,"PATIENTS",BDMNAME)) Q:BDMNAME=""!($D(BDMQ)) D
.S DFN="" F S DFN=$O(^XTMP("BDMDR2",BDMJOB,BDMBTH,"PATIENTS",BDMNAME,DFN)) Q:DFN=""!($D(BDMQ)) S BDMX=^XTMP("BDMDR2",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),?73,$S($P(BDMX,U,3):"YES",1:"NO")
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("BDMDR2",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("DIABETES REGISTER PATIENTS WITH NO RECORDED DATE OF ONSET OF DIABETES",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,"#DM DXS",?71,"DM ON PL",!,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")
;----------
BDMGO(BDMTR,BDMREG,BDMSTAT) ;EP - GUI DMS Entry Point
;cmi/anch/maw added 10/19/2004
S BDMGUI=1
D PROC
D GUIR^XBLM("PRINT^BDMDR2","^TMP($J,""BDMDR2"",")
D EXIT
Q
;
TEST ;
D BDMG("R",1,"A")
Q
BDMG(BDMTR,BDMREG,BDMSTAT) ;EP - GUI DMS Entry Point
S BDMTR="R",BDMGUI=1
NEW BDMNOW,BDMOPT,BDMIEN
S BDMOPT="DM Register Pts w/no recorded DM Date of Onset"
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^BDMDR2",ZTDESC="GUI DM PTS NO DX PL" D ^%ZTLOAD
D EXIT
Q
GUIEP ;EP
D PROC
K ^TMP($J,"BDMDR2")
S IOM=80
D GUIR^XBLM("PRINT^BDMDR2","^TMP($J,""BDMDR2"",")
S X=0,C=0 F S X=$O(^TMP($J,"BDMDR2",X)) Q:X'=+X D
.S BDMDATA=^TMP($J,"BDMDR2",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,"BDMDR2")
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
BDMDR2 ; IHS/CMI/LAB - patients w/o dm on problem list ; 05 Mar 2015 1:15 PM
+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
+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 are on the Diabetes Register who do not",!,"have a date of diagnosis recorded in either the Register or on the problem list.",!!
+5 QUIT
+6 ;
GETINFO ;
+1 SET (BDMTR,BDMREG,BDMSTAT,BDMND)=""
+2 DO R
+3 SET BDMTR="R"
IF $DATA(BDMQUIT)
DO EXIT
QUIT
+4 DO ZIS
+5 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
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^BDMDR2"
SET XBRC="PROC^BDMDR2"
SET XBRX="EXIT^BDMDR2"
SET XBNS="BDM"
+5 DO ^XBDBQUE
+6 DO EXIT
+7 QUIT
BROWSE ;
+1 SET XBRP="VIEWR^XBLM(""PRINT^BDMDR2"")"
+2 SET XBRC="PROC^BDMDR2"
SET XBRX="EXIT^BDMDR2"
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("BDMDR2",BDMJOB,BDMBTH)
+3 DO XTMP^BDMOSUT("BDMDR2","DM NOT ON PROBLEM LIST")
+4 IF BDMTR="R"
DO REGPROC
QUIT
+5 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 $$DEMO^BDMUTL(DFN,$GET(BDMDEMO))
QUIT
+2 IF $$DODX^BDMDD16(DFN,BDMREG,"E")]""
QUIT
+3 IF $$DOD^AUPNPAT(DFN)]""
QUIT
+4 ;IHS/CMI/GRL
IF $PIECE($GET(^AUPNPAT(DFN,41,$SELECT($GET(BDMDUZ2)
QUIT
+5 ;IHS/CMI/GRL
IF $PIECE($GET(^AUPNPAT(DFN,41,$SELECT($GET(BDMDUZ2)
QUIT
+6 SET BDMPLDX=$$DMPROB(DFN)
+7 SET ^XTMP("BDMDR2",BDMJOB,BDMBTH,"PATIENTS",$PIECE(^DPT(DFN,0),U),DFN)=$$LASTDMDX(DFN)_U_$$NUMDXS(DFN)_U_BDMPLDX
+8 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 BDM80D="-------------------------------------------------------------------------------"
+2 SET BDMPG=0
SET BDMIOSL=$SELECT($GET(BDMGUI):55,1:IOSL)
+3 DO HEAD
+4 IF '$DATA(^XTMP("BDMDR2",BDMJOB,BDMBTH))
WRITE !!,"NO PATIENTS TO REPORT"
GOTO DONE
+5 SET BDMNAME=""
KILL BDMQ
+6 FOR
SET BDMNAME=$ORDER(^XTMP("BDMDR2",BDMJOB,BDMBTH,"PATIENTS",BDMNAME))
IF BDMNAME=""!($DATA(BDMQ))
QUIT
Begin DoDot:1
+7 SET DFN=""
FOR
SET DFN=$ORDER(^XTMP("BDMDR2",BDMJOB,BDMBTH,"PATIENTS",BDMNAME,DFN))
IF DFN=""!($DATA(BDMQ))
QUIT
SET BDMX=^XTMP("BDMDR2",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),?73,$SELECT($PIECE(BDMX,U
,3):"YES",1:"NO")
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("BDMDR2",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("DIABETES REGISTER PATIENTS WITH NO RECORDED DATE OF ONSET OF DIABETES",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,"#DM DXS",?71,"DM ON PL",!,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 ;----------
BDMGO(BDMTR,BDMREG,BDMSTAT) ;EP - GUI DMS Entry Point
+1 ;cmi/anch/maw added 10/19/2004
+2 SET BDMGUI=1
+3 DO PROC
+4 DO GUIR^XBLM("PRINT^BDMDR2","^TMP($J,""BDMDR2"",")
+5 DO EXIT
+6 QUIT
+7 ;
TEST ;
+1 DO BDMG("R",1,"A")
+2 QUIT
BDMG(BDMTR,BDMREG,BDMSTAT) ;EP - GUI DMS Entry Point
+1 SET BDMTR="R"
SET BDMGUI=1
+2 NEW BDMNOW,BDMOPT,BDMIEN
+3 SET BDMOPT="DM Register Pts w/no recorded DM Date of Onset"
+4 DO NOW^%DTC
+5 SET BDMNOW=$GET(%)
+6 KILL DD,DO,DIC
+7 SET X=DUZ_BDMNOW
+8 SET DIC("DR")=".02////"_DUZ_";.03////"_BDMNOW_";.06///"_$GET(BDMOPT)_";.07////R"
+9 SET DIC="^BDMGUI("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=9003201.4
+10 DO FILE^DICN
+11 KILL DIADD,DLAYGO,DIC,DA
+12 IF Y=-1
SET BDMIEN=-1
QUIT
+13 SET BDMIEN=+Y
+14 ;cmi/maw added
SET BDMGIEN=BDMIEN
+15 DO ^XBFMK
+16 KILL ZTSAVE
SET ZTSAVE("*")=""
+17 ;D GUIEP for interactive testing
+18 SET ZTIO=""
SET ZTDTH=$$NOW^XLFDT
SET ZTRTN="GUIEP^BDMDR2"
SET ZTDESC="GUI DM PTS NO DX PL"
DO ^%ZTLOAD
+19 DO EXIT
+20 QUIT
GUIEP ;EP
+1 DO PROC
+2 KILL ^TMP($JOB,"BDMDR2")
+3 SET IOM=80
+4 DO GUIR^XBLM("PRINT^BDMDR2","^TMP($J,""BDMDR2"",")
+5 SET X=0
SET C=0
FOR
SET X=$ORDER(^TMP($JOB,"BDMDR2",X))
IF X'=+X
QUIT
Begin DoDot:1
+6 SET BDMDATA=^TMP($JOB,"BDMDR2",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,"BDMDR2")
+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
