APCM14E7 ;IHS/CMI/LAB - IHS MU;
;;1.0;IHS MU PERFORMANCE REPORTS;**5,6**;MAR 26, 2012;Build 65
;
LAB ;EP - CALCULATE LAB
;for each provider or for the facility count all labs that meet criteria and if it is not written it meets numerator
K ^TMP($J,"PATSRX")
K APCMLABS
D TOTLAB
NEW APCMP,N,F
S (APCMD1,APCMN1)=0
I APCMRPTT=2 S APCMP=APCMFAC D
.;I '$P($G(APCMLABS(APCMP)),U,1) S F=$P(^APCM14OB(APCMIC,0),U,11) D S^APCM14E1(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
.;set denominator value into field
.S F=$P(^APCM14OB(APCMIC,0),U,8) ;denom field for this measure
.S N=$P($G(APCMLABS(APCMP)),U,1) ;returns # of LABS^# not Structured data
.D S^APCM14E1(APCMRPT,APCMIC,+N,APCMP,APCMRPTT,APCMTIME,F)
.;now set patient list for this provider
.S P=0 F S P=$O(^TMP($J,"PATSRX",APCMP,P)) Q:P'=+P D
..;Q:'$P(^TMP($J,"PATSRX",APCMP,P),U,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
...S DFN=P D SETLIST^APCM14E1 Q
..S S="",APCMVALU="No Structured Result: "
..F S S=$O(^TMP($J,"PATSRX",APCMP,P,"SCRIPTS",S)) Q:S="" D
...I '$D(^TMP($J,"PATSRX",APCMP,P,"ELEC",S)) D
....S APCMVALU=APCMVALU_S_";"
..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^APCM14E1
.;numerator?
.S F=$P(^APCM14OB(APCMIC,0),U,9)
.S N=$P($G(APCMLABS(APCMP)),U,2)
.D S^APCM14E1(APCMRPT,APCMIC,+N,APCMP,APCMRPTT,APCMTIME,F)
K ^TMP($J,"PATSRX")
Q
TOTLAB ;EP - ep LAB
;SET ARRAY APCMLABS to APCMLABS(prov ien)=denom^numer
;IF DENOM =0 THEN PROVIDER EXCLUSION
NEW ID,C,Y,X,D,S,N,A,B,R,PAT,ED,APCMLAB,APCMX,APCML,PAR
S ED=9999999-APCMBDAT,ED=ED_".9999"
S SD=9999999-APCMEDAT
S C=0,N=0,PAT=""
S LABSNO=""
S T=$O(^ATXLAB("B","BGP PAP SMEAR TAX",0))
S PAT="" F S PAT=$O(^AUPNVSIT("AA",PAT)) Q:PAT'=+PAT D TOTLAB1
Q
TOTLAB1 ;
NEW APCMLAB,APCMLAB1
S APCMLAB="APCMLAB"
D ALLLAB^APCM24EB(PAT,APCMBDAT,APCMEDAT,,,,.APCMLAB)
;reorder by IEN of v lab
K APCMLAB1
S APCMX=0 F S APCMX=$O(APCMLAB(APCMX)) Q:APCMX'=+APCMX D
.S V=$P(APCMLAB(APCMX),U,5) ;VISIT IEN
.S Y=$P(APCMLAB(APCMX),U,4) ;V LAB IEN
.Q:'$D(^AUPNVSIT(V,0)) ;NO VISIT??
.Q:$P(^AUPNVSIT(V,0),U,6)'=APCMFAC
.I APCMMETH="E" I '$$HOSER^APCM14E6(V,APCMFAC),$P(^AUPNVSIT(V,0),U,7)'="I" Q ;not a H or 30 or I
.I APCMMETH="O" Q:"IOH"'[$P(^AUPNVSIT(V,0),U,7)
.S A=$P(^AUPNVLAB(Y,0),U,1) ;test pointer
.I T,$D(^ATXLAB(T,21,"B",A)) Q ;it's a pap smear
.I $$UP^XLFSTR($$VAL^XBDIQ1(9000010.09,Y,.01))="PAP SMEAR" Q ;it's a pap smear
.I $$UP^XLFSTR($P(^AUPNVLAB(Y,0),U,4))="CANC" Q
.I $O(^LAB(60,A,2,0)) Q ;this is the v lab for the panel
.I '$D(APCMLABS(APCMFAC)) S APCMLABS(APCMFAC)=""
.S $P(APCMLABS(APCMFAC),U,1)=$P(APCMLABS(APCMFAC),U,1)+1 D
..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))=""
.;now check numerator
.Q:$P($G(^AUPNVLAB(Y,11)),U,9)'="R" ;if status not resulted it doesn't make the numerator
.I $$UP^XLFSTR($P(^AUPNVLAB(Y,0),U,4))="COMMENT",'$$HASCOM(Y) Q
.S $P(APCMLABS(APCMFAC),U,2)=$P(APCMLABS(APCMFAC),U,2)+1 D
..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
Q
;
HASCOM(L) ;ARE THERE ANY COMMENTS
I '$D(^AUPNVLAB(L,21)) Q 0
NEW B,G
S G=0
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
Q G
APCM14E7 ;IHS/CMI/LAB - IHS MU;
+1 ;;1.0;IHS MU PERFORMANCE REPORTS;**5,6**;MAR 26, 2012;Build 65
+2 ;
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
+2 KILL ^TMP($JOB,"PATSRX")
+3 KILL APCMLABS
+4 DO TOTLAB
+5 NEW APCMP,N,F
+6 SET (APCMD1,APCMN1)=0
+7 IF APCMRPTT=2
SET APCMP=APCMFAC
Begin DoDot:1
+8 ;I '$P($G(APCMLABS(APCMP)),U,1) S F=$P(^APCM14OB(APCMIC,0),U,11) D S^APCM14E1(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
+9 ;set denominator value into field
+10 ;denom field for this measure
SET F=$PIECE(^APCM14OB(APCMIC,0),U,8)
+11 ;returns # of LABS^# not Structured data
SET N=$PIECE($GET(APCMLABS(APCMP)),U,1)
+12 DO S^APCM14E1(APCMRPT,APCMIC,+N,APCMP,APCMRPTT,APCMTIME,F)
+13 ;now set patient list for this provider
+14 SET P=0
FOR
SET P=$ORDER(^TMP($JOB,"PATSRX",APCMP,P))
IF P'=+P
QUIT
Begin DoDot:2
+15 ;Q:'$P(^TMP($J,"PATSRX",APCMP,P),U,1)
+16 IF $PIECE(^TMP($JOB,"PATSRX",APCMP,P),U,1)=$PIECE(^TMP($JOB,"PATSRX",APCMP,P),U,2)
SET APCMVALU="# Labs: "_$PIECE(^TMP($JOB,"PATSRX",APCMP,P),U,1)_"|||"_" # w/structured result: "_+$PIECE(^TMP($JOB,"PATSRX",APCMP,P),U,2)_"|||1"
Begin DoDot:3
+17 SET DFN=P
DO SETLIST^APCM14E1
QUIT
End DoDot:3
QUIT
+18 SET S=""
SET APCMVALU="No Structured Result: "
+19 FOR
SET S=$ORDER(^TMP($JOB,"PATSRX",APCMP,P,"SCRIPTS",S))
IF S=""
QUIT
Begin DoDot:3
+20 IF '$DATA(^TMP($JOB,"PATSRX",APCMP,P,"ELEC",S))
Begin DoDot:4
+21 SET APCMVALU=APCMVALU_S_";"
End DoDot:4
End DoDot:3
+22 SET DFN=P
SET APCMVALU="# of Labs: "_$PIECE(^TMP($JOB,"PATSRX",APCMP,P),U,1)_" # w/structured results: "_+$PIECE(^TMP($JOB,"PATSRX",APCMP,P),U,2)_"|||"_APCMVALU
SET $PIECE(APCMVALU,"|||",3)=0
DO SETLIST^APCM14E1
End DoDot:2
+23 ;numerator?
+24 SET F=$PIECE(^APCM14OB(APCMIC,0),U,9)
+25 SET N=$PIECE($GET(APCMLABS(APCMP)),U,2)
+26 DO S^APCM14E1(APCMRPT,APCMIC,+N,APCMP,APCMRPTT,APCMTIME,F)
End DoDot:1
+27 KILL ^TMP($JOB,"PATSRX")
+28 QUIT
TOTLAB ;EP - ep LAB
+1 ;SET ARRAY APCMLABS to APCMLABS(prov ien)=denom^numer
+2 ;IF DENOM =0 THEN PROVIDER EXCLUSION
+3 NEW ID,C,Y,X,D,S,N,A,B,R,PAT,ED,APCMLAB,APCMX,APCML,PAR
+4 SET ED=9999999-APCMBDAT
SET ED=ED_".9999"
+5 SET SD=9999999-APCMEDAT
+6 SET C=0
SET N=0
SET PAT=""
+7 SET LABSNO=""
+8 SET T=$ORDER(^ATXLAB("B","BGP PAP SMEAR TAX",0))
+9 SET PAT=""
FOR
SET PAT=$ORDER(^AUPNVSIT("AA",PAT))
IF PAT'=+PAT
QUIT
DO TOTLAB1
+10 QUIT
TOTLAB1 ;
+1 NEW APCMLAB,APCMLAB1
+2 SET APCMLAB="APCMLAB"
+3 DO ALLLAB^APCM24EB(PAT,APCMBDAT,APCMEDAT,,,,.APCMLAB)
+4 ;reorder by IEN of v lab
+5 KILL APCMLAB1
+6 SET APCMX=0
FOR
SET APCMX=$ORDER(APCMLAB(APCMX))
IF APCMX'=+APCMX
QUIT
Begin DoDot:1
+7 ;VISIT IEN
SET V=$PIECE(APCMLAB(APCMX),U,5)
+8 ;V LAB IEN
SET Y=$PIECE(APCMLAB(APCMX),U,4)
+9 ;NO VISIT??
IF '$DATA(^AUPNVSIT(V,0))
QUIT
+10 IF $PIECE(^AUPNVSIT(V,0),U,6)'=APCMFAC
QUIT
+11 ;not a H or 30 or I
IF APCMMETH="E"
IF '$$HOSER^APCM14E6(V,APCMFAC)
IF $PIECE(^AUPNVSIT(V,0),U,7)'="I"
QUIT
+12 IF APCMMETH="O"
IF "IOH"'[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+13 ;test pointer
SET A=$PIECE(^AUPNVLAB(Y,0),U,1)
+14 ;it's a pap smear
IF T
IF $DATA(^ATXLAB(T,21,"B",A))
QUIT
+15 ;it's a pap smear
IF $$UP^XLFSTR($$VAL^XBDIQ1(9000010.09,Y,.01))="PAP SMEAR"
QUIT
+16 IF $$UP^XLFSTR($PIECE(^AUPNVLAB(Y,0),U,4))="CANC"
QUIT
+17 ;this is the v lab for the panel
IF $ORDER(^LAB(60,A,2,0))
QUIT
+18 IF '$DATA(APCMLABS(APCMFAC))
SET APCMLABS(APCMFAC)=""
+19 SET $PIECE(APCMLABS(APCMFAC),U,1)=$PIECE(APCMLABS(APCMFAC),U,1)+1
Begin DoDot:2
+20 SET $PIECE(^TMP($JOB,"PATSRX",APCMFAC,PAT),U,1)=$PIECE($GET(^TMP($JOB,"PATSRX",APCMFAC,PAT)),U,1)+1
SET ^TMP($JOB,"PATSRX",APCMFAC,PAT,"SCRIPTS",$$VAL^XBDIQ1(9000010.09,Y,1201)_" "_$$VAL^XBDIQ1(9000010.09,Y,.01))=""
End DoDot:2
+21 ;now check numerator
+22 ;if status not resulted it doesn't make the numerator
IF $PIECE($GET(^AUPNVLAB(Y,11)),U,9)'="R"
QUIT
+23 IF $$UP^XLFSTR($PIECE(^AUPNVLAB(Y,0),U,4))="COMMENT"
IF '$$HASCOM(Y)
QUIT
+24 SET $PIECE(APCMLABS(APCMFAC),U,2)=$PIECE(APCMLABS(APCMFAC),U,2)+1
Begin DoDot:2
+25 ;S N=N+G Q ;S N=N+G
SET $PIECE(^TMP($JOB,"PATSRX",APCMFAC,PAT),U,2)=$PIECE($GET(^TMP($JOB,"PATSRX",APCMFAC,PAT)),U,2)+1
SET ^TMP($JOB,"PATSRX",APCMFAC,PAT,"ELEC",$$VAL^XBDIQ1(9000010.09,Y,1201)_" "_$$VAL^XBDIQ1(9000010.09,Y,.01))=""
End DoDot:2
End DoDot:1
+26 QUIT
+27 ;
HASCOM(L) ;ARE THERE ANY COMMENTS
+1 IF '$DATA(^AUPNVLAB(L,21))
QUIT 0
+2 NEW B,G
+3 SET G=0
+4 ;has comment
SET B=0
FOR
SET B=$ORDER(^AUPNVLAB(L,21,B))
IF B'=+B
QUIT
IF ^AUPNVLAB(L,21,B,0)]""
SET G=1
+5 QUIT G
