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

BGP8EOCI.m

Go to the documentation of this file.
  1. BGP8EOCI ; IHS/CMI/LAB - calculate HEDIS measures ;
  1. ;;8.0;IHS CLINICAL REPORTING;**2**;MAR 12, 2008
  1. ;
  1. CALCIND ;EP
  1. S BGPIC=0 F S BGPIC=$O(BGPIND(BGPIC)) Q:BGPIC'=+BGPIC D
  1. .K BGPSTOP,BGPVAL,BGPVALUE,BGPG,BGPC,BGPALLED,BGPV,A,B,C,D,E,F,G,H,I,J,K,M,N,O,P,Q,R,S,T,V,W,X,Y,Z
  1. .K BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN9,BGPN10,BGPN11,BGPN12,BGPN13,BGPN14,BGPN15,BGPN16,BGPN17,BGPN18,BGPN19,BGPN20,BGPN21,BGPN22,BGPN23,BGPN24,BGPN25,BGPN26,BGPN27,BGPN28,BGPN29,BGPN30
  1. .K BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9,BGPD10,BGPD11,BGPD12,BGPD13
  1. .K BGPNUMV,BGPMEDS,BGPDAE,BGPMEDS1
  1. .K ^TMP($J)
  1. .I $D(^BGPEOME(BGPIC,1)) X ^BGPEOME(BGPIC,1)
  1. .K BGPG,BGPC,BGPALLED,BGPVAL,BGPV,A,B,C,D,E,F,G,H,I,J,K,M,N,O,P,Q,R,S,T,V,W,X,Y,Z
  1. .I $D(BGPSTOP) Q ;no need to set since no num/denom
  1. .;loop each individual to set numerator and denominator
  1. .S BGPI=0 F S BGPI=$O(^BGPEOMIE("B",BGPIC,BGPI)) Q:BGPI'=+BGPI D
  1. ..S (BGPNUM,BGPDEN)=0
  1. ..X ^BGPEOMIE(BGPI,1)
  1. ..X ^BGPEOMIE(BGPI,2) ;denominator 1 or 0
  1. ..;set field counter
  1. ..S BGPNF=$P(^BGPEOMIE(BGPI,0),U,5)
  1. ..S BGPN=$P(^DD(90535.1,BGPNF,0),U,4),N=$P(BGPN,";"),P=$P(BGPN,";",2)
  1. ..D S(BGPRPT,BGPGBL,N,P,BGPNUM)
  1. ..S BGPDF=$P(^BGPEOMIE(BGPI,0),U,4)
  1. ..S BGPN=$P(^DD(90535.1,BGPDF,0),U,4),N=$P(BGPN,";"),P=$P(BGPN,";",2)
  1. ..I BGPDEN'="NO" D S(BGPRPT,BGPGBL,N,P,BGPDEN)
  1. .K BGPNUMV
  1. .I $D(BGPLIST(BGPIC)) D STMP^BGP8EOUT
  1. .K BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9,BGPD10,BGPD11,BGPD12,BGPD13,BGPD14,BGPD15,BGPD16,BGPD17,BGPD18,BGPD19,BGPD20,BGPD21,BGPD22,BGPD23,BGPD24,BGPD25,BGPD26
  1. .K BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN9,BGPN10,BGPN11,BGPN12,BGPN13,BGPN14,BGPN15,BGPN16,BGPN17,BGPN18,BGPN19,BGPN20,BGPN21,BGPN22,BGPN23,BGPN24,BGPN25,BGPN26,BGPN27,BGPN28,BGPN29,BGPN30
  1. Q
  1. ;
  1. S(R,G,N,P,V) ;
  1. I 'V Q ;no value to add
  1. S $P(@(G_R_","_N_")"),U,P)=$P($G(@(G_R_","_N_")")),U,P)+V
  1. Q
  1. D(D) ;
  1. I D="" Q ""
  1. Q $E(D,4,5)_"/"_$E(D,6,7)_"/"_(1700+$E(D,1,3))