Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BQIRGDMS

BQIRGDMS.m

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