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

APCM11E7.m

Go to the documentation of this file. 
  1. APCM11E7 ;IHS/CMI/LAB - IHS MU; 
  1.  ;;1.0;IHS MU PERFORMANCE REPORTS;**1**;MAR 26, 2012
  1.  ;
  1. ROIH ;EP
  1.  NEW X
  1.  S X=$O(^APCMMUM("B","S1.010.H",0))
  1.  I '$D(APCMIND(X)) Q  ;don't bother as this measure isn't in the report
  1.  NEW APCMD,APCMX,APCMPAT,X,APCMP
  1.  K APCMECHI
  1.  S X=APCMFAC S APCMECHI(X,1)=""
  1.  S X=APCMFAC S APCMECHI(X,2)=""
  1.  ;LOOP THROUGH ROI AND IF I FIND 1 FOR THE HOSPITAL
  1.  S APCMD=$$FMADD^XLFDT(APCMBD,-1)
  1.  S APCM4D=$$FMADD^XLFDT(APCMED,-4)
  1.  F  S APCMD=$O(^BRNREC("B",APCMD)) Q:APCMD'=+APCMD!(APCMD>APCM4D)  D
  1.  .S APCMX=0 F  S APCMX=$O(^BRNREC("B",APCMD,APCMX)) Q:APCMX'=+APCMX  D
  1.  ..Q:$P($G(^BRNREC(APCMX,11)),U,1)'="E"  ;not an electronic request
  1.  ..S APCMPAT=$P($G(^BRNREC(APCMX,0)),U,3)
  1.  ..K APCMVSTS,APCMHVTP
  1.  ..D ALLV^APCLAPIU(APCMPAT,$$FMADD^XLFDT(APCMED,-365),APCMED,"APCMVSTS")
  1.  ..S APCMP=APCMFAC  D
  1.  ...S APCMHV=$$HADVH^APCM11CI(APCMPAT,APCMP,$$FMADD^XLFDT(APCMED,-365),APCMED,.APCMVSTS)
  1.  ...Q:'APCMHV
  1.  ...K APCMECHI(APCMP,1)  ;had a visit with this patient and thus had a request, so no exclusion
  1.  Q:'$G(APCMWPP)
  1.  S APCMD=$$FMADD^XLFDT(APCMPBD,-1)
  1.  S APCM4D=$$FMADD^XLFDT(APCMPED,-4)
  1.  F  S APCMD=$O(^BRNREC("B",APCMD)) Q:APCMD'=+APCMD!(APCMD>APCM4D)  D
  1.  .S APCMX=0 F  S APCMX=$O(^BRNREC("B",APCMD,APCMX)) Q:APCMX'=+APCMX  D
  1.  ..Q:$P($G(^BRNREC(APCMX,11)),U,1)'="E"  ;not an electronic request
  1.  ..S APCMPAT=$P($G(^BRNREC(APCMX,0)),U,3)
  1.  ..K APCMVSTS,APCMHVTP
  1.  ..D ALLV^APCLAPIU(APCMPAT,$$FMADD^XLFDT(APCMPED,-365),APCMPED,"APCMVSTS")
  1.  ..S APCMP=0 F  S APCMP=$O(APCMPRV(APCMP)) Q:APCMP'=+APCMP  D
  1.  ...S APCMHV=$$HADV^APCM11CI(APCMPAT,APCMP,$$FMADD^XLFDT(APCMPED,-365),APCMPED,.APCMVSTS)
  1.  ...Q:'APCMHV
  1.  ...K APCMECHI(APCMP,2)  ;had a visit with this patient and thus had a request, so no exclusion
  1.  Q
  1. LAB ;EP - CALCULATE LAB
  1.  ;for each provider or for the facility count all labs that meet criteria and if it is not written it meets numerator
  1.  K ^TMP($J,"PATSRX")
  1.  K APCMLABS
  1.  D TOTLAB
  1.  NEW APCMP,N,F
  1.  S (APCMD1,APCMN1)=0
  1.  I APCMRPTT=2 S APCMP=APCMFAC  D
  1.  .;I '$P($G(APCMLABS(APCMP)),U,1) S F=$P(^APCMMUM(APCMIC,0),U,11) D S^APCM11E1(APCMRPT,APCMIC,"Provider is excluded from this measure as he/she did not order any lab tests with results during the time period.",APCMP,APCMRPTT,APCMTIME,F,1) Q
  1.  .;set denominator value into field
  1.  .S F=$P(^APCMMUM(APCMIC,0),U,8)  ;denom field for this measure
  1.  .S N=$P($G(APCMLABS(APCMP)),U,1)  ;returns # of LABS^# not Structured data
  1.  .D S^APCM11E1(APCMRPT,APCMIC,+N,APCMP,APCMRPTT,APCMTIME,F)
  1.  .;now set patient list for this provider
  1.  .S P=0 F  S P=$O(^TMP($J,"PATSRX",APCMP,P)) Q:P'=+P  D
  1.  ..;Q:'$P(^TMP($J,"PATSRX",APCMP,P),U,1)
  1.  ..I $P(^TMP($J,"PATSRX",APCMP,P),U,1)=$P(^TMP($J,"PATSRX",APCMP,P),U,2) S APCMVALU="# Labs: "_$P(^TMP($J,"PATSRX",APCMP,P),U,1)_"|||"_" # w/structured result: "_+$P(^TMP($J,"PATSRX",APCMP,P),U,2)_"|||1" D  Q
  1.  ...S DFN=P D SETLIST^APCM11E1 Q
  1.  ..S S="",APCMVALU="No Structured Result: "
  1.  ..F  S S=$O(^TMP($J,"PATSRX",APCMP,P,"SCRIPTS",S)) Q:S=""  D
  1.  ...I '$D(^TMP($J,"PATSRX",APCMP,P,"ELEC",S)) D
  1.  ....S APCMVALU=APCMVALU_S_";"
  1.  ..S DFN=P,APCMVALU="# of Labs: "_$P(^TMP($J,"PATSRX",APCMP,P),U,1)_" # w/structured results: "_+$P(^TMP($J,"PATSRX",APCMP,P),U,2)_"|||"_APCMVALU,$P(APCMVALU,"|||",3)=0 D SETLIST^APCM11E1
  1.  .;numerator?
  1.  .S F=$P(^APCMMUM(APCMIC,0),U,9)
  1.  .S N=$P($G(APCMLABS(APCMP)),U,2)
  1.  .D S^APCM11E1(APCMRPT,APCMIC,+N,APCMP,APCMRPTT,APCMTIME,F)
  1.  K ^TMP($J,"PATSRX")
  1.  Q
  1. TOTLAB ;EP - 
  1.  ;SET ARRAY APCMLABS to APCMLABS(prov ien)=denom^numer
  1.  ;IF DENOM =0 THEN PROVIDER EXCLUSION
  1.  NEW ID,C,Y,X,D,S,N,A,B,R,PAT,D,APCMLAB1,PAT
  1.  K APCMLAB1
  1.  S C=0,N=0
  1.  S LABSNO=""
  1.  S T=$O(^ATXLAB("B","BGP PAP SMEAR TAX",0))
  1.  S (ID,SD)=$$FMADD^XLFDT(APCMBDAT,-365),ID=ID_".99999"
  1.  F  S ID=$O(^AUPNVSIT("B",ID)) Q:ID'=+ID  D
  1.  .S X=0 F  S X=$O(^AUPNVSIT("B",ID,X)) Q:X'=+X  D
  1.  ..K APCMLAB1
  1.  ..S PAT=$P(^AUPNVSIT(X,0),U,5)
  1.  ..Q:'$D(^AUPNVLAB("AD",X))  ;no labs
  1.  ..Q:$P(^AUPNVSIT(X,0),U,6)'=APCMFAC
  1.  ..I '$$HOSER^APCM11E6(X,APCMFAC),$P(^AUPNVSIT(X,0),U,7)'="I" Q  ;not a H or 30 or I
  1.  ..S D=$$VD^APCLV(X)
  1.  ..S Y=0 F  S Y=$O(^AUPNVLAB("AD",X,Y)) Q:Y'=+Y  D
  1.  ...Q:$P($P($G(^AUPNVLAB(Y,12)),U,1),".")>APCMEDAT  ;ordered after end date
  1.  ...I $P($G(^AUPNVLAB(Y,12)),U,1)]"" Q:$P($P($G(^AUPNVLAB(Y,12)),U,1),".")<APCMBDAT  ;ordered before beg date
  1.  ...S A=$P(^AUPNVLAB(Y,0),U,1)
  1.  ...I T,$D(^ATXLAB(T,21,"B",A)) Q   ;it's a pap smear
  1.  ...I $$UP^XLFSTR($P(^AUPNVLAB(Y,0),U,4))="CANC" Q  ;it's cancelled
  1.  ...S APCMLAB1(Y)=D_"^"_$$VAL^XBDIQ1(9000010.09,Y,.01)_"^"_$$VAL^XBDIQ1(9000010.09,Y,.04)_"^"_Y_"^"_$P(^AUPNVLAB(Y,0),U,3)
  1.  ..;now go back through the labs and count or not count them
  1.  ..S Y=0 F  S Y=$O(APCMLAB1(Y)) Q:Y'=+Y  D
  1.  ...Q:$P(APCMLAB1(Y),U,10)]""  ;already processed this one
  1.  ...;is this a panel and if so do panel check
  1.  ...S PAR=$P($G(^AUPNVLAB(Y,12)),U,8)
  1.  ...I PAR S $P(APCMLAB1(Y),U,10)="HAS PARENT SKIP/EXCL" Q  ;has a parent, will deal with parent
  1.  ...D SETDENL
  1.  ...;now check numerator
  1.  ...;if panel do panel check for 1 test that is resulted
  1.  ...I $O(^LAB(60,A,2,0)) D PANEL Q
  1.  ...Q:$P($G(^AUPNVLAB(Y,11)),U,9)'="R"  ;if status not resulted it doesn't make the numerator
  1.  ...I $$UP^XLFSTR($P(^AUPNVLAB(Y,0),U,4))="COMMENT",'$$HASCOM(Y) Q
  1.  ...S $P(APCMLABS(APCMFAC),U,2)=$P(APCMLABS(APCMFAC),U,2)+1
  1.  ...S $P(^TMP($J,"PATSRX",APCMFAC,PAT),U,2)=$P($G(^TMP($J,"PATSRX",APCMFAC,PAT)),U,2)+1 S ^TMP($J,"PATSRX",APCMFAC,PAT,"ELEC",$$VAL^XBDIQ1(9000010.09,Y,1201)_" "_$$VAL^XBDIQ1(9000010.09,Y,.01))=""  ;S N=N+G Q  ;S N=N+G
  1.  Q
  1. PANEL ;
  1.  ;find all children and find at least one with a result, if one found set numerator
  1.  NEW X,Z,G,P
  1.  S G=0
  1.  S X=0 F  S X=$O(APCMLAB1(X)) Q:X'=+X!(G)  D
  1.  .S P=$P($G(^AUPNVLAB(X,12)),U,8)
  1.  .I P'=Y Q  ;not a member of this panel
  1.  .I $P($G(^AUPNVLAB(Y,11)),U,9)'="R" S $P(APCMLAB1(X),U,10)="NOT RESULTED" Q
  1.  .I $$UP^XLFSTR($P(^AUPNVLAB(X,0),U,4))="COMMENT",'$$HASCOM(X) S $P(APCMLAB1(X),U,10)="comment/no comments" Q
  1.  .S G=1
  1.  Q:'G
  1.  S $P(APCMLABS(APCMFAC),U,2)=$P(APCMLABS(APCMFAC),U,2)+1
  1.  S $P(^TMP($J,"PATSRX",APCMFAC,PAT),U,2)=$P($G(^TMP($J,"PATSRX",APCMFAC,PAT)),U,2)+1 S ^TMP($J,"PATSRX",APCMFAC,PAT,"ELEC",$$VAL^XBDIQ1(9000010.09,Y,1201)_" "_$$VAL^XBDIQ1(9000010.09,Y,.01))=""  ;S N=N+G Q  ;S N=N+G
  1.  Q
  1.  ;
  1. HASCOM(L) ;ARE THERE ANY COMMENTS
  1.  I '$D(^AUPNVLAB(L,21)) Q 0  ;no comment multiple
  1.  NEW B,G
  1.  S G=0
  1.  S B=0 F  S B=$O(^AUPNVLAB(L,21,B)) Q:B'=+B  I ^AUPNVLAB(L,21,B,0)]"" S G=1  ;has comment
  1.  Q G
  1.  ;
  1. SETDENL ;
  1.  S $P(APCMLAB1(Y),U,10)=1  ;processed this test
  1.  I '$D(APCMLABS(APCMFAC)) S APCMLABS(APCMFAC)=""
  1.  S $P(APCMLABS(APCMFAC),U,1)=$P(APCMLABS(APCMFAC),U,1)+1
  1.  S $P(^TMP($J,"PATSRX",APCMFAC,PAT),U,1)=$P($G(^TMP($J,"PATSRX",APCMFAC,PAT)),U,1)+1,^TMP($J,"PATSRX",APCMFAC,PAT,"SCRIPTS",$$VAL^XBDIQ1(9000010.09,Y,1201)_" "_$$VAL^XBDIQ1(9000010.09,Y,.01))=""
  1.  Q