APCLPDBL.m

APCLPDBL ; IHS/CMI/LAB - Routine to send bulletin if patient has certain PRE-DM test results ;

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

 ;

 Q  ;not at top

EN(T,P,V,RES) ;EP - Called by PD mumps x-ref on Results Field (.04)of V Lab File

 NEW APCLTNAM,APCLIFGT,APCLIGTT,XMB

 S APCLTNAM=$P(^LAB(60,T,0),U)  ;test name

 S APCLIFGT=$O(^ATXLAB("B","DM AUDIT FASTING GLUCOSE TESTS",0))  ;FBS taxonomy ien

 S APCLIGTT=$O(^ATXLAB("B","DM AUDIT 75GM 2HR GLUCOSE",0))  ;2 hr GTT taxonomy ien

 Q:APCLIFGT=""

 Q:APCLIGTT=""

 I $D(^ATXLAB(APCLIFGT,21,"B",T)) S XMB="APCL IFG NOTIFICATION"

 I $D(^ATXLAB(APCLIGTT,21,"B",T)),RES>139 S XMB="APCL IGT NOTIFICATION"

 Q:$G(XMB)']""

 I 'P,$D(BLRVADFN) S P=BLRVADFN

 Q:$$DMDX(P)="Yes"  ;quit if pt has DM dx 

 I $G(P) S XMB(1)=$P(^DPT(P,0),U)

 I $D(^AUPNVSIT(V)) D

 .S D=$P(^AUPNVSIT(V,0),U),XMB(2)=$$FMTE^XLFDT(D)

 .S XMB(3)=$P(^DIC(4,$P(^AUPNVSIT(V,0),U,6),0),U)  ;location of visit

 .S XMB(4)=$$COMMRES^AUPNPAT(P,"E") ;current community

 .S XMB(5)=$P($G(^AUPNPAT(P,41,DUZ(2),0)),U,2)

 .S XMB(6)=$$DOB^AUPNPAT(P,"E")  ;DOB

 .S XMB(7)=APCLTNAM

 .S XMB(8)=RES

 .S XMDUZ=.5

 .S XMDT=DT

 .D ^XMB

 ;K XMB,V,D,COMM,HRN,DOB,T,APCLIFGT,APCLIGTT,RES,APCLTNAM,APCLX

 Q

 ;

DMDX(P) ;

 ;check problem list OR must have 3 diagnoses

 N Z S Z=$O(^ATXAX("B","SURVEILLANCE DIABETES",0))

 I 'Z Q ""

 N X,Y,I S (X,Y,I)=0 F  S X=$O(^AUPNPROB("AC",P,X)) Q:X'=+X!(I)  I $D(^AUPNPROB(X,0)),$P(^AUPNPROB(X,0),U,12)'="D" S Y=$P(^AUPNPROB(X,0),U) I $$ICD^ATXAPI(Y,Z,9) S I=1

 I I Q "Yes"

 NEW APCLX,E

 S APCLX=""

 S X=P_"^LAST 3 DX [SURVEILLANCE DIABETES" S E=$$START1^APCLDF(X,"APCLX(") G:E DMX I $D(APCLX(3)) S APCLX="Yes"

 I $G(APCLX)="" S APCLX="No"

DMX ;

 Q APCLX

 ;

APCLPDBL  ; IHS/CMI/LAB - Routine to send bulletin if patient has certain PRE-DM test results ;

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

 +2       ;

 +3       ;not at top

           QUIT 

EN(T,P,V,RES) ;EP - Called by PD mumps x-ref on Results Field (.04)of V Lab File

 +1        NEW APCLTNAM,APCLIFGT,APCLIGTT,XMB

 +2       ;test name

           SET APCLTNAM=$PIECE(^LAB(60,T,0),U)

 +3       ;FBS taxonomy ien

           SET APCLIFGT=$ORDER(^ATXLAB("B","DM AUDIT FASTING GLUCOSE TESTS",0))

 +4       ;2 hr GTT taxonomy ien

           SET APCLIGTT=$ORDER(^ATXLAB("B","DM AUDIT 75GM 2HR GLUCOSE",0))

 +5        IF APCLIFGT=""

               QUIT 

 +6        IF APCLIGTT=""

               QUIT 

 +7        IF $DATA(^ATXLAB(APCLIFGT,21,"B",T))

               SET XMB="APCL IFG NOTIFICATION"

 +8        IF $DATA(^ATXLAB(APCLIGTT,21,"B",T))

               IF RES>139

                   SET XMB="APCL IGT NOTIFICATION"

 +9        IF $GET(XMB)']""

               QUIT 

 +10       IF 'P

               IF $DATA(BLRVADFN)

                   SET P=BLRVADFN

 +11      ;quit if pt has DM dx 

           IF $$DMDX(P)="Yes"

               QUIT 

 +12       IF $GET(P)

               SET XMB(1)=$PIECE(^DPT(P,0),U)

 +13       IF $DATA(^AUPNVSIT(V))

               Begin DoDot:1

 +14               SET D=$PIECE(^AUPNVSIT(V,0),U)

                   SET XMB(2)=$$FMTE^XLFDT(D)

 +15      ;location of visit

                   SET XMB(3)=$PIECE(^DIC(4,$PIECE(^AUPNVSIT(V,0),U,6),0),U)

 +16      ;current community

                   SET XMB(4)=$$COMMRES^AUPNPAT(P,"E")

 +17               SET XMB(5)=$PIECE($GET(^AUPNPAT(P,41,DUZ(2),0)),U,2)

 +18      ;DOB

                   SET XMB(6)=$$DOB^AUPNPAT(P,"E")

 +19               SET XMB(7)=APCLTNAM

 +20               SET XMB(8)=RES

 +21               SET XMDUZ=.5

 +22               SET XMDT=DT

 +23               DO ^XMB

               End DoDot:1

 +24      ;K XMB,V,D,COMM,HRN,DOB,T,APCLIFGT,APCLIGTT,RES,APCLTNAM,APCLX

 +25       QUIT 

 +26      ;

DMDX(P)   ;

 +1       ;check problem list OR must have 3 diagnoses

 +2        NEW Z

           SET Z=$ORDER(^ATXAX("B","SURVEILLANCE DIABETES",0))

 +3        IF 'Z

               QUIT ""

 +4        NEW X,Y,I

           SET (X,Y,I)=0

           FOR 

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

               IF X'=+X!(I)

                   QUIT 

               IF $DATA(^AUPNPROB(X,0))

                   IF $PIECE(^AUPNPROB(X,0),U,12)'="D"

                       SET Y=$PIECE(^AUPNPROB(X,0),U)

                       IF $$ICD^ATXAPI(Y,Z,9)

                           SET I=1

 +5        IF I

               QUIT "Yes"

 +6        NEW APCLX,E

 +7        SET APCLX=""

 +8        SET X=P_"^LAST 3 DX [SURVEILLANCE DIABETES"

           SET E=$$START1^APCLDF(X,"APCLX(")

           IF E

               GOTO DMX

           IF $DATA(APCLX(3))

               SET APCLX="Yes"

 +9        IF $GET(APCLX)=""

               SET APCLX="No"

DMX       ;

 +1        QUIT APCLX

 +2       ;