BDMDMNC.m

BDMDMNC ; IHS/CMI/LAB - is this the first of this diabetes diagnosis? ;

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

 ;

 ;cmi/anch/maw 9/10/2007 code set versioning in DMCOMPL

 ;

DMNC ;EP -- called by taxonomy system

 K ATXSTOP

 Q:'ATXPOVDA

 Q:'$P(^AUPNVPOV(ATXPOVDA,0),U,2)

 ; -- is this the first of this diagnosis (ICD9) for this patient

 K BDM

 S BDMY="BDM("

 S BDMX=$P(^AUPNVPOV(ATXPOVDA,0),U,2)_"^FIRST DX [BDM DIABETES REG NEW CASE" S BDMER=$$START1^APCLDF(BDMX,BDMY)

 I BDMER S ATXSTOP=1 G X1

 S V=+$P($G(BDM(1)),U,4) I V=ATXPOVDA G X1

 S ATXSTOP=1

X1 K BDM,BDMER,BDMX,BDMY

 Q

DMCOMPL ;PEP -- called from taxonomy system

 ;-- if this patient is on IHS DIABETES register, and this is the first dx of this complication send bulletin (do not set atxstp)

 ;S DIC="^ACM(41.1,",DIC(0)="M",X="IHS DIABETES" D ^DIC I Y=-1 G X3

 ;S BDMDMRG=+Y

 K ATXSTOP

 Q:'ATXPOVDA

 Q:'$P(^AUPNVPOV(ATXPOVDA,0),U,2)

 S BDMDFN=$P(^AUPNVPOV(ATXPOVDA,0),U,2)

 ; -- PUT CODE HERE TO SEE IF PATIENT ON REGISTER

 ;I '$D(^ACM(41,"AC",BDMDFN,BDMDMRG)) G X3

 I '$$DMREG(BDMDFN) G X3  ;IHS/CMI/GRL

 K BDM

 S BDMY="BDM("

 ;S BDMX=BDMDFN_"^FIRST DX "_$P(^ICD9(ATXICD,0),U) S BDMER=$$START1^APCLDF(BDMX,BDMY)  ;cmi/anch/maw 9/10/2007 orig line

 S BDMX=BDMDFN_"^FIRST DX "_$P($$ICDDX^BDMUTL(ATXICD),U,2) S BDMER=$$START1^APCLDF(BDMX,BDMY)  ;cmi/anch/maw 9/10/2007 csv

 I BDMER G X2

 S V=+$P($G(BDM(1)),U,4) I V=ATXPOVDA G X2

X3 S ATXSTOP=1

X2 K BDM,BDMDFN,BDMER,BDMX,BDMY

 Q

 ;

DMREG(P) ;is patient on any Diabetes register 1 if on reg, "" if not

 I $G(P)="" Q ""

 NEW X,Y

 S X=0,Y="" F  S X=$O(^ACM(41,"AC",P,X)) Q:X'=+X!(Y)  D

 .S N=$$UP^XLFSTR($P($G(^ACM(41.1,X,0)),U))

 .I N["DIABETES" S Y=1

 .I N["DIAB" S Y=1

 .I N["DM " S Y=1

 .I N[" DM" S Y=1

 .Q

 Q Y

BDMDMNC   ; IHS/CMI/LAB - is this the first of this diabetes diagnosis? ;

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

 +2       ;

 +3       ;cmi/anch/maw 9/10/2007 code set versioning in DMCOMPL

 +4       ;

DMNC      ;EP -- called by taxonomy system

 +1        KILL ATXSTOP

 +2        IF 'ATXPOVDA

               QUIT 

 +3        IF '$PIECE(^AUPNVPOV(ATXPOVDA,0),U,2)

               QUIT 

 +4       ; -- is this the first of this diagnosis (ICD9) for this patient

 +5        KILL BDM

 +6        SET BDMY="BDM("

 +7        SET BDMX=$PIECE(^AUPNVPOV(ATXPOVDA,0),U,2)_"^FIRST DX [BDM DIABETES REG NEW CASE"

           SET BDMER=$$START1^APCLDF(BDMX,BDMY)

 +8        IF BDMER

               SET ATXSTOP=1

               GOTO X1

 +9        SET V=+$PIECE($GET(BDM(1)),U,4)

           IF V=ATXPOVDA

               GOTO X1

 +10       SET ATXSTOP=1

X1         KILL BDM,BDMER,BDMX,BDMY

 +1        QUIT 

DMCOMPL   ;PEP -- called from taxonomy system

 +1       ;-- if this patient is on IHS DIABETES register, and this is the first dx of this complication send bulletin (do not set atxstp)

 +2       ;S DIC="^ACM(41.1,",DIC(0)="M",X="IHS DIABETES" D ^DIC I Y=-1 G X3

 +3       ;S BDMDMRG=+Y

 +4        KILL ATXSTOP

 +5        IF 'ATXPOVDA

               QUIT 

 +6        IF '$PIECE(^AUPNVPOV(ATXPOVDA,0),U,2)

               QUIT 

 +7        SET BDMDFN=$PIECE(^AUPNVPOV(ATXPOVDA,0),U,2)

 +8       ; -- PUT CODE HERE TO SEE IF PATIENT ON REGISTER

 +9       ;I '$D(^ACM(41,"AC",BDMDFN,BDMDMRG)) G X3

 +10      ;IHS/CMI/GRL

           IF '$$DMREG(BDMDFN)

               GOTO X3

 +11       KILL BDM

 +12       SET BDMY="BDM("

 +13      ;S BDMX=BDMDFN_"^FIRST DX "_$P(^ICD9(ATXICD,0),U) S BDMER=$$START1^APCLDF(BDMX,BDMY)  ;cmi/anch/maw 9/10/2007 orig line

 +14      ;cmi/anch/maw 9/10/2007 csv

           SET BDMX=BDMDFN_"^FIRST DX "_$PIECE($$ICDDX^BDMUTL(ATXICD),U,2)

           SET BDMER=$$START1^APCLDF(BDMX,BDMY)

 +15       IF BDMER

               GOTO X2

 +16       SET V=+$PIECE($GET(BDM(1)),U,4)

           IF V=ATXPOVDA

               GOTO X2

X3         SET ATXSTOP=1

X2         KILL BDM,BDMDFN,BDMER,BDMX,BDMY

 +1        QUIT 

 +2       ;

DMREG(P)  ;is patient on any Diabetes register 1 if on reg, "" if not

 +1        IF $GET(P)=""

               QUIT ""

 +2        NEW X,Y

 +3        SET X=0

           SET Y=""

           FOR 

               SET X=$ORDER(^ACM(41,"AC",P,X))

               IF X'=+X!(Y)

                   QUIT 

               Begin DoDot:1

 +4                SET N=$$UP^XLFSTR($PIECE($GET(^ACM(41.1,X,0)),U))

 +5                IF N["DIABETES"

                       SET Y=1

 +6                IF N["DIAB"

                       SET Y=1

 +7                IF N["DM "

                       SET Y=1

 +8                IF N[" DM"

                       SET Y=1

 +9                QUIT 

               End DoDot:1

 +10       QUIT Y