BDMGR ; IHS/CMI/LAB - BDM DMS GUI Reports ; [ 01/23/2009 4:11 PM ]
;;2.0;BDM DIABETES MANAGEMENT SYSTEM;**1,8**;JUN 14, 2007;Build 53
;
;
;cmi/anch/maw 1/25/2005 added line in FUR for uppercase dx type
;
DEBUG(BDMRET,BDMSTR) ;-- debugger
D DEBUG^%Serenji("FUR^BDMGR(.BDMRET,.BDMSTR)")
Q
;
HS(BDMRET,BDMSTR) ;-- get health summary data from BPC
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMDA,BDMI,BDMPAT,BDMTYPE,BDMCALL,P
S P="|"
S APCHSPAT=$P(BDMSTR,P)
S APCHSTYP=$P(BDMSTR,P,2)
I APCHSTYP'?.N S APCHSTYP=$O(^APCHSCTL("B",APCHSTYP,0))
S BDMI=0
S BDMERR=""
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S ^BDMTMP($J,BDMI)="T00080DATA"_$C(30)
S IOM=80
D GUIR^XBLM("EN^APCHS","^XTMP(""BDMHS"",$J)")
I '$D(^XTMP("BDMHS",$J)) D Q
. S BDMI=BDMI+1
. S ^BDMTMP($J,BDMI)="NO DATA"_$C(30)
. S ^BDMTMP($J,BDMI+1)=$C(31)
S BDMDA=.5 F S BDMDA=$O(^XTMP("BDMHS",$J,BDMDA)) Q:'BDMDA D
. N BDMDATA
. S BDMI=BDMI+1
. S BDMDATA=$G(^XTMP("BDMHS",$J,BDMDA))
. S ^BDMTMP($J,BDMI)=BDMDATA_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_BDMERR
K ^XTMP("BDMHS",$J)
Q
;
FLS(BDMRET,BDMSTR) ;-- get flow sheet data
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMDA,BDMI,BDMPAT,BDMTYPE,BDMCALL,P,BDMODFN
S P="|"
I $G(DFN) S BDMODFN=DFN
S DFN=$P(BDMSTR,P)
S BDMFDF=$P(BDMSTR,P,2)
I BDMFDF'?.N S BDMFDF=$O(^APCHSFLC("B",BDMFDF,0))
S BDMI=0
S BDMERR=""
D SETVARS^BDMFLOW
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S ^BDMTMP($J,BDMI)="T00080DATA"_$C(30)
S IOM=80
D GUIR^XBLM("FLOWDISP^BDMFLOW","^XTMP(""BDMFLS"",$J)")
I '$D(^XTMP("BDMFLS",$J)) D Q
. S BDMI=BDMI+1
. S ^BDMTMP($J,BDMI)="NO DATA"_$C(30)
. S ^BDMTMP($J,BDMI+1)=$C(31)
S BDMDA=.5 F S BDMDA=$O(^XTMP("BDMFLS",$J,BDMDA)) Q:'BDMDA D
. N BDMDATA
. S BDMI=BDMI+1
. S BDMDATA=$G(^XTMP("BDMFLS",$J,BDMDA))
. S ^BDMTMP($J,BDMI)=BDMDATA_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_BDMERR
K ^XTMP("BDMFLS",$J)
K BDMSPAT,BDMFDF
I $G(BDMODFN) S DFN=BDMODFN
Q
;
PCC(BDMRET,BDMSTR) ;-- display pcc visit
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMDA,BDMI,BDMPAT,BDMTYPE,BDMCALL,BDMVIEN,P
S P="|"
S BDMPAT=$P(BDMSTR,P)
S BDMVIEN=$P(BDMSTR,P,2)
S BDMI=0
S BDMERR=""
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S ^BDMTMP($J,BDMI)="T00250DATA"_$C(30)
I '$G(BDMVIEN) D
. S BDMIVDT=$O(^AUPNVSIT("AA",BDMPAT,0))
. I 'BDMIVDT D Q
.. S BDMI=BDMI+1
.. S ^BDMTMP($J,BDMI)="NO DATA"_$C(30)
.. S ^BDMTMP($J,BDMI+1)=$C(31)_BDMERR
. S BDMVIEN=$O(^AUPNVSIT("AA",BDMPAT,BDMIVDT,0))
Q:'$G(BDMVIEN)
N BDMGUI
S BDMGUI=1
D EN^APCDVDSG(BDMVIEN,"^XTMP(""BDMLV"",$J)",BDMGUI)
I '$D(^XTMP("BDMLV",$J)) D Q
. S BDMI=BDMI+1
. S ^BDMTMP($J,BDMI)="NO DATA"_$C(30)
. S ^BDMTMP($J,BDMI+1)=$C(31)
S BDMDA=0 F S BDMDA=$O(^XTMP("BDMLV",$J,BDMDA)) Q:'BDMDA D
. N BDMDATA
. S BDMI=BDMI+1
. S BDMDATA=$G(^XTMP("BDMLV",$J,BDMDA,0))
. S ^BDMTMP($J,BDMI)=BDMDATA_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_BDMERR
K ^XTMP("BDMLV",$J)
Q
;
MED(BDMRET,BDMSTR) ;-- medication profile all meds/dm meds
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMDA,BDMI,BDMPAT,BDMTYPE,BDMCALL,DFN,P,BDMDMO
K BDMONLY
S P="|"
S DFN=$P(BDMSTR,P)
S BDMDMO=+$P(BDMSTR,P,2)
I $G(BDMDMO) D
. S BDMONLY=""
. D DMMEDS
S BDMI=0
S BDMERR=""
K ^BDMTMP($J)
S BDMREGNM="IHS DIABETES REGISTER"
S BDMRDA=$O(^ACM(41.1,"B",BDMREGNM,0))
S BDMRET="^BDMTMP("_$J_")"
S ^BDMTMP($J,BDMI)="T00250DATA"_$C(30)
D MINIT^BDMVRL1
S BDMI=BDMI+1
S ^BDMTMP($J,BDMI)="PATIENT NAME: "_$$GET1^DIQ(2,DFN,.01)_$C(30)
S BDMI=BDMI+1
S ^BDMTMP($J,BDMI)="CHART: "_$$HRN^AUPNPAT(DFN,DUZ(2))_$C(30)
I '$D(^TMP("BDMVR",$J,2)) D Q
. S BDMI=BDMI+1
. S ^BDMTMP($J,BDMI)="NO DATA"_$C(30)
. S ^BDMTMP($J,BDMI+1)=$C(31)
S BDMDA=0 F S BDMDA=$O(^TMP("BDMVR",$J,BDMDA)) Q:'BDMDA D
. N BDMDATA
. S BDMI=BDMI+1
. S BDMDATA=$G(^TMP("BDMVR",$J,BDMDA,0))
. S ^BDMTMP($J,BDMI)=BDMDATA_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_BDMERR
K ^XTMP("BDMVR",$J),BDMMEDS,BDM
K ^TMP("BDMVR",$J)
Q
;
DMMEDS ;EP - setup array for dm meds
N S,T,TX,X,Y,Z,BDMJ
S (T,TX)="DM AUDIT "
F S T=$O(^ATXAX("B",T)) Q:T=""!(T'[TX) D
.S X=0
.F S X=$O(^ATXAX("B",T,X)) Q:'X D
..Q:+$P($G(^ATXAX(X,0)),U,15)'=50
..S BDM(X)=""
S BDMTXDA=0
F S BDMTXDA=$O(BDM(BDMTXDA)) Q:'BDMTXDA D
.S X=0
.F S X=$O(^ATXAX(BDMTXDA,21,X)) Q:'X D
..S Y=$P($G(^ATXAX(BDMTXDA,21,X,0)),U)
..Q:'Y
..S BDMMEDS(Y)=""
Q:'$D(BDMMEDS)
S DA=DFN
Q
;
APP(BDMRET,BDMSTR) ;-- appointments
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMDA,BDMI,BDMPAT,BDMTYPE,BDMCALL,DFN,P
S P="|"
S DFN=$P(BDMSTR,P)
S BDMI=0
S BDMERR=""
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S ^BDMTMP($J,BDMI)="T00250DATA"_$C(30)
S BDMREGNM=$P(BDMSTR,P,2)
S BDMRDA=$O(^ACM(41.1,"B",BDMREGNM,0))
D APPINIT^BDMVRL
I '$D(^TMP("BDMVR",$J,2)) D Q
. S BDMI=BDMI+1
. S ^BDMTMP($J,BDMI)="NO DATA"_$C(30)
. S ^BDMTMP($J,BDMI+1)=$C(31)
S BDMDA=0 F S BDMDA=$O(^TMP("BDMVR",$J,BDMDA)) Q:'BDMDA D
. N BDMDATA
. S BDMI=BDMI+1
. S BDMDATA=$G(^TMP("BDMVR",$J,BDMDA,0))
. S ^BDMTMP($J,BDMI)=BDMDATA_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_BDMERR
K ^TMP("BDMVR",$J)
Q
;
AS(BDMRET,BDMSTR) ;-- audit status
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N X,BDMY,BDMZ,BDMQUIT,P
S P="|"
S DFN=$P(BDMSTR,P,1)
S BDMRDA=$P(BDMSTR,P,2)
F BDMY=91 D:'$D(BDMQUIT)
.S X="BDMD"_BDMY
.X ^%ZOSF("TEST")
.I $T D Q
..S BDMJOB=$J
..S BDMBTH=$H
..S BDMDMRG=BDMRDA
..S ^XTMP(("BDMDM"_BDMY),BDMJOB,BDMBTH,"PATS",DFN)=""
..S ^TMP(("BDMDM"_BDMY),BDMJOB,BDMBTH,"PATS",DFN)=""
..S BDMZ="TIME^BDMD"_BDMY
..D @BDMZ
..Q:$G(BDMSTP)
..S BDMZ="IF^BDMD"_BDMY
..D @BDMZ
..S BDMQUIT=""
I $D(BDMQUIT) K BDMQUIT Q
S X="BDMD99"
X ^%ZOSF("TEST")
I $T D Q
.S BDMJOB=$J
.S BDMBTH=$H
.S BDMDMRG=BDMRDA
.S ^XTMP("BDMDM99",BDMJOB,BDMBTH,"PATS",DFN)=""
.S ^TMP("BDMDM99",BDMJOB,BDMBTH,"PATS",DFN)=""
.D TIME^BDMD99
.Q:$G(BDMSTP)
.D IF^BDMD99
S BDMDFN=$O(^APCLRPT("B","APCL DIABETES PROGRAM QA AUDIT",0))
Q:'BDMDFN
S BDMPTS=1
S BDMPREP=2
S BDMCUML=0
S ^XTMP("BDMPTS",$J,DFN)=""
S ^TMP("BDMPTS",$J,DFN)=""
D TIME^BDMASK
Q:$G(BDMSTP)
S BDMRTN="ZTM^BDMASK"
D GUIR^XBLM(BDMRTN,"^XTMP(""BDMAS"",$J)")
Q
;
CS(BDMRET,BDMSTR) ;-- case summary
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMDA,BDMI,BDMPAT,BDMTYPE,BDMCALL,DFN,P
S P="|"
S BDMCS=$P(BDMSTR,P)
S BDMRDA=$O(^ACM(41.1,"B",BDMCS,0))
S BDMRPDA=$P(BDMSTR,P,2)
S DFN=$P(BDMSTR,P,3)
S BDMI=0
S BDMERR=""
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S ^BDMTMP($J,BDMI)="T00250DATA"_$C(30)
S IOM=80
D GUIR^XBLM("CS1^BDMVRL","^XTMP(""BDMCS"",$J)")
I '$D(^XTMP("BDMCS",$J)) D Q
. S BDMI=BDMI+1
. S ^BDMTMP($J,BDMI)="NO DATA"_$C(30)
. S ^BDMTMP($J,BDMI+1)=$C(31)
S BDMDA=.5 F S BDMDA=$O(^XTMP("BDMCS",$J,BDMDA)) Q:'BDMDA D
. N BDMDATA
. S BDMI=BDMI+1
. S BDMDATA=$G(^XTMP("BDMCS",$J,BDMDA))
. S ^BDMTMP($J,BDMI)=BDMDATA_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_BDMERR
K ^TMP("BDMVR",$J)
Q
;
FS(BDMRET,BDMSTR) ;-- return patient reg face sheet
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N P,DFN,BDMDA,BDMI,BDMPAT,BDMTYPE,BDMCALL
S P="|"
S DFN=$P(BDMSTR,P)
S BDMI=0
S BDMERR=""
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S ^BDMTMP($J,BDMI)="T00250DATA"_$C(30)
S IOM=80
D GUIR^XBLM("START^AGFACE","^XTMP(""BDMFS"",$J)")
S BDMDA=.5 F S BDMDA=$O(^XTMP("BDMFS",$J,BDMDA)) Q:'BDMDA D
. N BDMDATA
. S BDMI=BDMI+1
. S BDMDATA=$G(^XTMP("BDMFS",$J,BDMDA))
. S ^BDMTMP($J,BDMI)=BDMDATA_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_BDMERR
K ^XTMP("BDMFS",$J)
Q
;
LET(BDMRET,BDMSTR) ;-- return letter
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N P,DFN,BDMDA,BDMI,BDMPAT,BDMTYPE,BDMCALL,BDMLDA,BDMLET
S P="|"
S DFN=$P(BDMSTR,P)
S BDMLET=$P(BDMSTR,P,2)
S BDMLDA=$O(^BDMLET("B",BDMLET,0))
S BDMI=0
S BDMERR=""
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S ^BDMTMP($J,BDMI)="T00250DATA"_$C(30)
D GUIR^XBLM("PRINT^BDMLET","^XTMP(""BDMLET"",$J)")
S BDMDA=.5 F S BDMDA=$O(^XTMP("BDMLET",$J,BDMDA)) Q:'BDMDA D
. N BDMDATA
. S BDMI=BDMI+1
. S BDMDATA=$G(^XTMP("BDMLET",$J,BDMDA))
. S ^BDMTMP($J,BDMI)=BDMDATA_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_BDMERR
K ^XTMP("BDMLET",$J)
Q
;
PLD(BDMRET,BDMSTR) ;-- return problem list display
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMPIEN,P
S P="|"
S BDMPIEN=$P(BDMSTR,P)
S BDMI=0
S BDMERR=""
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S ^BDMTMP($J,BDMI)="T00250DATA"_$C(30)
S DIC="^AUPNPROB(",DA=BDMPIEN,DIQ(0)="C"
D GUIR^XBLM("EN^DIQ","^XTMP(""BDMPL"",$J)")
S BDMDA=.5 F S BDMDA=$O(^XTMP("BDMPL",$J,BDMDA)) Q:'BDMDA D
. N BDMDATA
. S BDMI=BDMI+1
. S BDMDATA=$G(^XTMP("BDMPL",$J,BDMDA))
. S ^BDMTMP($J,BDMI)=BDMDATA_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_BDMERR
K ^XTMP("BDMPL",$J)
K DIC,DA,DIQ
Q
;
FUPROT(BDMRET) ;-- return the FU Protocols
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
S BDMI=0
S BDMERR=""
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S ^BDMTMP($J,BDMI)="T00250DATA"_$C(30)
S IOM=80
D GUIR^XBLM("PINIT^BDMVRL42","^XTMP(""BDMFUP"",$J)")
S BDMDA=.5 F S BDMDA=$O(^XTMP("BDMFUP",$J,BDMDA)) Q:'BDMDA D
. N BDMDATA
. S BDMI=BDMI+1
. S BDMDATA=$G(^XTMP("BDMFUP",$J,BDMDA))
. S ^BDMTMP($J,BDMI)=BDMDATA_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_BDMERR
K ^XTMP("BDMFUP",$J)
Q
;
FUR(RETVAL,BDMSTR) ;-- print the followup report
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N P,R,BDMRTYP,BDMRS,BDMST,BDMPS,BDMDD,BDMPA,BDMPABD,BDMPAED
N BDMPBY,BDMPBYV,BDMRL,BDMLP,BDM,BDMDEMO
S P="|",R="~"
D EXIT^BDMVRL4
I $G(BDMSTR)="" S BDMSTR=$$CATSTR^BDMGU(.BDMSTR)
S BDMRTYP=$P(BDMSTR,P)
S BDMRS=$P(BDMSTR,P,2)
S BDMST=$P(BDMSTR,P,3)
I $G(BDMST)]"" S BDM("SEARCH TEMPLATE")=$O(^DIBT("B",BDMST,0))
S BDMPS=$P(BDMSTR,P,4)
S BDM("STATUS")=BDMPS
S BDMDD=$P(BDMSTR,P,5)
;cmi/anch/maw 1/25/2005 added following line
N X S X=BDMDD X ^%ZOSF("UPPERCASE") S BDMDD=Y
S BDM("DM DIAGNOSIS")=BDMDD
S BDMPA=$P(BDMSTR,P,6)
I $G(BDMPA)="Y" S BDMFUAPP=""
S BDMPABD=$P(BDMSTR,P,7)
S BDMBEGIN=BDMPABD
S BDMPAED=$P(BDMSTR,P,8)
S BDMEND=BDMPAED
S BDMPBY=$P(BDMSTR,P,9)
I $P(BDMPBY,"-",2)="Community" S BDMFL=9999999.05,BDMK="COMMUNITY"
I $P(BDMPBY,"-",3)="Provider" S BDMFL=200,BDMK="PROVIDER"
S BDMPBYV=$P(BDMSTR,P,10)
I BDMPBYV="All" S BDMPBYV=""
F J=1:1 D Q:$P(BDMPBYV,R,J)=""
. Q:$P(BDMPBYV,R,J)=""
. S BDMK($P(BDMPBYV,R,J))=$$GET1^DIQ(BDMFL,$P(BDMPBYV,R,J),.01)
S BDMRL=$P(BDMSTR,P,11)
S BDMFU=$P(BDMRL,"-",2)
S BDMLP=$P(BDMSTR,P,12)
I $G(BDMLP)]"" S BDMLDA=$O(^BDMLET("B",BDMLP,0))
S BDMREGNM=$P(BDMSTR,P,13)
S BDMDEMO=$P(BDMSTR,P,15)
S IOM=80
D GUIR^XBLM("SCREEN^BDMVRL42","^TMP($J,")
S BDMRTYP=$TR(BDMRTYP,"~",",")
I BDMRTYP="All" D
. D ALL^BDMVRL42
. S BDMY=Y
. D PARSE^BDMVRL42
I BDMRTYP'="All" S BDMY=BDMRTYP D PARSE^BDMVRL42
;N I
;F I=1:1 D Q:$P(BDMRTYP,R,I)=""
;. ;Q:$P(BDMRTYP,R,I)=""
;. ;S BDM("PARSE",$P(BDMRTYP,R,I))=""
S BDMI=0
S BDMERR=""
K ^BDMTMP($J)
S RETVAL="^BDMTMP("_$J_")"
S ^BDMTMP($J,BDMI)="T00250DATA"_$C(30)
;D BDMG^BDMVRL4(.BDM)
;D FUHEAD^BDMVRL42
;Q
;
D BDMGA^BDMVRL4(.BDMERR,.BDM,$G(BDMFUAPP),BDMFL,.BDMK,BDMRL,BDMFU,$G(BDMLDA),BDMREGNM,1,BDMDEMO)
;S BDMJ=0
;D GUIR^XBLM("BDMG^BDMVRL4(.BDM)","^XTMP(""BDMFUR"",$J)")
;S BDMDA=.5 F S BDMDA=$O(^XTMP("BDMFUR",$J,BDMDA)) Q:'BDMDA D
;. N BDMDATA
;. S BDMI=BDMI+1
;. S BDMDATA=$G(^XTMP("BDMFUR",$J,BDMDA))
;. S ^BDMTMP($J,BDMI)=BDMDATA_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)
D EN^XBVK("BDM")
Q
;
SELF(RETVAL,BDMSTR) ;-- glucose self monitoring report
N BDMRG,BDMST,BDMRT,BDME,BDMSRT,P,BDMDEMO
S P="|"
S BDMRG=$P(BDMSTR,P)
S BDMRDA=$O(^ACM(41.1,"B",BDMRG,0))
S BDMST=$P(BDMSTR,P,2)
S BDMRT=$P(BDMSTR,P,3)
S BDME=$P(BDMSTR,P,4)
S BDMSRT=$P(BDMSTR,P,5)
S BDMDEMO=$P(BDMSTR,P,6)
S BDMI=0
S BDMERR=""
K ^BDMTMP($J)
S RETVAL="^BDMTMP("_$J_")"
S ^BDMTMP($J,BDMI)="T00250DATA"_$C(30)
S IOM=80
D BDMGA^BDMSELFM(.BDMERR,BDMRDA,BDMST,BDMRT,BDME,BDMSRT,1,BDMDEMO)
S ^BDMTMP($J,1)=$C(31)_$G(BDMERR)
D EN^XBVK("BDM")
Q
;
LPA(RETVAL,BDMSTR) ;-- list patient appointments
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMDA,BDMI,BDMPAT,BDMTYPE,BDMCALL,BDMREGNM,BDMBEGIN,BDMEND,P
S P="|"
S BDMREGNM=$P(BDMSTR,P)
S BDMBEGIN=$P(BDMSTR,P,2)
S BDMEND=$P(BDMSTR,P,3)
S BDMRDA=$O(^ACM(41.1,"B",BDMREGNM,0))
S BDMI=0
S BDMERR=""
K ^BDMTMP($J)
S RETVAL="^BDMTMP("_$J_")"
S ^BDMTMP($J,BDMI)="T00250DATA"_$C(30)
S IOM=80
D BDMGA^BDMVRL6(.BDMERR,BDMBEGIN,BDMEND,BDMRDA,1)
;D APPINIT^BDMVRL6
;I '$D(^TMP("BDMVR",$J,2)) D Q
;. S BDMI=BDMI+1
;. S ^BDMTMP($J,BDMI)="NO DATA"_$C(30)
;. S ^BDMTMP($J,BDMI+1)=$C(31)
;S BDMDA=0 F S BDMDA=$O(^TMP("BDMVR",$J,BDMDA)) Q:'BDMDA D
;. N BDMDATA
;. S BDMI=BDMI+1
;. S BDMDATA=$G(^TMP("BDMVR",$J,BDMDA,0))
;. S ^BDMTMP($J,BDMI)=BDMDATA_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_BDMERR
D EN^XBVK("BDM")
Q
;
BDMGR ; IHS/CMI/LAB - BDM DMS GUI Reports ; [ 01/23/2009 4:11 PM ]
+1 ;;2.0;BDM DIABETES MANAGEMENT SYSTEM;**1,8**;JUN 14, 2007;Build 53
+2 ;
+3 ;
+4 ;cmi/anch/maw 1/25/2005 added line in FUR for uppercase dx type
+5 ;
DEBUG(BDMRET,BDMSTR) ;-- debugger
+1 DO DEBUG^%Serenji("FUR^BDMGR(.BDMRET,.BDMSTR)")
+2 QUIT
+3 ;
HS(BDMRET,BDMSTR) ;-- get health summary data from BPC
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMDA,BDMI,BDMPAT,BDMTYPE,BDMCALL,P
+3 SET P="|"
+4 SET APCHSPAT=$PIECE(BDMSTR,P)
+5 SET APCHSTYP=$PIECE(BDMSTR,P,2)
+6 IF APCHSTYP'?.N
SET APCHSTYP=$ORDER(^APCHSCTL("B",APCHSTYP,0))
+7 SET BDMI=0
+8 SET BDMERR=""
+9 KILL ^BDMTMP($JOB)
+10 SET BDMRET="^BDMTMP("_$JOB_")"
+11 SET ^BDMTMP($JOB,BDMI)="T00080DATA"_$CHAR(30)
+12 SET IOM=80
+13 DO GUIR^XBLM("EN^APCHS","^XTMP(""BDMHS"",$J)")
+14 IF '$DATA(^XTMP("BDMHS",$JOB))
Begin DoDot:1
+15 SET BDMI=BDMI+1
+16 SET ^BDMTMP($JOB,BDMI)="NO DATA"_$CHAR(30)
+17 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)
End DoDot:1
QUIT
+18 SET BDMDA=.5
FOR
SET BDMDA=$ORDER(^XTMP("BDMHS",$JOB,BDMDA))
IF 'BDMDA
QUIT
Begin DoDot:1
+19 NEW BDMDATA
+20 SET BDMI=BDMI+1
+21 SET BDMDATA=$GET(^XTMP("BDMHS",$JOB,BDMDA))
+22 SET ^BDMTMP($JOB,BDMI)=BDMDATA_$CHAR(30)
End DoDot:1
+23 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_BDMERR
+24 KILL ^XTMP("BDMHS",$JOB)
+25 QUIT
+26 ;
FLS(BDMRET,BDMSTR) ;-- get flow sheet data
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMDA,BDMI,BDMPAT,BDMTYPE,BDMCALL,P,BDMODFN
+3 SET P="|"
+4 IF $GET(DFN)
SET BDMODFN=DFN
+5 SET DFN=$PIECE(BDMSTR,P)
+6 SET BDMFDF=$PIECE(BDMSTR,P,2)
+7 IF BDMFDF'?.N
SET BDMFDF=$ORDER(^APCHSFLC("B",BDMFDF,0))
+8 SET BDMI=0
+9 SET BDMERR=""
+10 DO SETVARS^BDMFLOW
+11 KILL ^BDMTMP($JOB)
+12 SET BDMRET="^BDMTMP("_$JOB_")"
+13 SET ^BDMTMP($JOB,BDMI)="T00080DATA"_$CHAR(30)
+14 SET IOM=80
+15 DO GUIR^XBLM("FLOWDISP^BDMFLOW","^XTMP(""BDMFLS"",$J)")
+16 IF '$DATA(^XTMP("BDMFLS",$JOB))
Begin DoDot:1
+17 SET BDMI=BDMI+1
+18 SET ^BDMTMP($JOB,BDMI)="NO DATA"_$CHAR(30)
+19 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)
End DoDot:1
QUIT
+20 SET BDMDA=.5
FOR
SET BDMDA=$ORDER(^XTMP("BDMFLS",$JOB,BDMDA))
IF 'BDMDA
QUIT
Begin DoDot:1
+21 NEW BDMDATA
+22 SET BDMI=BDMI+1
+23 SET BDMDATA=$GET(^XTMP("BDMFLS",$JOB,BDMDA))
+24 SET ^BDMTMP($JOB,BDMI)=BDMDATA_$CHAR(30)
End DoDot:1
+25 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_BDMERR
+26 KILL ^XTMP("BDMFLS",$JOB)
+27 KILL BDMSPAT,BDMFDF
+28 IF $GET(BDMODFN)
SET DFN=BDMODFN
+29 QUIT
+30 ;
PCC(BDMRET,BDMSTR) ;-- display pcc visit
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMDA,BDMI,BDMPAT,BDMTYPE,BDMCALL,BDMVIEN,P
+3 SET P="|"
+4 SET BDMPAT=$PIECE(BDMSTR,P)
+5 SET BDMVIEN=$PIECE(BDMSTR,P,2)
+6 SET BDMI=0
+7 SET BDMERR=""
+8 KILL ^BDMTMP($JOB)
+9 SET BDMRET="^BDMTMP("_$JOB_")"
+10 SET ^BDMTMP($JOB,BDMI)="T00250DATA"_$CHAR(30)
+11 IF '$GET(BDMVIEN)
Begin DoDot:1
+12 SET BDMIVDT=$ORDER(^AUPNVSIT("AA",BDMPAT,0))
+13 IF 'BDMIVDT
Begin DoDot:2
+14 SET BDMI=BDMI+1
+15 SET ^BDMTMP($JOB,BDMI)="NO DATA"_$CHAR(30)
+16 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_BDMERR
End DoDot:2
QUIT
+17 SET BDMVIEN=$ORDER(^AUPNVSIT("AA",BDMPAT,BDMIVDT,0))
End DoDot:1
+18 IF '$GET(BDMVIEN)
QUIT
+19 NEW BDMGUI
+20 SET BDMGUI=1
+21 DO EN^APCDVDSG(BDMVIEN,"^XTMP(""BDMLV"",$J)",BDMGUI)
+22 IF '$DATA(^XTMP("BDMLV",$JOB))
Begin DoDot:1
+23 SET BDMI=BDMI+1
+24 SET ^BDMTMP($JOB,BDMI)="NO DATA"_$CHAR(30)
+25 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)
End DoDot:1
QUIT
+26 SET BDMDA=0
FOR
SET BDMDA=$ORDER(^XTMP("BDMLV",$JOB,BDMDA))
IF 'BDMDA
QUIT
Begin DoDot:1
+27 NEW BDMDATA
+28 SET BDMI=BDMI+1
+29 SET BDMDATA=$GET(^XTMP("BDMLV",$JOB,BDMDA,0))
+30 SET ^BDMTMP($JOB,BDMI)=BDMDATA_$CHAR(30)
End DoDot:1
+31 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_BDMERR
+32 KILL ^XTMP("BDMLV",$JOB)
+33 QUIT
+34 ;
MED(BDMRET,BDMSTR) ;-- medication profile all meds/dm meds
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMDA,BDMI,BDMPAT,BDMTYPE,BDMCALL,DFN,P,BDMDMO
+3 KILL BDMONLY
+4 SET P="|"
+5 SET DFN=$PIECE(BDMSTR,P)
+6 SET BDMDMO=+$PIECE(BDMSTR,P,2)
+7 IF $GET(BDMDMO)
Begin DoDot:1
+8 SET BDMONLY=""
+9 DO DMMEDS
End DoDot:1
+10 SET BDMI=0
+11 SET BDMERR=""
+12 KILL ^BDMTMP($JOB)
+13 SET BDMREGNM="IHS DIABETES REGISTER"
+14 SET BDMRDA=$ORDER(^ACM(41.1,"B",BDMREGNM,0))
+15 SET BDMRET="^BDMTMP("_$JOB_")"
+16 SET ^BDMTMP($JOB,BDMI)="T00250DATA"_$CHAR(30)
+17 DO MINIT^BDMVRL1
+18 SET BDMI=BDMI+1
+19 SET ^BDMTMP($JOB,BDMI)="PATIENT NAME: "_$$GET1^DIQ(2,DFN,.01)_$CHAR(30)
+20 SET BDMI=BDMI+1
+21 SET ^BDMTMP($JOB,BDMI)="CHART: "_$$HRN^AUPNPAT(DFN,DUZ(2))_$CHAR(30)
+22 IF '$DATA(^TMP("BDMVR",$JOB,2))
Begin DoDot:1
+23 SET BDMI=BDMI+1
+24 SET ^BDMTMP($JOB,BDMI)="NO DATA"_$CHAR(30)
+25 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)
End DoDot:1
QUIT
+26 SET BDMDA=0
FOR
SET BDMDA=$ORDER(^TMP("BDMVR",$JOB,BDMDA))
IF 'BDMDA
QUIT
Begin DoDot:1
+27 NEW BDMDATA
+28 SET BDMI=BDMI+1
+29 SET BDMDATA=$GET(^TMP("BDMVR",$JOB,BDMDA,0))
+30 SET ^BDMTMP($JOB,BDMI)=BDMDATA_$CHAR(30)
End DoDot:1
+31 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_BDMERR
+32 KILL ^XTMP("BDMVR",$JOB),BDMMEDS,BDM
+33 KILL ^TMP("BDMVR",$JOB)
+34 QUIT
+35 ;
DMMEDS ;EP - setup array for dm meds
+1 NEW S,T,TX,X,Y,Z,BDMJ
+2 SET (T,TX)="DM AUDIT "
+3 FOR
SET T=$ORDER(^ATXAX("B",T))
IF T=""!(T'[TX)
QUIT
Begin DoDot:1
+4 SET X=0
+5 FOR
SET X=$ORDER(^ATXAX("B",T,X))
IF 'X
QUIT
Begin DoDot:2
+6 IF +$PIECE($GET(^ATXAX(X,0)),U,15)'=50
QUIT
+7 SET BDM(X)=""
End DoDot:2
End DoDot:1
+8 SET BDMTXDA=0
+9 FOR
SET BDMTXDA=$ORDER(BDM(BDMTXDA))
IF 'BDMTXDA
QUIT
Begin DoDot:1
+10 SET X=0
+11 FOR
SET X=$ORDER(^ATXAX(BDMTXDA,21,X))
IF 'X
QUIT
Begin DoDot:2
+12 SET Y=$PIECE($GET(^ATXAX(BDMTXDA,21,X,0)),U)
+13 IF 'Y
QUIT
+14 SET BDMMEDS(Y)=""
End DoDot:2
End DoDot:1
+15 IF '$DATA(BDMMEDS)
QUIT
+16 SET DA=DFN
+17 QUIT
+18 ;
APP(BDMRET,BDMSTR) ;-- appointments
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMDA,BDMI,BDMPAT,BDMTYPE,BDMCALL,DFN,P
+3 SET P="|"
+4 SET DFN=$PIECE(BDMSTR,P)
+5 SET BDMI=0
+6 SET BDMERR=""
+7 KILL ^BDMTMP($JOB)
+8 SET BDMRET="^BDMTMP("_$JOB_")"
+9 SET ^BDMTMP($JOB,BDMI)="T00250DATA"_$CHAR(30)
+10 SET BDMREGNM=$PIECE(BDMSTR,P,2)
+11 SET BDMRDA=$ORDER(^ACM(41.1,"B",BDMREGNM,0))
+12 DO APPINIT^BDMVRL
+13 IF '$DATA(^TMP("BDMVR",$JOB,2))
Begin DoDot:1
+14 SET BDMI=BDMI+1
+15 SET ^BDMTMP($JOB,BDMI)="NO DATA"_$CHAR(30)
+16 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)
End DoDot:1
QUIT
+17 SET BDMDA=0
FOR
SET BDMDA=$ORDER(^TMP("BDMVR",$JOB,BDMDA))
IF 'BDMDA
QUIT
Begin DoDot:1
+18 NEW BDMDATA
+19 SET BDMI=BDMI+1
+20 SET BDMDATA=$GET(^TMP("BDMVR",$JOB,BDMDA,0))
+21 SET ^BDMTMP($JOB,BDMI)=BDMDATA_$CHAR(30)
End DoDot:1
+22 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_BDMERR
+23 KILL ^TMP("BDMVR",$JOB)
+24 QUIT
+25 ;
AS(BDMRET,BDMSTR) ;-- audit status
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW X,BDMY,BDMZ,BDMQUIT,P
+3 SET P="|"
+4 SET DFN=$PIECE(BDMSTR,P,1)
+5 SET BDMRDA=$PIECE(BDMSTR,P,2)
+6 FOR BDMY=91
IF '$DATA(BDMQUIT)
Begin DoDot:1
+7 SET X="BDMD"_BDMY
+8 XECUTE ^%ZOSF("TEST")
+9 IF $TEST
Begin DoDot:2
+10 SET BDMJOB=$JOB
+11 SET BDMBTH=$HOROLOG
+12 SET BDMDMRG=BDMRDA
+13 SET ^XTMP(("BDMDM"_BDMY),BDMJOB,BDMBTH,"PATS",DFN)=""
+14 SET ^TMP(("BDMDM"_BDMY),BDMJOB,BDMBTH,"PATS",DFN)=""
+15 SET BDMZ="TIME^BDMD"_BDMY
+16 DO @BDMZ
+17 IF $GET(BDMSTP)
QUIT
+18 SET BDMZ="IF^BDMD"_BDMY
+19 DO @BDMZ
+20 SET BDMQUIT=""
End DoDot:2
QUIT
End DoDot:1
+21 IF $DATA(BDMQUIT)
KILL BDMQUIT
QUIT
+22 SET X="BDMD99"
+23 XECUTE ^%ZOSF("TEST")
+24 IF $TEST
Begin DoDot:1
+25 SET BDMJOB=$JOB
+26 SET BDMBTH=$HOROLOG
+27 SET BDMDMRG=BDMRDA
+28 SET ^XTMP("BDMDM99",BDMJOB,BDMBTH,"PATS",DFN)=""
+29 SET ^TMP("BDMDM99",BDMJOB,BDMBTH,"PATS",DFN)=""
+30 DO TIME^BDMD99
+31 IF $GET(BDMSTP)
QUIT
+32 DO IF^BDMD99
End DoDot:1
QUIT
+33 SET BDMDFN=$ORDER(^APCLRPT("B","APCL DIABETES PROGRAM QA AUDIT",0))
+34 IF 'BDMDFN
QUIT
+35 SET BDMPTS=1
+36 SET BDMPREP=2
+37 SET BDMCUML=0
+38 SET ^XTMP("BDMPTS",$JOB,DFN)=""
+39 SET ^TMP("BDMPTS",$JOB,DFN)=""
+40 DO TIME^BDMASK
+41 IF $GET(BDMSTP)
QUIT
+42 SET BDMRTN="ZTM^BDMASK"
+43 DO GUIR^XBLM(BDMRTN,"^XTMP(""BDMAS"",$J)")
+44 QUIT
+45 ;
CS(BDMRET,BDMSTR) ;-- case summary
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMDA,BDMI,BDMPAT,BDMTYPE,BDMCALL,DFN,P
+3 SET P="|"
+4 SET BDMCS=$PIECE(BDMSTR,P)
+5 SET BDMRDA=$ORDER(^ACM(41.1,"B",BDMCS,0))
+6 SET BDMRPDA=$PIECE(BDMSTR,P,2)
+7 SET DFN=$PIECE(BDMSTR,P,3)
+8 SET BDMI=0
+9 SET BDMERR=""
+10 KILL ^BDMTMP($JOB)
+11 SET BDMRET="^BDMTMP("_$JOB_")"
+12 SET ^BDMTMP($JOB,BDMI)="T00250DATA"_$CHAR(30)
+13 SET IOM=80
+14 DO GUIR^XBLM("CS1^BDMVRL","^XTMP(""BDMCS"",$J)")
+15 IF '$DATA(^XTMP("BDMCS",$JOB))
Begin DoDot:1
+16 SET BDMI=BDMI+1
+17 SET ^BDMTMP($JOB,BDMI)="NO DATA"_$CHAR(30)
+18 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)
End DoDot:1
QUIT
+19 SET BDMDA=.5
FOR
SET BDMDA=$ORDER(^XTMP("BDMCS",$JOB,BDMDA))
IF 'BDMDA
QUIT
Begin DoDot:1
+20 NEW BDMDATA
+21 SET BDMI=BDMI+1
+22 SET BDMDATA=$GET(^XTMP("BDMCS",$JOB,BDMDA))
+23 SET ^BDMTMP($JOB,BDMI)=BDMDATA_$CHAR(30)
End DoDot:1
+24 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_BDMERR
+25 KILL ^TMP("BDMVR",$JOB)
+26 QUIT
+27 ;
FS(BDMRET,BDMSTR) ;-- return patient reg face sheet
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW P,DFN,BDMDA,BDMI,BDMPAT,BDMTYPE,BDMCALL
+3 SET P="|"
+4 SET DFN=$PIECE(BDMSTR,P)
+5 SET BDMI=0
+6 SET BDMERR=""
+7 KILL ^BDMTMP($JOB)
+8 SET BDMRET="^BDMTMP("_$JOB_")"
+9 SET ^BDMTMP($JOB,BDMI)="T00250DATA"_$CHAR(30)
+10 SET IOM=80
+11 DO GUIR^XBLM("START^AGFACE","^XTMP(""BDMFS"",$J)")
+12 SET BDMDA=.5
FOR
SET BDMDA=$ORDER(^XTMP("BDMFS",$JOB,BDMDA))
IF 'BDMDA
QUIT
Begin DoDot:1
+13 NEW BDMDATA
+14 SET BDMI=BDMI+1
+15 SET BDMDATA=$GET(^XTMP("BDMFS",$JOB,BDMDA))
+16 SET ^BDMTMP($JOB,BDMI)=BDMDATA_$CHAR(30)
End DoDot:1
+17 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_BDMERR
+18 KILL ^XTMP("BDMFS",$JOB)
+19 QUIT
+20 ;
LET(BDMRET,BDMSTR) ;-- return letter
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW P,DFN,BDMDA,BDMI,BDMPAT,BDMTYPE,BDMCALL,BDMLDA,BDMLET
+3 SET P="|"
+4 SET DFN=$PIECE(BDMSTR,P)
+5 SET BDMLET=$PIECE(BDMSTR,P,2)
+6 SET BDMLDA=$ORDER(^BDMLET("B",BDMLET,0))
+7 SET BDMI=0
+8 SET BDMERR=""
+9 KILL ^BDMTMP($JOB)
+10 SET BDMRET="^BDMTMP("_$JOB_")"
+11 SET ^BDMTMP($JOB,BDMI)="T00250DATA"_$CHAR(30)
+12 DO GUIR^XBLM("PRINT^BDMLET","^XTMP(""BDMLET"",$J)")
+13 SET BDMDA=.5
FOR
SET BDMDA=$ORDER(^XTMP("BDMLET",$JOB,BDMDA))
IF 'BDMDA
QUIT
Begin DoDot:1
+14 NEW BDMDATA
+15 SET BDMI=BDMI+1
+16 SET BDMDATA=$GET(^XTMP("BDMLET",$JOB,BDMDA))
+17 SET ^BDMTMP($JOB,BDMI)=BDMDATA_$CHAR(30)
End DoDot:1
+18 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_BDMERR
+19 KILL ^XTMP("BDMLET",$JOB)
+20 QUIT
+21 ;
PLD(BDMRET,BDMSTR) ;-- return problem list display
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMPIEN,P
+3 SET P="|"
+4 SET BDMPIEN=$PIECE(BDMSTR,P)
+5 SET BDMI=0
+6 SET BDMERR=""
+7 KILL ^BDMTMP($JOB)
+8 SET BDMRET="^BDMTMP("_$JOB_")"
+9 SET ^BDMTMP($JOB,BDMI)="T00250DATA"_$CHAR(30)
+10 SET DIC="^AUPNPROB("
SET DA=BDMPIEN
SET DIQ(0)="C"
+11 DO GUIR^XBLM("EN^DIQ","^XTMP(""BDMPL"",$J)")
+12 SET BDMDA=.5
FOR
SET BDMDA=$ORDER(^XTMP("BDMPL",$JOB,BDMDA))
IF 'BDMDA
QUIT
Begin DoDot:1
+13 NEW BDMDATA
+14 SET BDMI=BDMI+1
+15 SET BDMDATA=$GET(^XTMP("BDMPL",$JOB,BDMDA))
+16 SET ^BDMTMP($JOB,BDMI)=BDMDATA_$CHAR(30)
End DoDot:1
+17 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_BDMERR
+18 KILL ^XTMP("BDMPL",$JOB)
+19 KILL DIC,DA,DIQ
+20 QUIT
+21 ;
FUPROT(BDMRET) ;-- return the FU Protocols
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 SET BDMI=0
+3 SET BDMERR=""
+4 KILL ^BDMTMP($JOB)
+5 SET BDMRET="^BDMTMP("_$JOB_")"
+6 SET ^BDMTMP($JOB,BDMI)="T00250DATA"_$CHAR(30)
+7 SET IOM=80
+8 DO GUIR^XBLM("PINIT^BDMVRL42","^XTMP(""BDMFUP"",$J)")
+9 SET BDMDA=.5
FOR
SET BDMDA=$ORDER(^XTMP("BDMFUP",$JOB,BDMDA))
IF 'BDMDA
QUIT
Begin DoDot:1
+10 NEW BDMDATA
+11 SET BDMI=BDMI+1
+12 SET BDMDATA=$GET(^XTMP("BDMFUP",$JOB,BDMDA))
+13 SET ^BDMTMP($JOB,BDMI)=BDMDATA_$CHAR(30)
End DoDot:1
+14 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_BDMERR
+15 KILL ^XTMP("BDMFUP",$JOB)
+16 QUIT
+17 ;
FUR(RETVAL,BDMSTR) ;-- print the followup report
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW P,R,BDMRTYP,BDMRS,BDMST,BDMPS,BDMDD,BDMPA,BDMPABD,BDMPAED
+3 NEW BDMPBY,BDMPBYV,BDMRL,BDMLP,BDM,BDMDEMO
+4 SET P="|"
SET R="~"
+5 DO EXIT^BDMVRL4
+6 IF $GET(BDMSTR)=""
SET BDMSTR=$$CATSTR^BDMGU(.BDMSTR)
+7 SET BDMRTYP=$PIECE(BDMSTR,P)
+8 SET BDMRS=$PIECE(BDMSTR,P,2)
+9 SET BDMST=$PIECE(BDMSTR,P,3)
+10 IF $GET(BDMST)]""
SET BDM("SEARCH TEMPLATE")=$ORDER(^DIBT("B",BDMST,0))
+11 SET BDMPS=$PIECE(BDMSTR,P,4)
+12 SET BDM("STATUS")=BDMPS
+13 SET BDMDD=$PIECE(BDMSTR,P,5)
+14 ;cmi/anch/maw 1/25/2005 added following line
+15 NEW X
SET X=BDMDD
XECUTE ^%ZOSF("UPPERCASE")
SET BDMDD=Y
+16 SET BDM("DM DIAGNOSIS")=BDMDD
+17 SET BDMPA=$PIECE(BDMSTR,P,6)
+18 IF $GET(BDMPA)="Y"
SET BDMFUAPP=""
+19 SET BDMPABD=$PIECE(BDMSTR,P,7)
+20 SET BDMBEGIN=BDMPABD
+21 SET BDMPAED=$PIECE(BDMSTR,P,8)
+22 SET BDMEND=BDMPAED
+23 SET BDMPBY=$PIECE(BDMSTR,P,9)
+24 IF $PIECE(BDMPBY,"-",2)="Community"
SET BDMFL=9999999.05
SET BDMK="COMMUNITY"
+25 IF $PIECE(BDMPBY,"-",3)="Provider"
SET BDMFL=200
SET BDMK="PROVIDER"
+26 SET BDMPBYV=$PIECE(BDMSTR,P,10)
+27 IF BDMPBYV="All"
SET BDMPBYV=""
+28 FOR J=1:1
Begin DoDot:1
+29 IF $PIECE(BDMPBYV,R,J)=""
QUIT
+30 SET BDMK($PIECE(BDMPBYV,R,J))=$$GET1^DIQ(BDMFL,$PIECE(BDMPBYV,R,J),.01)
End DoDot:1
IF $PIECE(BDMPBYV,R,J)=""
QUIT
+31 SET BDMRL=$PIECE(BDMSTR,P,11)
+32 SET BDMFU=$PIECE(BDMRL,"-",2)
+33 SET BDMLP=$PIECE(BDMSTR,P,12)
+34 IF $GET(BDMLP)]""
SET BDMLDA=$ORDER(^BDMLET("B",BDMLP,0))
+35 SET BDMREGNM=$PIECE(BDMSTR,P,13)
+36 SET BDMDEMO=$PIECE(BDMSTR,P,15)
+37 SET IOM=80
+38 DO GUIR^XBLM("SCREEN^BDMVRL42","^TMP($J,")
+39 SET BDMRTYP=$TRANSLATE(BDMRTYP,"~",",")
+40 IF BDMRTYP="All"
Begin DoDot:1
+41 DO ALL^BDMVRL42
+42 SET BDMY=Y
+43 DO PARSE^BDMVRL42
End DoDot:1
+44 IF BDMRTYP'="All"
SET BDMY=BDMRTYP
DO PARSE^BDMVRL42
+45 ;N I
+46 ;F I=1:1 D Q:$P(BDMRTYP,R,I)=""
+47 ;. ;Q:$P(BDMRTYP,R,I)=""
+48 ;. ;S BDM("PARSE",$P(BDMRTYP,R,I))=""
+49 SET BDMI=0
+50 SET BDMERR=""
+51 KILL ^BDMTMP($JOB)
+52 SET RETVAL="^BDMTMP("_$JOB_")"
+53 SET ^BDMTMP($JOB,BDMI)="T00250DATA"_$CHAR(30)
+54 ;D BDMG^BDMVRL4(.BDM)
+55 ;D FUHEAD^BDMVRL42
+56 ;Q
+57 ;
+58 DO BDMGA^BDMVRL4(.BDMERR,.BDM,$GET(BDMFUAPP),BDMFL,.BDMK,BDMRL,BDMFU,$GET(BDMLDA),BDMREGNM,1,BDMDEMO)
+59 ;S BDMJ=0
+60 ;D GUIR^XBLM("BDMG^BDMVRL4(.BDM)","^XTMP(""BDMFUR"",$J)")
+61 ;S BDMDA=.5 F S BDMDA=$O(^XTMP("BDMFUR",$J,BDMDA)) Q:'BDMDA D
+62 ;. N BDMDATA
+63 ;. S BDMI=BDMI+1
+64 ;. S BDMDATA=$G(^XTMP("BDMFUR",$J,BDMDA))
+65 ;. S ^BDMTMP($J,BDMI)=BDMDATA_$C(30)
+66 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)
+67 DO EN^XBVK("BDM")
+68 QUIT
+69 ;
SELF(RETVAL,BDMSTR) ;-- glucose self monitoring report
+1 NEW BDMRG,BDMST,BDMRT,BDME,BDMSRT,P,BDMDEMO
+2 SET P="|"
+3 SET BDMRG=$PIECE(BDMSTR,P)
+4 SET BDMRDA=$ORDER(^ACM(41.1,"B",BDMRG,0))
+5 SET BDMST=$PIECE(BDMSTR,P,2)
+6 SET BDMRT=$PIECE(BDMSTR,P,3)
+7 SET BDME=$PIECE(BDMSTR,P,4)
+8 SET BDMSRT=$PIECE(BDMSTR,P,5)
+9 SET BDMDEMO=$PIECE(BDMSTR,P,6)
+10 SET BDMI=0
+11 SET BDMERR=""
+12 KILL ^BDMTMP($JOB)
+13 SET RETVAL="^BDMTMP("_$JOB_")"
+14 SET ^BDMTMP($JOB,BDMI)="T00250DATA"_$CHAR(30)
+15 SET IOM=80
+16 DO BDMGA^BDMSELFM(.BDMERR,BDMRDA,BDMST,BDMRT,BDME,BDMSRT,1,BDMDEMO)
+17 SET ^BDMTMP($JOB,1)=$CHAR(31)_$GET(BDMERR)
+18 DO EN^XBVK("BDM")
+19 QUIT
+20 ;
LPA(RETVAL,BDMSTR) ;-- list patient appointments
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMDA,BDMI,BDMPAT,BDMTYPE,BDMCALL,BDMREGNM,BDMBEGIN,BDMEND,P
+3 SET P="|"
+4 SET BDMREGNM=$PIECE(BDMSTR,P)
+5 SET BDMBEGIN=$PIECE(BDMSTR,P,2)
+6 SET BDMEND=$PIECE(BDMSTR,P,3)
+7 SET BDMRDA=$ORDER(^ACM(41.1,"B",BDMREGNM,0))
+8 SET BDMI=0
+9 SET BDMERR=""
+10 KILL ^BDMTMP($JOB)
+11 SET RETVAL="^BDMTMP("_$JOB_")"
+12 SET ^BDMTMP($JOB,BDMI)="T00250DATA"_$CHAR(30)
+13 SET IOM=80
+14 DO BDMGA^BDMVRL6(.BDMERR,BDMBEGIN,BDMEND,BDMRDA,1)
+15 ;D APPINIT^BDMVRL6
+16 ;I '$D(^TMP("BDMVR",$J,2)) D Q
+17 ;. S BDMI=BDMI+1
+18 ;. S ^BDMTMP($J,BDMI)="NO DATA"_$C(30)
+19 ;. S ^BDMTMP($J,BDMI+1)=$C(31)
+20 ;S BDMDA=0 F S BDMDA=$O(^TMP("BDMVR",$J,BDMDA)) Q:'BDMDA D
+21 ;. N BDMDATA
+22 ;. S BDMI=BDMI+1
+23 ;. S BDMDATA=$G(^TMP("BDMVR",$J,BDMDA,0))
+24 ;. S ^BDMTMP($J,BDMI)=BDMDATA_$C(30)
+25 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_BDMERR
+26 DO EN^XBVK("BDM")
+27 QUIT
+28 ;
