APCLDMNC.m

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

 ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58

 ;

 ;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 APCL

 S APCLY="APCL("

 S APCLX=$P(^AUPNVPOV(ATXPOVDA,0),U,2)_"^FIRST DX [APCL DIABETES REG NEW CASE" S APCLER=$$START1^APCLDF(APCLX,APCLY)

 I APCLER S ATXSTOP=1 G X1

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

 S ATXSTOP=1

X1 K APCL,APCLER,APCLX,APCLY

 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 APCLDMRG=+Y

 K ATXSTOP

 Q:'ATXPOVDA

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

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

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

 ;I '$D(^ACM(41,"AC",APCLDFN,APCLDMRG)) G X3

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

 K APCL

 S APCLY="APCL("

 ;S APCLX=APCLDFN_"^FIRST DX "_$P(^ICD9(ATXICD,0),U) S APCLER=$$START1^APCLDF(APCLX,APCLY)  ;cmi/anch/maw 9/10/2007 orig line

 S APCLX=APCLDFN_"^FIRST DX "_$P($$ICDDX^ICDEX(ATXICD),U,2) S APCLER=$$START1^APCLDF(APCLX,APCLY)  ;cmi/anch/maw 9/10/2007 csv

 I APCLER G X2

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

X3 S ATXSTOP=1

X2 K APCL,APCLDFN,APCLER,APCLX,APCLY

 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

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

 +1       ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58

 +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 APCL

 +6        SET APCLY="APCL("

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

           SET APCLER=$$START1^APCLDF(APCLX,APCLY)

 +8        IF APCLER

               SET ATXSTOP=1

               GOTO X1

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

           IF V=ATXPOVDA

               GOTO X1

 +10       SET ATXSTOP=1

X1         KILL APCL,APCLER,APCLX,APCLY

 +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 APCLDMRG=+Y

 +4        KILL ATXSTOP

 +5        IF 'ATXPOVDA

               QUIT 

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

               QUIT 

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

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

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

 +10      ;IHS/CMI/GRL

           IF '$$DMREG(APCLDFN)

               GOTO X3

 +11       KILL APCL

 +12       SET APCLY="APCL("

 +13      ;S APCLX=APCLDFN_"^FIRST DX "_$P(^ICD9(ATXICD,0),U) S APCLER=$$START1^APCLDF(APCLX,APCLY)  ;cmi/anch/maw 9/10/2007 orig line

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

           SET APCLX=APCLDFN_"^FIRST DX "_$PIECE($$ICDDX^ICDEX(ATXICD),U,2)

           SET APCLER=$$START1^APCLDF(APCLX,APCLY)

 +15       IF APCLER

               GOTO X2

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

           IF V=ATXPOVDA

               GOTO X2

X3         SET ATXSTOP=1

X2         KILL APCL,APCLDFN,APCLER,APCLX,APCLY

 +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