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

BDMD210.m

Go to the documentation of this file. 
  1. BDMD210 ; IHS/CMI/LAB -IHS -GETS DATA FOR DIABETES QA REPORT ;
  1.  ;;2.0;DIABETES MANAGEMENT SYSTEM;**2**;JUN 14, 2007
  1.  ;
  1.  ;
  1. EN ; - ENTRY POINT - from ^BDMASK
  1.  K ^BDMDATA("BDMEPI",$J)
  1.  S ^XTMP("BDMDM21",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^DM AUDIT 2001"
  1.  S BDMEPIN=0
  1.  S BDMPD=0 F  S BDMPD=$O(^XTMP("BDMDM21",BDMJOB,BDMBTH,"PATS",BDMPD)) Q:'BDMPD  D
  1.  .I BDMPREP=2 D EPIREC Q
  1.  .D GATHER
  1.  I BDMPREP=2 D WRITEF^BDMD21 Q
  1.  I BDMPREP=3!(BDMPREP=4) D CUML^BDMD215
  1.  Q
  1. S(P,I,V) ;
  1.  S ^XTMP("BDMDM21",BDMJOB,BDMBTH,"AUDIT",P,I)=V
  1.  Q
  1. REC(DFN,BDMRTYP,BDMRBD,BDMRED,BDMED,BDMDMRG) ;EP - called to send back a visit record as
  1.  NEW BDMX,BDMREC
  1.  S BDMREC=""
  1.  S BDMRTYP("IEN")=$O(^BDMRECD("B",BDMRTYP,0))
  1.  I 'BDMRTYP("IEN") Q BDMREC
  1. PROC ;
  1.  S BDMX=0
  1.  F  S BDMX=$O(^BDMRECD(BDMRTYP("IEN"),11,"AC",BDMX)) Q:BDMX'=+BDMX!(BDMREC=-1)  S BDMTTT=$O(^BDMRECD(BDMRTYP("IEN"),11,"AC",BDMX,0))  D
  1.  .S X="" X:$D(^BDMRECD(BDMRTYP("IEN"),11,BDMTTT,11)) ^BDMRECD(BDMRTYP("IEN"),11,BDMTTT,11)
  1.  .S $E(BDMREC,$P(^BDMRECD(BDMRTYP("IEN"),11,BDMTTT,0),U,2))=X ;W !,BDMTTT,?5,$P(^BDMRECD(BDMRTYP("IEN"),11,BDMTTT,0),U),?40,X H 2
  1.  Q BDMREC
  1. EPIREC ;create epi info record in ^BDMDATA("BDMEPI",$J,n)
  1.  S BDMEPIR="",BDMEPIR=$$REC(BDMPD,"DM AUDIT 2001 EPI REC 1",BDMRBD,BDMRED,BDMADAT,BDMDMRG),BDMEPIN=BDMEPIN+1,^BDMDATA("BDMEPI",$J,BDMEPIN)=BDMEPIR
  1.  S BDMEPIR="",BDMEPIR=$$REC(BDMPD,"DM AUDIT 2001 EPI REC 2",BDMRBD,BDMRED,BDMADAT,BDMDMRG),BDMEPIN=BDMEPIN+1,^BDMDATA("BDMEPI",$J,BDMEPIN)=BDMEPIR
  1.  S BDMEPIR="",BDMEPIR=$$REC(BDMPD,"DM AUDIT 2001 EPI REC 3",BDMRBD,BDMRED,BDMADAT,BDMDMRG),BDMEPIN=BDMEPIN+1,^BDMDATA("BDMEPI",$J,BDMEPIN)=BDMEPIR
  1.  S BDMEPIR="",BDMEPIR=$$REC(BDMPD,"DM AUDIT 2001 EPI REC 4",BDMRBD,BDMRED,BDMADAT,BDMDMRG),BDMEPIN=BDMEPIN+1,^BDMDATA("BDMEPI",$J,BDMEPIN)=BDMEPIR
  1.  Q
  1. GATHER ;gather data for 1 patient
  1.  S BDMER=0
  1.  ;set report dates
  1.  S ^XTMP("BDMDM21",BDMJOB,BDMBTH,"AUDIT",BDMPD,1)=$S($G(BDMFISC)]"":BDMFISC,1:BDMRBD_" - "_BDMRED)
  1.  ;set audit date to DT
  1.  S ^XTMP("BDMDM21",BDMJOB,BDMBTH,"AUDIT",BDMPD,2)=$$FMTE^XLFDT(DT)
  1.  ;set area, su, facility code and name
  1.  S ^XTMP("BDMDM21",BDMJOB,BDMBTH,"AUDIT",BDMPD,4)=$P(^DIC(4,DUZ(2),0),U)
  1.  S ^XTMP("BDMDM21",BDMJOB,BDMBTH,"AUDIT",BDMPD,6)=$E($P(^AUTTLOC(DUZ(2),0),U,10),1,2)
  1.  S ^XTMP("BDMDM21",BDMJOB,BDMBTH,"AUDIT",BDMPD,8)=$E($P(^AUTTLOC(DUZ(2),0),U,10),3,4)
  1.  S ^XTMP("BDMDM21",BDMJOB,BDMBTH,"AUDIT",BDMPD,10)=$E($P(^AUTTLOC(DUZ(2),0),U,10),5,6)
  1.  ;# pats in register
  1.  S ^XTMP("BDMDM21",BDMJOB,BDMBTH,"AUDIT",BDMPD,12)=$S(BDMDMRG:$$RSTAT^BDMDM6(BDMDMRG,"A"),1:"")
  1.  ;reviewer
  1.  S ^XTMP("BDMDM21",BDMJOB,BDMBTH,"AUDIT",BDMPD,14)=$P(^VA(200,DUZ,0),U,2)
  1.  S ^XTMP("BDMDM21",BDMJOB,BDMBTH,"AUDIT",BDMPD,15)=$$VAL^XBDIQ1(9000001,BDMPD,.14)
  1. DEMO ;pat demographics
  1.  S ^XTMP("BDMDM21",BDMJOB,BDMBTH,"AUDIT",BDMPD,16)=$$HRN^AUPNPAT(BDMPD,DUZ(2))
  1.  S ^XTMP("BDMDM21",BDMJOB,BDMBTH,"AUDIT",BDMPD,18)=$$DOB^AUPNPAT(BDMPD,"E")
  1.  S ^XTMP("BDMDM21",BDMJOB,BDMBTH,"AUDIT",BDMPD,20)=$$VAL^XBDIQ1(2,BDMPD,.02)
  1.  S ^XTMP("BDMDM21",BDMJOB,BDMBTH,"AUDIT",BDMPD,120)=$$TRIBE(BDMPD)
  1.  S ^XTMP("BDMDM21",BDMJOB,BDMBTH,"AUDIT",BDMPD,121)=$$COMM(BDMPD)
  1. DXDT ;dates of and dm dxs
  1.  S ^XTMP("BDMDM21",BDMJOB,BDMBTH,"AUDIT",BDMPD,22)=$S(BDMDMRG:$$CMSFDX^BDMD217(BDMPD,BDMDMRG,"D"),1:"")
  1.  S ^XTMP("BDMDM21",BDMJOB,BDMBTH,"AUDIT",BDMPD,24)=$S(BDMDMRG:$$CMSFDX^BDMD217(BDMPD,BDMDMRG,"DX"),1:"")
  1.  S ^XTMP("BDMDM21",BDMJOB,BDMBTH,"AUDIT",BDMPD,23)=$$PLDMDOO^BDMD217(BDMPD)
  1.  D S(BDMPD,25,$$PLDMDXS^BDMD217(BDMPD))
  1.  D S(BDMPD,21,$$FRSTDMDX^BDMD217(BDMPD))
  1.  D S(BDMPD,26,$$LASTDMDX^BDMD217(BDMPD,BDMRED))
  1.  D S(BDMPD,27,$$TOBACCO^BDMD216(BDMPD,BDMRED))
  1.  S BDMTYDM="" D TYPEDM,S(BDMPD,29,BDMTYDM)
  1.  D S(BDMPD,28,$$CESS^BDMD211(BDMPD,BDMRBD,BDMRED))
  1. VITAL ;
  1.  D S(BDMPD,30,$$LASTHT^BDMD217(BDMPD,BDMRED))
  1.  D S(BDMPD,32,$$LASTWT^BDMD217(BDMPD,BDMRED))
  1.  ;htn dx
  1.  D S(BDMPD,34,$$HTNDX^BDMD217(BDMPD,BDMRED))
  1.  ;last 3 BPs
  1.  D S(BDMPD,36,$$BPS^BDMD217(BDMPD,BDMRBD,BDMRED))
  1. EXAMS ;
  1.  D S(BDMPD,38,$$DFE^BDMD217(BDMPD,BDMRBD,BDMRED))
  1.  D S(BDMPD,40,$$EYE^BDMD217(BDMPD,BDMRBD,BDMRED))
  1.  D S(BDMPD,42,$$DENTAL^BDMD217(BDMPD,BDMRBD,BDMRED))
  1.  D S(BDMPD,44,$$DIETEDUC^BDMD217(BDMPD,BDMRBD,BDMRED))
  1.  D S(BDMPD,46,$$EXEDUC^BDMD217(BDMPD,BDMRBD,BDMRED))
  1.  D S(BDMPD,48,$$OTHEDUC^BDMD217(BDMPD,BDMRBD,BDMRED))
  1. THERAPY ;
  1.  S BDM6MBD=$$FMADD^XLFDT(BDMADAT,-(6*31)),BDM6MBD=$$FMTE^XLFDT(BDM6MBD)
  1.  D S(BDMPD,52,$$INSULIN^BDMD212(BDMPD,BDM6MBD,BDMRED))
  1.  D S(BDMPD,53,$$SULF^BDMD212(BDMPD,BDM6MBD,BDMRED))
  1.  D S(BDMPD,54,$$MET^BDMD212(BDMPD,BDM6MBD,BDMRED))
  1.  D S(BDMPD,55,$$ACAR^BDMD212(BDMPD,BDM6MBD,BDMRED))
  1.  D S(BDMPD,56,$$TROG^BDMD212(BDMPD,BDM6MBD,BDMRED))
  1.  S Y=0 F X=52:1:56 I ^XTMP("BDMDM21",BDMJOB,BDMBTH,"AUDIT",BDMPD,X)="X" S Y=1
  1.  D S(BDMPD,51,$S(Y:"",1:"X"))
  1.  D S(BDMPD,60,$$ACE^BDMD216(BDMPD,BDM6MBD,BDMRED))
  1. IMM ;
  1.  D S(BDMPD,62,$$ASPIRIN^BDMD216(BDMPD,BDMRBD,BDMRED))
  1.  D S(BDMPD,61,$$LIPID^BDMD216(BDMPD,BDM6MBD,BDMRED))
  1.  D S(BDMPD,64,$$FLU^BDMD216(BDMPD,BDMRBD,BDMRED))
  1.  D S(BDMPD,66,$$PNEU^BDMD216(BDMPD,BDMRED))
  1.  D S(BDMPD,68,$$TD^BDMD216(BDMPD,BDMRED))
  1. PPD ;
  1.  D S(BDMPD,70,$$PPD^BDMD218(BDMPD,BDMRED))
  1.  D S(BDMPD,114,$$LASTNP^BDMD218(BDMPD,BDMRED))
  1.  D S(BDMPD,72,$$TBTX^BDMD212(BDMPD))
  1.  D S(BDMPD,76,$$EKG^BDMD212(BDMPD,BDMRED))
  1. LABS ;
  1.  D S(BDMPD,78,$$HGBA1C^BDMD218(BDMPD,BDMRBD,BDMRED))
  1.  D S(BDMPD,82,$$BS^BDMD218(BDMPD,BDMRBD,BDMRED))
  1.  D S(BDMPD,84,$$CREAT^BDMD218(BDMPD,BDMRBD,BDMRED))
  1.  D S(BDMPD,86,$$CHOL^BDMD218(BDMPD,BDMRBD,BDMRED))
  1.  D S(BDMPD,88,$$LDL^BDMD218(BDMPD,BDMRBD,BDMRED))
  1.  D S(BDMPD,89,$$HDL^BDMD218(BDMPD,BDMRBD,BDMRED))
  1.  D S(BDMPD,90,$$TRIG^BDMD218(BDMPD,BDMRBD,BDMRED))
  1.  D S(BDMPD,92,$$URIN^BDMD218(BDMPD,BDMRBD,BDMRED))
  1.  D S(BDMPD,94,$$PROTEIN^BDMD218(BDMPD,BDMRBD,BDMRED))
  1.  D S(BDMPD,96,$$MICRO^BDMD218(BDMPD,BDMRBD,BDMRED))
  1.  D S(BDMPD,98,$$SELF^BDMD216(BDMPD,BDMRBD,BDMRED))
  1.  D S(BDMPD,100,$$SDM^BDMD216(BDMPD,BDMRBD,BDMRED))
  1.  ;D S(BDMPD,102,$$PERI^BDMD216(BDMPD,BDMRBD,BDMRED))
  1.  D S(BDMPD,104,$$AST^BDMD212(BDMPD,BDMRBD,BDMRED))
  1.  D S(BDMPD,106,$$ALT^BDMD212(BDMPD,BDMRBD,BDMRED))
  1.  D S(BDMPD,108,$$PAP^BDMD212(BDMPD,BDMRBD,BDMRED))
  1.  D S(BDMPD,110,$$MAMMOG^BDMD212(BDMPD,BDMRBD,BDMRED))
  1.  D S(BDMPD,112,$$BMI^BDMD218(BDMPD,BDMRBD,BDMRED))
  1.  ;
  1.  Q
  1. TYPEDM ;return type of DM in BDMTYDM
  1.  I ^XTMP("BDMDM21",BDMJOB,BDMBTH,"AUDIT",BDMPD,24)="NIDDM" S BDMTYDM="2  Type 2" Q
  1.  I ^XTMP("BDMDM21",BDMJOB,BDMBTH,"AUDIT",BDMPD,24)="TYPE II" S BDMTYDM="2  Type 2" Q
  1.  I ^XTMP("BDMDM21",BDMJOB,BDMBTH,"AUDIT",BDMPD,24)[2 S BDMTYDM="2  Type 2" Q
  1.  I ^XTMP("BDMDM21",BDMJOB,BDMBTH,"AUDIT",BDMPD,24)="IDDM" S BDMTYDM="1  Type 1" Q
  1.  I ^XTMP("BDMDM21",BDMJOB,BDMBTH,"AUDIT",BDMPD,24)[1 S BDMTYDM="1  Type 1" Q
  1.  S X=^XTMP("BDMDM21",BDMJOB,BDMBTH,"AUDIT",BDMPD,25) ;get problem list dxs
  1.  F I=1:1 S C=$P(X,";",I) Q:C=""!(BDMTYDM]"")  I $E(C,6)=0!($E(C,6)=2) S BDMTYDM="2  Type 2"
  1.  Q:BDMTYDM]""
  1.  F I=1:1 S C=$P(X,";",I) Q:C=""!(BDMTYDM]"")  I $E(C,6)=1!($E(C,6)=3) S BDMTYDM="1  Type 1"
  1.  Q:BDMTYDM]""
  1.  S X=^XTMP("BDMDM21",BDMJOB,BDMBTH,"AUDIT",BDMPD,26) ;get pov list dxs
  1.  I X[2 S BDMTYDM="2  Type 2" Q
  1.  I X[1 S BDMTYDM="1  Type 1" Q
  1.  Q
  1. DATE(D) ;EP
  1.  I $G(D)="" Q ""
  1.  Q $E(D,4,5)_"/"_$E(D,6,7)_"/"_(1700+($E(D,1,3)))
  1. TRIBE(P) ;EP
  1.  I '$G(P) Q ""
  1.  I '$D(^AUPNPAT(P,11)) Q ""
  1.  Q $$TRIBE^AUPNPAT(P,"C")_"^"_$$TRIBE^AUPNPAT(P,"E")
  1. COMM(P) ;EP
  1.  I '$G(P) Q ""
  1.  I '$D(^AUPNPAT(P,11)) Q ""
  1.  Q $$COMMRES^AUPNPAT(P,"C")_"^"_$$COMMRES^AUPNPAT(P,"E")