BDMGE.m

BDMGE ; cmi/anch/maw - BDM DMS GUI Filing Routine ; 28 Oct 2014  4:31 PM

 ;;2.0;BDM DIABETES MANAGEMENT SYSTEM;**1,8**;JUN 14, 2007;Build 53

 ;

 ;

 ;

 ;1/25/2005 added in REGSV a check for DX

 ;3/22/2006 added diagnosis save to complications list add, subroutine CMPA

 ;

DEBUG(BDMRET,BDMSTR) ;-- debugger

 D DEBUG^%Serenji("DME^BDMGE(.BDMRET,.BDMSTR)")

 Q

 ;

REGADD(BDMRET,BDMSTR) ;EP - add patient to register

 S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap

 N BDMREG,BDMREGE,BDMFDA,BDMIENS,BDMERR,P

 S P="|"

 S BDMREGE=$P(BDMSTR,P)

 S BDMREG=$O(^ACM(41.1,"B",BDMREGE,0))

 S BDMPAT=$P(BDMSTR,P,2)

 S BDMIENS=""

 S BDMFDA(9002241,"+1,",.01)=BDMREG

 S BDMFDA(9002241,"+1,",.02)=BDMPAT

 S BDMFDA(9002241,"+1,",1)="A"

 S BDMFDA(9002241,"+1,",2)=DT

 S BDMFDA(9002241,"+1,",4)=DT

 D UPDATE^DIE("","BDMFDA","BDMIENS","BDMERR(1)")

 I $D(BDMERR) S BDMRET="" Q

 S BDMRET=+$G(BDMIENS(1))

 Q

 ;

REGSV(BDMRET,BDMSTR) ;-- save the data to the register

 S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap

 N BDMREG,BDMPIEN,BDMPCP,BDMREGE,BDMFDA,BDMIENS,BDMERR,P,R,BDMST,BDMRP,BDMCM,BDMWF,BDMCON,BDMED,BDMLE,BDMLR,BDMNR,BDMON,BDMDX,BDMDXE

 S P="|",R="~"

 S BDMRET=1

 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 BDMST=$P($P(BDMSTR,P,3),"-")

 S BDMRP=$P($P(BDMSTR,P,4),R)

 S BDMCM=$P($P(BDMSTR,P,5),R)

 S BDMWF=$P($P(BDMSTR,P,6),R)

 ;S BDMRP=$S($P(BDMSTR,P,4)]"":$O(^VA(200,"B",$P(BDMSTR,P,4),0)),1:"")

 ;S BDMCM=$S($P(BDMSTR,P,5)]"":$O(^VA(200,"B",$P(BDMSTR,P,5),0)),1:"")

 ;S BDMWF=$S($P($P(BDMSTR,P,6),"-")]"":$O(^AUTTLOC("C",$P($P(BDMSTR,P,6),"-"),0)),1:"")

 S BDMCON=$P(BDMSTR,P,7)

 S BDMLR=$P(BDMSTR,P,8)

 S BDMNR=$P(BDMSTR,P,9)

 ;S BDMDXE=$P(BDMSTR,P,10)

 ;cmi/anch/maw 1/25/2005 added due to possibility of null dx

 S BDMDX=$S($G(BDMDXE)]"":$O(^ACM(44.1,"B",BDMDXE,0)),1:"")

 S BDMON=$P(BDMSTR,P,11)

 S BDMPCP=$P($P(BDMSTR,P,12),R)

 S BDMIENS=BDMPAT_","

 S BDMFDA(9002241,BDMIENS,1)=BDMST

 S BDMFDA(9002241,BDMIENS,6)=BDMCM

 S BDMFDA(9002241,BDMIENS,8)=BDMLR

 S BDMFDA(9002241,BDMIENS,9)=BDMNR

 S BDMFDA(9002241,BDMIENS,10)=BDMWF

 S BDMFDA(9002241,BDMIENS,11)=DT

 S BDMFDA(9002241,BDMIENS,14)=BDMCON

 S BDMFDA(9002241,BDMIENS,15)=BDMRP

 S BDMFDA(9002241,BDMIENS,20)=BDMON

 D FILE^DIE("K","BDMFDA","BDMERR(1)")

 I $G(BDMERR(1)) S BDMRET=1 Q

 S BDMRET=""

 ;D REGDX(BDMPAT,BDMREG,BDMPIEN,BDMDX,BDMON)

 D PCP(BDMPCP,BDMPIEN)

 Q

 ;

