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

APCM14E6.m

Go to the documentation of this file. 
  1. APCM14E6 ;IHS/CMI/LAB - IHS MU; 
  1.  ;;1.0;IHS MU PERFORMANCE REPORTS;**5,6**;MAR 26, 2012;Build 65
  1.  ;;;;;;Build 3
  1. ADV ;EP - CALCULATE adv directives
  1.  NEW APCMP,APCMZ
  1.  S (APCMD1,APCMN1)=0
  1.  I APCMRPTT=2 D
  1.  .S APCMP=APCMFAC
  1.  .I $D(APCMHO65(APCMP,APCMTIME)) S F=$P(^APCM14OB(APCMIC,0),U,11) D  Q
  1.  ..D S^APCM14E1(APCMRPT,APCMIC,"Hospital is excluded from this measure as it did not admit anyone >=65 during the EHR Reporting Period.",APCMP,APCMRPTT,APCMTIME,F,1) Q
  1.  .S APCMZ=$$HASADM65(DFN,APCMP,.APCMVSTS)
  1.  .Q:APCMZ=""  ;NO ADMISSION
  1.  .D ADV1
  1.  .Q
  1.  Q
  1. HASADM65(P,R,VSTS) ;
  1.  NEW X,Y,Z,V,G
  1.  S G=""
  1.  S X=0 F  S X=$O(VSTS(X)) Q:X'=+X!(G)  D
  1.  .S V=$P(VSTS(X),U,5)
  1.  .I '$D(^AUPNVSIT(V,0)) Q
  1.  .I $P(^AUPNVSIT(V,0),U,11) Q
  1.  .I $P(^AUPNVSIT(V,0),U,7)'="H" Q  ;not correct service category
  1.  .Q:$P(^AUPNVSIT(V,0),U,6)'=APCMP  ;not this facility
  1.  .Q:$$AGE^AUPNPAT(P,$$VD^APCLV(V))<65  ;not 65 on date of admission
  1.  .S G=$$VD^APCLV(V)
  1.  Q G
  1. ADV1 ;
  1.  ;set denominator value into field
  1.  S F=$P(^APCM14OB(APCMIC,0),U,8)  ;denom field for this measure
  1.  D S^APCM14E1(APCMRPT,APCMIC,1,APCMP,APCMRPTT,APCMTIME,F)
  1.  S APCMVALU="Admission: "_$$DATE^APCM1UTL(APCMZ)_" Age: "_$$AGE^AUPNPAT(DFN,APCMZ)
  1.  ;numerator?
  1.  S APCMEP=$$HASADV(DFN,APCMEDAT)
  1.  S APCMVALU=APCMVALU_"|||"_$P(APCMEP,U,2)_"|||"_$P(APCMEP,U,1)
  1.  S F=$P(^APCM14OB(APCMIC,0),U,9)
  1.  D S^APCM14E1(APCMRPT,APCMIC,$P(APCMEP,U,1),APCMP,APCMRPTT,APCMTIME,F)
  1.  D SETLIST^APCM14E1
  1.  Q
  1. HASADV(P,ED) ;does patient have an ADVANCE DIRECTIVE before end of report period
  1.  ;
  1.  NEW A,B,C,D,E,X
  1.  ;check advance directive file
  1.  S E=""
  1.  S X=0 F  S X=$O(^AUPNADVD(P,11,X)) Q:X'=+X!(E)  D
  1.  .Q:'$D(^AUPNADVD(P,11,X,0))  ;no zero node?
  1.  .S D=$P(^AUPNADVD(P,11,X,0),U,1)
  1.  .I D>ED Q  ;after report period
  1.  .S B=$P(^AUPNADVD(P,11,X,0),U,2)
  1.  .Q:B=""
  1.  .S E=1_U_"Advance Directives: "_$S(B="Y":"YES",1:"NO")_" entered on "_$$DATE^APCM1UTL(D) Q
  1.  I E]"" Q E
  1.  ;now check for TIU Note title before ED of A
  1.  S X=0 F  S X=$O(^AUPNVNOT("AC",P,X)) Q:X'=+X!(E)  D
  1.  .S B=$$VAL^XBDIQ1(9000010.28,X,.01)
  1.  .Q:$$UP^XLFSTR(B)'="ADVANCE DIRECTIVE"
  1.  .S D=$$VD^APCLV($P(^AUPNVNOT(X,0),U,3))
  1.  .Q:D>ED
  1.  .S E=1_U_"Advance Directives: TIU document entered on "_$$DATE^APCM1UTL(D) Q
  1.  Q E
  1. MR ;EP - med reconciliation
  1.  ;for each provider or for the facility find out if this
  1.  ;patient had a er visit or an admission of transferred
  1.  ;if so, then check to see if they have m-mr anytime before end of report period
  1.  NEW APCMP
  1.  S (APCMD1,APCMN1)=0
  1.  I APCMRPTT=2 S APCMP=APCMFAC  D
  1.  .Q:'$D(APCMHVTP(APCMP))  ;no ADMISSIONS/ER TO THIS FACILITY SO SKIP THIS OBJ
  1.  .S APCMEP=$$HASMMR(DFN,APCMBDAT,APCMEDAT,APCMP,.APCMVSTS,APCMMETH)  ;return # of visits^# w/M-MR
  1.  .;set denominator value into field
  1.  .S F=$P(^APCM14OB(APCMIC,0),U,8)  ;denom field for this measure
  1.  .D S^APCM14E1(APCMRPT,APCMIC,$P(APCMEP,U,1),APCMP,APCMRPTT,APCMTIME,F)
  1.  .;numerator?
  1.  .S APCMVALU="# of visits: "_$P(APCMEP,U,1)_" - # w/ M-MR: "_+$P(APCMEP,U,2)_"|||"_$P(APCMEP,U,3)_"|||"_$S($P(APCMEP,U,1)=$P(APCMEP,U,2):1,1:0)
  1.  .S F=$P(^APCM14OB(APCMIC,0),U,9)
  1.  .D S^APCM14E1(APCMRPT,APCMIC,$P(APCMEP,U,2),APCMP,APCMRPTT,APCMTIME,F)
  1.  .Q:$P(APCMEP,U,1)=0
  1.  .D SETLIST^APCM14E1
  1.  Q
  1. HOSER(Z,R) ;EP
  1.  I $P(^AUPNVSIT(Z,0),U,6)'=R Q 0  ;not correct facility
  1.  I $P(^AUPNVSIT(Z,0),U,7)="H" Q 1
  1.  NEW C
  1.  I "A"'[$P(^AUPNVSIT(Z,0),U,7) Q 0
  1.  S C=$$CLINIC^APCLV(Z,"C")
  1.  I C=30 Q 1
  1.  ;I C=80 Q 1
  1.  Q 0
  1. DSCHDATE(V) ;EP
  1.  I 'V Q ""
  1.  I '$D(^AUPNVSIT(V)) Q ""
  1.  NEW Y,Z,D
  1.  S D=""
  1.  I $P(^AUPNVSIT(V,0),U,7)="H" D  Q D
  1.  .S Z=$O(^AUPNVINP("AD",V,0))
  1.  .I 'Z S D=$$VD^APCLV(V) Q
  1.  .S Y=$P($P(^AUPNVINP(Z,0),U),".")
  1.  .S D=Y
  1.  S Z=$O(^AUPNVER("AD",V,0))
  1.  I 'Z Q $$VD^APCLV(V)
  1.  I '$D(^AUPNVER(Z,0)) Q $$VD^APCLV(V)
  1.  S Y=$P($P(^AUPNVER(Z,0),U,13),".")
  1.  I Y="" Q $$VD^APCLV(V)
  1.  Q $P(Y,".")
  1. HASMMR(P,BD,ED,R,VSTS,APCMMETH) ;does patient have a M-MR on each visit?
  1.  ;
  1.  NEW A,B,C,D,E,X,Y,V,PWH,T,W,Z,Q,EDUC
  1.  ;LOOP THROUGH ALL VISITS AND COUNT VISIT AND M-MR'S
  1.  S PWH="0^0"
  1.  S X=0 F  S X=$O(VSTS(X)) Q:X'=+X  D
  1.  .S G=0
  1.  .S V=$P(VSTS(X),U,5)
  1.  .I '$D(^AUPNVSIT(V,0)) Q
  1.  .I $P(^AUPNVSIT(V,0),U,11) Q  ;deleted
  1.  .Q:$P(^AUPNVSIT(V,0),U,6)'=R
  1.  .I APCMMETH="E" D  Q:'G
  1.  ..I '$$HOSER(V,R) Q  ;not correct service category/ER VISIT
  1.  ..S G=1
  1.  .I APCMMETH="O" Q:"OH"'[$P(^AUPNVSIT(V,0),U,7)
  1.  .I $P(^AUPNVSIT(V,0),U,7)="H"!($P(^AUPNVSIT(V,0),U,7)="O") Q:'$$TRANS(V)
  1.  .I $$CLINIC^APCLV(V,"C")=30 Q:'$$ERTRANS(V)
  1.  .S $P(PWH,U,1)=$P(PWH,U,1)+1
  1.  .;V UPDATED REVIEWED SNOMED DURING REPORT PERIOD
  1.  .S Z="",B=""
  1.  .S W=0 F  S W=$O(^AUPNVRUP("AC",P,W)) Q:W'=+W!(Z)  D
  1.  ..S Y=0 F  S Y=$O(^AUPNVRUP(W,26,Y)) Q:Y'=+Y!(Z)  D
  1.  ...I $P($G(^AUPNVRUP(W,26,Y,0)),U,1)'=428191000124101 Q
  1.  ...;getevent date/time (1201)
  1.  ...S E=""
  1.  ...S D=$P($$GET1^DIQ(9000010.54,W,1201,"I"),".")
  1.  ...I D<BD Q
  1.  ...I D>ED Q
  1. SN ...S Z=1
  1.  ...S B=1 S $P(PWH,U,2)=$P(PWH,U,2)+1
  1.  .S $P(PWH,U,3)=$P(PWH,U,3)_$$DATE^APCM1UTL($$VD^APCLV(V))_":"_$S(B:"M-MR",1:"NO M-MR")_";"
  1.  .Q
  1.  Q PWH
  1. TRANS(%) ;
  1.  NEW A
  1.  S A=$$ADMTYPE^APCLV(%,"C")
  1.  I A="" S A=$O(^DGPM("AVISIT",%,0)) I A S A=$$GET1^DIQ(405,A,.04,"I") I A S A=$$GET1^DIQ(405.1,A,9999999.1)
  1.  I A=2 Q 1
  1.  I A=3 Q 1
  1.  I A=4 Q 1
  1.  Q 0
  1.  ;
  1. ERTRANS(%) ;
  1.  NEW E
  1.  S E=$O(^AMERVSIT("AD",%,0))
  1.  I 'E Q 0  ;no visit in ER Visit
  1.  I '$P($G(^AMERVSIT(E,17)),U,1) Q 0
  1.  Q 1
  1. TRANSOUT(%) ;
  1.  NEW A
  1.  S A=$$DSCHTYPE^APCLV(%,"C")
  1.  I A=2 Q 1
  1.  Q 0
  1.  ;
  1. ERTRANSO(%) ;
  1.  NEW E,J
  1.  S E=$O(^AMERVSIT("AD",%,0))
  1.  I 'E Q 0  ;no visit in ER Visit
  1.  S J=$$VAL^XBDIQ1(9009080,E,6.1)
  1.  I J="REFERRED TO ANOTHER SERVICE" Q 1
  1.  I J="TRANSFER TO ANOTHER FACILITY" Q 1
  1.  Q 0