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

APCM13E2.m

Go to the documentation of this file. 
  1. APCM13E2 ; IHS/CMI/LAB - IHS MU ;
  1.  ;;1.0;IHS MU PERFORMANCE REPORTS;**2,4,5,6**;MAR 26, 2012;Build 65
  1.  ;;;;;;Build 3
  1. TEST ;
  1.  S APCMRPTT=1
  1.  S DFN=118876
  1.  S APCMP=5948
  1.  S APCMHVTP(APCMP)=""
  1.  S APCMPRV(APCMP)=""
  1.  K APCM100R
  1.  S APCMIC=1
  1.  S APCMRPT=1
  1.  S APCMTIME=1
  1.  S APCMBDAT=3100101
  1.  S APCMEDAT=3101231
  1.  Q
  1. CPOE ;EP - CALCULATE CPOE MEDICATIONS MEASURE
  1.  ;for each provider or for the facility find out if this
  1.  ;patient had a visit of A, O, R, S to this provider or facility
  1.  ;if so, then count all med orders to that provider from these
  1.  ;visits and update denom/numerator counts
  1.  ;
  1.  ;if they had any prescription that had a nature of order of electronic
  1.  ;they are in the numerator
  1.  NEW APCMP
  1.  S (APCMD1,APCMN1)=0
  1.  I APCMRPTT=1 D  Q
  1.  .S APCMP=0 F  S APCMP=$O(APCMPRV(APCMP)) Q:APCMP'=+APCMP  D
  1.  ..I $D(APCM100R(APCMP,APCMTIME)) S F=$P(^APCM13OB(APCMIC,0),U,11) D S^APCM13E1(APCMRPT,APCMIC,"Provider is excluded from this measure as he/she had < 100 prescriptions issued during the EHR reporting period.",APCMP,APCMRPTT,APCMTIME,F,1) Q
  1.  ..;Q:'$D(APCMHVTP(APCMP))  ;no visits to this provider for this patient so don't bother, the patient is not in the denominator
  1.  ..D CPOE1
  1.  .Q
  1.  I APCMRPTT=2 D
  1.  .S APCMP=APCMFAC
  1.  .;Q:'$D(APCMHVTP(APCMP))
  1.  .D CPOE1
  1.  .Q
  1.  Q
  1. CPOE1 ;
  1.  K APCMRXS
  1.  S APCMHP=$$HADRX(DFN,APCMBDAT,APCMEDAT,APCMP,.APCMRXS,APCMRPTT)  ;return # of denom - orders^numerator - ordered by CPOE, ARRAY OF PRESCRIPTIONS
  1.  Q:APCMHP=""  ;no prescriptions with an issue date in report period
  1.  ;set denominator value into field
  1.  S F=$P(^APCM13OB(APCMIC,0),U,8)  ;denom field for this measure
  1.  D S^APCM13E1(APCMRPT,APCMIC,$P(APCMHP,U,1),APCMP,APCMRPTT,APCMTIME,F)
  1.  S V=""
  1.  S APCMVALU=$P(APCMHP,U,1)_" Med orders|||w/CPOE: "_$P(APCMHP,U,2)_" ; w/o CPOE: "_$P(APCMHP,U,1)-$P(APCMHP,U,2)
  1.  S F=$P(^APCM13OB(APCMIC,0),U,9)
  1.  D S^APCM13E1(APCMRPT,APCMIC,$P(APCMHP,U,2),APCMP,APCMRPTT,APCMTIME,F)
  1. CPOEL D SETLIST^APCM13E1
  1.  Q
  1. HADRX(P,BD,ED,PROV,RXS,RPT) ;EP - did patient have a RX in file 52 with an issue date
  1.  ;between BD and ED
  1.  I '$G(P) Q ""
  1.  I '$G(BD) Q ""
  1.  I '$G(ED) Q ""
  1.  I '$D(^AUPNPAT(P,0)) Q ""
  1.  NEW EXDT,IFN,ID,G,DENOM,NUMER,H,X,I,D,V,DISPG,STOP
  1.  S G="",(DENOM,NUMER)=0
  1.  ;FOR EP REPORT
  1.  I RPT=1 D
  1.  .S DISPG=$O(^ORD(100.98,"B","OUTPATIENT MEDICATIONS",0))
  1.  .Q:'DISPG
  1.  .S D=9999999-(ED_".9999"),STOP=(9999999-(BD_".000001")),VP=P_";DPT("
  1.  .F  S D=$O(^OR(100,"ACT",VP,D)) Q:D>STOP  D
  1.  ..S X=0 F  S X=$O(^OR(100,"ACT",VP,D,DISPG,X)) Q:X'=+X  D
  1.  ...S O=0 F  S O=$O(^OR(100,"ACT",VP,D,DISPG,X,O)) Q:O=+O  D
  1.  ....S V=$P($G(^OR(100,O,0)),U,4)
  1.  ....Q:V'=PROV  ;not correct provider
  1.  ....S V=$P($G(^OR(100,X,0)),U,10)
  1.  ...I V,$D(^SC(V,0)) S C=$P(^SC(V,0),U,7) I C Q:$P($G(^DIC(40.7,C,0)),U,2)=30
  1.  ...S DENOM=DENOM+1
  1.  ...;now see if any are not written
  1.  ...S B=$P($G(^OR(100,X,0)),U,10)
  1.  ...Q:B=""
  1.  ...Q:'$$ORES(B,$P(D,"."))
  1.  ...S N=""
  1.  ...S A=0 F  S A=$O(^OR(100,X,8,A)) Q:A'=+A!(N)  D
  1.  ....Q:'$D(^OR(100,O,8,X,0))
  1.  ....S B=$P(^OR(100,O,8,X,0),U,12)
  1.  ....Q:B=1
  1.  ....Q:B=""
  1.  ....S N=1 S NUMER=NUMER+1
  1.  I RPT=2 D
  1.  .S D=BD
  1.  .F  S D=$O(^OR(100,"AF",D)) Q:$P(D,".",1)>ED  D
  1.  ..S X=0 F  S X=$O(^OR(100,"AF",D,X)) Q:X'=+X  D
  1.  ...S V=$P(^OR(100,X,0),U,2)
  1.  ...Q:V'["DPT"
  1.  ...Q:+V'=P
  1.  ...Q:'$$HOSP(X,PROV)  ;
  1.  ...S DENOM=DENOM+1
  1.  ...;now see if any are not written
  1.  ...S B=$P($G(^OR(100,X,0)),U,6)
  1.  ...Q:B=""
  1.  ...Q:'$$ORES(B,ID)
  1.  ...S N=""
  1.  ...S A=0 F  S A=$O(^OR(100,O,8,A)) Q:A'=+A!(N)  D
  1.  ....Q:'$D(^OR(100,O,8,A,0))
  1.  ....S B=$P(^OR(100,O,8,A,0),U,12)
  1.  ....Q:B=1
  1.  ....Q:B=""
  1.  ....S N=1 S NUMER=NUMER+1  ;,$P(RXS(X),U,3)=$P($P(^OR(100,O,8,A,0),U),".")_U_$P(^ORD(100.02,B,0),U,1)_U_$P(^OR(100,O,0),U)
  1.  Q DENOM_U_NUMER
  1. HOSP(O,FAC) ;
  1.  NEW V,L,C
  1.  S V=$$VAL^XBDIQ1(100,O,23)
  1.  I V="IV MEDICATIONS" Q 1
  1.  I V="UNIT DOSE MEDICATIONS" Q 1
  1.  I V="INPATIENT MEDICATIONS" Q 1
  1.  I V'="OUTPATIENT MEDICATIONS" Q 0
  1.  S L=$P($G(^OR(100,O,0)),U,10)
  1.  I L,$D(^SC(L,0)) S C=$P(^SC(L,0),U,15) I C,C'=FAC Q 0
  1.  I L,$D(^SC(L,0)) S C=$P(^SC(L,0),U,7) I C,$P($G(^DIC(40.7,C,0)),U,2)=30 Q 1
  1.  Q 0
  1. ORES(R,D) ;EP - DID PROVIDER HAVE ORES OR ORESLE ON DATE D
  1.  I '$G(R) Q ""
  1.  I '$D(^VA(200,R,0)) Q ""
  1.  NEW K,J
  1.  S K=$O(^DIC(19.1,"B","ORES",0))
  1.  S J=$O(^DIC(19.1,"B","ORELSE",0))
  1.  I $D(^VA(200,R,51,K,0)),$P(^VA(200,R,51,K,0),U,3)'>D Q 1
  1.  I $D(^VA(200,R,51,J,0)),$P(^VA(200,R,51,J,0),U,3)'>D Q 1
  1.  Q ""
  1. DEMO ;EP - CALCULATE DEMOGRAPHICS
  1.  ;for each provider or for the facility find out if this
  1.  ;patient had a visit of A, O, R, S to this provider or facility
  1.  ;if so, then check to see if they had dob, preferred language, gender, race, ethnicity recorded
  1.  NEW APCMP
  1.  S (APCMD1,APCMN1)=0
  1.  I APCMRPTT=1 D  Q
  1.  .S APCMP=0 F  S APCMP=$O(APCMPRV(APCMP)) Q:APCMP'=+APCMP  D
  1.  ..Q:'$D(APCMHVTP(APCMP))  ;DID NOT SEE THIS PATIENT
  1.  ..D DEMO1
  1.  I APCMRPTT=2 D
  1.  .S APCMP=APCMFAC
  1.  .Q:'$D(APCMHVTP(APCMP))
  1.  .D DEMO1
  1.  .Q
  1.  Q
  1. DEMO1 ;set denominator value into field
  1.  S F=$P(^APCM13OB(APCMIC,0),U,8)  ;denom field for this measure
  1.  D S^APCM13E1(APCMRPT,APCMIC,1,APCMP,APCMRPTT,APCMTIME,F)
  1.  S APCMVALU="VISIT: "_$$DATE^APCM1UTL(APCMHVTP(APCMP))
  1.  ;numerator?
  1.  S APCMEP=$$HASDEMO(DFN,APCMBDAT,APCMEDAT,APCMRPTT,$G(APCMVDOD))
  1.  S APCMVALU=APCMVALU_"|||"_$S($P(APCMEP,U,1)=1:"MEETS OBJECTIVE: ",1:"DOES NOT MEET OBJECTIVE: ")_$P(APCMEP,U,2)_"|||"_$P(APCMEP,U,1)
  1.  S F=$P(^APCM13OB(APCMIC,0),U,9)
  1.  D S^APCM13E1(APCMRPT,APCMIC,$P(APCMEP,U,1),APCMP,APCMRPTT,APCMTIME,F)
  1.  D SETLIST^APCM13E1
  1.  Q
  1. HASDEMO(P,BD,ED,T,DODV) ;
  1.  NEW PL,G,R,E,D,C,Y,X,B,Z
  1.  S C=0
  1.  S T=$G(T)
  1.  S DODV=$G(DODV)
  1.  S (PL,G,R,E,D)=""
  1.  ;preferred language
  1.  S X=0 F  S X=$O(^AUPNPAT(P,86,X)) Q:X'=+X!(PL]"")  D
  1.  .S B=$P(^AUPNPAT(P,86,X,0),U)
  1.  .Q:B>ED
  1.  .S C=C+1,PL="Preferred Language"
  1.  S G=$P(^DPT(P,0),U,2) I G]"" S C=C+1,G="Gender"
  1.  S R=""
  1.  I $T(RACE^AGUTL)]"" S R=$$RACE^AGUTL(P)
  1.  I R S C=C+1,R="Race" I 1
  1.  E  S R=$$VAL^XBDIQ1(2,P,.06) I R]"" S C=C+1,R="Race"
  1.  S Z=0 F  S Z=$O(^DPT(P,.06,Z)) Q:Z'=+Z!(E]"")  D
  1.  .S E=$P($G(^DPT(P,.06,Z,0)),U,1)
  1.  .Q:E=""
  1.  .S E="Ethnicity",C=C+1
  1.  .Q
  1.  I $P(^DPT(P,0),U,3)]"" S D="DOB",C=C+1
  1.  I T=2,$G(DODV) G HASDEMOH
  1.  I C=5 Q 1_U_"Has: "_PL_";"_G_";"_R_";"_E_";"_D
  1.  Q 0_U_"Has: "_PL_";"_G_";"_R_";"_E_";"_D
  1. HASDEMOH ;did patient die in the hospital during report period?  if so is dod and underlying cause there?
  1.  NEW VDOD,L,UCD
  1.  S UCD=""
  1.  S VDOD=$$DOD^AUPNPAT(P)
  1.  I VDOD]"" S C=C+1,VDOD="DOD"
  1.  S L=$$VAL^XBDIQ1(9000001,P,1114)
  1.  I L]"" S C=C+1,UCD="UCD"
  1.  I C=7 Q 1_U_"Has: "_PL_";"_G_";"_R_";"_E_";"_D_";"_VDOD_";"_UCD
  1.  Q 0_U_"Has: "_PL_";"_G_";"_R_";"_E_";"_D_";"_VDOD_";"_UCD
  1.  ;
  1. PL ;EP - CALCULATE PROBLEM LIST
  1.  ;for each provider or for the facility find out if this
  1.  ;patient had a visit of A, O, R, S to this provider or facility
  1.  ;if so, then check to see if they any problems on their problem list (skip deleted) or a NAP documented in report period
  1.  NEW APCMP
  1.  S (APCMD1,APCMN1)=0
  1.  I APCMRPTT=1 D  Q
  1.  .S APCMP=0 F  S APCMP=$O(APCMPRV(APCMP)) Q:APCMP'=+APCMP  D
  1.  ..Q:'$D(APCMHVTP(APCMP))  ;no visits to this provider for this patient so don't bother, the patient is not in the denominator
  1.  ..D PL1
  1.  ..Q
  1.  I APCMRPTT=2 D
  1.  .S APCMP=APCMFAC
  1.  .Q:'$D(APCMHVTP(APCMP))
  1.  .D PL1
  1.  .Q
  1.  Q
  1. PL1 ;set denominator value into field
  1.  S F=$P(^APCM13OB(APCMIC,0),U,8)  ;denom field for this measure
  1.  D S^APCM13E1(APCMRPT,APCMIC,1,APCMP,APCMRPTT,APCMTIME,F)
  1.  S APCMVALU="VISIT: "_$$DATE^APCM1UTL(APCMHVTP(APCMP))
  1.  ;numerator?
  1.  S APCMEP=$$HASPL(DFN,APCMBDAT,APCMEDAT)
  1.  S APCMVALU=APCMVALU_"|||"_$P(APCMEP,U,2)_"|||"_$P(APCMEP,U,1)
  1.  S F=$P(^APCM13OB(APCMIC,0),U,9)
  1.  D S^APCM13E1(APCMRPT,APCMIC,$P(APCMEP,U,1),APCMP,APCMRPTT,APCMTIME,F)
  1.  D SETLIST^APCM13E1
  1.  Q
  1. HASPL(P,BD,ED) ;does patient have a problem entered before end of report period
  1.  ;
  1.  NEW A,B,C,D,E
  1.  S E=""
  1.  S A=0 F  S A=$O(^AUPNPROB("AC",P,A)) Q:A'=+A!(E]"")  D
  1.  .;if date entered is after the ED don't count it
  1.  .Q:'$D(^AUPNPROB(A,0))
  1.  .Q:$P(^AUPNPROB(A,0),U,8)>ED  ;after end date of report period
  1.  .I $P(^AUPNPROB(A,0),U,12)'="D" S E=1_U_"Problem Entry: "_$$VAL^XBDIQ1(9000011,A,.01)_" entered on "_$$VAL^XBDIQ1(9000011,A,.08) Q
  1.  .;since it's deleted, deletion date must not be before time period
  1.  .S D=$P($P($G(^AUPNPROB(A,2)),U,2),".")  ;date deleted
  1.  .Q:D>ED
  1.  .Q:D<BD
  1.  .S E="1^Problem Entry: "_$$VAL^XBDIQ1(9000011,A,.01)_" entered on "_$$VAL^XBDIQ1(9000011,A,.08)
  1.  I E]"" Q E
  1.  ;no problems on PL so how about a NAP before end of time period
  1.  S C=$O(^AUTTCRA("B","NO ACTIVE PROBLEMS",0))
  1.  I 'C Q ""
  1.  S A=0 F  S A=$O(^AUPNVRUP("AC",P,A)) Q:A'=+A!(E]"")  D
  1.  .Q:'$D(^AUPNVRUP(A,0))  ;oops
  1.  .Q:$P(^AUPNVRUP(A,0),U,1)'=C  ;not NAP
  1.  .S D=$$VD^APCLV($P(^AUPNVRUP(A,0),U,3))
  1.  .Q:D>ED
  1.  .S E="1^No Active Problems on "_$$DATE^APCM1UTL(D)
  1.  Q E
  1. MEDL ;EP - CALCULATE MEDICATION LIST
  1.  ;for each provider or for the facility find out if this
  1.  ;patient had a visit of A, O, R, S to this provider or facility
  1.  ;d
  1.  NEW APCMP
  1.  S (APCMD1,APCMN1)=0
  1.  I APCMRPTT=1 D  Q
  1.  .S APCMP=0 F  S APCMP=$O(APCMPRV(APCMP)) Q:APCMP'=+APCMP  D
  1.  ..Q:'$D(APCMHVTP(APCMP))  ;no visits to this provider for this patient so don't bother, the patient is not in the denominator
  1.  ..D MEDL1
  1.  ..Q
  1.  .Q
  1.  I APCMRPTT=2 D
  1.  .S APCMP=APCMFAC
  1.  .Q:'$D(APCMHVTP(APCMP))
  1.  .D MEDL1
  1.  .Q
  1.  Q
  1. MEDL1 ;set denominator value into field
  1.  S F=$P(^APCM13OB(APCMIC,0),U,8)  ;denom field for this measure
  1.  D S^APCM13E1(APCMRPT,APCMIC,1,APCMP,APCMRPTT,APCMTIME,F)
  1.  S APCMVALU="VISIT: "_$$DATE^APCM1UTL(APCMHVTP(APCMP))
  1.  ;numerator?
  1.  S APCMEP=$$HASML(DFN,APCMBDAT,APCMEDAT)
  1.  S APCMVALU=APCMVALU_"|||"_$P(APCMEP,U,2)_"|||"_$P(APCMEP,U,1)
  1.  S F=$P(^APCM13OB(APCMIC,0),U,9)
  1.  D S^APCM13E1(APCMRPT,APCMIC,$P(APCMEP,U,1),APCMP,APCMRPTT,APCMTIME,F)
  1.  D SETLIST^APCM13E1
  1.  Q
  1. HASML(P,BDT,EDT) ;EP
  1.  N RXIEN,ACTIEN,RTSDT,FILLDT,A0,FDTLP,IEN,G,DC,EXP,SDT,X,I,DRG,L,V,EXDT,IFN,ID,D365
  1.  ;between BD and ED
  1.  I '$G(P) Q ""
  1.  I '$G(BDT) Q ""
  1.  I '$G(EDT) Q ""
  1.  I '$D(^AUPNPAT(P,0)) Q ""
  1.  S G=""
  1. NAM ;look for "No Active Medications" anytime during the report period
  1.  S C=$O(^AUTTCRA("B","NO ACTIVE MEDICATIONS",0))
  1.  I 'C G RXS
  1.  ;GET most recent visit date
  1.  S A=0 F  S A=$O(^AUPNVRUP("AC",P,A)) Q:A'=+A!(G]"")  D
  1.  .Q:'$D(^AUPNVRUP(A,0))  ;oops
  1.  .Q:$P(^AUPNVRUP(A,0),U,1)'=C  ;not NAM
  1.  .S D=$$VD^APCLV($P(^AUPNVRUP(A,0),U,3))
  1.  .Q:D<BDT  ;before beg date
  1.  .Q:D>EDT  ;after end date
  1.  .S G="1^No Active Medications on "_$$DATE^APCM1UTL(D)
  1.  I G Q G
  1. RXS ;
  1.  S G=""
  1.  S D365=$$FMADD^XLFDT(BDT,-365)
  1.  S EXDT=$$FMADD^XLFDT(BDT,-(365*3))
  1.  F  S EXDT=$O(^PS(55,P,"P","A",EXDT)) Q:'EXDT!(G]"")  S IFN=0 F  S IFN=$O(^PS(55,P,"P","A",EXDT,IFN)) Q:'IFN!(G]"")  D:$D(^PSRX(IFN,0))
  1.  .Q:$P($G(^PSRX(IFN,"STA")),"^")=13  ;deleted
  1.  .Q:'$P(^PSRX(IFN,0),U,6)   ; Prescription must have a drug
  1.  .S ID=$P(^PSRX(IFN,0),U,13)  ;issue date
  1.  .Q:ID<D365
  1.  .Q:ID>EDT
  1.  .S DC=$P($G(^PSRX(IFN,3)),U,5)  ;dc date
  1.  .I DC]"" Q:DC<BDT  ;IF DC'ED DATE IF MUST BE ON OR AFTER 1ST DATE OF TIME PERIOD
  1.  .S G=1_U_$$DATE^APCM1UTL(ID)_" Rx: "_$P(^PSRX(IFN,0),U,1) Q
  1.  I G]"" Q G
  1.  ;now check NVA meds
  1. NVA ; Set Non-VA Med Orders in the ^TMP Global
  1.  S G=""
  1.  F I=0:0 S I=$O(^PS(55,P,"NVA",I)) Q:'I!(G]"")  S X=$G(^PS(55,P,"NVA",I,0)) D
  1.  .Q:'$P(X,"^")
  1.  .S DRG=$S($P(X,"^",2):$P($G(^PSDRUG($P(X,"^",2),0)),"^"),1:$P(^PS(50.7,$P(X,"^"),0),"^")_" "_$P(^PS(50.606,$P(^PS(50.7,$P(X,"^"),0),"^",2),0),"^"))
  1.  .I $P(X,"^",7),$P(X,"^",7)<BDT Q  ;DC'ED
  1.  .S SDT=$P(X,"^",10) I 'SDT Q  ;NO documented date
  1.  .I SDT>EDT Q  ;documented date after end date
  1.  .Q:$P(X,U,6)]""
  1.  .S G=1_U_"NVA: "_$$DATE^APCM1UTL($P(X,U,10))_" Item: "_DRG
  1.  I G]"" Q G
  1.  Q G
  1.  ; Return boolean flag indicating valid patient
  1. PATVRY(RX,PAT) ;EP
  1.  Q:PAT="*" 1
  1.  Q +$P($G(^PSRX(RX,0)),U,2)=PAT
  1.  ; Return release date for dispense
  1. DSPRDT(RX,TYP,SIEN) ;EP
  1.  Q $S($G(SIEN):+$P($G(^PSRX(RX,$S(TYP="ADP":"P",1:1),SIEN,0)),U,$S(TYP="ADP":19,1:18)),1:+$P(^PSRX(RX,2),U,13))