REGDX(PAT,REG,PIEN,DIAG,ON) ;-- add the diagnosis if not there already

 ;10/19/2005 added cleanup of existing entries if changed dx

 S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap

 Q:DIAG=""

 I $D(^ACM(44,"AC",REG,PIEN)) Q:$D(^ACM(44,"AC",REG,PIEN,DIAG))

 N BDMDA

 S BDMDA=0 F  S BDMDA=$O(^ACM(44,"AC",REG,PIEN,BDMDA)) Q:'BDMDA  D

 . S DIK="^ACM(44,",DA=$G(^ACM(44,"AC",REG,PIEN,BDMDA)) D ^DIK

 N BDMFDA,BDMIENS,BDMERR

 S BDMIENS=""

 S BDMFDA(9002244,"+1,",.01)=DIAG

 S BDMFDA(9002244,"+1,",.02)=PIEN

 S BDMFDA(9002244,"+1,",.03)=PAT

 S BDMFDA(9002244,"+1,",.04)=REG

 S BDMFDA(9002244,"+1,",2)=ON

 D UPDATE^DIE("","BDMFDA","BDMIENS","BDMERR(1)")

 I $G(BDMERR(1)) S BDMRET=1 Q

 S BDMRET=""

 Q

 ;

PCP(PCP,PAT) ;-- file the primary care provider

 S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap

 Q:'PCP

 N BDMFDA,BDMIENS,BDMERR

 S BDMIENS=PAT_","

 S BDMIENS(1)=PAT

 S BDMFDA(9000001,BDMIENS,.14)=PCP

 D FILE^DIE("K","BDMFDA","BDMERR(1)")

 Q

 ;

CMP(BDMRET,BDMSTR) ;-- save complications

 S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap

 N BDMDA,BDMI,BDMPAT,BDMPIEN,BDMREG,BDMREGE,P,CS

 S P="|"

 S CS="~"

 I $G(BDMSTR)="" D CATSTR^BDMGU(.BDMSTR,.BDMSTR)

 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 BDMERR=""

 ;S BDMDA=0 F  S BDMDA=$O(^ACM(42,"AC",BDMREG,BDMPIEN,BDMDA)) Q:'BDMDA  D

 ;. S BDMCMPI=$G(^ACM(42,"AC",BDMREG,BDMPIEN,BDMDA))

 ;. S DIK="^ACM(42,",DA=BDMCMPI D ^DIK

 F BDMI=3:1 D  Q:$G(BDMDATA)=""

 . N BDMCMPE,BDMSTE,BDMON,BDMCMT,BDMCMP,BDMST

 . S BDMDATA=$P(BDMSTR,P,BDMI)

 . Q:BDMDATA=""

 . S BDMCMPE=$P(BDMDATA,CS)

 . S BDMSTE=$P(BDMDATA,CS,2)

 . S BDMON=$P(BDMDATA,CS,3)

 . S BDMCMP=$O(^ACM(42.1,"B",BDMCMPE,0))

 . S BDMST=$S($G(BDMSTE)]"":$O(^ACM(42.3,"B",BDMSTE,0)),1:"")

 . I $D(^ACM(42,"AC",BDMREG,BDMPIEN,BDMCMP)) D  Q

 .. N BDMENT

 .. S BDMENT=$G(^ACM(42,"AC",BDMREG,BDMPIEN,BDMCMP))

 .. D ECMP(BDMST,BDMON,BDMENT,$P(BDMDATA,CS,4)) ;edit if it exists

 . N BDMERR,BDMIENS,BDMFDA

 . S BDMIENS=""

 . S BDMFDA(9002242,"+1,",.01)=BDMCMP

 . S BDMFDA(9002242,"+1,",.02)=BDMPIEN

 . S BDMFDA(9002242,"+1,",.03)=BDMPAT

 . S BDMFDA(9002242,"+1,",.04)=BDMREG

 . S BDMFDA(9002242,"+1,",1)=BDMON

 . S BDMFDA(9002242,"+1,",2)=BDMST

 . D UPDATE^DIE("","BDMFDA","BDMIENS","BDMERR(1)")

 . I $G(BDMERR(1)) S BDMRET="" Q

 . S BDMRET=$G(BDMIENS(1))

 . N BDMFL,BDMIENS,BDMFLD,BDMERR

 . S BDMFL=9002242

 . S BDMIENS=BDMRET_","

 . S BDMFLD=3

 . S BDMCMT(1)=$P(BDMDATA,CS,4)

 . D WP^DIE(BDMFL,BDMIENS,BDMFLD,,"BDMCMT","BDMERR")

 . S BDMRET=1

 . I $D(BDMERR(1)) S BDMRET=""

 Q

 ;

