BQIRGDMS ;GDIT/HS/ALA-Diabetes Care Summary fields ; 19 Oct 2012 9:17 AM
;;2.4;ICARE MANAGEMENT SYSTEM;**3**;Apr 01, 2015;Build 5
;
DOO(DFN) ;EP
NEW X,DOO,BDMSDFN,BDMSPAT
S (BDMSDFN,BDMSPAT)=DFN
S X=$$CMSFDX^BDMS9B4(DFN,"I")
I X]"",'$D(DOO(X)) S DOO(X)="Diabetes Register"
S DOO="" S X=$$PLDMDOO(DFN,"I")
I X]"" S DOO(X)="Problem List"
I $O(DOO(0))="" Q ""
S X=$O(DOO(0)) Q $$FMTMDY^BQIUL1(X)_" ("_DOO(X)_")"
;
PLDMDOO(P,F) ;EP get first dm dx from case management
I '$G(P) Q ""
I $G(F)="" S F="E"
NEW T S T=$O(^ATXAX("B","SURVEILLANCE DIABETES",0))
I 'T Q ""
NEW D,X,I S D="",X=0 F S X=$O(^AUPNPROB("AC",P,X)) Q:X'=+X D
.Q:$P(^AUPNPROB(X,0),U,12)="D"
.S I=$P(^AUPNPROB(X,0),U)
.I $$ICD^ATXCHK(I,T,9) D
..I $P(^AUPNPROB(X,0),U,13)]"" S D($P(^AUPNPROB(X,0),U,13))=""
..Q
.Q
S D=$O(D(0))
I D="" Q D
Q $S(F="E":$$FMTE^XLFDT(D),1:D)
;
MSR(DFN,TYP) ;EP
NEW BDMX,RESULT,DATE,BDMSDFN,BDMSPAT
S (BDMSDFN,BDMSPAT)=DFN
D GETHWB^BDMS9B1(DFN)
I TYP="BMI" Q $G(BDMX("BMI"))
I TYP="HT" D Q RESULT
. I $G(BDMX("HT"))="" S RESULT="" Q
. S DATE=$$DATE^BQIUL1($G(BDMX("HTD")))
. S RESULT=BDMX("HT")_" inches ("_$$FMTMDY^BQIUL1(DATE)_")",$P(RESULT,U,4)=DATE
I TYP="WT" D Q RESULT
. I $G(BDMX("WT"))="" S RESULT="" Q
. S DATE=$$DATE^BQIUL1($G(BDMX("WTD")))
. S RESULT=BDMX("WT")_" lbs ("_$$FMTMDY^BQIUL1(DATE)_")",$P(RESULT,U,4)=DATE
I TYP="WC" D Q RESULT
. I $G(BDMX("WC"))="" S RESULT="" Q
. S DATE=$$DATE^BQIUL1($G(BDMX("WCD")))
. S RESULT=BDMX("WC")_" ("_$$FMTMDY^BQIUL1(DATE)_")",$P(RESULT,U,4)=DATE
Q ""
;
TOB(DFN) ;EP
NEW BDMTOBS
S BDMTOBS=$$TOBACCO^BDMDA1T(DFN,$$DOB^AUPNPAT(DFN),DT)
S VAL=0
I $P(BDMTOBS,U,1)=2 S VAL="1^YES"
I $P(BDMTOBS,U,1)=1 S VAL="1^NO"
Q VAL
;NEW GPYR,MEAS,PIEN,DEN,NUM,VAL
;S VAL=0
;S GPYR=$P($G(^BQI(90508,1,"GPRA")),U,1)
;S MEAS=GPYR_"_269"
;S PIEN=$O(^BQIPAT(DFN,30,"B",MEAS,"")) I PIEN="" Q VAL
;S DEN=$P($G(^BQIPAT(DFN,30,PIEN,0)),U,4)
;S NUM=+$P($G(^BQIPAT(DFN,30,PIEN,0)),U,3)
;
;I DEN="" Q VAL
;I DEN D
;. I 'NUM S VAL="1^NO" Q
;. S VAL="1^YES"
;Q VAL
;
ACE(DFN) ;EP
NEW APCHSBEG,%,BDMSDFN,BDMSPAT
S (BDMSDFN,BDMSPAT)=DFN
S APCHSBEG=$$FMADD^XLFDT(DT,-(6*30.5))
S %=$$ACE^BDMS9B4(DFN,APCHSBEG)
I %["No" Q "1^NO"
I %["Discontinued" Q 0
I %["Yes" Q "1^YES"
Q ""
;
ASP(DFN) ;EP
NEW APCHSBEG,%,BDMSDFN,BDMSPAT
S (BDMSDFN,BDMSPAT)=DFN
S BDMSBEG=$$FMADD^XLFDT(DT,-365)
S %=$$ASPIRIN^BDMS9B1(DFN,BDMSBEG)
I %["No" Q "1^NO"
I %["Discontinued" Q 0
I %["Yes" Q "1^YES"
Q ""
;
BP(DFN) ;EP
NEW LST3,N,BDMX,VALL,BDMSDFN,BDMSPAT,DATE
S (BDMSDFN,BDMSPAT)=DFN
D BP^BDMS9B1(DFN)
S LST3="",N=""
F S N=$O(BDMX(N)) Q:N="" D
. S DATE=$P(BDMX(N),U,1),VALL=$P(BDMX(N),U,2)
. S LST3=LST3_VALL_" ("_$$FMTMDY^BQIUL1(DATE)_")"_$C(13)_$C(10)
Q LST3
;
DEP(DFN) ; EP
NEW APCHDEPP,APCHDEPS,BDMSDFN,BDMSPAT
S (BDMSDFN,BDMSPAT)=DFN
S APCHDEPP=$$UP^XLFSTR($$DEPPL^BDMS9B1(DFN,$$FMADD^XLFDT(DT,-(6*30.5)),DT))
I APCHDEPP["YES" Q "1^YES (Problem List)"
S APCHDEPS=$$UP^XLFSTR($$DEPSCR^BDMDA12(DFN,$$FMADD^XLFDT(DT,-(6*30.5)),DT))
I APCHDEPS'["YES" Q "1^NO Screening"
Q ""
;
EXM(DFN,TYP) ; EP
NEW BDMSBEG,RES,BDMSDFN,BDMSPAT
S (BDMSDFN,BDMSPAT)=DFN
S BDMSBEG=$$FMADD^XLFDT(DT,-365)
I TYP="FT" D
. S RES=$$UP^XLFSTR($P($$DFE^BDMDA17(DFN,BDMSBEG,DT,"H")," ",2,99))
I TYP="EYE" D
. S RES=$$UP^XLFSTR($P($$EYE^BDMDA17(DFN,BDMSBEG,DT,"H")," ",2,99))
I TYP="DEN" D
. S RES=$$UP^XLFSTR($P($$DENTAL^BDMDA17(DFN,BDMSBEG,DT,"H")," ",2,99))
I TYP="SMB" D
. S RES=$$UP^XLFSTR($$SELF^APCHS9B3(DFN,BDMSBEG))
. I RES["NO" S RES="1^NO"
I RES="NO" Q "1^"_RES
I RES["YES" Q "1^YES"
Q "1^NO"
;
SEX(DFN,TYP) ; EP
NEW RES,BDMSPAT,BDMSDFN,APCHSDAT
S (BDMSDFN,BDMSPAT)=DFN
I $P(^DPT(DFN,0),U,2)'="F" Q "N/A"
I TYP="PAP" D
. S RES=$$FMTMDY^BQIUL1($P($$PAP^BDMS9B4(DFN),U,1))
I TYP="MAM" D
. S RES=$$FMTMDY^BQIUL1($P($$LASTMAM^APCLAPI1(DFN,,,"A"),U,1))
;. S APCHSDAT=DT
;. S APCHSDAT=$P($$LASTMAM^APCLAPI1(DFN,,,"A"),U,1)
;. S RES=$$FMTMDY^BQIUL1(APCHSDAT)
Q RES
;
DIET(DFN) ;EP
NEW RES,BDMSDFN,BDMSPAT,DATE
S (BDMSDFN,BDMSPAT)=DFN
S RES=$$DIETV^BDMS9B3(DFN)
I RES="" Q RES
S DATE=$E(RES,1,12),DATE=$$DATE^BQIUL1(DATE)
Q $$FMTMDY^BQIUL1(DATE)
;
FLU(DFN) ;EP
NEW RES,BDMSDFN,BDMSPAT
S (BDMSDFN,BDMSPAT)=DFN
S RES=$$UP^XLFSTR($$FLU^BDMS9B3(DFN))
I RES["NO" Q "1^NO"
I RES["YES" Q "1^YES"
Q "1^NO"
;
VAX(DFN) ;EP
NEW BDMSPAT,RES,BX,BDMSDFN
S (BDMSDFN,BDMSPAT)=DFN
S RES=$$UP^XLFSTR($$PNEU^BDMS9B4(DFN))
I RES="NO" Q RES
I RES["YES" D Q RES
. S DAT1=$E(RES,6,17),DAT2=$E(RES,21,32)
. S DAT1=$$DATE^BQIUL1(DAT1),DAT2=$$DATE^BQIUL1(DAT2)
. S RES=$$FMTMDY^BQIUL1(DAT1)_$C(13)_$C(10)_$$FMTMDY^BQIUL1(DAT2)
Q "NO"
;
TD(DFN) ;EP
NEW RES,BDMSDFN,BDMSPAT,DATE
S (BDMSDFN,BDMSPAT)=DFN
S RES=$$UP^XLFSTR($$TD^BDMS9B3(DFN,(DT-100000)))
I RES["YES" S DATE=$E(RES,6,17),DATE=$$DATE^BQIUL1(DATE),RES=$$FMTMDY^BQIUL1(DATE) Q RES
I RES'["YES" S RES=""
Q RES
;
RAD(DFN,TYP) ;EP
NEW RES,BDMSDFN,BDMSPAT,DATE
S (BDMSDFN,BDMSPAT)=DFN
I TYP="EKG" D
. S RES=$$EKG^APCHS9B7(DFN),DATE=$P(RES,U,1)
I TYP="CHEST" D
. S DATE=$$CHEST^BDMS9B3(DFN)
I DATE="" Q DATE
S DATE=$$DATE^BQIUL1(DATE)
Q $$FMTMDY^BQIUL1(DATE)
;
PPDS(DFN) ;EP
NEW BDMSDFN,BDMSPAT
S (BDMSDFN,BDMSPAT)=DFN
Q $$PPDS^BDMS9B4(DFN)
;
PPD(DFN) ;EP
NEW BDMSDFN,BDMSPAT
S (BDMSDFN,BDMSPAT)=DFN
Q $$PPD^BDMS9B4(DFN)
;
TB(DFN) ;EP
NEW BDMSDFN,BDMSPAT
S (BDMSDFN,BDMSPAT)=DFN
Q $$TB^BDMS9B2(BQDFN)
;
TBHF(DFN) ;EP
NEW BDMSDFN,BDMSPAT
S (BDMSDFN,BDMSPAT)=DFN
Q $$TB^BDMS9B2(DFN)
;
A1C(DFN) ;EP
NEW RES,DATE,RIEN,VISIT,RESULT
S RES=$$HBA1C^BDMS9B2(DFN)
I RES="||||||" Q ""
S DATE=$P(RES,"|",4),DATE=$$DATE^BQIUL1(DATE)
S RESULT=$P(RES,"|",1)_" ("_$$FMTMDY^BQIUL1(DATE)_")",$P(RESULT,U,4)=DATE
S RIEN=$P(RES,"|",10) I RIEN'="" S VISIT=$P($G(^AUPNVLAB(RIEN,0)),U,3),$P(RESULT,U,2)=VISIT
Q RESULT
;
NA1C(DFN) ;EP
NEW RES,DATE,RESULT
S RES=$$NLHGB^BDMS9B2(DFN)
I RES="" Q ""
S DATE=$P(RES,"|",4),DATE=$$DATE^BQIUL1(DATE)
S RESULT=$P(RES,"|",1)_" ("_$$FMTMDY^BQIUL1(DATE)_")",$P(RESULT,U,4)=DATE
Q RESULT
;
NEP(DFN,TYP) ;EP
NEW RES,DATE,RESULT
I TYP="UR" D
. S RES=$$URIN^APCHS9B2(DFN)
I TYP="MIC" D
. S RES=$$MICRO^APCHS9B2(DFN)
I TYP="RATIO" D
. S RES=$$ACRATIO^BDMS9B2(DFN)
I TYP="CREAT" D
. S RES=$$CREAT^BDMS9B2(DFN)
I TYP="GFR" D
. S RES=$$GFR^BDMS9B2(DFN)
I TYP="TCHOL" D
. S RES=$$TCHOL^BDMS9B2(DFN)
I TYP="CHOL" D
. S RES=$$CHOL^BDMS9B2(DFN)
I TYP="NHDL" D
. S RES=$$NONHDL^BDMS9B2(DFN)
I TYP="HDL" D
. S RES=$$HDL^BDMS9B2(DFN)
I TYP="TRIG" D
. S RES=$$TRIG^BDMS9B2(DFN)
I RES=""!(RES="||||||") Q ""
S DATE=$P(RES,"|",4),DATE=$$DATE^BQIUL1(DATE)
S RESULT=$P(RES,"|",1)_" ("_$$FMTMDY^BQIUL1(DATE)_")",$P(RESULT,U,4)=DATE
S RIEN=$P(RES,"|",10) I RIEN'="" S VISIT=$P($G(^AUPNVLAB(RIEN,0)),U,3),$P(RESULT,U,2)=VISIT
Q RESULT
;
HEPB(DFN) ;EP
NEW RES
S RES=$$HEP^BDMD413(DFN,DT,"","")
I RES["No" Q "NO"
I RES["Yes" Q "YES"
Q ""
;
DIETV(P) ;EP
;go through all visits in AA and get last to Prov 29 or
NEW D,V,G,X S (D,V,G)="" F S D=$O(^AUPNVSIT("AA",P,D)) Q:D'=+D!(G) D
.S V=0 F S V=$O(^AUPNVSIT("AA",P,D,V)) Q:V'=+V!(G) D
..Q:'$D(^AUPNVSIT(V,0))
..Q:$P(^AUPNVSIT(V,0),U,11)
..Q:'$P(^AUPNVSIT(V,0),U,9)
..Q:'$D(^AUPNVPOV("AD",V))
..Q:'$D(^AUPNVPRV("AD",V))
..Q:$$DNKA^APCHS9B4(V)
..Q:$$CLINIC^APCLV(V,"C")=52 ;chart review
..I $P(^AUPNVSIT(V,0),U,7)="C" Q ;chart review
..I $$CLINIC^APCLV(V,"C")=67 S G=V Q
..S X=$$DIETP(V) ; is there a prov 07 or 29
..I X S G=V Q
..Q
.Q
I 'G Q ""
Q $$FMTE^XLFDT($P($P(^AUPNVSIT(G,0),U),"."))_" "_$E($$PRIMPOV^APCLV(G,"N"),1,39)
;
DIETP(V) ;are any providers an 07 or 29
I '$G(V) Q ""
NEW X,Y,Z,H
S H="",Z=0 F S Z=$O(^AUPNVPRV("AD",V,Z)) Q:Z'=+Z!(H) D
.S Y=$P(^AUPNVPRV(Z,0),U) ;provider ien
.I Y=0 Q
.I $P(^DD(9000010.06,.01,0),U,2)[200 S Y=$$PROVCLSC^XBFUNC1(Y) I Y=29!(Y="07") S H=1 Q
.I $P(^DD(9000010.06,.01,0),U,2)[6 S Y=$P($G(^DIC(6,Y,0)),U,4) I Y S Y=$P($G(^DIC(7,Y,9999999)),U,1) I Y="07"!(Y=29) S H=1
.Q
Q H
;
GLS(DATA,FAKE) ;EP - BQI GET DIABETES GLOSSARY
NEW UID,II,TRIEN,CAT,TIT,SORT,RMK,REMARK,CT,NXT,GLIEN,IEN
;
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIRGDMGLS",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIRGDMS D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S @DATA@(II)="T32767REPORT_TEXT"_$C(30)
S GLIEN=$O(^BQI(90508.2,"B","Diabetes","")) I GLIEN="" S BMXSEC="Problem with Diabetes glossary in file 90508.2" G DONE
S IEN=0 F S IEN=$O(^BQI(90508.2,GLIEN,1,IEN)) Q:'IEN D
. S II=II+1,@DATA@(II)=$G(^BQI(90508.2,GLIEN,1,IEN,0))
I II>0 S @DATA@(II)=@DATA@(II)_$C(30)
;
DONE S II=II+1,@DATA@(II)=$C(31)
Q
;
ERR ;
D ^%ZTER
NEW Y,ERRDTM
S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
S BMXSEC="Recording that an error occurred at "_ERRDTM
I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
Q
BQIRGDMS ;GDIT/HS/ALA-Diabetes Care Summary fields ; 19 Oct 2012 9:17 AM
+1 ;;2.4;ICARE MANAGEMENT SYSTEM;**3**;Apr 01, 2015;Build 5
+2 ;
DOO(DFN) ;EP
+1 NEW X,DOO,BDMSDFN,BDMSPAT
+2 SET (BDMSDFN,BDMSPAT)=DFN
+3 SET X=$$CMSFDX^BDMS9B4(DFN,"I")
+4 IF X]""
IF '$DATA(DOO(X))
SET DOO(X)="Diabetes Register"
+5 SET DOO=""
SET X=$$PLDMDOO(DFN,"I")
+6 IF X]""
SET DOO(X)="Problem List"
+7 IF $ORDER(DOO(0))=""
QUIT ""
+8 SET X=$ORDER(DOO(0))
QUIT $$FMTMDY^BQIUL1(X)_" ("_DOO(X)_")"
+9 ;
PLDMDOO(P,F) ;EP get first dm dx from case management
+1 IF '$GET(P)
QUIT ""
+2 IF $GET(F)=""
SET F="E"
+3 NEW T
SET T=$ORDER(^ATXAX("B","SURVEILLANCE DIABETES",0))
+4 IF 'T
QUIT ""
+5 NEW D,X,I
SET D=""
SET X=0
FOR
SET X=$ORDER(^AUPNPROB("AC",P,X))
IF X'=+X
QUIT
Begin DoDot:1
+6 IF $PIECE(^AUPNPROB(X,0),U,12)="D"
QUIT
+7 SET I=$PIECE(^AUPNPROB(X,0),U)
+8 IF $$ICD^ATXCHK(I,T,9)
Begin DoDot:2
+9 IF $PIECE(^AUPNPROB(X,0),U,13)]""
SET D($PIECE(^AUPNPROB(X,0),U,13))=""
+10 QUIT
End DoDot:2
+11 QUIT
End DoDot:1
+12 SET D=$ORDER(D(0))
+13 IF D=""
QUIT D
+14 QUIT $SELECT(F="E":$$FMTE^XLFDT(D),1:D)
+15 ;
MSR(DFN,TYP) ;EP
+1 NEW BDMX,RESULT,DATE,BDMSDFN,BDMSPAT
+2 SET (BDMSDFN,BDMSPAT)=DFN
+3 DO GETHWB^BDMS9B1(DFN)
+4 IF TYP="BMI"
QUIT $GET(BDMX("BMI"))
+5 IF TYP="HT"
Begin DoDot:1
+6 IF $GET(BDMX("HT"))=""
SET RESULT=""
QUIT
+7 SET DATE=$$DATE^BQIUL1($GET(BDMX("HTD")))
+8 SET RESULT=BDMX("HT")_" inches ("_$$FMTMDY^BQIUL1(DATE)_")"
SET $PIECE(RESULT,U,4)=DATE
End DoDot:1
QUIT RESULT
+9 IF TYP="WT"
Begin DoDot:1
+10 IF $GET(BDMX("WT"))=""
SET RESULT=""
QUIT
+11 SET DATE=$$DATE^BQIUL1($GET(BDMX("WTD")))
+12 SET RESULT=BDMX("WT")_" lbs ("_$$FMTMDY^BQIUL1(DATE)_")"
SET $PIECE(RESULT,U,4)=DATE
End DoDot:1
QUIT RESULT
+13 IF TYP="WC"
Begin DoDot:1
+14 IF $GET(BDMX("WC"))=""
SET RESULT=""
QUIT
+15 SET DATE=$$DATE^BQIUL1($GET(BDMX("WCD")))
+16 SET RESULT=BDMX("WC")_" ("_$$FMTMDY^BQIUL1(DATE)_")"
SET $PIECE(RESULT,U,4)=DATE
End DoDot:1
QUIT RESULT
+17 QUIT ""
+18 ;
TOB(DFN) ;EP
+1 NEW BDMTOBS
+2 SET BDMTOBS=$$TOBACCO^BDMDA1T(DFN,$$DOB^AUPNPAT(DFN),DT)
+3 SET VAL=0
+4 IF $PIECE(BDMTOBS,U,1)=2
SET VAL="1^YES"
+5 IF $PIECE(BDMTOBS,U,1)=1
SET VAL="1^NO"
+6 QUIT VAL
+7 ;NEW GPYR,MEAS,PIEN,DEN,NUM,VAL
+8 ;S VAL=0
+9 ;S GPYR=$P($G(^BQI(90508,1,"GPRA")),U,1)
+10 ;S MEAS=GPYR_"_269"
+11 ;S PIEN=$O(^BQIPAT(DFN,30,"B",MEAS,"")) I PIEN="" Q VAL
+12 ;S DEN=$P($G(^BQIPAT(DFN,30,PIEN,0)),U,4)
+13 ;S NUM=+$P($G(^BQIPAT(DFN,30,PIEN,0)),U,3)
+14 ;
+15 ;I DEN="" Q VAL
+16 ;I DEN D
+17 ;. I 'NUM S VAL="1^NO" Q
+18 ;. S VAL="1^YES"
+19 ;Q VAL
+20 ;
ACE(DFN) ;EP
+1 NEW APCHSBEG,%,BDMSDFN,BDMSPAT
+2 SET (BDMSDFN,BDMSPAT)=DFN
+3 SET APCHSBEG=$$FMADD^XLFDT(DT,-(6*30.5))
+4 SET %=$$ACE^BDMS9B4(DFN,APCHSBEG)
+5 IF %["No"
QUIT "1^NO"
+6 IF %["Discontinued"
QUIT 0
+7 IF %["Yes"
QUIT "1^YES"
+8 QUIT ""
+9 ;
ASP(DFN) ;EP
+1 NEW APCHSBEG,%,BDMSDFN,BDMSPAT
+2 SET (BDMSDFN,BDMSPAT)=DFN
+3 SET BDMSBEG=$$FMADD^XLFDT(DT,-365)
+4 SET %=$$ASPIRIN^BDMS9B1(DFN,BDMSBEG)
+5 IF %["No"
QUIT "1^NO"
+6 IF %["Discontinued"
QUIT 0
+7 IF %["Yes"
QUIT "1^YES"
+8 QUIT ""
+9 ;
BP(DFN) ;EP
+1 NEW LST3,N,BDMX,VALL,BDMSDFN,BDMSPAT,DATE
+2 SET (BDMSDFN,BDMSPAT)=DFN
+3 DO BP^BDMS9B1(DFN)
+4 SET LST3=""
SET N=""
+5 FOR
SET N=$ORDER(BDMX(N))
IF N=""
QUIT
Begin DoDot:1
+6 SET DATE=$PIECE(BDMX(N),U,1)
SET VALL=$PIECE(BDMX(N),U,2)
+7 SET LST3=LST3_VALL_" ("_$$FMTMDY^BQIUL1(DATE)_")"_$CHAR(13)_$CHAR(10)
End DoDot:1
+8 QUIT LST3
+9 ;
DEP(DFN) ; EP
+1 NEW APCHDEPP,APCHDEPS,BDMSDFN,BDMSPAT
+2 SET (BDMSDFN,BDMSPAT)=DFN
+3 SET APCHDEPP=$$UP^XLFSTR($$DEPPL^BDMS9B1(DFN,$$FMADD^XLFDT(DT,-(6*30.5)),DT))
+4 IF APCHDEPP["YES"
QUIT "1^YES (Problem List)"
+5 SET APCHDEPS=$$UP^XLFSTR($$DEPSCR^BDMDA12(DFN,$$FMADD^XLFDT(DT,-(6*30.5)),DT))
+6 IF APCHDEPS'["YES"
QUIT "1^NO Screening"
+7 QUIT ""
+8 ;
EXM(DFN,TYP) ; EP
+1 NEW BDMSBEG,RES,BDMSDFN,BDMSPAT
+2 SET (BDMSDFN,BDMSPAT)=DFN
+3 SET BDMSBEG=$$FMADD^XLFDT(DT,-365)
+4 IF TYP="FT"
Begin DoDot:1
+5 SET RES=$$UP^XLFSTR($PIECE($$DFE^BDMDA17(DFN,BDMSBEG,DT,"H")," ",2,99))
End DoDot:1
+6 IF TYP="EYE"
Begin DoDot:1
+7 SET RES=$$UP^XLFSTR($PIECE($$EYE^BDMDA17(DFN,BDMSBEG,DT,"H")," ",2,99))
End DoDot:1
+8 IF TYP="DEN"
Begin DoDot:1
+9 SET RES=$$UP^XLFSTR($PIECE($$DENTAL^BDMDA17(DFN,BDMSBEG,DT,"H")," ",2,99))
End DoDot:1
+10 IF TYP="SMB"
Begin DoDot:1
+11 SET RES=$$UP^XLFSTR($$SELF^APCHS9B3(DFN,BDMSBEG))
+12 IF RES["NO"
SET RES="1^NO"
End DoDot:1
+13 IF RES="NO"
QUIT "1^"_RES
+14 IF RES["YES"
QUIT "1^YES"
+15 QUIT "1^NO"
+16 ;
SEX(DFN,TYP) ; EP
+1 NEW RES,BDMSPAT,BDMSDFN,APCHSDAT
+2 SET (BDMSDFN,BDMSPAT)=DFN
+3 IF $PIECE(^DPT(DFN,0),U,2)'="F"
QUIT "N/A"
+4 IF TYP="PAP"
Begin DoDot:1
+5 SET RES=$$FMTMDY^BQIUL1($PIECE($$PAP^BDMS9B4(DFN),U,1))
End DoDot:1
+6 IF TYP="MAM"
Begin DoDot:1
+7 SET RES=$$FMTMDY^BQIUL1($PIECE($$LASTMAM^APCLAPI1(DFN,,,"A"),U,1))
End DoDot:1
+8 ;. S APCHSDAT=DT
+9 ;. S APCHSDAT=$P($$LASTMAM^APCLAPI1(DFN,,,"A"),U,1)
+10 ;. S RES=$$FMTMDY^BQIUL1(APCHSDAT)
+11 QUIT RES
+12 ;
DIET(DFN) ;EP
+1 NEW RES,BDMSDFN,BDMSPAT,DATE
+2 SET (BDMSDFN,BDMSPAT)=DFN
+3 SET RES=$$DIETV^BDMS9B3(DFN)
+4 IF RES=""
QUIT RES
+5 SET DATE=$EXTRACT(RES,1,12)
SET DATE=$$DATE^BQIUL1(DATE)
+6 QUIT $$FMTMDY^BQIUL1(DATE)
+7 ;
FLU(DFN) ;EP
+1 NEW RES,BDMSDFN,BDMSPAT
+2 SET (BDMSDFN,BDMSPAT)=DFN
+3 SET RES=$$UP^XLFSTR($$FLU^BDMS9B3(DFN))
+4 IF RES["NO"
QUIT "1^NO"
+5 IF RES["YES"
QUIT "1^YES"
+6 QUIT "1^NO"
+7 ;
VAX(DFN) ;EP
+1 NEW BDMSPAT,RES,BX,BDMSDFN
+2 SET (BDMSDFN,BDMSPAT)=DFN
+3 SET RES=$$UP^XLFSTR($$PNEU^BDMS9B4(DFN))
+4 IF RES="NO"
QUIT RES
+5 IF RES["YES"
Begin DoDot:1
+6 SET DAT1=$EXTRACT(RES,6,17)
SET DAT2=$EXTRACT(RES,21,32)
+7 SET DAT1=$$DATE^BQIUL1(DAT1)
SET DAT2=$$DATE^BQIUL1(DAT2)
+8 SET RES=$$FMTMDY^BQIUL1(DAT1)_$CHAR(13)_$CHAR(10)_$$FMTMDY^BQIUL1(DAT2)
End DoDot:1
QUIT RES
+9 QUIT "NO"
+10 ;
TD(DFN) ;EP
+1 NEW RES,BDMSDFN,BDMSPAT,DATE
+2 SET (BDMSDFN,BDMSPAT)=DFN
+3 SET RES=$$UP^XLFSTR($$TD^BDMS9B3(DFN,(DT-100000)))
+4 IF RES["YES"
SET DATE=$EXTRACT(RES,6,17)
SET DATE=$$DATE^BQIUL1(DATE)
SET RES=$$FMTMDY^BQIUL1(DATE)
QUIT RES
+5 IF RES'["YES"
SET RES=""
+6 QUIT RES
+7 ;
RAD(DFN,TYP) ;EP
+1 NEW RES,BDMSDFN,BDMSPAT,DATE
+2 SET (BDMSDFN,BDMSPAT)=DFN
+3 IF TYP="EKG"
Begin DoDot:1
+4 SET RES=$$EKG^APCHS9B7(DFN)
SET DATE=$PIECE(RES,U,1)
End DoDot:1
+5 IF TYP="CHEST"
Begin DoDot:1
+6 SET DATE=$$CHEST^BDMS9B3(DFN)
End DoDot:1
+7 IF DATE=""
QUIT DATE
+8 SET DATE=$$DATE^BQIUL1(DATE)
+9 QUIT $$FMTMDY^BQIUL1(DATE)
+10 ;
PPDS(DFN) ;EP
+1 NEW BDMSDFN,BDMSPAT
+2 SET (BDMSDFN,BDMSPAT)=DFN
+3 QUIT $$PPDS^BDMS9B4(DFN)
+4 ;
PPD(DFN) ;EP
+1 NEW BDMSDFN,BDMSPAT
+2 SET (BDMSDFN,BDMSPAT)=DFN
+3 QUIT $$PPD^BDMS9B4(DFN)
+4 ;
TB(DFN) ;EP
+1 NEW BDMSDFN,BDMSPAT
+2 SET (BDMSDFN,BDMSPAT)=DFN
+3 QUIT $$TB^BDMS9B2(BQDFN)
+4 ;
TBHF(DFN) ;EP
+1 NEW BDMSDFN,BDMSPAT
+2 SET (BDMSDFN,BDMSPAT)=DFN
+3 QUIT $$TB^BDMS9B2(DFN)
+4 ;
A1C(DFN) ;EP
+1 NEW RES,DATE,RIEN,VISIT,RESULT
+2 SET RES=$$HBA1C^BDMS9B2(DFN)
+3 IF RES="||||||"
QUIT ""
+4 SET DATE=$PIECE(RES,"|",4)
SET DATE=$$DATE^BQIUL1(DATE)
+5 SET RESULT=$PIECE(RES,"|",1)_" ("_$$FMTMDY^BQIUL1(DATE)_")"
SET $PIECE(RESULT,U,4)=DATE
+6 SET RIEN=$PIECE(RES,"|",10)
IF RIEN'=""
SET VISIT=$PIECE($GET(^AUPNVLAB(RIEN,0)),U,3)
SET $PIECE(RESULT,U,2)=VISIT
+7 QUIT RESULT
+8 ;
NA1C(DFN) ;EP
+1 NEW RES,DATE,RESULT
+2 SET RES=$$NLHGB^BDMS9B2(DFN)
+3 IF RES=""
QUIT ""
+4 SET DATE=$PIECE(RES,"|",4)
SET DATE=$$DATE^BQIUL1(DATE)
+5 SET RESULT=$PIECE(RES,"|",1)_" ("_$$FMTMDY^BQIUL1(DATE)_")"
SET $PIECE(RESULT,U,4)=DATE
+6 QUIT RESULT
+7 ;
NEP(DFN,TYP) ;EP
+1 NEW RES,DATE,RESULT
+2 IF TYP="UR"
Begin DoDot:1
+3 SET RES=$$URIN^APCHS9B2(DFN)
End DoDot:1
+4 IF TYP="MIC"
Begin DoDot:1
+5 SET RES=$$MICRO^APCHS9B2(DFN)
End DoDot:1
+6 IF TYP="RATIO"
Begin DoDot:1
+7 SET RES=$$ACRATIO^BDMS9B2(DFN)
End DoDot:1
+8 IF TYP="CREAT"
Begin DoDot:1
+9 SET RES=$$CREAT^BDMS9B2(DFN)
End DoDot:1
+10 IF TYP="GFR"
Begin DoDot:1
+11 SET RES=$$GFR^BDMS9B2(DFN)
End DoDot:1
+12 IF TYP="TCHOL"
Begin DoDot:1
+13 SET RES=$$TCHOL^BDMS9B2(DFN)
End DoDot:1
+14 IF TYP="CHOL"
Begin DoDot:1
+15 SET RES=$$CHOL^BDMS9B2(DFN)
End DoDot:1
+16 IF TYP="NHDL"
Begin DoDot:1
+17 SET RES=$$NONHDL^BDMS9B2(DFN)
End DoDot:1
+18 IF TYP="HDL"
Begin DoDot:1
+19 SET RES=$$HDL^BDMS9B2(DFN)
End DoDot:1
+20 IF TYP="TRIG"
Begin DoDot:1
+21 SET RES=$$TRIG^BDMS9B2(DFN)
End DoDot:1
+22 IF RES=""!(RES="||||||")
QUIT ""
+23 SET DATE=$PIECE(RES,"|",4)
SET DATE=$$DATE^BQIUL1(DATE)
+24 SET RESULT=$PIECE(RES,"|",1)_" ("_$$FMTMDY^BQIUL1(DATE)_")"
SET $PIECE(RESULT,U,4)=DATE
+25 SET RIEN=$PIECE(RES,"|",10)
IF RIEN'=""
SET VISIT=$PIECE($GET(^AUPNVLAB(RIEN,0)),U,3)
SET $PIECE(RESULT,U,2)=VISIT
+26 QUIT RESULT
+27 ;
HEPB(DFN) ;EP
+1 NEW RES
+2 SET RES=$$HEP^BDMD413(DFN,DT,"","")
+3 IF RES["No"
QUIT "NO"
+4 IF RES["Yes"
QUIT "YES"
+5 QUIT ""
+6 ;
DIETV(P) ;EP
+1 ;go through all visits in AA and get last to Prov 29 or
+2 NEW D,V,G,X
SET (D,V,G)=""
FOR
SET D=$ORDER(^AUPNVSIT("AA",P,D))
IF D'=+D!(G)
QUIT
Begin DoDot:1
+3 SET V=0
FOR
SET V=$ORDER(^AUPNVSIT("AA",P,D,V))
IF V'=+V!(G)
QUIT
Begin DoDot:2
+4 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+5 IF $PIECE(^AUPNVSIT(V,0),U,11)
QUIT
+6 IF '$PIECE(^AUPNVSIT(V,0),U,9)
QUIT
+7 IF '$DATA(^AUPNVPOV("AD",V))
QUIT
+8 IF '$DATA(^AUPNVPRV("AD",V))
QUIT
+9 IF $$DNKA^APCHS9B4(V)
QUIT
+10 ;chart review
IF $$CLINIC^APCLV(V,"C")=52
QUIT
+11 ;chart review
IF $PIECE(^AUPNVSIT(V,0),U,7)="C"
QUIT
+12 IF $$CLINIC^APCLV(V,"C")=67
SET G=V
QUIT
+13 ; is there a prov 07 or 29
SET X=$$DIETP(V)
+14 IF X
SET G=V
QUIT
+15 QUIT
End DoDot:2
+16 QUIT
End DoDot:1
+17 IF 'G
QUIT ""
+18 QUIT $$FMTE^XLFDT($PIECE($PIECE(^AUPNVSIT(G,0),U),"."))_" "_$EXTRACT($$PRIMPOV^APCLV(G,"N"),1,39)
+19 ;
DIETP(V) ;are any providers an 07 or 29
+1 IF '$GET(V)
QUIT ""
+2 NEW X,Y,Z,H
+3 SET H=""
SET Z=0
FOR
SET Z=$ORDER(^AUPNVPRV("AD",V,Z))
IF Z'=+Z!(H)
QUIT
Begin DoDot:1
+4 ;provider ien
SET Y=$PIECE(^AUPNVPRV(Z,0),U)
+5 IF Y=0
QUIT
+6 IF $PIECE(^DD(9000010.06,.01,0),U,2)[200
SET Y=$$PROVCLSC^XBFUNC1(Y)
IF Y=29!(Y="07")
SET H=1
QUIT
+7 IF $PIECE(^DD(9000010.06,.01,0),U,2)[6
SET Y=$PIECE($GET(^DIC(6,Y,0)),U,4)
IF Y
SET Y=$PIECE($GET(^DIC(7,Y,9999999)),U,1)
IF Y="07"!(Y=29)
SET H=1
+8 QUIT
End DoDot:1
+9 QUIT H
+10 ;
GLS(DATA,FAKE) ;EP - BQI GET DIABETES GLOSSARY
+1 NEW UID,II,TRIEN,CAT,TIT,SORT,RMK,REMARK,CT,NXT,GLIEN,IEN
+2 ;
+3 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+4 SET DATA=$NAME(^TMP("BQIRGDMGLS",UID))
+5 KILL @DATA
+6 ;
+7 SET II=0
+8 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIRGDMS D UNWIND^%ZTER"
+9 ;
+10 SET @DATA@(II)="T32767REPORT_TEXT"_$CHAR(30)
+11 SET GLIEN=$ORDER(^BQI(90508.2,"B","Diabetes",""))
IF GLIEN=""
SET BMXSEC="Problem with Diabetes glossary in file 90508.2"
GOTO DONE
+12 SET IEN=0
FOR
SET IEN=$ORDER(^BQI(90508.2,GLIEN,1,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+13 SET II=II+1
SET @DATA@(II)=$GET(^BQI(90508.2,GLIEN,1,IEN,0))
End DoDot:1
+14 IF II>0
SET @DATA@(II)=@DATA@(II)_$CHAR(30)
+15 ;
DONE SET II=II+1
SET @DATA@(II)=$CHAR(31)
+1 QUIT
+2 ;
ERR ;
+1 DO ^%ZTER
+2 NEW Y,ERRDTM
+3 SET Y=$$NOW^XLFDT()
XECUTE ^DD("DD")
SET ERRDTM=Y
+4 SET BMXSEC="Recording that an error occurred at "_ERRDTM
+5 IF $DATA(II)
IF $DATA(DATA)
SET II=II+1
SET @DATA@(II)=$CHAR(31)
+6 QUIT
