BDMDR6 ; 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 ;
K BDMREG
R1 ;
S DIC="^ACM(41.1,",DIC(0)="AEMQ",DIC("A")="Enter "_$S($D(BDMREG):"Another ",1:"")_"Register Name: " D ^DIC
I Y=-1,$D(BDMREG) G GETDATES
I Y=-1,'$D(BDMREG) W !,"No register selected." D EXIT Q
S BDMREG(+Y)=""
G R1
GETDATES ;
BD ;
W !!!,"Enter the time frame to look for visits with a diabetes diagnosis.",!
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) R
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
D ;
;how many
S BDMND=""
S DIR(0)="N^1:99:0",DIR("A")="How many diagnoses must the patient have had in that time period",DIR("B")="3" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G GETDATES
S BDMND=Y
ZIS ;
S BDMTEMP=""
S DIR(0)="S^P:PRINT the List;B:BROWSE the List on the Screen;S:Create Search Template;D:Create Delimited Output file",DIR("A")="Output Type",DIR("B")="P" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G GETDATES
S BDMTEMP=Y
I BDMTEMP="P"!(BDMTEMP="B") G DEMO
I BDMTEMP="S" D G:BDMSTMP="" ZIS G DEMO
.D EN2^BDMRML
;get file name
D PT G:BDMDELT="" ZIS I BDMDELT="F",BDMDELF="" G ZIS
;call to XBDBQUE
DEMO ;
D DEMOCHK^BDMUTL(.BDMDEMO)
I BDMDEMO=-1 D EXIT Q
I BDMTEMP="B" D BROWSE,EXIT Q
S XBRP="PRINT^BDMDR6",XBRC="PROC^BDMDR6",XBRX="EXIT^BDMDR6",XBNS="BDM"
D ^XBDBQUE
D EXIT
Q
ST ;
BROWSE ;
S XBRP="VIEWR^XBLM(""PRINT^BDMDR6"")"
S XBRC="PROC^BDMDR6",XBRX="EXIT^BDMDR6",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 not on any diabetes register ",!
W "but who have had a visit with a diagnosis of diabetes in a date range",!
W "specified by the user. If you are multi-divisional with multiple registers",!
W "you can enter all of the register names. Only patients who are not on ANY",!
W "of the registers will be displayed on the list.",!
W !
Q
PROC ;EP - called from XBDBQUE
S BDMJOB=$J,BDMBTH=$H
K ^XTMP("BDMDR6",BDMJOB,BDMBTH)
D XTMP^BDMOSUT("BDMDR6","DM NOT ON REGISTER")
S DFN=0 F S DFN=$O(^AUPNPAT(DFN)) Q:DFN'=+DFN D
.Q:$P($G(^DPT(DFN,0)),U,19)
.Q:$D(^DPT(DFN,-9))
.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
.Q:$$ONREG(DFN,.BDMREG) ;I $D(^ACM(41,"AC",DFN,BDMREG)) Q ;on register
.S X=$$LASTDMDX(DFN,BDMBD,BDMED,BDMND)
.I X S ^XTMP("BDMDR6",BDMJOB,BDMBTH,"PATIENTS",$$GET1^DIQ(2,DFN,.01),DFN)=""
Q
ONREG(P,R) ;
NEW X,G
S G=""
S X=0 F S X=$O(BDMREG(X)) Q:X'=+X!(G) I $D(^ACM(41,"AC",DFN,X)) S G=1
Q G
PRINT ;EP - called from xbdbque
S BDMIOSL=$S($G(BDMGUI):55,1:IOSL)
S BDM80D="-------------------------------------------------------------------------------"
S BDMPG=0 D HEAD
K ^TMP($J)
I BDMTEMP'="D" I '$D(^XTMP("BDMDR6",BDMJOB,BDMBTH)) W !!,"NO PATIENTS TO REPORT" G DONE
S BDMNAME="" K BDMQ
S BDMDCNT=0
F S BDMNAME=$O(^XTMP("BDMDR6",BDMJOB,BDMBTH,"PATIENTS",BDMNAME)) Q:BDMNAME=""!($D(BDMQ)) D
.S DFN="" F S DFN=$O(^XTMP("BDMDR6",BDMJOB,BDMBTH,"PATIENTS",BDMNAME,DFN)) Q:DFN=""!($D(BDMQ)) S BDMX=^XTMP("BDMDR6",BDMJOB,BDMBTH,"PATIENTS",BDMNAME,DFN) D
..I BDMTEMP="S" S ^DIBT(BDMSTMP,1,DFN)="" Q
..I BDMTEMP="D" D DELR Q
..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,$$DATE^BDMS9B1($$DOB^AUPNPAT(DFN))
..W ?40,$E($$COMMRES^AUPNPAT(DFN,"E"),1,10)
..S V=$$LASTV(DFN)
..W ?53,$$DATE($P(V,U,1))
..W ?63,$$LBLK^BDMUTL($$NUMDXS(DFN,BDMBD,BDMED),5)
..W ?70,$$DATE($$LASTDMDX(DFN,$$DOB^AUPNPAT(DFN),DT)),!
..W ?5,"Seen at: ",$$VLOCS(DFN,BDMBD,BDMED)
DONE ;
I BDMTEMP="S" W !!,"Search Template ",$P(^DIBT(BDMSTMP,0),U,1)," has been created.",!
I BDMTEMP="D" D WRITEF Q
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("BDMDR6",BDMJOB,BDMBTH),BDMJOB,BDMBTH
Q
DELR ;
S BDMDCNT=BDMDCNT+1
S BDMREC=""
S $P(BDMREC,U)=BDMNAME
S $P(BDMREC,U,2)=$$HRN^AUPNPAT(DFN,$S($G(BDMDUZ2):BDMDUZ2,1:DUZ(2)))
S $P(BDMREC,U,3)=$$DATE^BDMS9B1($$DOB^AUPNPAT(DFN))
S $P(BDMREC,U,4)=$$COMMRES^AUPNPAT(DFN,"E")
S V=$$LASTV(DFN)
S $P(BDMREC,U,5)=$$DATE($P(V,U,1))
S $P(BDMREC,U,6)=$$NUMDXS(DFN,BDMBD,BDMED)
S $P(BDMREC,U,7)=$$DATE($$LASTDMDX(DFN,$$DOB^AUPNPAT(DFN),DT))
S $P(BDMREC,U,8)=$$VLOCS(DFN,BDMBD,BDMED)
S ^TMP($J,"DELIMITED",BDMDCNT)=BDMREC
Q
HEAD I BDMTEMP="D" Q
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 NOT on any of the following Registers:"),!
S X=0 F S X=$O(BDMREG(X)) Q:X'=+X D
.W $$CTR($P(^ACM(41.1,X,0),U)_" Register",80),!
W $$CTR("with at least "_BDMND_" visits with a DX of Diabetes between ",80),!
W $$CTR($$FMTE^XLFDT(BDMBD)_" and "_$$FMTE^XLFDT(BDMED),80),!
PIH W !,"PATIENT NAME",?22,"HRN",?29,"DOB",?40,"COMMUNITY",?53,"LAST VISIT",?64,"# DM",?70,"LAST DM",!,?64,"DXS",?70,"DX",!,BDM80D
Q
NUMDXS(P,BD,ED) ;
I '$G(P) Q ""
NEW X,E,BDM,Y
S Y="BDM("
S X=P_"^ALL DX [SURVEILLANCE DIABETES;DURING "_BD_"-"_ED 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,BDATE,EDATE,N) ;
I '$G(P) Q ""
I '$G(N) S N=1
NEW X,E,BDM,Y
S Y="BDM("
S X=P_"^LAST "_N_" DX [SURVEILLANCE DIABETES;DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,Y)
I $D(BDM(N)) Q $P(BDM(N),U)
Q ""
VLOCS(P,BDATE,EDATE) ;
NEW X,V,BDMVS,BDMLOCS,L
D ALLV^APCLAPIU(P,BDATE,EDATE,"BDMVS")
S X=0 F S X=$O(BDMVS(X)) Q:X'=+X D
.S V=$P(BDMVS(X),U,5)
.S L=$$VALI^XBDIQ1(9000010,V,.06)
.Q:'$D(^AUTTLOC(L,0))
.;S L=$P(^AUTTLOC(L,0),U,7)
.S L=$E($P(^DIC(4,L,0),U,1),1,15)
.S BDMLOCS(L)=""
S L="",V=""
F S L=$O(BDMLOCS(L)) Q:L="" S V=V_$S(V]"":";",1:""),V=V_L
Q V
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^BDMDR6",ZTDESC="GUI DM PTS NO DX PL" D ^%ZTLOAD
D EXIT
Q
GUIEP ;EP
D PROC
K ^TMP($J,"BDMDR6")
S IOM=80
D GUIR^XBLM("PRINT^BDMDR6","^TMP($J,""BDMDR6"",")
S X=0,C=0 F S X=$O(^TMP($J,"BDMDR6",X)) Q:X'=+X D
.S BDMDATA=^TMP($J,"BDMDR6",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,"BDMDR6")
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
DATE(D) ;EP
I D="" Q ""
Q $E(D,4,5)_"/"_$E(D,6,7)_"/"_$E(D,2,3)
PT ;EP
S (BDMROT,BDMDELT,BDMDELF)=""
S BDMDELF="",BDMDELT=""
W !!,"You have selected to create a delimited output file. You can have this",!,"output file created as a text file in the pub directory, ",!,"OR you can have the delimited output display on your screen so that"
W !,"you can do a file capture. Keep in mind that if you choose to",!,"do a screen capture you CANNOT Queue your report to run in the background!!",!!
S DIR(0)="S^S:SCREEN-delimited output will display on screen for capture;F:FILE-delimited output will be written to a file in pub",DIR("A")="Select output type",DIR("B")="S" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G PT
S BDMDELT=Y
Q:BDMDELT="S"
S DIR(0)="F^1:40",DIR("A")="Enter a filename for the delimited output (no more than 40 characters)" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G PT
S BDMDELF=Y
S BDMHDIR=$S($P($G(^AUTTSITE(1,1)),U,2)]"":$P(^AUTTSITE(1,1),U,2),1:$G(^XTV(8989.3,1,"DEV")))
I $G(BDMHDIR)="" S BDMHDIR="/usr/spool/uucppublic/"
W !!,"When the report is finished your delimited output will be found in the",!,BDMHDIR," directory. The filename will be ",BDMDELF,".txt",!
Q
WRITEF ;
I BDMDELT="S" D SCREEN Q
S Y=$$OPEN^%ZISH(BDMHDIR,BDMDELF,"W")
I Y=1 W:'$D(ZTQUEUED) !!,"Cannot open host file to write out DELIMITED data. Notify programmer." Q
U IO
W !,"NAME^HRN^DOB^COMMUNITY^LAST VISIT^# DM DXS^LAST DM DXS^LOCATIONS WHERE SEEN"
S X=0 F S X=$O(^TMP($J,"DELIMITED",X)) Q:X'=+X W !,^TMP($J,"DELIMITED",X)
W !
D ^%ZISC
Q
SCREEN ;
W !,"NAME^HRN^DOB^COMMUNITY^LAST VISIT^# DM DXS^LAST DM DXS^LOCATIONS WHERE SEEN"
S X=0 F S X=$O(^TMP($J,"DELIMITED",X)) Q:X'=+X W !,^TMP($J,"DELIMITED",X)
W !
Q
BDMDR6 ; 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 KILL BDMREG
R1 ;
+1 SET DIC="^ACM(41.1,"
SET DIC(0)="AEMQ"
SET DIC("A")="Enter "_$SELECT($DATA(BDMREG):"Another ",1:"")_"Register Name: "
DO ^DIC
+2 IF Y=-1
IF $DATA(BDMREG)
GOTO GETDATES
+3 IF Y=-1
IF '$DATA(BDMREG)
WRITE !,"No register selected."
DO EXIT
QUIT
+4 SET BDMREG(+Y)=""
+5 GOTO R1
GETDATES ;
BD ;
+1 WRITE !!!,"Enter the time frame to look for visits with a diabetes diagnosis.",!
+2 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
+3 IF $DATA(DIRUT)
GOTO R
+4 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
D ;
+1 ;how many
+2 SET BDMND=""
+3 SET DIR(0)="N^1:99:0"
SET DIR("A")="How many diagnoses must the patient have had in that time period"
SET DIR("B")="3"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
GOTO GETDATES
+5 SET BDMND=Y
ZIS ;
+1 SET BDMTEMP=""
+2 SET DIR(0)="S^P:PRINT the List;B:BROWSE the List on the Screen;S:Create Search Template;D:Create Delimited Output file"
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 IF BDMTEMP="P"!(BDMTEMP="B")
GOTO DEMO
+6 IF BDMTEMP="S"
Begin DoDot:1
+7 DO EN2^BDMRML
End DoDot:1
IF BDMSTMP=""
GOTO ZIS
GOTO DEMO
+8 ;get file name
+9 DO PT
IF BDMDELT=""
GOTO ZIS
IF BDMDELT="F"
IF BDMDELF=""
GOTO ZIS
+10 ;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^BDMDR6"
SET XBRC="PROC^BDMDR6"
SET XBRX="EXIT^BDMDR6"
SET XBNS="BDM"
+5 DO ^XBDBQUE
+6 DO EXIT
+7 QUIT
ST ;
BROWSE ;
+1 SET XBRP="VIEWR^XBLM(""PRINT^BDMDR6"")"
+2 SET XBRC="PROC^BDMDR6"
SET XBRX="EXIT^BDMDR6"
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 not on any diabetes register ",!
+5 WRITE "but who have had a visit with a diagnosis of diabetes in a date range",!
+6 WRITE "specified by the user. If you are multi-divisional with multiple registers",!
+7 WRITE "you can enter all of the register names. Only patients who are not on ANY",!
+8 WRITE "of the registers will be displayed on the list.",!
+9 WRITE !
+10 QUIT
PROC ;EP - called from XBDBQUE
+1 SET BDMJOB=$JOB
SET BDMBTH=$HOROLOG
+2 KILL ^XTMP("BDMDR6",BDMJOB,BDMBTH)
+3 DO XTMP^BDMOSUT("BDMDR6","DM NOT ON REGISTER")
+4 SET DFN=0
FOR
SET DFN=$ORDER(^AUPNPAT(DFN))
IF DFN'=+DFN
QUIT
Begin DoDot:1
+5 IF $PIECE($GET(^DPT(DFN,0)),U,19)
QUIT
+6 IF $DATA(^DPT(DFN,-9))
QUIT
+7 IF $$DEMO^BDMUTL(DFN,$GET(BDMDEMO))
QUIT
+8 IF $$DOD^AUPNPAT(DFN)]""
QUIT
+9 ;IHS/CMI/GRL
IF $PIECE($GET(^AUPNPAT(DFN,41,$SELECT($GET(BDMDUZ2)
QUIT
+10 ;IHS/CMI/GRL
IF $PIECE($GET(^AUPNPAT(DFN,41,$SELECT($GET(BDMDUZ2)
QUIT
+11 ;I $D(^ACM(41,"AC",DFN,BDMREG)) Q ;on register
IF $$ONREG(DFN,.BDMREG)
QUIT
+12 SET X=$$LASTDMDX(DFN,BDMBD,BDMED,BDMND)
+13 IF X
SET ^XTMP("BDMDR6",BDMJOB,BDMBTH,"PATIENTS",$$GET1^DIQ(2,DFN,.01),DFN)=""
End DoDot:1
+14 QUIT
ONREG(P,R) ;
+1 NEW X,G
+2 SET G=""
+3 SET X=0
FOR
SET X=$ORDER(BDMREG(X))
IF X'=+X!(G)
QUIT
IF $DATA(^ACM(41,"AC",DFN,X))
SET G=1
+4 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 KILL ^TMP($JOB)
+5 IF BDMTEMP'="D"
IF '$DATA(^XTMP("BDMDR6",BDMJOB,BDMBTH))
WRITE !!,"NO PATIENTS TO REPORT"
GOTO DONE
+6 SET BDMNAME=""
KILL BDMQ
+7 SET BDMDCNT=0
+8 FOR
SET BDMNAME=$ORDER(^XTMP("BDMDR6",BDMJOB,BDMBTH,"PATIENTS",BDMNAME))
IF BDMNAME=""!($DATA(BDMQ))
QUIT
Begin DoDot:1
+9 SET DFN=""
FOR
SET DFN=$ORDER(^XTMP("BDMDR6",BDMJOB,BDMBTH,"PATIENTS",BDMNAME,DFN))
IF DFN=""!($DATA(BDMQ))
QUIT
SET BDMX=^XTMP("BDMDR6",BDMJOB,BDMBTH,"PATIENTS",BDMNAME,DFN)
Begin DoDot:2
+10 IF BDMTEMP="S"
SET ^DIBT(BDMSTMP,1,DFN)=""
QUIT
+11 IF BDMTEMP="D"
DO DELR
QUIT
+12 IF $Y>(BDMIOSL-4)
DO HEAD
IF $DATA(BDMQ)
QUIT
+13 WRITE !,$EXTRACT(BDMNAME,1,20),?22,$$HRN^AUPNPAT(DFN,$SELECT($GET(BDMDUZ2):BDMDUZ2,1:DUZ(2))),?29,$$DATE^BDMS9B1($$DOB^AUPNPAT(DFN))
+14 WRITE ?40,$EXTRACT($$COMMRES^AUPNPAT(DFN,"E"),1,10)
+15 SET V=$$LASTV(DFN)
+16 WRITE ?53,$$DATE($PIECE(V,U,1))
+17 WRITE ?63,$$LBLK^BDMUTL($$NUMDXS(DFN,BDMBD,BDMED),5)
+18 WRITE ?70,$$DATE($$LASTDMDX(DFN,$$DOB^AUPNPAT(DFN),DT)),!
+19 WRITE ?5,"Seen at: ",$$VLOCS(DFN,BDMBD,BDMED)
End DoDot:2
End DoDot:1
DONE ;
+1 IF BDMTEMP="S"
WRITE !!,"Search Template ",$PIECE(^DIBT(BDMSTMP,0),U,1)," has been created.",!
+2 IF BDMTEMP="D"
DO WRITEF
QUIT
+3 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
+4 IF $DATA(IOF)
WRITE @IOF
+5 KILL ^XTMP("BDMDR6",BDMJOB,BDMBTH),BDMJOB,BDMBTH
+6 QUIT
DELR ;
+1 SET BDMDCNT=BDMDCNT+1
+2 SET BDMREC=""
+3 SET $PIECE(BDMREC,U)=BDMNAME
+4 SET $PIECE(BDMREC,U,2)=$$HRN^AUPNPAT(DFN,$SELECT($GET(BDMDUZ2):BDMDUZ2,1:DUZ(2)))
+5 SET $PIECE(BDMREC,U,3)=$$DATE^BDMS9B1($$DOB^AUPNPAT(DFN))
+6 SET $PIECE(BDMREC,U,4)=$$COMMRES^AUPNPAT(DFN,"E")
+7 SET V=$$LASTV(DFN)
+8 SET $PIECE(BDMREC,U,5)=$$DATE($PIECE(V,U,1))
+9 SET $PIECE(BDMREC,U,6)=$$NUMDXS(DFN,BDMBD,BDMED)
+10 SET $PIECE(BDMREC,U,7)=$$DATE($$LASTDMDX(DFN,$$DOB^AUPNPAT(DFN),DT))
+11 SET $PIECE(BDMREC,U,8)=$$VLOCS(DFN,BDMBD,BDMED)
+12 SET ^TMP($JOB,"DELIMITED",BDMDCNT)=BDMREC
+13 QUIT
HEAD IF BDMTEMP="D"
QUIT
+1 IF 'BDMPG
GOTO HEAD1
+2 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 NOT on any of the following Registers:"),!
+7 SET X=0
FOR
SET X=$ORDER(BDMREG(X))
IF X'=+X
QUIT
Begin DoDot:1
+8 WRITE $$CTR($PIECE(^ACM(41.1,X,0),U)_" Register",80),!
End DoDot:1
+9 WRITE $$CTR("with at least "_BDMND_" visits with a DX of Diabetes between ",80),!
+10 WRITE $$CTR($$FMTE^XLFDT(BDMBD)_" and "_$$FMTE^XLFDT(BDMED),80),!
PIH WRITE !,"PATIENT NAME",?22,"HRN",?29,"DOB",?40,"COMMUNITY",?53,"LAST VISIT",?64,"# DM",?70,"LAST DM",!,?64,"DXS",?70,"DX",!,BDM80D
+1 QUIT
NUMDXS(P,BD,ED) ;
+1 IF '$GET(P)
QUIT ""
+2 NEW X,E,BDM,Y
+3 SET Y="BDM("
+4 SET X=P_"^ALL DX [SURVEILLANCE DIABETES;DURING "_BD_"-"_ED
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,BDATE,EDATE,N) ;
+1 IF '$GET(P)
QUIT ""
+2 IF '$GET(N)
SET N=1
+3 NEW X,E,BDM,Y
+4 SET Y="BDM("
+5 SET X=P_"^LAST "_N_" DX [SURVEILLANCE DIABETES;DURING "_BDATE_"-"_EDATE
SET E=$$START1^APCLDF(X,Y)
+6 IF $DATA(BDM(N))
QUIT $PIECE(BDM(N),U)
+7 QUIT ""
VLOCS(P,BDATE,EDATE) ;
+1 NEW X,V,BDMVS,BDMLOCS,L
+2 DO ALLV^APCLAPIU(P,BDATE,EDATE,"BDMVS")
+3 SET X=0
FOR
SET X=$ORDER(BDMVS(X))
IF X'=+X
QUIT
Begin DoDot:1
+4 SET V=$PIECE(BDMVS(X),U,5)
+5 SET L=$$VALI^XBDIQ1(9000010,V,.06)
+6 IF '$DATA(^AUTTLOC(L,0))
QUIT
+7 ;S L=$P(^AUTTLOC(L,0),U,7)
+8 SET L=$EXTRACT($PIECE(^DIC(4,L,0),U,1),1,15)
+9 SET BDMLOCS(L)=""
End DoDot:1
+10 SET L=""
SET V=""
+11 FOR
SET L=$ORDER(BDMLOCS(L))
IF L=""
QUIT
SET V=V_$SELECT(V]"":";",1:"")
SET V=V_L
+12 QUIT V
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^BDMDR6"
SET ZTDESC="GUI DM PTS NO DX PL"
DO ^%ZTLOAD
+21 DO EXIT
+22 QUIT
GUIEP ;EP
+1 DO PROC
+2 KILL ^TMP($JOB,"BDMDR6")
+3 SET IOM=80
+4 DO GUIR^XBLM("PRINT^BDMDR6","^TMP($J,""BDMDR6"",")
+5 SET X=0
SET C=0
FOR
SET X=$ORDER(^TMP($JOB,"BDMDR6",X))
IF X'=+X
QUIT
Begin DoDot:1
+6 SET BDMDATA=^TMP($JOB,"BDMDR6",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,"BDMDR6")
+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
DATE(D) ;EP
+1 IF D=""
QUIT ""
+2 QUIT $EXTRACT(D,4,5)_"/"_$EXTRACT(D,6,7)_"/"_$EXTRACT(D,2,3)
PT ;EP
+1 SET (BDMROT,BDMDELT,BDMDELF)=""
+2 SET BDMDELF=""
SET BDMDELT=""
+3 WRITE !!,"You have selected to create a delimited output file. You can have this",!,"output file created as a text file in the pub directory, ",!,"OR you can have the delimited output display on your screen so that"
+4 WRITE !,"you can do a file capture. Keep in mind that if you choose to",!,"do a screen capture you CANNOT Queue your report to run in the background!!",!!
+5 SET DIR(0)="S^S:SCREEN-delimited output will display on screen for capture;F:FILE-delimited output will be written to a file in pub"
SET DIR("A")="Select output type"
SET DIR("B")="S"
KILL DA
DO ^DIR
KILL DIR
+6 IF $DATA(DIRUT)
GOTO PT
+7 SET BDMDELT=Y
+8 IF BDMDELT="S"
QUIT
+9 SET DIR(0)="F^1:40"
SET DIR("A")="Enter a filename for the delimited output (no more than 40 characters)"
KILL DA
DO ^DIR
KILL DIR
+10 IF $DATA(DIRUT)
GOTO PT
+11 SET BDMDELF=Y
+12 SET BDMHDIR=$SELECT($PIECE($GET(^AUTTSITE(1,1)),U,2)]"":$PIECE(^AUTTSITE(1,1),U,2),1:$GET(^XTV(8989.3,1,"DEV")))
+13 IF $GET(BDMHDIR)=""
SET BDMHDIR="/usr/spool/uucppublic/"
+14 WRITE !!,"When the report is finished your delimited output will be found in the",!,BDMHDIR," directory. The filename will be ",BDMDELF,".txt",!
+15 QUIT
WRITEF ;
+1 IF BDMDELT="S"
DO SCREEN
QUIT
+2 SET Y=$$OPEN^%ZISH(BDMHDIR,BDMDELF,"W")
+3 IF Y=1
IF '$DATA(ZTQUEUED)
WRITE !!,"Cannot open host file to write out DELIMITED data. Notify programmer."
QUIT
+4 USE IO
+5 WRITE !,"NAME^HRN^DOB^COMMUNITY^LAST VISIT^# DM DXS^LAST DM DXS^LOCATIONS WHERE SEEN"
+6 SET X=0
FOR
SET X=$ORDER(^TMP($JOB,"DELIMITED",X))
IF X'=+X
QUIT
WRITE !,^TMP($JOB,"DELIMITED",X)
+7 WRITE !
+8 DO ^%ZISC
+9 QUIT
SCREEN ;
+1 WRITE !,"NAME^HRN^DOB^COMMUNITY^LAST VISIT^# DM DXS^LAST DM DXS^LOCATIONS WHERE SEEN"
+2 SET X=0
FOR
SET X=$ORDER(^TMP($JOB,"DELIMITED",X))
IF X'=+X
QUIT
WRITE !,^TMP($JOB,"DELIMITED",X)
+3 WRITE !
+4 QUIT