ECMP(ST,ON,ENT,CMT) ;-- edit the entry

 N BDMERR,BDMIENS,BDMFDA

 S BDMIENS=ENT_","

 S BDMFDA(9002242,BDMIENS,1)=ON

 S BDMFDA(9002242,BDMIENS,2)=ST

 D FILE^DIE("K","BDMFDA","BDMERR(1)")

 I $G(BDMERR(1)) S BDMRET="" Q

 N BDMFL,BDMFLD,BDMERR

 S BDMFL=9002242

 S BDMFLD=3

 S BDMCMT(1)=CMT

 D WP^DIE(BDMFL,BDMIENS,BDMFLD,,"BDMCMT","BDMERR")

 Q

 ;

DCMP(BDMRET,BDMSTR) ;-- delete the complication

 N I,P

 S P="|"

 F I=2:1 D  Q:$P(BDMSTR,P,I)=""

 . Q:$P(BDMSTR,P,I)=""

 . S DIK="^ACM(42,"

 . S DA=$P(BDMSTR,P,I)

 . D ^DIK

 S BDMRET="^BDMTMP("_$J_")"

 S ^BDMTMP($J,0)="T00030Error"_$C(30)

 S ^BDMTMP($J,1)=$C(31)

 Q

 ;

DIAG(BDMRET,BDMSTR) ;-- save complications

 S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap

 N BDMDA,BDMI,BDMPAT,BDMPIEN,BDMREG,BDMREGE,P,CS

 S P="|"

 S CS="~"

 I $G(BDMSTR)="" D CATSTR^BDMGU(.BDMSTR,.BDMSTR)

 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 BDMERR=""

 ;S BDMDA=0 F  S BDMDA=$O(^ACM(42,"AC",BDMREG,BDMPIEN,BDMDA)) Q:'BDMDA  D

 ;. S BDMCMPI=$G(^ACM(42,"AC",BDMREG,BDMPIEN,BDMDA))

 ;. S DIK="^ACM(42,",DA=BDMCMPI D ^DIK

 F BDMI=3:1 D  Q:$G(BDMDATA)=""

 . N BDMCMPE,BDMSTE,BDMON,BDMCMT,BDMCMP,BDMST

 . S BDMDATA=$P(BDMSTR,P,BDMI)

 . Q:BDMDATA=""

 . S BDMCMPE=$P(BDMDATA,CS)

 . S BDMSTE=$P(BDMDATA,CS,2)

 . S BDMON=$P(BDMDATA,CS,3)

 . S BDMCMP=$O(^ACM(44.1,"B",BDMCMPE,0))

 . I $D(^ACM(44,"AC",BDMREG,BDMPIEN,BDMCMP)) D  Q

 .. N BDMENT

 .. S BDMENT=$G(^ACM(44,"AC",BDMREG,BDMPIEN,BDMCMP))

 .. D EDIAG(BDMSTE,BDMON,BDMENT) ;edit if it exists

 . N BDMERR,BDMIENS,BDMFDA

 . S BDMIENS=""

 . S BDMFDA(9002244,"+1,",.01)=BDMCMP

 . S BDMFDA(9002244,"+1,",.02)=BDMPIEN

 . S BDMFDA(9002244,"+1,",.03)=BDMPAT

 . S BDMFDA(9002244,"+1,",.04)=BDMREG

 . S BDMFDA(9002244,"+1,",2)=BDMON

 . S BDMFDA(9002244,"+1,",1)=BDMSTE

 . D UPDATE^DIE("","BDMFDA","BDMIENS","BDMERR(1)")

 . I $G(BDMERR(1)) S BDMRET="" Q

 . S BDMRET=$G(BDMIENS(1))

 Q

 ;

EDIAG(ST,ON,ENT) ;-- edit the entry

 N BDMERR,BDMIENS,BDMFDA

 S BDMIENS=ENT_","

 S BDMFDA(9002244,BDMIENS,1)=ST

 S BDMFDA(9002244,BDMIENS,2)=ON

 D FILE^DIE("K","BDMFDA","BDMERR(1)")

 I $G(BDMERR(1)) S BDMRET="" Q

 Q

 ;

DDIAG(BDMRET,BDMSTR) ;-- delete the diagnosis

 N I,P

 S P="|"

 F I=2:1 D  Q:$P(BDMSTR,P,I)=""

 . Q:$P(BDMSTR,P,I)=""

 . S DIK="^ACM(44,"

 . S DA=$P(BDMSTR,P,I)

 . D ^DIK

 S BDMRET="^BDMTMP("_$J_")"

 S ^BDMTMP($J,0)="T00030Error"_$C(30)

 S ^BDMTMP($J,1)=$C(31)

 Q

 ;

