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

BGPD1.m

Go to the documentation of this file. 
  1. BGPD1 ; IHS/CMI/LAB - IHS area GPRA ;
  1.  ;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007
  1.  ;
  1. PROC ;EP
  1.  S BGPBT=$H
  1.  D JRNL
  1.  S BGPJ=$J,BGPH=$H
  1.  ;calculate 3 years before end of each time frame
  1.  S BGP3YE=$$FMADD^XLFDT(BGPED,-1096)
  1.  S BGPP3YE=$$FMADD^XLFDT(BGPPED,-1096)
  1.  S BGPB3YE=$$FMADD^XLFDT(BGPBED,-1096)
  1.  F X=1:1:18 S $P(^BGPD(BGPRPT,10),U,X)="0!0",$P(^BGPD(BGPRPT,40),U,X)="0!0",$P(^BGPD(BGPRPT,80),U,X)="0!0" ;indicator 1
  1.  F X=1:1:4 S $P(^BGPD(BGPRPT,18),U,X)="0!0",$P(^BGPD(BGPRPT,48),U,X)="0!0",$P(^BGPD(BGPRPT,88),U,X)="0!0"
  1.  S ^BGPD(BGPRPT,480,0)="^90240.048A^0^0"
  1.  S ^BGPD(BGPRPT,880,0)="^90240.088A^0^0"
  1.  S ^BGPD(BGPRPT,180,0)="^90240.018A^0^0"
  1.  S DFN=0 F  S DFN=$O(^AUPNPAT(DFN)) Q:DFN'=+DFN  D PROC1,PROCPR,PROC98
  1.  S DIK="^BGPD(" D IXALL^DIK
  1.  K DIK
  1.  S BGPET=$H
  1.  Q
  1.  ;
  1. JRNL ;
  1.  N (DT,U) S %=$$NOJOURN^ZIBGCHAR("BGPD")
  1.  Q
  1. PROC1 ;current time period
  1.  S (BGPDMPAT,BGPMBP,BGPLHGB,BGPHGBV,BGP2BD,BGP2CD,BGP4LP,BGP4TG,BGP4LDL,BGP4HDL,BGPUP,BGPACT)=""
  1.  K BGPHV,BGPBPV ;kill glycemic value array
  1.  S BGPHV(1)="",BGPHV(0)="",BGPHV(8)=""
  1.  S BGPBPV(1)="",BGPBPV(0)="",BGPBPV(8)=""
  1.  Q:$$BEN^AUPNPAT(DFN,"C")'="01"
  1.  S DOD=$$DOD^AUPNPAT(DFN) I DOD]"",DOD<BGPED Q
  1.  S X=$P($G(^AUPNPAT(DFN,11)),U,18) Q:X=""
  1.  Q:'$D(BGPTAX($P(^AUPNPAT(DFN,11),U,18)))
  1.  S X=$$LASTVD(DFN,BGP3YE,BGPED)
  1.  Q:X=""  ;not an active user
  1.  S BGPACT=1 ;an active user by end of time frame
  1.  S BGPEDATE=BGPED,BGPTIME=1,BGPBDATE=BGPBD
  1.  S BGPAGEB=$$AGE^AUPNPAT(DFN,BGPBDATE)
  1.  S BGPAGEE=$$AGE^AUPNPAT(DFN,BGPEDATE)
  1.  D CALCIND
  1.  Q
  1. PROCPR ;
  1.  S (BGPDMPAT,BGPMBP,BGPLHGB,BGPHGBV,BGP2BD,BGP2CD,BGP4LP,BGP4TG,BGP4LDL,BGP4HDL,BGPUP,BGPACT)=""
  1.  Q:$$BEN^AUPNPAT(DFN,"C")'="01"
  1.  S DOD=$$DOD^AUPNPAT(DFN) I DOD]"",DOD<BGPPED Q
  1.  S X=$P($G(^AUPNPAT(DFN,11)),U,18) Q:X=""
  1.  Q:'$D(BGPTAX($P(^AUPNPAT(DFN,11),U,18)))  ;not a community of interest)
  1.  S X=$$LASTVD(DFN,BGPP3YE,BGPPED)
  1.  Q:X=""  ;not an active user
  1.  S BGPACT=1 ;an active user by end of time frame
  1.  S BGPEDATE=BGPPED,BGPBDATE=BGPPBD,BGPTIME=0
  1.  S BGPAGEB=$$AGE^AUPNPAT(DFN,BGPBDATE)
  1.  S BGPAGEE=$$AGE^AUPNPAT(DFN,BGPEDATE)
  1.  D CALCIND
  1.  Q
  1. PROC98 ;
  1.  S (BGPDMPAT,BGPMBP,BGPLHGB,BGPHGBV,BGP2BD,BGP2CD,BGP4LP,BGP4TG,BGP4LDL,BGP4HDL,BGPUP,BGPACT)=""
  1.  Q:$$BEN^AUPNPAT(DFN,"C")'="01"
  1.  S DOD=$$DOD^AUPNPAT(DFN) I DOD]"",DOD<BGPBED Q
  1.  S X=$P($G(^AUPNPAT(DFN,11)),U,18) Q:X=""
  1.  Q:'$D(BGPTAX($P(^AUPNPAT(DFN,11),U,18)))  ;not a community of interest)
  1.  S X=$$LASTVD(DFN,BGPB3YE,BGPBED)
  1.  Q:X=""  ;not an active user
  1.  S BGPACT=1 ;an active user by end of time frame
  1.  S BGPEDATE=BGPBED,BGPBDATE=BGPBBD,BGPTIME=8
  1.  S BGPAGEB=$$AGE^AUPNPAT(DFN,BGPBDATE)
  1.  S BGPAGEE=$$AGE^AUPNPAT(DFN,BGPEDATE)
  1.  D CALCIND
  1.  Q
  1. CALCIND ;
  1.  D I1A
  1.  I $D(BGPIND(1))!($D(BGPIND(2)))!($D(BGPIND(3)))!($D(BGPIND(4)))!($D(BGPIND(5)))!($D(BGPIND(6)))!($D(BGPIND(7)))!($D(BGPIND(8)))!($D(BGPIND(9)))!($D(BGPIND(10)))!($D(BGPIND(11)))!($D(BGPIND(12)))!($D(BGPIND(13)))!($D(BGPIND(14))) D
  1.  .D I1
  1.  .D I1B^BGPD1B
  1.  .D I2A^BGPD2
  1.  .D I2B^BGPD2
  1.  .D I2C^BGPD2
  1.  .D I3A^BGPD3
  1.  .D I3B^BGPD3
  1.  .D I3C^BGPD3
  1.  .D I4A^BGPD4
  1.  .D I4B^BGPD4
  1.  .D I4C^BGPD4
  1.  .D I5A^BGPD5
  1.  .D I5B^BGPD5
  1.  .D I5C^BGPD5
  1.  I $D(BGPIND(15))!($D(BGPIND(16))) D I6^BGPD6
  1.  I $D(BGPIND(16)) D I6A^BGPD6
  1.  I $D(BGPIND(17)) D I7^BGPD7
  1.  I $D(BGPIND(18))!($D(BGPIND(23))) D I8^BGPD8
  1.  I $D(BGPIND(19)) D I12^BGPD12
  1.  I $D(BGPIND(20)) D I13^BGPD13
  1.  I $D(BGPIND(21)) D I14^BGPD14
  1.  I $D(BGPIND(22)) D I22^BGPD22
  1.  ;I $D(BGPIND(23)) D I23^BGPD23
  1.  I $D(BGPIND(24)) D I24^BGPD24
  1.  I $D(BGPIND(25)) D I29^BGPD29
  1.  I $D(BGPIND(26)) D I30^BGPD30
  1.  I $D(BGPIND(27)) D IA^BGPDA
  1.  I $D(BGPIND(28)) D IB^BGPDB
  1.  I $D(BGPIND(29)) D IC^BGPDC
  1.  I $D(BGPIND(30)) D ID^BGPDD
  1.  Q
  1. I1A ;EP - indicator 1
  1.  S BGPSEX=$P(^DPT(DFN,0),U,2),BGPSEX=$S(BGPSEX="M":1,1:2)
  1.  D SAGE(BGPRPT,$S(BGPTIME=1:10,BGPTIME=0:40,BGPTIME=8:80,1:"999"),1,BGPSEX,BGPACT) ;set total denom for 1 prevalence
  1.  S BGPAGEEP=$S(BGPAGEE<15:2,BGPAGEE>14&(BGPAGEE<20):3,BGPAGEE>19&(BGPAGEE<25):4,BGPAGEE>24&(BGPAGEE<35):5,BGPAGEE>34&(BGPAGEE<45):6,BGPAGEE>44&(BGPAGEE<55):7,BGPAGEE>54&(BGPAGEE<65):8,BGPAGEE>64:9,1:"")
  1.  D SAGE(BGPRPT,$S(BGPTIME=1:10,BGPTIME=0:40,BGPTIME=8:80,1:999),BGPAGEEP,BGPSEX,1)
  1.  Q
  1. I1 ;
  1.  S BGPDMPAT=$$DM(DFN,BGPEDATE)
  1.  D SAGE(BGPRPT,$S(BGPTIME=1:10,BGPTIME=0:40,BGPTIME=8:80,1:"999"),10,BGPSEX,BGPDMPAT)
  1.  S BGPAGEEP=$S(BGPAGEE<15:11,BGPAGEE>14&(BGPAGEE<20):12,BGPAGEE>19&(BGPAGEE<25):13,BGPAGEE>24&(BGPAGEE<35):14,BGPAGEE>34&(BGPAGEE<45):15,BGPAGEE>44&(BGPAGEE<55):16,BGPAGEE>54&(BGPAGEE<65):17,BGPAGEE>64:18,1:"")
  1.  D SAGE(BGPRPT,$S(BGPTIME=1:10,BGPTIME=0:40,BGPTIME=8:80,1:999),BGPAGEEP,BGPSEX,BGPDMPAT)
  1.  I BGPDMPAT,$D(BGPLIST(1)),BGPTIME=1 S ^XTMP("BGPD",BGPJ,BGPH,"LIST",1,$S($P($G(^AUPNPAT(DFN,11)),U,18)]"":$P(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$P(^DPT(DFN,0),U,2),BGPAGEE,DFN)=""
  1.  Q
  1. SAGE(R,N,P,S,V) ;set age into file
  1.  I 'V Q  ;no value
  1.  NEW X,Y
  1.  S X=$P($G(^BGPD(R,N)),U,P)
  1.  S $P(X,"!",S)=$P(X,"!",S)+V
  1.  S $P(^BGPD(R,N),U,P)=X
  1.  Q
  1. S(R,N,P,V) ;
  1.  I 'V Q  ;no value to add
  1.  S $P(^BGPD(R,N),U,P)=$P($G(^BGPD(R,N)),U,P)+V
  1.  Q
  1. DM(P,EDATE) ;EP is patient diabetic 1 or 0
  1.  I $G(P)="" Q ""
  1.  ;check povs
  1.  NEW X,E,BGPG,Y
  1.  K BGPG
  1.  S Y="BGPG("
  1.  S X=P_"^LAST DX [SURVEILLANCE DIABETES;DURING "_$$DOB^AUPNPAT(P,"E")_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
  1.  I $D(BGPG(1)) Q 1  ;has a dx
  1.  Q 0
  1.  ;
  1. LASTVD(P,BDATE,EDATE) ;
  1.  I '$G(P) Q ""
  1.  I '$D(^AUPNVSIT("AC",P)) Q ""
  1.  NEW A,B,E,V,X,G
  1.  K ^TMP($J,"A")
  1.  S A="^TMP($J,""A"",",B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(B,A)
  1.  I '$D(^TMP($J,"A",1)) Q ""
  1.  S (X,G)=0 F  S X=$O(^TMP($J,"A",X)) Q:X'=+X!(G)  S V=$P(^TMP($J,"A",X),U,5) D
  1.  .Q:'$D(^AUPNVSIT(V,0))
  1.  .Q:'$P(^AUPNVSIT(V,0),U,9)
  1.  .Q:$P(^AUPNVSIT(V,0),U,11)
  1.  .Q:'$D(^AUPNVPRV("AD",V))
  1.  .Q:"SAHO"'[$P(^AUPNVSIT(V,0),U,7)
  1.  .Q:"V"[$P(^AUPNVSIT(V,0),U,3)
  1.  .S G=1
  1.  .Q
  1.  Q G