BDMGU ; cmi/anch/maw - BDM DMS GUI Utilities ;
;;2.0;BDM DIABETES MANAGEMENT SYSTEM;**1,4,7,8**;JUN 14, 2007;Build 53
;
;
;
;cmi/anch/maw 1/23/2005 added in PATCHT a quit if mult chts with same #
;cmi/anch/maw 2/1/2006 changed visit retrieval to ADO.NET
;cmi/anch/maw 3/22/2006 changed weight, bp, labs, to sort earliest to latest
;cmi/anch/maw 3/23/2006 changed patient lookup to not look at other names
;
DEBUG(BDMRET,BDMSTR) ;-- debug
D DEBUG^%Serenji("CHK^BDMGU(.BDMRET,.BDMSTR)")
Q
;
GETPAT(BDMRET,BDMSTR) ;-- return patient in ADO table
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMI,BDMERR,BDMUIEN,P
S P="|"
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S BDMI=0
S BDMERR=""
S ^BDMTMP($J,BDMI)="T00010IEN^T00030PATIENTNAME^T00015DOB^T00001SEX^T00007CHART^T00009SSN^T00010REG"_$C(30)
S BDMREGE=$P(BDMSTR,P)
I $G(BDMREGE)]"" S BDMREG=$O(^ACM(41.1,"B",BDMREGE,0))
S BDMPAT=$P(BDMSTR,P,2)
S BDMMT=$P(BDMSTR,P,3)
S BDMNPAT=$P(BDMSTR,P,4)
I BDMMT="ALL" S BDMMT=9999999
S BDMMT=(BDMMT-1)
I BDMPAT?9N D
. S BDMPIEN=$$PATSSN(BDMPAT)
I BDMPAT?1.6N D
. S BDMPIEN=$$PATCHT(.BDMPIEN,BDMPAT)
I BDMPAT?1.2N1"/"1.2N1"/"4N D
. S X=BDMPAT D ^%DT S BDMPAT=Y
. S BDMPIEN=$$PATDOB(.BDMPIEN,BDMPAT)
I '$G(BDMPIEN) D PATNAM(.BDMPIEN,BDMPAT,BDMNPAT)
I $G(BDMPIEN),'$G(BDMPATS) D PATADO(.BDMPIEN)
S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)
K BDMPAT,BDMPIEN,BDMCNT,BDMDA,BDMIEN,BDMPATE,BDMNM,BDMDC,BDMSX,BDMCT,BDMSSN,BDMHD
K BDMPATS
Q
;
PATSSN(PAT) ;-- look up by ssn
S BDMPIEN=$O(^DPT("SSN",PAT,0))
S BDMPIEN(1)=BDMPIEN
Q $G(BDMPIEN)
;
PATCHT(BDMPIEN,PAT) ;-- lookup by chart
N BDMCNT
S BDMCNT=0,BDMPATE=0,BDMMCNT=0
S BDMDA=(PAT-1) F S BDMDA=$O(^AUPNPAT("D",BDMDA)) Q:'BDMDA!(BDMDA>PAT)!(BDMCNT>BDMMT) D
. S BDMIEN=0 F S BDMIEN=$O(^AUPNPAT("D",BDMDA,BDMIEN)) Q:'BDMIEN D
.. I $O(^AUPNPAT("D",BDMDA,BDMIEN,0))=DUZ(2) S BDMPIEN=BDMIEN
.. Q:'$G(BDMPIEN) ;cmi/anch/maw 1/23/2005 added for mult chts
.. S BDMCNT=BDMCNT+1
.. S:'$D(BDMPIEN(BDMCNT)) BDMPIEN(BDMCNT)=0
.. S BDMPIEN(BDMCNT)=BDMPIEN
Q $G(BDMPIEN)
;
PATDOB(BDMPATE,PAT) ;-- lookup by DOB
N BDMCNT
S BDMCNT=0,BDMPATE=0
S BDMDOB=PAT-1 F S BDMDOB=$O(^DPT("ADOB",BDMDOB)) Q:'BDMDOB!(BDMDOB'=+PAT)!(BDMCNT>BDMMT) D
. S BDMIEN=0 F S BDMIEN=$O(^DPT("ADOB",BDMDOB,BDMIEN)) Q:'BDMIEN D
.. S:'$D(BDMPATE(BDMCNT)) BDMPATE(BDMCNT)=0
.. S BDMCNT=BDMCNT+1,BDMPATE=1
.. S BDMPATE(BDMCNT)=BDMIEN
S BDMPATE=BDMCNT
Q $G(BDMPATE)
;
PATNAM(BDMPATE,PAT,NPAT) ;lookup by name
S BDMCNT=0,BDMPATE=0
N BDMLEN
S BDMLEN=$L(PAT)
S BDMNAM=PAT
S BDMNAM=$$BEGIN(PAT)
I $G(NPAT)]"" S BDMNAM=NPAT
F S BDMNAM=$O(^DPT("B",BDMNAM)) Q:BDMNAM=""!($E(BDMNAM,1,BDMLEN)'=PAT)!(BDMCNT>BDMMT) D
. S BDMIEN=0 F S BDMIEN=$O(^DPT("B",BDMNAM,BDMIEN)) Q:'BDMIEN D
.. I $D(BDMPATE(BDMCNT)),$G(BDMPATE(BDMCNT))=BDMIEN Q ;maw 3/23/2006 added line
.. S BDMCNT=BDMCNT+1
.. S:'$D(BDMPATE(BDMCNT)) BDMPATE(BDMCNT)=0
.. S BDMPATE(BDMCNT)=BDMIEN
S BDMPATE=BDMCNT
Q $G(BDMPATE)
;
BEGIN(PT) ;-- get begin point
N BDMPDA,BDMPIEN,BDMPCNT
S BDMPCNT=0
S BDMPDA=PT
I $O(^DPT("B",BDMPDA,0)) D
. S BDMPDA=$O(^DPT("B",BDMPDA),-1)
F S BDMPDA=$O(^DPT("B",BDMPDA)) Q
I $G(BDMPDA)="" Q ""
Q $O(^DPT("B",BDMPDA),-1)
;
PATADO(PIEN) ;-- ado return
S BDMCNTR=0
S BDMDA=0 F S BDMDA=$O(PIEN(BDMDA)) Q:'BDMDA D
. N BDMPI,BDMNM,BDMDC,BDMSX,BDMCT,BDMSSN,BDMHD
. S BDMCNTR=BDMCNTR+1
. S BDMPI=$G(PIEN(BDMDA))
. Q:$P($G(^DPT(BDMPI,.35)),U) ;maw 3/23/2006 don't display deceased
. Q:$P($G(^AUPNPAT(BDMPI,41,DUZ(2),0)),U,3) ;maw 3/23/2006 don't display inactive
. S BDMNM=$P($G(^DPT(BDMPI,0)),U)
. S BDMDC=$$FMTE^XLFDT($P($G(^DPT(BDMPI,0)),U,3))
. S BDMSX=$P($G(^DPT(BDMPI,0)),U,2)
. S BDMCT=$$HRN^AUPNPAT(BDMPI,DUZ(2))
. S BDMSSN=$P($G(^DPT(BDMPI,0)),U,9)
. I BDMSSN]"" D ;ihs/cmi/maw p7 10/01/2013
.. N LN
.. S LN=$L(BDMSSN)
.. S BDMSSN="XXX-XX-"_$E(BDMSSN,(LN-3),LN)
. I $D(^ACM(41,"AC",BDMPI)) D
.. I $G(BDMREG)]"",$D(^ACM(41,"AC",BDMPI,BDMREG)) S BDMHD=+$G(^ACM(41,"AC",BDMPI,BDMREG))
. S BDMI=BDMI+1
. S ^BDMTMP($J,BDMI)=BDMPI_U_BDMNM_U_BDMDC_U_BDMSX_U_BDMCT_U_BDMSSN_U_$G(BDMHD)_$C(30)
Q
;
REGSEL(BDMRET) ;-- return register to work with
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMDA,BDMC,BDMREG
S BDMC=0
S BDMDA=0 F S BDMDA=$O(^ACM(41.1,"B",BDMDA)) Q:BDMDA="" D
. Q:BDMDA'["DIAB"
. S BDMRIEN=$O(^ACM(41.1,"B",BDMDA,0))
. Q:'$D(^ACM(41.1,BDMRIEN,"AU","B",DUZ))
. S BDMC=BDMC+1
. S $P(BDMREG,"|",BDMC)=BDMDA_U_BDMRIEN
S BDMRET=BDMC_"|"_$G(BDMREG)
Q
;
DMG(BDMRET,BDMSTR) ;-- get patient demographics
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMPAT,P,BDMAD,BDMCTY,BDMST,BDMZIP,BDMPH,BDMPCP,BDMDATA,BDMCOM
S P="|"
S BDMPAT=$P(BDMSTR,P)
S BDMDATA=$G(^DPT(BDMPAT,.11))
S BDMAD=$P(BDMDATA,U)
S BDMCTY=$P(BDMDATA,U,4)
I $P(BDMDATA,U,5)]"" S BDMST=$P($G(^DIC(5,$P(BDMDATA,U,5),0)),U)
S BDMZIP=$P(BDMDATA,U,6)
S BDMPH=$P($G(^DPT(BDMPAT,.13)),U)
S BDMPCP=$S($P($G(^AUPNPAT(BDMPAT,0)),U,14):$P(^AUPNPAT(BDMPAT,0),U,14)_"~"_$$GET1^DIQ(9000001,BDMPAT,.14,"E"),1:"")
S BDMCOM=$$GET1^DIQ(9000001,BDMPAT,1117,"E")
S BDMRET=BDMAD_P_BDMCTY_P_$G(BDMST)_P_BDMZIP_P_BDMPH_P_BDMPCP_P_BDMCOM
Q
;
PATDAT(BDMRET,BDMSTR) ;-- get patient data from CMS Register
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMDATA,P,BDMPAT,BDMREG,BDMREGE,BDMSTAT,BDMRP,BDMCM,BDMWF,BDMCON,BDMED,BDMLE,BDMLR,BDMNR,BDMOD,BDMDX,BDMPIEN
S P="|"
S BDMREGE=$P(BDMSTR,P)
S BDMREG=$O(^ACM(41.1,"B",BDMREGE,0))
S BDMPAT=$P(BDMSTR,P,2)
S BDMPIEN=$P($G(^ACM(41,BDMPAT,0)),U,2)
S BDMDATA=$G(^ACM(41,BDMPAT,"DT"))
S BDMSTAT=$P(BDMDATA,U)
S BDMRP=$S($P(BDMDATA,U,15)]"":$P(BDMDATA,U,15)_"~"_$P($G(^VA(200,$P(BDMDATA,U,15),0)),U),1:"")
S BDMCM=$S($P(BDMDATA,U,6)]"":$P(BDMDATA,U,16)_"~"_$P($G(^VA(200,$P(BDMDATA,U,6),0)),U),1:"")
S BDMWF=$S($P(BDMDATA,U,10)]"":$P(BDMDATA,U,10)_"~"_$P($G(^AUTTLOC($P(BDMDATA,U,10),0)),U,10)_"-"_$P($G(^DIC(4,$P(BDMDATA,U,10),0)),U),1:"")
S BDMCON=$P(BDMDATA,U,13)
S BDMED=$P(BDMDATA,U,4)
S BDMLE=$P(BDMDATA,U,11)
S BDMLR=$P(BDMDATA,U,8)
S BDMNR=$P(BDMDATA,U,9)
S BDMOD=$P($G(^ACM(41,BDMPAT,"CH")),U)
I $D(^ACM(44,"AC",BDMREG)) D
. Q:'$D(^ACM(44,"AC",BDMREG,BDMPIEN))
. S BDMDXI=$O(^ACM(44,"AC",BDMREG,BDMPIEN,0))
. I BDMDXI S BDMDX=$P($G(^ACM(44.1,BDMDXI,0)),U)
S BDMRET=BDMSTAT_P_BDMRP_P_BDMCM_P_BDMWF_P_BDMCON_P_BDMED_P_BDMLE_P_BDMLR_P_BDMNR_P_BDMOD_P_$G(BDMDX)
Q
;
CMP(BDMRET,BDMSTR) ;-- return complications data
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMDA,BDMI,BDMERR,BDMDATA,BDMPAT,BDMPIEN,BDMREG,BDMREGE,P,BDMCMP,BDMST,BDMIEN,BDMSTI,BDMON,BDMONE,BDMCMT
S P="|"
S BDMREGE=$P(BDMSTR,P)
S BDMREG=$O(^ACM(41.1,"B",BDMREGE,0))
S BDMPAT=$P(BDMSTR,P,2)
S BDMPIEN=$P($G(^ACM(41,BDMPAT,0)),U,2)
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S BDMI=0
S BDMERR=""
S ^BDMTMP($J,BDMI)="T00007BMXIEN^T00060COMPLICATION^T00030STATUS^T00020ONSET^T32000COMMENTS"_$C(30)
S BDMDA=0 F S BDMDA=$O(^ACM(42,"AC",BDMREG,BDMPIEN,BDMDA)) Q:'BDMDA D
. S BDMI=BDMI+1
. S BDMCMP=$P($G(^ACM(42.1,BDMDA,0)),U)
. S BDMIEN=$G(^ACM(42,"AC",BDMREG,BDMPIEN,BDMDA))
. S BDMDATA=$G(^ACM(42,BDMIEN,"DT"))
. S BDMST=$S($P(BDMDATA,U,2)]"":$P($G(^ACM(42.3,$P(BDMDATA,U,2),0)),U),1:"")
. S BDMONE=$P(BDMDATA,U)
. S BDMON=""
. I BDMONE]"" D
.. S BDMON=$E(BDMONE,4,5)_"/"_$E(BDMONE,6,7)_"/"_($E(BDMONE,1,3)+1700)
. N BDMCDA
. S BDMCMT=""
. S BDMCDA=0 F S BDMCDA=$O(^ACM(42,BDMIEN,1,BDMCDA)) Q:'BDMCDA D
.. S BDMCMT=BDMCMT_$G(^ACM(42,BDMIEN,1,BDMCDA,0)) ;_$C(13,10)
. ;S BDMCMT=$G(^ACM(42,BDMIEN,1,1,0)) ;only need 80 characters for GUI DMS
. S ^BDMTMP($J,BDMI)=BDMIEN_U_BDMCMP_U_$G(BDMST)_U_$G(BDMON)_U_$G(BDMCMT)_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)
Q
;
DIAG(BDMRET,BDMSTR) ;-- return diagnosis data
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMDA,BDMI,BDMERR,BDMDATA,BDMPAT,BDMPIEN,BDMREG,BDMREGE,P,BDMCMP,BDMST,BDMIEN,BDMSTI,BDMON,BDMONE,BDMCMT
S P="|"
S BDMREGE=$P(BDMSTR,P)
S BDMREG=$O(^ACM(41.1,"B",BDMREGE,0))
S BDMPAT=$P(BDMSTR,P,2)
S BDMPIEN=$P($G(^ACM(41,BDMPAT,0)),U,2)
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S BDMI=0
S BDMERR=""
S ^BDMTMP($J,BDMI)="T00007BMXIEN^T00060DIAGNOSIS^T00030SEVERITY^T00020ONSET"_$C(30)
S BDMDA=0 F S BDMDA=$O(^ACM(44,"AC",BDMREG,BDMPIEN,BDMDA)) Q:'BDMDA D
. S BDMI=BDMI+1
. S BDMCMP=$P($G(^ACM(44.1,BDMDA,0)),U)
. S BDMIEN=$G(^ACM(44,"AC",BDMREG,BDMPIEN,BDMDA))
. S BDMDATA=$G(^ACM(44,BDMIEN,"SV"))
. S BDMST=$S($P(BDMDATA,U)="N":"N-NORMAL",$P(BDMDATA,U)="M":"M-MILD",$P(BDMDATA,U)="MO":"MO-MODERATE",$P(BDMDATA,U)="S":"S-SEVERE",1:"")
. S BDMONE=$P(BDMDATA,U,2)
. S BDMON=""
. I BDMONE]"" D
.. S BDMON=$E(BDMONE,4,5)_"/"_$E(BDMONE,6,7)_"/"_($E(BDMONE,1,3)+1700)
. S ^BDMTMP($J,BDMI)=BDMIEN_U_BDMCMP_U_$G(BDMST)_U_$G(BDMON)_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)
Q
;
CMT(BDMRET,BDMSTR) ;-- get comment history
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMCMT,BDMERR,BDMCMTE,BDMCMTR,BDMI
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S BDMERR=""
S BDMI=0
S ^BDMTMP($J,BDMI)="T00100COMMENTS"_$C(30)
S BDMCMT=0 F S BDMCMT=$O(^ACM(41,BDMSTR,1,BDMCMT)) Q:'BDMCMT D
. S BDMCMTE=$G(^ACM(41,BDMSTR,1,BDMCMT,0))
. S BDMI=BDMI+1
. S ^BDMTMP($J,BDMI)=BDMCMTE_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)
Q
;
VST(BDMRET,BDMSTR) ;-- get visit data by patient
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMCNT,BDMDA,BDMIVDT,BDMVIEN,BDMVDT,BDMCLNI,BDMVTYP,BDMSC,BDMACU,BDMLOI,BDMRVDT
N BDMPROV,BDMSPROV,BDMVSTR,PAT,P,BDMI
S P="|"
S BDMRET="^BDMTMP("_$J_")"
S BDMI=0
S ^BDMTMP($J,BDMI)="T00020Visit Date^T00030Location^T00010Type^T00010Service Category^T00010IEN^T00030Provider^T00030Secondary Provider^T00030Clinic"_$C(30)
S BDMCNT=0
S PAT=$P(BDMSTR,P)
I '$O(^AUPNVSIT("AC",PAT,0)) S BDMRET=0 Q
S BDMDA=PAT-1 F S BDMDA=$O(^AUPNVSIT("AA",BDMDA)) Q:'BDMDA!(BDMDA>PAT)!(BDMCNT>400) D
. S BDMIVDT=0 F S BDMIVDT=$O(^AUPNVSIT("AA",BDMDA,BDMIVDT)) Q:'BDMIVDT!(BDMCNT>400) D
.. S BDMVIEN=0 F S BDMVIEN=$O(^AUPNVSIT("AA",BDMDA,BDMIVDT,BDMVIEN)) Q:'BDMVIEN!(BDMCNT>400) D
... S BDMCNT=BDMCNT+1
... N BDMVND,BDMVDT,BDMVTYP,BDMLOC,BDMSC,BDMPROV,BDMSPROV,BDMCL
... ;Q:BDMCNT>4 ;cmi/maw let's make this a site parameter
... S BDMVND=$G(^AUPNVSIT(BDMVIEN,0))
... S BDMVDT=$$FMTE^XLFDT($P(BDMVND,U))
... I $P(BDMVND,U,6)]"" S BDMLOC=$P($G(^AUTTLOC($P(BDMVND,U,6),0)),U,10)_"-"_$$GET1^DIQ(9999999.06,$P(BDMVND,U,6),.01,"E")
... S BDMVTYP=$P(BDMVND,U,3)
... S BDMSC=$P(BDMVND,U,7)_"-"_$$GET1^DIQ(9000010,BDMVIEN,.07,"E")
... S BDMCL=$$GET1^DIQ(9000010,BDMVIEN,.08,"E")
... S BDMPROV=$$PRIMPROV^APCLV(BDMVIEN,"N")
... S BDMSPROV=$$SECPROV^APCLV(BDMVIEN,"N")
... S BDMI=BDMI+1
... S ^BDMTMP($J,BDMI)=$G(BDMVDT)_U_$G(BDMLOC)_U_$G(BDMVTYP)_U_$G(BDMSC)_U_$G(BDMVIEN)_U_$G(BDMPROV)_U_$G(BDMSPROV)_U_$G(BDMCL)_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)
Q
;
CATSTR(BDMSRET,STR) ;EP - concatenate a long string in
N BDMDA
S BDMSRET=""
S BDMDA=0 F S BDMDA=$O(STR(BDMDA)) Q:'BDMDA D
. S BDMSRET=BDMSRET_$G(STR(BDMDA))
Q
;
MERR ; MUMPS ERROR TRAP
N BDMX
X ("S X=$"_"ZE")
S BDMX="MUMPS error: """_BDMX_""""
D ERR(BDMX)
Q
;
ERR(ERR) ; BMX ADO SCHEMA ERROR PROCESSOR
N BDMGX
S BDMGX="ERROR|"_ERR_$C(30)
S @BDMRET@(1)=BDMGX
S @BDMRET@(2)=$C(31)
Q
;
BDMGU ; cmi/anch/maw - BDM DMS GUI Utilities ;
+1 ;;2.0;BDM DIABETES MANAGEMENT SYSTEM;**1,4,7,8**;JUN 14, 2007;Build 53
+2 ;
+3 ;
+4 ;
+5 ;cmi/anch/maw 1/23/2005 added in PATCHT a quit if mult chts with same #
+6 ;cmi/anch/maw 2/1/2006 changed visit retrieval to ADO.NET
+7 ;cmi/anch/maw 3/22/2006 changed weight, bp, labs, to sort earliest to latest
+8 ;cmi/anch/maw 3/23/2006 changed patient lookup to not look at other names
+9 ;
DEBUG(BDMRET,BDMSTR) ;-- debug
+1 DO DEBUG^%Serenji("CHK^BDMGU(.BDMRET,.BDMSTR)")
+2 QUIT
+3 ;
GETPAT(BDMRET,BDMSTR) ;-- return patient in ADO table
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMI,BDMERR,BDMUIEN,P
+3 SET P="|"
+4 KILL ^BDMTMP($JOB)
+5 SET BDMRET="^BDMTMP("_$JOB_")"
+6 SET BDMI=0
+7 SET BDMERR=""
+8 SET ^BDMTMP($JOB,BDMI)="T00010IEN^T00030PATIENTNAME^T00015DOB^T00001SEX^T00007CHART^T00009SSN^T00010REG"_$CHAR(30)
+9 SET BDMREGE=$PIECE(BDMSTR,P)
+10 IF $GET(BDMREGE)]""
SET BDMREG=$ORDER(^ACM(41.1,"B",BDMREGE,0))
+11 SET BDMPAT=$PIECE(BDMSTR,P,2)
+12 SET BDMMT=$PIECE(BDMSTR,P,3)
+13 SET BDMNPAT=$PIECE(BDMSTR,P,4)
+14 IF BDMMT="ALL"
SET BDMMT=9999999
+15 SET BDMMT=(BDMMT-1)
+16 IF BDMPAT?9N
Begin DoDot:1
+17 SET BDMPIEN=$$PATSSN(BDMPAT)
End DoDot:1
+18 IF BDMPAT?1.6N
Begin DoDot:1
+19 SET BDMPIEN=$$PATCHT(.BDMPIEN,BDMPAT)
End DoDot:1
+20 IF BDMPAT?1.2N1"/"1.2N1"/"4N
Begin DoDot:1
+21 SET X=BDMPAT
DO ^%DT
SET BDMPAT=Y
+22 SET BDMPIEN=$$PATDOB(.BDMPIEN,BDMPAT)
End DoDot:1
+23 IF '$GET(BDMPIEN)
DO PATNAM(.BDMPIEN,BDMPAT,BDMNPAT)
+24 IF $GET(BDMPIEN)
IF '$GET(BDMPATS)
DO PATADO(.BDMPIEN)
+25 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)
+26 KILL BDMPAT,BDMPIEN,BDMCNT,BDMDA,BDMIEN,BDMPATE,BDMNM,BDMDC,BDMSX,BDMCT,BDMSSN,BDMHD
+27 KILL BDMPATS
+28 QUIT
+29 ;
PATSSN(PAT) ;-- look up by ssn
+1 SET BDMPIEN=$ORDER(^DPT("SSN",PAT,0))
+2 SET BDMPIEN(1)=BDMPIEN
+3 QUIT $GET(BDMPIEN)
+4 ;
PATCHT(BDMPIEN,PAT) ;-- lookup by chart
+1 NEW BDMCNT
+2 SET BDMCNT=0
SET BDMPATE=0
SET BDMMCNT=0
+3 SET BDMDA=(PAT-1)
FOR
SET BDMDA=$ORDER(^AUPNPAT("D",BDMDA))
IF 'BDMDA!(BDMDA>PAT)!(BDMCNT>BDMMT)
QUIT
Begin DoDot:1
+4 SET BDMIEN=0
FOR
SET BDMIEN=$ORDER(^AUPNPAT("D",BDMDA,BDMIEN))
IF 'BDMIEN
QUIT
Begin DoDot:2
+5 IF $ORDER(^AUPNPAT("D",BDMDA,BDMIEN,0))=DUZ(2)
SET BDMPIEN=BDMIEN
+6 ;cmi/anch/maw 1/23/2005 added for mult chts
IF '$GET(BDMPIEN)
QUIT
+7 SET BDMCNT=BDMCNT+1
+8 IF '$DATA(BDMPIEN(BDMCNT))
SET BDMPIEN(BDMCNT)=0
+9 SET BDMPIEN(BDMCNT)=BDMPIEN
End DoDot:2
End DoDot:1
+10 QUIT $GET(BDMPIEN)
+11 ;
PATDOB(BDMPATE,PAT) ;-- lookup by DOB
+1 NEW BDMCNT
+2 SET BDMCNT=0
SET BDMPATE=0
+3 SET BDMDOB=PAT-1
FOR
SET BDMDOB=$ORDER(^DPT("ADOB",BDMDOB))
IF 'BDMDOB!(BDMDOB'=+PAT)!(BDMCNT>BDMMT)
QUIT
Begin DoDot:1
+4 SET BDMIEN=0
FOR
SET BDMIEN=$ORDER(^DPT("ADOB",BDMDOB,BDMIEN))
IF 'BDMIEN
QUIT
Begin DoDot:2
+5 IF '$DATA(BDMPATE(BDMCNT))
SET BDMPATE(BDMCNT)=0
+6 SET BDMCNT=BDMCNT+1
SET BDMPATE=1
+7 SET BDMPATE(BDMCNT)=BDMIEN
End DoDot:2
End DoDot:1
+8 SET BDMPATE=BDMCNT
+9 QUIT $GET(BDMPATE)
+10 ;
PATNAM(BDMPATE,PAT,NPAT) ;lookup by name
+1 SET BDMCNT=0
SET BDMPATE=0
+2 NEW BDMLEN
+3 SET BDMLEN=$LENGTH(PAT)
+4 SET BDMNAM=PAT
+5 SET BDMNAM=$$BEGIN(PAT)
+6 IF $GET(NPAT)]""
SET BDMNAM=NPAT
+7 FOR
SET BDMNAM=$ORDER(^DPT("B",BDMNAM))
IF BDMNAM=""!($EXTRACT(BDMNAM,1,BDMLEN)'=PAT)!(BDMCNT>BDMMT)
QUIT
Begin DoDot:1
+8 SET BDMIEN=0
FOR
SET BDMIEN=$ORDER(^DPT("B",BDMNAM,BDMIEN))
IF 'BDMIEN
QUIT
Begin DoDot:2
+9 ;maw 3/23/2006 added line
IF $DATA(BDMPATE(BDMCNT))
IF $GET(BDMPATE(BDMCNT))=BDMIEN
QUIT
+10 SET BDMCNT=BDMCNT+1
+11 IF '$DATA(BDMPATE(BDMCNT))
SET BDMPATE(BDMCNT)=0
+12 SET BDMPATE(BDMCNT)=BDMIEN
End DoDot:2
End DoDot:1
+13 SET BDMPATE=BDMCNT
+14 QUIT $GET(BDMPATE)
+15 ;
BEGIN(PT) ;-- get begin point
+1 NEW BDMPDA,BDMPIEN,BDMPCNT
+2 SET BDMPCNT=0
+3 SET BDMPDA=PT
+4 IF $ORDER(^DPT("B",BDMPDA,0))
Begin DoDot:1
+5 SET BDMPDA=$ORDER(^DPT("B",BDMPDA),-1)
End DoDot:1
+6 FOR
SET BDMPDA=$ORDER(^DPT("B",BDMPDA))
QUIT
+7 IF $GET(BDMPDA)=""
QUIT ""
+8 QUIT $ORDER(^DPT("B",BDMPDA),-1)
+9 ;
PATADO(PIEN) ;-- ado return
+1 SET BDMCNTR=0
+2 SET BDMDA=0
FOR
SET BDMDA=$ORDER(PIEN(BDMDA))
IF 'BDMDA
QUIT
Begin DoDot:1
+3 NEW BDMPI,BDMNM,BDMDC,BDMSX,BDMCT,BDMSSN,BDMHD
+4 SET BDMCNTR=BDMCNTR+1
+5 SET BDMPI=$GET(PIEN(BDMDA))
+6 ;maw 3/23/2006 don't display deceased
IF $PIECE($GET(^DPT(BDMPI,.35)),U)
QUIT
+7 ;maw 3/23/2006 don't display inactive
IF $PIECE($GET(^AUPNPAT(BDMPI,41,DUZ(2),0)),U,3)
QUIT
+8 SET BDMNM=$PIECE($GET(^DPT(BDMPI,0)),U)
+9 SET BDMDC=$$FMTE^XLFDT($PIECE($GET(^DPT(BDMPI,0)),U,3))
+10 SET BDMSX=$PIECE($GET(^DPT(BDMPI,0)),U,2)
+11 SET BDMCT=$$HRN^AUPNPAT(BDMPI,DUZ(2))
+12 SET BDMSSN=$PIECE($GET(^DPT(BDMPI,0)),U,9)
+13 ;ihs/cmi/maw p7 10/01/2013
IF BDMSSN]""
Begin DoDot:2
+14 NEW LN
+15 SET LN=$LENGTH(BDMSSN)
+16 SET BDMSSN="XXX-XX-"_$EXTRACT(BDMSSN,(LN-3),LN)
End DoDot:2
+17 IF $DATA(^ACM(41,"AC",BDMPI))
Begin DoDot:2
+18 IF $GET(BDMREG)]""
IF $DATA(^ACM(41,"AC",BDMPI,BDMREG))
SET BDMHD=+$GET(^ACM(41,"AC",BDMPI,BDMREG))
End DoDot:2
+19 SET BDMI=BDMI+1
+20 SET ^BDMTMP($JOB,BDMI)=BDMPI_U_BDMNM_U_BDMDC_U_BDMSX_U_BDMCT_U_BDMSSN_U_$GET(BDMHD)_$CHAR(30)
End DoDot:1
+21 QUIT
+22 ;
REGSEL(BDMRET) ;-- return register to work with
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMDA,BDMC,BDMREG
+3 SET BDMC=0
+4 SET BDMDA=0
FOR
SET BDMDA=$ORDER(^ACM(41.1,"B",BDMDA))
IF BDMDA=""
QUIT
Begin DoDot:1
+5 IF BDMDA'["DIAB"
QUIT
+6 SET BDMRIEN=$ORDER(^ACM(41.1,"B",BDMDA,0))
+7 IF '$DATA(^ACM(41.1,BDMRIEN,"AU","B",DUZ))
QUIT
+8 SET BDMC=BDMC+1
+9 SET $PIECE(BDMREG,"|",BDMC)=BDMDA_U_BDMRIEN
End DoDot:1
+10 SET BDMRET=BDMC_"|"_$GET(BDMREG)
+11 QUIT
+12 ;
DMG(BDMRET,BDMSTR) ;-- get patient demographics
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMPAT,P,BDMAD,BDMCTY,BDMST,BDMZIP,BDMPH,BDMPCP,BDMDATA,BDMCOM
+3 SET P="|"
+4 SET BDMPAT=$PIECE(BDMSTR,P)
+5 SET BDMDATA=$GET(^DPT(BDMPAT,.11))
+6 SET BDMAD=$PIECE(BDMDATA,U)
+7 SET BDMCTY=$PIECE(BDMDATA,U,4)
+8 IF $PIECE(BDMDATA,U,5)]""
SET BDMST=$PIECE($GET(^DIC(5,$PIECE(BDMDATA,U,5),0)),U)
+9 SET BDMZIP=$PIECE(BDMDATA,U,6)
+10 SET BDMPH=$PIECE($GET(^DPT(BDMPAT,.13)),U)
+11 SET BDMPCP=$SELECT($PIECE($GET(^AUPNPAT(BDMPAT,0)),U,14):$PIECE(^AUPNPAT(BDMPAT,0),U,14)_"~"_$$GET1^DIQ(9000001,BDMPAT,.14,"E"),1:"")
+12 SET BDMCOM=$$GET1^DIQ(9000001,BDMPAT,1117,"E")
+13 SET BDMRET=BDMAD_P_BDMCTY_P_$GET(BDMST)_P_BDMZIP_P_BDMPH_P_BDMPCP_P_BDMCOM
+14 QUIT
+15 ;
PATDAT(BDMRET,BDMSTR) ;-- get patient data from CMS Register
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMDATA,P,BDMPAT,BDMREG,BDMREGE,BDMSTAT,BDMRP,BDMCM,BDMWF,BDMCON,BDMED,BDMLE,BDMLR,BDMNR,BDMOD,BDMDX,BDMPIEN
+3 SET P="|"
+4 SET BDMREGE=$PIECE(BDMSTR,P)
+5 SET BDMREG=$ORDER(^ACM(41.1,"B",BDMREGE,0))
+6 SET BDMPAT=$PIECE(BDMSTR,P,2)
+7 SET BDMPIEN=$PIECE($GET(^ACM(41,BDMPAT,0)),U,2)
+8 SET BDMDATA=$GET(^ACM(41,BDMPAT,"DT"))
+9 SET BDMSTAT=$PIECE(BDMDATA,U)
+10 SET BDMRP=$SELECT($PIECE(BDMDATA,U,15)]"":$PIECE(BDMDATA,U,15)_"~"_$PIECE($GET(^VA(200,$PIECE(BDMDATA,U,15),0)),U),1:"")
+11 SET BDMCM=$SELECT($PIECE(BDMDATA,U,6)]"":$PIECE(BDMDATA,U,16)_"~"_$PIECE($GET(^VA(200,$PIECE(BDMDATA,U,6),0)),U),1:"")
+12 SET BDMWF=$SELECT($PIECE(BDMDATA,U,10)]"":$PIECE(BDMDATA,U,10)_"~"_$PIECE($GET(^AUTTLOC($PIECE(BDMDATA,U,10),0)),U,10)_"-"_$PIECE($GET(^DIC(4,$PIECE(BDMDATA,U,10),0)),U),1:"")
+13 SET BDMCON=$PIECE(BDMDATA,U,13)
+14 SET BDMED=$PIECE(BDMDATA,U,4)
+15 SET BDMLE=$PIECE(BDMDATA,U,11)
+16 SET BDMLR=$PIECE(BDMDATA,U,8)
+17 SET BDMNR=$PIECE(BDMDATA,U,9)
+18 SET BDMOD=$PIECE($GET(^ACM(41,BDMPAT,"CH")),U)
+19 IF $DATA(^ACM(44,"AC",BDMREG))
Begin DoDot:1
+20 IF '$DATA(^ACM(44,"AC",BDMREG,BDMPIEN))
QUIT
+21 SET BDMDXI=$ORDER(^ACM(44,"AC",BDMREG,BDMPIEN,0))
+22 IF BDMDXI
SET BDMDX=$PIECE($GET(^ACM(44.1,BDMDXI,0)),U)
End DoDot:1
+23 SET BDMRET=BDMSTAT_P_BDMRP_P_BDMCM_P_BDMWF_P_BDMCON_P_BDMED_P_BDMLE_P_BDMLR_P_BDMNR_P_BDMOD_P_$GET(BDMDX)
+24 QUIT
+25 ;
CMP(BDMRET,BDMSTR) ;-- return complications data
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMDA,BDMI,BDMERR,BDMDATA,BDMPAT,BDMPIEN,BDMREG,BDMREGE,P,BDMCMP,BDMST,BDMIEN,BDMSTI,BDMON,BDMONE,BDMCMT
+3 SET P="|"
+4 SET BDMREGE=$PIECE(BDMSTR,P)
+5 SET BDMREG=$ORDER(^ACM(41.1,"B",BDMREGE,0))
+6 SET BDMPAT=$PIECE(BDMSTR,P,2)
+7 SET BDMPIEN=$PIECE($GET(^ACM(41,BDMPAT,0)),U,2)
+8 KILL ^BDMTMP($JOB)
+9 SET BDMRET="^BDMTMP("_$JOB_")"
+10 SET BDMI=0
+11 SET BDMERR=""
+12 SET ^BDMTMP($JOB,BDMI)="T00007BMXIEN^T00060COMPLICATION^T00030STATUS^T00020ONSET^T32000COMMENTS"_$CHAR(30)
+13 SET BDMDA=0
FOR
SET BDMDA=$ORDER(^ACM(42,"AC",BDMREG,BDMPIEN,BDMDA))
IF 'BDMDA
QUIT
Begin DoDot:1
+14 SET BDMI=BDMI+1
+15 SET BDMCMP=$PIECE($GET(^ACM(42.1,BDMDA,0)),U)
+16 SET BDMIEN=$GET(^ACM(42,"AC",BDMREG,BDMPIEN,BDMDA))
+17 SET BDMDATA=$GET(^ACM(42,BDMIEN,"DT"))
+18 SET BDMST=$SELECT($PIECE(BDMDATA,U,2)]"":$PIECE($GET(^ACM(42.3,$PIECE(BDMDATA,U,2),0)),U),1:"")
+19 SET BDMONE=$PIECE(BDMDATA,U)
+20 SET BDMON=""
+21 IF BDMONE]""
Begin DoDot:2
+22 SET BDMON=$EXTRACT(BDMONE,4,5)_"/"_$EXTRACT(BDMONE,6,7)_"/"_($EXTRACT(BDMONE,1,3)+1700)
End DoDot:2
+23 NEW BDMCDA
+24 SET BDMCMT=""
+25 SET BDMCDA=0
FOR
SET BDMCDA=$ORDER(^ACM(42,BDMIEN,1,BDMCDA))
IF 'BDMCDA
QUIT
Begin DoDot:2
+26 ;_$C(13,10)
SET BDMCMT=BDMCMT_$GET(^ACM(42,BDMIEN,1,BDMCDA,0))
End DoDot:2
+27 ;S BDMCMT=$G(^ACM(42,BDMIEN,1,1,0)) ;only need 80 characters for GUI DMS
+28 SET ^BDMTMP($JOB,BDMI)=BDMIEN_U_BDMCMP_U_$GET(BDMST)_U_$GET(BDMON)_U_$GET(BDMCMT)_$CHAR(30)
End DoDot:1
+29 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)
+30 QUIT
+31 ;
DIAG(BDMRET,BDMSTR) ;-- return diagnosis data
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMDA,BDMI,BDMERR,BDMDATA,BDMPAT,BDMPIEN,BDMREG,BDMREGE,P,BDMCMP,BDMST,BDMIEN,BDMSTI,BDMON,BDMONE,BDMCMT
+3 SET P="|"
+4 SET BDMREGE=$PIECE(BDMSTR,P)
+5 SET BDMREG=$ORDER(^ACM(41.1,"B",BDMREGE,0))
+6 SET BDMPAT=$PIECE(BDMSTR,P,2)
+7 SET BDMPIEN=$PIECE($GET(^ACM(41,BDMPAT,0)),U,2)
+8 KILL ^BDMTMP($JOB)
+9 SET BDMRET="^BDMTMP("_$JOB_")"
+10 SET BDMI=0
+11 SET BDMERR=""
+12 SET ^BDMTMP($JOB,BDMI)="T00007BMXIEN^T00060DIAGNOSIS^T00030SEVERITY^T00020ONSET"_$CHAR(30)
+13 SET BDMDA=0
FOR
SET BDMDA=$ORDER(^ACM(44,"AC",BDMREG,BDMPIEN,BDMDA))
IF 'BDMDA
QUIT
Begin DoDot:1
+14 SET BDMI=BDMI+1
+15 SET BDMCMP=$PIECE($GET(^ACM(44.1,BDMDA,0)),U)
+16 SET BDMIEN=$GET(^ACM(44,"AC",BDMREG,BDMPIEN,BDMDA))
+17 SET BDMDATA=$GET(^ACM(44,BDMIEN,"SV"))
+18 SET BDMST=$SELECT($PIECE(BDMDATA,U)="N":"N-NORMAL",$PIECE(BDMDATA,U)="M":"M-MILD",$PIECE(BDMDATA,U)="MO":"MO-MODERATE",$PIECE(BDMDATA,U)="S":"S-SEVERE",1:"")
+19 SET BDMONE=$PIECE(BDMDATA,U,2)
+20 SET BDMON=""
+21 IF BDMONE]""
Begin DoDot:2
+22 SET BDMON=$EXTRACT(BDMONE,4,5)_"/"_$EXTRACT(BDMONE,6,7)_"/"_($EXTRACT(BDMONE,1,3)+1700)
End DoDot:2
+23 SET ^BDMTMP($JOB,BDMI)=BDMIEN_U_BDMCMP_U_$GET(BDMST)_U_$GET(BDMON)_$CHAR(30)
End DoDot:1
+24 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)
+25 QUIT
+26 ;
CMT(BDMRET,BDMSTR) ;-- get comment history
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMCMT,BDMERR,BDMCMTE,BDMCMTR,BDMI
+3 KILL ^BDMTMP($JOB)
+4 SET BDMRET="^BDMTMP("_$JOB_")"
+5 SET BDMERR=""
+6 SET BDMI=0
+7 SET ^BDMTMP($JOB,BDMI)="T00100COMMENTS"_$CHAR(30)
+8 SET BDMCMT=0
FOR
SET BDMCMT=$ORDER(^ACM(41,BDMSTR,1,BDMCMT))
IF 'BDMCMT
QUIT
Begin DoDot:1
+9 SET BDMCMTE=$GET(^ACM(41,BDMSTR,1,BDMCMT,0))
+10 SET BDMI=BDMI+1
+11 SET ^BDMTMP($JOB,BDMI)=BDMCMTE_$CHAR(30)
End DoDot:1
+12 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)
+13 QUIT
+14 ;
VST(BDMRET,BDMSTR) ;-- get visit data by patient
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMCNT,BDMDA,BDMIVDT,BDMVIEN,BDMVDT,BDMCLNI,BDMVTYP,BDMSC,BDMACU,BDMLOI,BDMRVDT
+3 NEW BDMPROV,BDMSPROV,BDMVSTR,PAT,P,BDMI
+4 SET P="|"
+5 SET BDMRET="^BDMTMP("_$JOB_")"
+6 SET BDMI=0
+7 SET ^BDMTMP($JOB,BDMI)="T00020Visit Date^T00030Location^T00010Type^T00010Service Category^T00010IEN^T00030Provider^T00030Secondary Provider^T00030Clinic"_$CHAR(30)
+8 SET BDMCNT=0
+9 SET PAT=$PIECE(BDMSTR,P)
+10 IF '$ORDER(^AUPNVSIT("AC",PAT,0))
SET BDMRET=0
QUIT
+11 SET BDMDA=PAT-1
FOR
SET BDMDA=$ORDER(^AUPNVSIT("AA",BDMDA))
IF 'BDMDA!(BDMDA>PAT)!(BDMCNT>400)
QUIT
Begin DoDot:1
+12 SET BDMIVDT=0
FOR
SET BDMIVDT=$ORDER(^AUPNVSIT("AA",BDMDA,BDMIVDT))
IF 'BDMIVDT!(BDMCNT>400)
QUIT
Begin DoDot:2
+13 SET BDMVIEN=0
FOR
SET BDMVIEN=$ORDER(^AUPNVSIT("AA",BDMDA,BDMIVDT,BDMVIEN))
IF 'BDMVIEN!(BDMCNT>400)
QUIT
Begin DoDot:3
+14 SET BDMCNT=BDMCNT+1
+15 NEW BDMVND,BDMVDT,BDMVTYP,BDMLOC,BDMSC,BDMPROV,BDMSPROV,BDMCL
+16 ;Q:BDMCNT>4 ;cmi/maw let's make this a site parameter
+17 SET BDMVND=$GET(^AUPNVSIT(BDMVIEN,0))
+18 SET BDMVDT=$$FMTE^XLFDT($PIECE(BDMVND,U))
+19 IF $PIECE(BDMVND,U,6)]""
SET BDMLOC=$PIECE($GET(^AUTTLOC($PIECE(BDMVND,U,6),0)),U,10)_"-"_$$GET1^DIQ(9999999.06,$PIECE(BDMVND,U,6),.01,"E")
+20 SET BDMVTYP=$PIECE(BDMVND,U,3)
+21 SET BDMSC=$PIECE(BDMVND,U,7)_"-"_$$GET1^DIQ(9000010,BDMVIEN,.07,"E")
+22 SET BDMCL=$$GET1^DIQ(9000010,BDMVIEN,.08,"E")
+23 SET BDMPROV=$$PRIMPROV^APCLV(BDMVIEN,"N")
+24 SET BDMSPROV=$$SECPROV^APCLV(BDMVIEN,"N")
+25 SET BDMI=BDMI+1
+26 SET ^BDMTMP($JOB,BDMI)=$GET(BDMVDT)_U_$GET(BDMLOC)_U_$GET(BDMVTYP)_U_$GET(BDMSC)_U_$GET(BDMVIEN)_U_$GET(BDMPROV)_U_$GET(BDMSPROV)_U_$GET(BDMCL)_$CHAR(30)
End DoDot:3
End DoDot:2
End DoDot:1
+27 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)
+28 QUIT
+29 ;
CATSTR(BDMSRET,STR) ;EP - concatenate a long string in
+1 NEW BDMDA
+2 SET BDMSRET=""
+3 SET BDMDA=0
FOR
SET BDMDA=$ORDER(STR(BDMDA))
IF 'BDMDA
QUIT
Begin DoDot:1
+4 SET BDMSRET=BDMSRET_$GET(STR(BDMDA))
End DoDot:1
+5 QUIT
+6 ;
MERR ; MUMPS ERROR TRAP
+1 NEW BDMX
+2 XECUTE ("S X=$"_"ZE")
+3 SET BDMX="MUMPS error: """_BDMX_""""
+4 DO ERR(BDMX)
+5 QUIT
+6 ;
ERR(ERR) ; BMX ADO SCHEMA ERROR PROCESSOR
+1 NEW BDMGX
+2 SET BDMGX="ERROR|"_ERR_$CHAR(30)
+3 SET @BDMRET@(1)=BDMGX
+4 SET @BDMRET@(2)=$CHAR(31)
+5 QUIT
+6 ;