EPRB(BDMRET,BDMSTR) ;-- edit a problem on the problem list

 S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap

 N P,BDMP,BDMDX,BDMDLM,BDMCL,BDMNAR,BDMFAC,BDMDE,BDMST,BDMON

 S P="|"

 S BDMP=$P(BDMSTR,P)

 S BDMDX=$P(BDMSTR,P,2)

 I '$G(BDMDX) S BDMRET="1^Invalid Diagnosis Code" Q  ;maw added 10/19/2005

 ;S BDMDX=$O(^ICD9("BA",BDMDX,0))

 ;I 'BDMDX S BDMRET="1^Invalid Diagnosis Code" Q

 S BDMDLM=$P(BDMSTR,P,3)

 S BDMCL=$P(BDMSTR,P,4)

 S BDMNAR=$P(BDMSTR,P,5)

 S BDMNAR=$$FIND1^DIC(9999999.27,,"X",BDMNAR)

 I 'BDMNAR S BDMRET="2^Provider Narrative Not Found in AUTNPOV" Q

 ;S BDMFAC=$P($P(BDMSTR,P,6),"-")

 ;I $G(BDMFAC) S BDMFAC=$O(^AUTTLOC("C",BDMFAC,0))

 S BDMFAC=$P(BDMSTR,P,6)

 S BDMST=$P(BDMSTR,P,7)

 S BDMON=$P(BDMSTR,P,8)

 N BDMERR,BDMFDA,BDMIENS

 S BDMIENS=BDMP_","

 S BDMFDA(9000011,BDMIENS,.01)=BDMDX

 S BDMFDA(9000011,BDMIENS,.03)=DT

 S BDMFDA(9000011,BDMIENS,.04)=BDMCL

 S BDMFDA(9000011,BDMIENS,.05)=BDMNAR

 S BDMFDA(9000011,BDMIENS,.14)=DUZ

 ;S BDMFDA(9000011,BDMIENS,.07)=BDMNMBR  why???

 S BDMFDA(9000011,BDMIENS,.12)=BDMST

 S BDMFDA(9000011,BDMIENS,.13)=BDMON

 D FILE^DIE("K","BDMFDA","BDMERR")

 S BDMRET=$S($G(BDMERR(1)):$G(BDMERR(1)),1:0)

 Q

 ;

NOTEA(BDMRET,BDMSTR) ;-- add a note

 S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap

 N BDMNAR,BDMLOC,BDMIEN,BDMLIEN,P

 S P="|"

 S BDMIEN=$P(BDMSTR,P)

 ;S BDMLOC=$P($P(BDMSTR,P,2),"-")

 S BDMLOC=$P(BDMSTR,P,2)

 S BDMNAR=$P(BDMSTR,P,3)

 ;S BDMLOC=$O(^AUTTLOC("C",BDMLOC,0))

 N BDMIENS,BDMERR,BDMFDA

 I $O(^AUPNPROB(BDMIEN,11,"B",BDMLOC,0)) D

 . S BDMLIEN=$O(^AUPNPROB(BDMIEN,11,"B",BDMLOC,0))

 I '$O(^AUPNPROB(BDMIEN,11,"B",BDMLOC,0)) D  Q:$G(BDMERR(1))

 . S BDMIENS="+2,"_BDMIEN_","

 . S BDMFDA(9000011.11,BDMIENS,.01)=BDMLOC

 . D UPDATE^DIE("","BDMFDA","BDMIENS","BDMERR")

 . I $G(BDMERR(1)) S BDMRET="1^Error Adding Note Location" Q

 . S BDMLIEN=$G(BDMIENS(2))

 N BDMIENS,BDMERR,BDMFDA

 S BDMIENS="+3,"_BDMLIEN_","_BDMIEN_","

 S BDMNN=+$P($G(^AUPNPROB(BDMIEN,11,BDMLIEN,11,0)),U,3)+1

 S BDMFDA(9000011.1111,BDMIENS,.01)=BDMNN

 S BDMFDA(9000011.1111,BDMIENS,.03)=BDMNAR

 S BDMFDA(9000011.1111,BDMIENS,.05)=DT

 D UPDATE^DIE("","BDMFDA","BDMIENS","BDMERR")

 I $G(BDMERR(1)) S BDMRET="1^Error Adding Note" Q

 S BDMRET=0

 Q

 ;

NOTEE(BDMRET,BDMSTR) ;-- edit a note

 S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap

 N BDMNAR,BDMLOC,BDMIEN,BDMLIEN,BDMNIEN,BDMLIEN,P

 S P="|"

 S BDMIEN=$P(BDMSTR,P)

 S BDMLIEN=$P(BDMSTR,P,2)

 S BDMNIEN=$P(BDMSTR,P,3)

 S BDMNAR=$P(BDMSTR,P,4)

 N BDMIENS,BDMERR,BDMFDA

 S BDMIENS=BDMNIEN_","_BDMLIEN_","_BDMIEN_","

 S BDMFDA(9000011.1111,BDMIENS,.03)=BDMNAR

 S BDMFDA(9000011.1111,BDMIENS,.05)=DT

 D FILE^DIE("K","BDMFDA","BDMERR")

 I $G(BDMERR(1)) S BDMRET="1^Error Editing Note" Q

 S BDMRET=0

 Q

 ;

NOTED(BDMRET,BDMSTR) ;-- delete a note

 S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap

 N BDMIEN,BDMLIEN,BDMNIEN,BDMLIEN,P

 S P="|"

 S BDMIEN=$P(BDMSTR,P)

 S BDMLIEN=$P(BDMSTR,P,2)

 S BDMNIEN=$P(BDMSTR,P,3)

 S DIK="^AUPNPROB("_BDMIEN_",11,"_BDMLIEN_",11,",DA=BDMNIEN,DA(1)=BDMLIEN,DA(2)=BDMIEN

 D ^DIK

 I '$P($G(^AUPNPROB(BDMIEN,11,BDMLIEN,11,0)),U,4) D

 . S DIK="^AUPNPROB("_BDMIEN_",11,",DA=BDMLIEN,DA(1)=BDMIEN

 . D ^DIK

 S BDMRET=0

 Q

 ;

ACMT(BDMRET,BDMSTR) ;-- call CMT

 S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap

 D CMT(.BDMRET,.BDMSTR)

 Q

 ;

CMT(BDMRET,BDMSTR) ;-- the entire array

 N P,BDMVIEN,BDMTXT

 S P="|"

 I $G(BDMSTR)]"" D

 . S BDMVIEN=$P(BDMSTR,P)

 . S BDMTXT(1)=$P(BDMSTR,P,2)

 I $G(BDMSTR)="" D

 . S BDMTXT(1)=""

 . S BDMVIEN=$P($G(BDMSTR(1)),P)

 . S BDMTXT(1)=$P($G(BDMSTR(1)),P,2)

 . S BDMDA=1 F  S BDMDA=$O(BDMSTR(BDMDA)) Q:'BDMDA  D

 .. S BDMTXT(1)=BDMTXT(1)_$G(BDMSTR(BDMDA))

 N BDMFL,BDMIENS,BDMFLD,BDMERR

 S BDMFL=9002241

 S BDMIENS=BDMVIEN_","

 S BDMFLD=13

 D WP^DIE(BDMFL,BDMIENS,BDMFLD,,"BDMTXT","BDMERR")

 S BDMRET=""

 I $D(BDMERR(1)) S BDMRET=1

 Q

 ;

DME(BDMRET,BDMSTR) ;-- create entry in BDMEDMUP

 S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap

 N P,BDMIEN,BDMPIEN,BDMON,BDMPN,BDMHD,BDMHV,BDMWD,BDMWV,BDMTU,BDMTB,BDMFTD

 N BDMEYED,BDMDEND,BDMPAPD,BDMMAMD,BDMFLUD,BDMPNUD,BDMTDD,BDMBPD,BDMBPV,BDMFTR

 N BDMEYER,BDMEKGR,BDMPPDD,BDMPPDR,BDMEKGD,BDMGLU,BDMASTR,BDMMAMP,BDMDEPD,BDMDEPR

 S P="|"

 I $G(BDMSTR)="" D CATSTR^BDMGU(.BDMSTR,.BDMSTR)

 I $G(BDMSTR)="" S BDMRET="Error Creating BDMEDMUP Entry, Invalid String" Q

 S BDMDMIEN=$P(BDMSTR,P)

 I $G(BDMDMIEN) D  Q

 . D DMEE^BDMGEA(.BDMRET,.BDMSTR)

 S BDMPIEN=$P(BDMSTR,P,2)

 S BDMON=$P(BDMSTR,P,3)

 S BDMPN=$P(BDMSTR,P,4)

 S BDMHD=$P(BDMSTR,P,5)

 S BDMHV=$P(BDMSTR,P,6)

 S BDMWD=$P(BDMSTR,P,7)

 S BDMWV=$P(BDMSTR,P,8)

 S BDMBPD=$P(BDMSTR,P,9)

 S BDMBPV=$P(BDMSTR,P,10)

 S BDMFTD=$P(BDMSTR,P,11)

 S BDMFTR=$P(BDMSTR,P,12)

 S BDMEYED=$P(BDMSTR,P,13)

 S BDMEYER=$P(BDMSTR,P,14)

 S BDMEKGD=$P(BDMSTR,P,15)

 S BDMEKGR=$P(BDMSTR,P,16)

 S BDMDEND=$P(BDMSTR,P,17)

 S BDMPAPD=$P(BDMSTR,P,18)

 S BDMMAMD=$P(BDMSTR,P,19)

 S BDMPPDD=$P(BDMSTR,P,20)

 S BDMPPDR=$P(BDMSTR,P,21)

 S BDMMAMP=$P(BDMSTR,P,22)

 S BDMDEPD=$P(BDMSTR,P,23)

 S BDMDEPR=$P(BDMSTR,P,24)

 S BDMASTR="+1,"

 N BDMERR,BDMIENS,BDMFDA

 S BDMIENS=""

 S BDMFDA(9003203.2,"+1,",.01)=BDMPIEN

 S BDMFDA(9003203.2,"+1,",.02)=DT

 S BDMFDA(9003203.2,"+1,",.03)=BDMON

 S BDMFDA(9003203.2,"+1,",.04)=BDMPN

 S BDMFDA(9003203.2,"+1,",.05)=BDMHD

 S BDMFDA(9003203.2,"+1,",.06)=BDMHV

 S BDMFDA(9003203.2,"+1,",.07)=BDMWD

 S BDMFDA(9003203.2,"+1,",.08)=BDMWV

 S BDMFDA(9003203.2,"+1,",.11)=BDMFTD

 S BDMFDA(9003203.2,"+1,",.12)=BDMEYED

 S BDMFDA(9003203.2,"+1,",.13)=BDMDEND

 S BDMFDA(9003203.2,"+1,",.14)=BDMPAPD

 S BDMFDA(9003203.2,"+1,",.15)=BDMMAMD

 S BDMFDA(9003203.2,"+1,",.19)=BDMBPD

 S BDMFDA(9003203.2,"+1,",.2)=BDMBPV

 S BDMFDA(9003203.2,"+1,",.21)=BDMFTR

 S BDMFDA(9003203.2,"+1,",.22)=BDMEYER

 S BDMFDA(9003203.2,"+1,",.23)=BDMEKGR

 S BDMFDA(9003203.2,"+1,",.24)=BDMMAMP

 S BDMFDA(9003203.2,"+1,",.25)=BDMDEPD

 S BDMFDA(9003203.2,"+1,",.26)=BDMDEPR

 S BDMFDA(9003203.2,"+1,",1103)=BDMEKGD

 S BDMFDA(9003203.2,"+1,",1101)=BDMPPDD

 S BDMFDA(9003203.2,"+1,",1102)=BDMPPDR

 D UPDATE^DIE("","BDMFDA","BDMIENS","BDMERR(1)")

 I $G(BDMERR(1)) S BDMRET="" Q

 S BDMRET=$G(BDMIENS(1))

 Q

 ;

BDMGE     ; cmi/anch/maw - BDM DMS GUI Filing Routine ; 28 Oct 2014  4:31 PM

 +1       ;;2.0;BDM DIABETES MANAGEMENT SYSTEM;**1,8**;JUN 14, 2007;Build 53

 +2       ;

 +3       ;

 +4       ;

 +5       ;1/25/2005 added in REGSV a check for DX

 +6       ;3/22/2006 added diagnosis save to complications list add, subroutine CMPA

 +7       ;

DEBUG(BDMRET,BDMSTR) ;-- debugger

 +1        DO DEBUG^%Serenji("DME^BDMGE(.BDMRET,.BDMSTR)")

 +2        QUIT 

 +3       ;

REGADD(BDMRET,BDMSTR) ;EP - add patient to register

 +1       ; m error trap

           SET X="MERR^BDMGU"

           SET @^%ZOSF("TRAP")

 +2        NEW BDMREG,BDMREGE,BDMFDA,BDMIENS,BDMERR,P

 +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 BDMIENS=""

 +8        SET BDMFDA(9002241,"+1,",.01)=BDMREG

 +9        SET BDMFDA(9002241,"+1,",.02)=BDMPAT

 +10       SET BDMFDA(9002241,"+1,",1)="A"

 +11       SET BDMFDA(9002241,"+1,",2)=DT

 +12       SET BDMFDA(9002241,"+1,",4)=DT

 +13       DO UPDATE^DIE("","BDMFDA","BDMIENS","BDMERR(1)")

 +14       IF $DATA(BDMERR)

               SET BDMRET=""

               QUIT 

 +15       SET BDMRET=+$GET(BDMIENS(1))

 +16       QUIT 

 +17      ;

REGSV(BDMRET,BDMSTR) ;-- save the data to the register

 +1       ; m error trap

           SET X="MERR^BDMGU"

           SET @^%ZOSF("TRAP")

 +2        NEW BDMREG,BDMPIEN,BDMPCP,BDMREGE,BDMFDA,BDMIENS,BDMERR,P,R,BDMST,BDMRP,BDMCM,BDMWF,BDMCON,BDMED,BDMLE,BDMLR,BDMNR,BDMON,BDMDX,BDMDXE

 +3        SET P="|"

           SET R="~"

 +4        SET BDMRET=1

 +5        SET BDMREGE=$PIECE(BDMSTR,P)

 +6        SET BDMREG=$ORDER(^ACM(41.1,"B",BDMREGE,0))

 +7        SET BDMPAT=$PIECE(BDMSTR,P,2)

 +8        SET BDMPIEN=$PIECE($GET(^ACM(41,BDMPAT,0)),U,2)

 +9        SET BDMST=$PIECE($PIECE(BDMSTR,P,3),"-")

 +10       SET BDMRP=$PIECE($PIECE(BDMSTR,P,4),R)

 +11       SET BDMCM=$PIECE($PIECE(BDMSTR,P,5),R)

 +12       SET BDMWF=$PIECE($PIECE(BDMSTR,P,6),R)

 +13      ;S BDMRP=$S($P(BDMSTR,P,4)]"":$O(^VA(200,"B",$P(BDMSTR,P,4),0)),1:"")

 +14      ;S BDMCM=$S($P(BDMSTR,P,5)]"":$O(^VA(200,"B",$P(BDMSTR,P,5),0)),1:"")

 +15      ;S BDMWF=$S($P($P(BDMSTR,P,6),"-")]"":$O(^AUTTLOC("C",$P($P(BDMSTR,P,6),"-"),0)),1:"")

 +16       SET BDMCON=$PIECE(BDMSTR,P,7)

 +17       SET BDMLR=$PIECE(BDMSTR,P,8)

 +18       SET BDMNR=$PIECE(BDMSTR,P,9)

 +19      ;S BDMDXE=$P(BDMSTR,P,10)

 +20      ;cmi/anch/maw 1/25/2005 added due to possibility of null dx

 +21       SET BDMDX=$SELECT($GET(BDMDXE)]"":$ORDER(^ACM(44.1,"B",BDMDXE,0)),1:"")

 +22       SET BDMON=$PIECE(BDMSTR,P,11)

 +23       SET BDMPCP=$PIECE($PIECE(BDMSTR,P,12),R)

 +24       SET BDMIENS=BDMPAT_","

 +25       SET BDMFDA(9002241,BDMIENS,1)=BDMST

 +26       SET BDMFDA(9002241,BDMIENS,6)=BDMCM

 +27       SET BDMFDA(9002241,BDMIENS,8)=BDMLR

 +28       SET BDMFDA(9002241,BDMIENS,9)=BDMNR

 +29       SET BDMFDA(9002241,BDMIENS,10)=BDMWF

 +30       SET BDMFDA(9002241,BDMIENS,11)=DT

 +31       SET BDMFDA(9002241,BDMIENS,14)=BDMCON

 +32       SET BDMFDA(9002241,BDMIENS,15)=BDMRP

 +33       SET BDMFDA(9002241,BDMIENS,20)=BDMON

 +34       DO FILE^DIE("K","BDMFDA","BDMERR(1)")

 +35       IF $GET(BDMERR(1))

               SET BDMRET=1

               QUIT 

 +36       SET BDMRET=""

 +37      ;D REGDX(BDMPAT,BDMREG,BDMPIEN,BDMDX,BDMON)

 +38       DO PCP(BDMPCP,BDMPIEN)

 +39       QUIT 

 +40      ;

REGDX(PAT,REG,PIEN,DIAG,ON) ;-- add the diagnosis if not there already

 +1       ;10/19/2005 added cleanup of existing entries if changed dx

 +2       ; m error trap

           SET X="MERR^BDMGU"

           SET @^%ZOSF("TRAP")

 +3        IF DIAG=""

               QUIT 

 +4        IF $DATA(^ACM(44,"AC",REG,PIEN))

               IF $DATA(^ACM(44,"AC",REG,PIEN,DIAG))

                   QUIT 

 +5        NEW BDMDA

 +6        SET BDMDA=0

           FOR 

               SET BDMDA=$ORDER(^ACM(44,"AC",REG,PIEN,BDMDA))

               IF 'BDMDA

                   QUIT 

               Begin DoDot:1

 +7                SET DIK="^ACM(44,"

                   SET DA=$GET(^ACM(44,"AC",REG,PIEN,BDMDA))

                   DO ^DIK

               End DoDot:1

 +8        NEW BDMFDA,BDMIENS,BDMERR

 +9        SET BDMIENS=""

 +10       SET BDMFDA(9002244,"+1,",.01)=DIAG

 +11       SET BDMFDA(9002244,"+1,",.02)=PIEN

 +12       SET BDMFDA(9002244,"+1,",.03)=PAT

 +13       SET BDMFDA(9002244,"+1,",.04)=REG

 +14       SET BDMFDA(9002244,"+1,",2)=ON

 +15       DO UPDATE^DIE("","BDMFDA","BDMIENS","BDMERR(1)")

 +16       IF $GET(BDMERR(1))

               SET BDMRET=1

               QUIT 

 +17       SET BDMRET=""

 +18       QUIT 

 +19      ;

PCP(PCP,PAT) ;-- file the primary care provider

 +1       ; m error trap

           SET X="MERR^BDMGU"

           SET @^%ZOSF("TRAP")

 +2        IF 'PCP

               QUIT 

 +3        NEW BDMFDA,BDMIENS,BDMERR

 +4        SET BDMIENS=PAT_","

 +5        SET BDMIENS(1)=PAT

 +6        SET BDMFDA(9000001,BDMIENS,.14)=PCP

 +7        DO FILE^DIE("K","BDMFDA","BDMERR(1)")

 +8        QUIT 

 +9       ;

CMP(BDMRET,BDMSTR) ;-- save complications

 +1       ; m error trap

           SET X="MERR^BDMGU"

           SET @^%ZOSF("TRAP")

 +2        NEW BDMDA,BDMI,BDMPAT,BDMPIEN,BDMREG,BDMREGE,P,CS

 +3        SET P="|"

 +4        SET CS="~"

 +5        IF $GET(BDMSTR)=""

               DO CATSTR^BDMGU(.BDMSTR,.BDMSTR)

 +6        SET BDMREGE=$PIECE(BDMSTR,P)

 +7        SET BDMREG=$ORDER(^ACM(41.1,"B",BDMREGE,0))

 +8        SET BDMPAT=$PIECE(BDMSTR,P,2)

 +9        SET BDMPIEN=$PIECE($GET(^ACM(41,BDMPAT,0)),U,2)

 +10       SET BDMERR=""

 +11      ;S BDMDA=0 F  S BDMDA=$O(^ACM(42,"AC",BDMREG,BDMPIEN,BDMDA)) Q:'BDMDA  D

 +12      ;. S BDMCMPI=$G(^ACM(42,"AC",BDMREG,BDMPIEN,BDMDA))

 +13      ;. S DIK="^ACM(42,",DA=BDMCMPI D ^DIK

 +14       FOR BDMI=3:1

               Begin DoDot:1

 +15               NEW BDMCMPE,BDMSTE,BDMON,BDMCMT,BDMCMP,BDMST

 +16               SET BDMDATA=$PIECE(BDMSTR,P,BDMI)

 +17               IF BDMDATA=""

                       QUIT 

 +18               SET BDMCMPE=$PIECE(BDMDATA,CS)

 +19               SET BDMSTE=$PIECE(BDMDATA,CS,2)

 +20               SET BDMON=$PIECE(BDMDATA,CS,3)

 +21               SET BDMCMP=$ORDER(^ACM(42.1,"B",BDMCMPE,0))

 +22               SET BDMST=$SELECT($GET(BDMSTE)]"":$ORDER(^ACM(42.3,"B",BDMSTE,0)),1:"")

 +23               IF $DATA(^ACM(42,"AC",BDMREG,BDMPIEN,BDMCMP))

                       Begin DoDot:2

 +24                       NEW BDMENT

 +25                       SET BDMENT=$GET(^ACM(42,"AC",BDMREG,BDMPIEN,BDMCMP))

 +26      ;edit if it exists

                           DO ECMP(BDMST,BDMON,BDMENT,$PIECE(BDMDATA,CS,4))

                       End DoDot:2

                       QUIT 

 +27               NEW BDMERR,BDMIENS,BDMFDA

 +28               SET BDMIENS=""

 +29               SET BDMFDA(9002242,"+1,",.01)=BDMCMP

 +30               SET BDMFDA(9002242,"+1,",.02)=BDMPIEN

 +31               SET BDMFDA(9002242,"+1,",.03)=BDMPAT

 +32               SET BDMFDA(9002242,"+1,",.04)=BDMREG

 +33               SET BDMFDA(9002242,"+1,",1)=BDMON

 +34               SET BDMFDA(9002242,"+1,",2)=BDMST

 +35               DO UPDATE^DIE("","BDMFDA","BDMIENS","BDMERR(1)")

 +36               IF $GET(BDMERR(1))