APCM24E6 ;IHS/CMI/LAB - IHS MU;
;;1.0;IHS MU PERFORMANCE REPORTS;**5,6**;MAR 26, 2012;Build 65
;;;;;;Build 3
ADV ;EP - CALCULATE adv directives
NEW APCMP,APCMZ
S (APCMD1,APCMN1)=0
I APCMRPTT=2 D
.S APCMP=APCMFAC
.I $D(APCMHO65(APCMP,APCMTIME)) S F=$P(^APCM24OB(APCMIC,0),U,11) D Q
..D S^APCM24E1(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
.S APCMZ=$$HASADM65(DFN,APCMP,.APCMVSTS)
.Q:APCMZ="" ;NO ADMISSION
.D ADV1
.Q
Q
HASADM65(P,R,VSTS) ;
NEW X,Y,Z,V,G
S G=""
S X=0 F S X=$O(VSTS(X)) Q:X'=+X!(G) D
.S V=$P(VSTS(X),U,5)
.I '$D(^AUPNVSIT(V,0)) Q
.I $P(^AUPNVSIT(V,0),U,11) Q
.I $P(^AUPNVSIT(V,0),U,7)'="H" Q ;not correct service category
.Q:$P(^AUPNVSIT(V,0),U,6)'=APCMP ;not this facility
.Q:$$AGE^AUPNPAT(P,$$VD^APCLV(V))<65 ;not 65 on date of admission
.S G=$$VD^APCLV(V)
Q G
ADV1 ;
;set denominator value into field
S F=$P(^APCM24OB(APCMIC,0),U,8) ;denom field for this measure
D S^APCM24E1(APCMRPT,APCMIC,1,APCMP,APCMRPTT,APCMTIME,F)
S APCMVALU="Admission: "_$$DATE^APCM1UTL(APCMZ)_" Age: "_$$AGE^AUPNPAT(DFN,APCMZ)
;numerator?
S APCMEP=$$HASADV(DFN,APCMEDAT)
S APCMVALU=APCMVALU_"|||"_$P(APCMEP,U,2)_"|||"_$P(APCMEP,U,1)
S F=$P(^APCM24OB(APCMIC,0),U,9)
D S^APCM24E1(APCMRPT,APCMIC,$P(APCMEP,U,1),APCMP,APCMRPTT,APCMTIME,F)
D SETLIST^APCM24E1
Q
HASADV(P,ED) ;does patient have an ADVANCE DIRECTIVE before end of report period
;
NEW A,B,C,D,E,X
;check advance directive file
S E=""
S X=0 F S X=$O(^AUPNADVD(P,11,X)) Q:X'=+X!(E) D
.Q:'$D(^AUPNADVD(P,11,X,0)) ;no zero node?
.S D=$P(^AUPNADVD(P,11,X,0),U,1)
.I D>ED Q ;after report period
.S B=$P(^AUPNADVD(P,11,X,0),U,2)
.Q:B=""
.S E=1_U_"Advance Directives: "_$S(B="Y":"YES",1:"NO")_" entered on "_$$DATE^APCM1UTL(D) Q
I E]"" Q E
;now check for TIU Note title before ED of A
S X=0 F S X=$O(^AUPNVNOT("AC",P,X)) Q:X'=+X!(E) D
.S B=$$VAL^XBDIQ1(9000010.28,X,.01)
.Q:$$UP^XLFSTR(B)'="ADVANCE DIRECTIVE"
.S D=$$VD^APCLV($P(^AUPNVNOT(X,0),U,3))
.Q:D>ED
.S E=1_U_"Advance Directives: TIU document entered on "_$$DATE^APCM1UTL(D) Q
Q E
MR ;EP - med reconciliation
;for each provider or for the facility find out if this
;patient had a er visit or an admission of transferred
;if so, then check to see if they have m-mr anytime before end of report period
NEW APCMP
S (APCMD1,APCMN1)=0
I APCMRPTT=2 S APCMP=APCMFAC D
.Q:'$D(APCMHVTP(APCMP)) ;no ADMISSIONS/ER TO THIS FACILITY SO SKIP THIS OBJ
.S APCMEP=$$HASMMR(DFN,APCMBDAT,APCMEDAT,APCMP,.APCMVSTS,APCMMETH) ;return # of visits^# w/M-MR
.;set denominator value into field
.S F=$P(^APCM24OB(APCMIC,0),U,8) ;denom field for this measure
.D S^APCM24E1(APCMRPT,APCMIC,$P(APCMEP,U,1),APCMP,APCMRPTT,APCMTIME,F)
.;numerator?
.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)
.S F=$P(^APCM24OB(APCMIC,0),U,9)
.D S^APCM24E1(APCMRPT,APCMIC,$P(APCMEP,U,2),APCMP,APCMRPTT,APCMTIME,F)
.Q:$P(APCMEP,U,1)=0
.D SETLIST^APCM24E1
Q
HOSER(Z,R) ;EP
I $P(^AUPNVSIT(Z,0),U,6)'=R Q 0 ;not correct facility
I $P(^AUPNVSIT(Z,0),U,7)="H" Q 1
NEW C
I "A"'[$P(^AUPNVSIT(Z,0),U,7) Q 0
S C=$$CLINIC^APCLV(Z,"C")
I C=30 Q 1
;I C=80 Q 1
Q 0
DSCHDATE(V) ;EP
I 'V Q ""
I '$D(^AUPNVSIT(V)) Q ""
NEW Y,Z,D
S D=""
I $P(^AUPNVSIT(V,0),U,7)="H" D Q D
.S Z=$O(^AUPNVINP("AD",V,0))
.I 'Z S D=$$VD^APCLV(V) Q
.S Y=$P($P(^AUPNVINP(Z,0),U),".")
.S D=Y
S Z=$O(^AUPNVER("AD",V,0))
I 'Z Q $$VD^APCLV(V)
I '$D(^AUPNVER(Z,0)) Q $$VD^APCLV(V)
S Y=$P($P(^AUPNVER(Z,0),U,13),".")
I Y="" Q $$VD^APCLV(V)
Q $P(Y,".")
HASMMR(P,BD,ED,R,VSTS,APCMMETH) ;does patient have a M-MR on each visit?
;
NEW A,B,C,D,E,X,Y,V,PWH,T,W,Z,Q,EDUC,G,BDD,EDD
;LOOP THROUGH ALL VISITS AND COUNT VISIT AND M-MR'S
S PWH="0^0"
S X=0 F S X=$O(VSTS(X)) Q:X'=+X D
.S G=0
.S V=$P(VSTS(X),U,5)
.I '$D(^AUPNVSIT(V,0)) Q
.I $P(^AUPNVSIT(V,0),U,11) Q ;deleted
.Q:$P(^AUPNVSIT(V,0),U,6)'=R
.I APCMMETH="E" D Q:'G
..I '$$HOSER(V,R) Q ;not correct service category/ER VISIT
..S G=1
.I APCMMETH="O" Q:"OH"'[$P(^AUPNVSIT(V,0),U,7)
.I $P(^AUPNVSIT(V,0),U,7)="H"!($P(^AUPNVSIT(V,0),U,7)="O") Q:'$$TRANS(V)
.I $$CLINIC^APCLV(V,"C")=30 Q:'$$ERTRANS(V)
.S $P(PWH,U,1)=$P(PWH,U,1)+1
.;V UPDATED REVIEWED SNOMED DURING REPORT PERIOD
.S Z="",B=""
.S W=0 F S W=$O(^AUPNVRUP("AC",P,W)) Q:W'=+W!(Z) D
..S Y=0 F S Y=$O(^AUPNVRUP(W,26,Y)) Q:Y'=+Y!(Z) D
...I $P($G(^AUPNVRUP(W,26,Y,0)),U,1)'=428191000124101 Q
...;getevent date/time (1201)
...S E=""
...S D=$P($$GET1^DIQ(9000010.54,W,1201,"I"),".")
...I D<BD Q
...I D>ED Q
SN ...S Z=1
...S B=1 S $P(PWH,U,2)=$P(PWH,U,2)+1
.S $P(PWH,U,3)=$P(PWH,U,3)_$$DATE^APCM1UTL($$VD^APCLV(V))_":"_$S(B:"M-MR",1:"NO M-MR")_";"
.Q
Q PWH
TRANS(%) ;
NEW A
S A=$$ADMTYPE^APCLV(%,"C")
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)
I A=2 Q 1
I A=3 Q 1
I A=4 Q 1
Q 0
;
ERTRANS(%) ;
NEW E
S E=$O(^AMERVSIT("AD",%,0))
I 'E Q 0 ;no visit in ER Visit
I '$P($G(^AMERVSIT(E,17)),U,1) Q 0
Q 1
TRANSOUT(%) ;
NEW A
S A=$$DSCHTYPE^APCLV(%,"C")
I A=2 Q 1
Q 0
;
ERTRANSO(%) ;
NEW E,J
S E=$O(^AMERVSIT("AD",%,0))
I 'E Q 0 ;no visit in ER Visit
S J=$$VAL^XBDIQ1(9009080,E,6.1)
I J="REFERRED TO ANOTHER SERVICE" Q 1
I J="TRANSFER TO ANOTHER FACILITY" Q 1
Q 0
PVCL(N) ;
I '$G(N) Q ""
I '$D(^VA(200,N,0)) Q ""
NEW C,T
S C=$$GET1^DIQ(200,N,53.5,"I")
I C="" Q ""
S C=$P($G(^DIC(7,C,9999999)),U,1)
I C="" Q ""
S T=$O(^APCMMUCN("B","INTERIM STAGE 2 2014",0))
I 'T Q ""
I '$D(^APCMMUCN(T,19,"B",C)) Q ""
Q 1
EN ;EP - CALCULATE ELECTRONIC NOTES
NEW APCMP
S (APCMD1,APCMN1)=0
I APCMRPTT=1 D Q
.S APCMP=0 F S APCMP=$O(APCMPRV(APCMP)) Q:APCMP'=+APCMP D
..Q:'$$PVCL(APCMP) ;PROVIDER ISN'T THE RIGHT CLASS CODE
..Q:'$D(APCMHVTP(APCMP)) ;no visits to this provider for this patient so don't bother, the patient is not in the denominator
..D EN1
I APCMRPTT=2 D
.S APCMP=APCMFAC
.Q:'$D(APCMHVTP(APCMP))
.D EN1
.Q
Q
EN1 ;set denominator value into field
S F=$P(^APCM24OB(APCMIC,0),U,8) ;denom field for this measure
D S^APCM24E1(APCMRPT,APCMIC,1,APCMP,APCMRPTT,APCMTIME,F)
S APCMVALU="VISIT: "_$$DATE^APCM1UTL(APCMHVTP(APCMP))
;numerator?
S APCMEP=$$HASEN(DFN,APCMBDAT,APCMEDAT,APCMP)
S APCMVALU=APCMVALU_"|||"_$P(APCMEP,U,2)_"|||"_$P(APCMEP,U,1)
S F=$P(^APCM24OB(APCMIC,0),U,9)
D S^APCM24E1(APCMRPT,APCMIC,$P(APCMEP,U,1),APCMP,APCMRPTT,APCMTIME,F)
D SETLIST^APCM24E1
Q
HASEN(P,BD,ED,R) ;does patient have a AN ELECTRONIC NOTE?
;
NEW A,B,C,D,E,T,N,X,Y,G,X
S G=""
;$o through TIU document file AA xref for this patient
;find first one with ep as author/signer
;or ep is co signer and author/signor is a student
;skip notes with report text ="VistA Imaging - Scanned Document
S T=0 F S T=$O(^TIU(8925,"AA",P,T)) Q:T'=+T!(G) D
.S D=0 F S D=$O(^TIU(8925,"AA",P,T,D)) Q:D'=+D!(G) D
..S X=0 F S X=$O(^TIU(8925,"AA",P,T,D,X)) Q:X'=+X!(G) D
...;check report text
...Q:$$SCAN(X)
...;ADDED LOGIC PER DONNA AND JOANNE 9/3/2014 TO MAKE SURE NOTE IS WITHIN REPORT PERIOD
...S Z=$P($$GET1^DIQ(8925,X,1201,"I"),".")
...Q:Z<BD
...Q:Z>ED
...Q:'$$PRVD(X) ;not on of this providers
...S G=1_U_"Note: "_$$GET1^DIQ(8925,X,1201)
Q G
SCAN(%) ;
NEW A,B,C
S A=0,B="" F S A=$O(^TIU(8925,%,"TEXT",A)) Q:A'=+A S B=B_^TIU(8925,%,"TEXT",A,0)
I $$UP^XLFSTR(B)["VISTA IMAGING - SCANNED DOCUMENT" Q 1
Q 0
PRVD(%) ;
NEW A,S,C,D
S A=$$GET1^DIQ(8925,%,1202,"I") ;AUTHOR
S S=$$GET1^DIQ(8925,%,1502,"I") ;SIGNED BY
;I A=R,S=R Q 1
I A=S,$$PVCL(A) Q 1
S C=$$GET1^DIQ(8925,%,1508,"I") ;CO SIGNER
I '$$PVCL(C) Q 0
;I C'=R Q 0
I '$$ISA^USRLM(A,"STUDENT","",$P($$GET1^DIQ(8925,%,1201,"I"),".",1)) Q 0
I '$$ISA^USRLM(S,"STUDENT","",$P($$GET1^DIQ(8925,%,1201,"I"),".",1)) Q 0
Q 1
;
IMGR ;EP - IMAGING RESULTS
;for each provider or for the facility count all rad EXAM that meet criteria
K ^TMP($J,"PATSRAD")
K APCMRADS
D IMGR1
K ^TMP($J,"ORDERSPROCESSED")
NEW APCMP,N,F
S (APCMD1,APCMN1)=0
I APCMRPTT=1 S APCMP=0 F S APCMP=$O(APCMPRV(APCMP)) Q:APCMP'=+APCMP D
.I $P($G(APCMRADS(APCMP)),U,1)<100 S F=$P(^APCM24OB(APCMIC,0),U,11) D
..D S^APCM24E1(APCMRPT,APCMIC,"Provider is excluded from this measure as he/she had < 100 Radiology EXAMS during the EHR reporting period.",APCMP,APCMRPTT,APCMTIME,F,1)
DR .;set denominator value into field
.S F=$P(^APCM24OB(APCMIC,0),U,8) ;denom field for this measure
.S N=$P($G(APCMRADS(APCMP)),U,1) ;returns # of prescriptions^# not written by nature of order
.D S^APCM24E1(APCMRPT,APCMIC,N,APCMP,APCMRPTT,APCMTIME,F)
.;now set patient list for this provider
.S P=0 F S P=$O(^TMP($J,"PATSRAD",APCMP,P)) Q:P'=+P D
..S D=$P(^TMP($J,"PATSRAD",APCMP,P),U,1),N=$P(^TMP($J,"PATSRAD",APCMP,P),U,2) S APCMVALU="# Orders: "_D_"|||"_"# IMAGE: "_N_" # NO IMAGE: "_(D-N)
..S DFN=P D SETLIST^APCM24E1
.;numerator?
.S F=$P(^APCM24OB(APCMIC,0),U,9)
.S N=$P($G(APCMRADS(APCMP)),U,2)
.D S^APCM24E1(APCMRPT,APCMIC,N,APCMP,APCMRPTT,APCMTIME,F)
I APCMRPTT=2 D
.S APCMP=APCMFAC
.S F=$P(^APCM24OB(APCMIC,0),U,8) ;denom field for this measure
.S N=$P($G(APCMRADS(APCMFAC)),U,1) ;returns # of prescriptions^# not written by nature of order
.D S^APCM24E1(APCMRPT,APCMIC,N,APCMFAC,APCMRPTT,APCMTIME,F)
.;now set patient list for this FACILITY
.S P=0 F S P=$O(^TMP($J,"PATSRAD",APCMFAC,P)) Q:P'=+P D
..S D=$P(^TMP($J,"PATSRAD",APCMFAC,P),U,1),N=$P(^TMP($J,"PATSRAD",APCMFAC,P),U,2) S APCMVALU="# Orders: "_D_"|||"_"# IMAGE: "_N_" # NO IMAGE: "_(D-N)
..S DFN=P D SETLIST^APCM24E1
.;numerator?
.S F=$P(^APCM24OB(APCMIC,0),U,9)
.S N=$P($G(APCMRADS(APCMFAC)),U,2)
.D S^APCM24E1(APCMRPT,APCMIC,N,APCMFAC,APCMRPTT,APCMTIME,F)
K ^TMP($J,"PATSRAD"),^TMP($J,"ORDERSPROCESSED"),APCMRADS
Q
IMGR1 ;EP -
;between BD and ED
;SET ARRAY APCMRADS to APCMRADS(prov ien)=denom^numer
NEW ID,C,Y,X,D,S,N,A,B,R,PAT,G,IEN,ORPFILE,ORPTST,PATLOC,ORDEB,PATSTA,CN
S ID=$$FMADD^XLFDT(APCMBDAT,-1),ID=ID_".9999"
F S ID=$O(^RADPT("AR",ID)) Q:ID'=+ID!($P(ID,".")>APCMEDAT) D
.S PAT=0 F S PAT=$O(^RADPT("AR",ID,PAT)) Q:PAT'=+PAT D
..Q:$$DEMO^APCLUTL(PAT,APCMDEMO) ;Quit if demo patient
..S IEN=0 F S IEN=$O(^RADPT("AR",ID,PAT,IEN)) Q:IEN'=+IEN D
...S EIEN=0 F S EIEN=$O(^RADPT(PAT,"DT",IEN,"P",EIEN)) Q:EIEN'=+EIEN D
....;CHECK STATUS, MUST BE EXAMINED OR COMPLETE
....S S=$$GET1^DIQ(70.03,EIEN_","_IEN_","_PAT,3)
....I S'="EXAMINED",S'="COMPLETE" Q
....S G=0
....I APCMRPTT=1 D
.....S ORPVID=$$GET1^DIQ(70.03,EIEN_","_IEN_","_PAT,14,"I") Q:'$D(APCMPRV(ORPVID)) ;quit if ordering provider doesn't match user selected provider
.....S PATSTA=$$GET1^DIQ(70.03,EIEN_","_IEN_","_PAT,4,"I")
.....Q:PATSTA'="O"
.....S C=""
.....S PATLOC=$$GET1^DIQ(70.03,EIEN_","_IEN_","_PAT,8,"I")
.....I PATLOC,$D(^SC(PATLOC,0)) S C=$P(^SC(PATLOC,0),U,7) I C Q:$P($G(^DIC(40.7,C,0)),U,2)=30 ;IF ER IN HOSP LOC Q
.....S G=1
....I APCMRPTT=2 D
.....;is provider authorized?
.....S ORPVID=$$GET1^DIQ(70.03,EIEN_","_IEN_","_PAT,14,"I")
.....;Q:'$$ORES^APCM24E9(ORPVID,ID)
.....S PATSTA=$$GET1^DIQ(70.03,EIEN_","_IEN_","_PAT,4,"I")
.....I PATSTA="I" S G=1 Q
.....Q:APCMMETH="O"
.....Q:PATSTA'="O"
.....S C=""
.....S PATLOC=$$GET1^DIQ(70.03,EIEN_","_IEN_","_PAT,8,"I")
.....I PATLOC,$D(^SC(PATLOC,0)) S C=$P(^SC(PATLOC,0),U,7) I C Q:$P($G(^DIC(40.7,C,0)),U,2)'=30 ;IF ER IN HOSP LOC Q
.....S G=1
....Q:'G
....;I DUZ=2793 W !,"PAT: ",$P(^DPT(PAT,0),U,1),"DATE: ",$$FMTE^XLFDT(ID)," ORDER: ",ORIEN," NATURE: ",ORORD
....I APCMRPTT=1 S $P(APCMRADS(ORPVID),U,1)=$P($G(APCMRADS(ORPVID)),U,1)+1,$P(^TMP($J,"PATSRAD",ORPVID,PAT),U,1)=$P($G(^TMP($J,"PATSRAD",ORPVID,PAT)),U,1)+1
....I APCMRPTT=2 S $P(APCMRADS(APCMFAC),U,1)=$P($G(APCMRADS(APCMFAC)),U,1)+1,$P(^TMP($J,"PATSRAD",APCMFAC,PAT),U,1)=$P($G(^TMP($J,"PATSRAD",APCMFAC,PAT)),U,1)+1
....;now check to see if it has REPORT TEXT
....S CN=$$GET1^DIQ(70.03,EIEN_","_IEN_","_PAT,17,"I")
....I 'CN Q ;no entry in report text file
....I '$O(^RARPT(CN,2005,0)) Q ;no image
....I APCMRPTT=1 S $P(APCMRADS(ORPVID),U,2)=$P(APCMRADS(ORPVID),U,2)+1,$P(^TMP($J,"PATSRAD",ORPVID,PAT),U,2)=$P($G(^TMP($J,"PATSRAD",ORPVID,PAT)),U,2)+1
....I APCMRPTT=2 S $P(APCMRADS(APCMFAC),U,2)=$P($G(APCMRADS(APCMFAC)),U,2)+1,$P(^TMP($J,"PATSRAD",APCMFAC,PAT),U,2)=$P($G(^TMP($J,"PATSRAD",APCMFAC,PAT)),U,2)+1
Q
FH ;EP - FAMILY HX
;for each provider or for the facility find out if this
;patient had a visit of A, O, R, S to this provider or facility
;if so, then check to see if they have FAMILY HX documented anytime before end of report period
NEW APCMP
S (APCMD1,APCMN1)=0
I APCMRPTT=1 D Q
.S APCMP=0 F S APCMP=$O(APCMPRV(APCMP)) Q:APCMP'=+APCMP D
..Q:'$D(APCMHVTP(APCMP)) ;no visits to this provider for this patient so don't bother, the patient is not in the denominator
..D FH1
I APCMRPTT=2 D
.S APCMP=APCMFAC
.Q:'$D(APCMHVTP(APCMP))
.D FH1
.Q
Q
FH1 ;set denominator value into field
S F=$P(^APCM24OB(APCMIC,0),U,8) ;denom field for this measure
D S^APCM24E1(APCMRPT,APCMIC,1,APCMP,APCMRPTT,APCMTIME,F)
S APCMVALU="VISIT: "_$$DATE^APCM1UTL(APCMHVTP(APCMP))
;numerator?
S APCMEP=$$HASFH(DFN,$$DOB^AUPNPAT(DFN),APCMEDAT)
S APCMVALU=APCMVALU_"|||"_$P(APCMEP,U,2)_"|||"_$P(APCMEP,U,1)
S F=$P(^APCM24OB(APCMIC,0),U,9)
D S^APCM24E1(APCMRPT,APCMIC,$P(APCMEP,U,1),APCMP,APCMRPTT,APCMTIME,F)
D SETLIST^APCM24E1
Q
HASFH(P,BD,ED) ;does patient have a SMOKING STATUS
;
NEW A,B,C,D,E,HF
S C=0
S HF=""
;CHECK AUPNFH
S A=0 F S A=$O(^AUPNFH("AC",P,A)) Q:A'=+A!(HF) D
.Q:'$D(^AUPNFH(A,0))
.Q:$$GET1^DIQ(9000014,A,.03)>ED ;documentd after time period
.S B=$$GET1^DIQ(9000014,A,.03)
.I B'["NATURAL",B'["UNKNOWN" Q
.S HF=1_U_B
I HF Q HF
S A=0 F S A=$O(^AUPNFHR("AA",P,A)) Q:A'=+A!(HF) D
.S B=$P($G(^AUTTRLSH(A,0)),U,1)
.I B'["NATURAL",B'["UNKNOWN" Q
.S HF=1_U_B
Q HF
APCM24E6 ;IHS/CMI/LAB - IHS MU;
+1 ;;1.0;IHS MU PERFORMANCE REPORTS;**5,6**;MAR 26, 2012;Build 65
+2 ;;;;;;Build 3
ADV ;EP - CALCULATE adv directives
+1 NEW APCMP,APCMZ
+2 SET (APCMD1,APCMN1)=0
+3 IF APCMRPTT=2
Begin DoDot:1
+4 SET APCMP=APCMFAC
+5 IF $DATA(APCMHO65(APCMP,APCMTIME))
SET F=$PIECE(^APCM24OB(APCMIC,0),U,11)
Begin DoDot:2
+6 DO S^APCM24E1(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)
QUIT
End DoDot:2
QUIT
+7 SET APCMZ=$$HASADM65(DFN,APCMP,.APCMVSTS)
+8 ;NO ADMISSION
IF APCMZ=""
QUIT
+9 DO ADV1
+10 QUIT
End DoDot:1
+11 QUIT
HASADM65(P,R,VSTS) ;
+1 NEW X,Y,Z,V,G
+2 SET G=""
+3 SET X=0
FOR
SET X=$ORDER(VSTS(X))
IF X'=+X!(G)
QUIT
Begin DoDot:1
+4 SET V=$PIECE(VSTS(X),U,5)
+5 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+6 IF $PIECE(^AUPNVSIT(V,0),U,11)
QUIT
+7 ;not correct service category
IF $PIECE(^AUPNVSIT(V,0),U,7)'="H"
QUIT
+8 ;not this facility
IF $PIECE(^AUPNVSIT(V,0),U,6)'=APCMP
QUIT
+9 ;not 65 on date of admission
IF $$AGE^AUPNPAT(P,$$VD^APCLV(V))<65
QUIT
+10 SET G=$$VD^APCLV(V)
End DoDot:1
+11 QUIT G
ADV1 ;
+1 ;set denominator value into field
+2 ;denom field for this measure
SET F=$PIECE(^APCM24OB(APCMIC,0),U,8)
+3 DO S^APCM24E1(APCMRPT,APCMIC,1,APCMP,APCMRPTT,APCMTIME,F)
+4 SET APCMVALU="Admission: "_$$DATE^APCM1UTL(APCMZ)_" Age: "_$$AGE^AUPNPAT(DFN,APCMZ)
+5 ;numerator?
+6 SET APCMEP=$$HASADV(DFN,APCMEDAT)
+7 SET APCMVALU=APCMVALU_"|||"_$PIECE(APCMEP,U,2)_"|||"_$PIECE(APCMEP,U,1)
+8 SET F=$PIECE(^APCM24OB(APCMIC,0),U,9)
+9 DO S^APCM24E1(APCMRPT,APCMIC,$PIECE(APCMEP,U,1),APCMP,APCMRPTT,APCMTIME,F)
+10 DO SETLIST^APCM24E1
+11 QUIT
HASADV(P,ED) ;does patient have an ADVANCE DIRECTIVE before end of report period
+1 ;
+2 NEW A,B,C,D,E,X
+3 ;check advance directive file
+4 SET E=""
+5 SET X=0
FOR
SET X=$ORDER(^AUPNADVD(P,11,X))
IF X'=+X!(E)
QUIT
Begin DoDot:1
+6 ;no zero node?
IF '$DATA(^AUPNADVD(P,11,X,0))
QUIT
+7 SET D=$PIECE(^AUPNADVD(P,11,X,0),U,1)
+8 ;after report period
IF D>ED
QUIT
+9 SET B=$PIECE(^AUPNADVD(P,11,X,0),U,2)
+10 IF B=""
QUIT
+11 SET E=1_U_"Advance Directives: "_$SELECT(B="Y":"YES",1:"NO")_" entered on "_$$DATE^APCM1UTL(D)
QUIT
End DoDot:1
+12 IF E]""
QUIT E
+13 ;now check for TIU Note title before ED of A
+14 SET X=0
FOR
SET X=$ORDER(^AUPNVNOT("AC",P,X))
IF X'=+X!(E)
QUIT
Begin DoDot:1
+15 SET B=$$VAL^XBDIQ1(9000010.28,X,.01)
+16 IF $$UP^XLFSTR(B)'="ADVANCE DIRECTIVE"
QUIT
+17 SET D=$$VD^APCLV($PIECE(^AUPNVNOT(X,0),U,3))
+18 IF D>ED
QUIT
+19 SET E=1_U_"Advance Directives: TIU document entered on "_$$DATE^APCM1UTL(D)
QUIT
End DoDot:1
+20 QUIT E
MR ;EP - med reconciliation
+1 ;for each provider or for the facility find out if this
+2 ;patient had a er visit or an admission of transferred
+3 ;if so, then check to see if they have m-mr anytime before end of report period
+4 NEW APCMP
+5 SET (APCMD1,APCMN1)=0
+6 IF APCMRPTT=2
SET APCMP=APCMFAC
Begin DoDot:1
+7 ;no ADMISSIONS/ER TO THIS FACILITY SO SKIP THIS OBJ
IF '$DATA(APCMHVTP(APCMP))
QUIT
+8 ;return # of visits^# w/M-MR
SET APCMEP=$$HASMMR(DFN,APCMBDAT,APCMEDAT,APCMP,.APCMVSTS,APCMMETH)
+9 ;set denominator value into field
+10 ;denom field for this measure
SET F=$PIECE(^APCM24OB(APCMIC,0),U,8)
+11 DO S^APCM24E1(APCMRPT,APCMIC,$PIECE(APCMEP,U,1),APCMP,APCMRPTT,APCMTIME,F)
+12 ;numerator?
+13 SET APCMVALU="# of visits: "_$PIECE(APCMEP,U,1)_" - # w/ M-MR: "_+$PIECE(APCMEP,U,2)_"|||"_$PIECE(APCMEP,U,3)_"|||"_$SELECT($PIECE(APCMEP,U,1)=$PIECE(APCMEP,U,2):1,1:0)
+14 SET F=$PIECE(^APCM24OB(APCMIC,0),U,9)
+15 DO S^APCM24E1(APCMRPT,APCMIC,$PIECE(APCMEP,U,2),APCMP,APCMRPTT,APCMTIME,F)
+16 IF $PIECE(APCMEP,U,1)=0
QUIT
+17 DO SETLIST^APCM24E1
End DoDot:1
+18 QUIT
HOSER(Z,R) ;EP
+1 ;not correct facility
IF $PIECE(^AUPNVSIT(Z,0),U,6)'=R
QUIT 0
+2 IF $PIECE(^AUPNVSIT(Z,0),U,7)="H"
QUIT 1
+3 NEW C
+4 IF "A"'[$PIECE(^AUPNVSIT(Z,0),U,7)
QUIT 0
+5 SET C=$$CLINIC^APCLV(Z,"C")
+6 IF C=30
QUIT 1
+7 ;I C=80 Q 1
+8 QUIT 0
DSCHDATE(V) ;EP
+1 IF 'V
QUIT ""
+2 IF '$DATA(^AUPNVSIT(V))
QUIT ""
+3 NEW Y,Z,D
+4 SET D=""
+5 IF $PIECE(^AUPNVSIT(V,0),U,7)="H"
Begin DoDot:1
+6 SET Z=$ORDER(^AUPNVINP("AD",V,0))
+7 IF 'Z
SET D=$$VD^APCLV(V)
QUIT
+8 SET Y=$PIECE($PIECE(^AUPNVINP(Z,0),U),".")
+9 SET D=Y
End DoDot:1
QUIT D
+10 SET Z=$ORDER(^AUPNVER("AD",V,0))
+11 IF 'Z
QUIT $$VD^APCLV(V)
+12 IF '$DATA(^AUPNVER(Z,0))
QUIT $$VD^APCLV(V)
+13 SET Y=$PIECE($PIECE(^AUPNVER(Z,0),U,13),".")
+14 IF Y=""
QUIT $$VD^APCLV(V)
+15 QUIT $PIECE(Y,".")
HASMMR(P,BD,ED,R,VSTS,APCMMETH) ;does patient have a M-MR on each visit?
+1 ;
+2 NEW A,B,C,D,E,X,Y,V,PWH,T,W,Z,Q,EDUC,G,BDD,EDD
+3 ;LOOP THROUGH ALL VISITS AND COUNT VISIT AND M-MR'S
+4 SET PWH="0^0"
+5 SET X=0
FOR
SET X=$ORDER(VSTS(X))
IF X'=+X
QUIT
Begin DoDot:1
+6 SET G=0
+7 SET V=$PIECE(VSTS(X),U,5)
+8 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+9 ;deleted
IF $PIECE(^AUPNVSIT(V,0),U,11)
QUIT
+10 IF $PIECE(^AUPNVSIT(V,0),U,6)'=R
QUIT
+11 IF APCMMETH="E"
Begin DoDot:2
+12 ;not correct service category/ER VISIT
IF '$$HOSER(V,R)
QUIT
+13 SET G=1
End DoDot:2
IF 'G
QUIT
+14 IF APCMMETH="O"
IF "OH"'[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+15 IF $PIECE(^AUPNVSIT(V,0),U,7)="H"!($PIECE(^AUPNVSIT(V,0),U,7)="O")
IF '$$TRANS(V)
QUIT
+16 IF $$CLINIC^APCLV(V,"C")=30
IF '$$ERTRANS(V)
QUIT
+17 SET $PIECE(PWH,U,1)=$PIECE(PWH,U,1)+1
+18 ;V UPDATED REVIEWED SNOMED DURING REPORT PERIOD
+19 SET Z=""
SET B=""
+20 SET W=0
FOR
SET W=$ORDER(^AUPNVRUP("AC",P,W))
IF W'=+W!(Z)
QUIT
Begin DoDot:2
+21 SET Y=0
FOR
SET Y=$ORDER(^AUPNVRUP(W,26,Y))
IF Y'=+Y!(Z)
QUIT
Begin DoDot:3
+22 IF $PIECE($GET(^AUPNVRUP(W,26,Y,0)),U,1)'=428191000124101
QUIT
+23 ;getevent date/time (1201)
+24 SET E=""
+25 SET D=$PIECE($$GET1^DIQ(9000010.54,W,1201,"I"),".")
+26 IF D<BD
QUIT
+27 IF D>ED
QUIT
SN SET Z=1
+1 SET B=1
SET $PIECE(PWH,U,2)=$PIECE(PWH,U,2)+1
End DoDot:3
End DoDot:2
+2 SET $PIECE(PWH,U,3)=$PIECE(PWH,U,3)_$$DATE^APCM1UTL($$VD^APCLV(V))_":"_$SELECT(B:"M-MR",1:"NO M-MR")_";"
+3 QUIT
End DoDot:1
+4 QUIT PWH
TRANS(%) ;
+1 NEW A
+2 SET A=$$ADMTYPE^APCLV(%,"C")
+3 IF A=""
SET A=$ORDER(^DGPM("AVISIT",%,0))
IF A
SET A=$$GET1^DIQ(405,A,.04,"I")
IF A
SET A=$$GET1^DIQ(405.1,A,9999999.1)
+4 IF A=2
QUIT 1
+5 IF A=3
QUIT 1
+6 IF A=4
QUIT 1
+7 QUIT 0
+8 ;
ERTRANS(%) ;
+1 NEW E
+2 SET E=$ORDER(^AMERVSIT("AD",%,0))
+3 ;no visit in ER Visit
IF 'E
QUIT 0
+4 IF '$PIECE($GET(^AMERVSIT(E,17)),U,1)
QUIT 0
+5 QUIT 1
TRANSOUT(%) ;
+1 NEW A
+2 SET A=$$DSCHTYPE^APCLV(%,"C")
+3 IF A=2
QUIT 1
+4 QUIT 0
+5 ;
ERTRANSO(%) ;
+1 NEW E,J
+2 SET E=$ORDER(^AMERVSIT("AD",%,0))
+3 ;no visit in ER Visit
IF 'E
QUIT 0
+4 SET J=$$VAL^XBDIQ1(9009080,E,6.1)
+5 IF J="REFERRED TO ANOTHER SERVICE"
QUIT 1
+6 IF J="TRANSFER TO ANOTHER FACILITY"
QUIT 1
+7 QUIT 0
PVCL(N) ;
+1 IF '$GET(N)
QUIT ""
+2 IF '$DATA(^VA(200,N,0))
QUIT ""
+3 NEW C,T
+4 SET C=$$GET1^DIQ(200,N,53.5,"I")
+5 IF C=""
QUIT ""
+6 SET C=$PIECE($GET(^DIC(7,C,9999999)),U,1)
+7 IF C=""
QUIT ""
+8 SET T=$ORDER(^APCMMUCN("B","INTERIM STAGE 2 2014",0))
+9 IF 'T
QUIT ""
+10 IF '$DATA(^APCMMUCN(T,19,"B",C))
QUIT ""
+11 QUIT 1
EN ;EP - CALCULATE ELECTRONIC NOTES
+1 NEW APCMP
+2 SET (APCMD1,APCMN1)=0
+3 IF APCMRPTT=1
Begin DoDot:1
+4 SET APCMP=0
FOR
SET APCMP=$ORDER(APCMPRV(APCMP))
IF APCMP'=+APCMP
QUIT
Begin DoDot:2
+5 ;PROVIDER ISN'T THE RIGHT CLASS CODE
IF '$$PVCL(APCMP)
QUIT
+6 ;no visits to this provider for this patient so don't bother, the patient is not in the denominator
IF '$DATA(APCMHVTP(APCMP))
QUIT
+7 DO EN1
End DoDot:2
End DoDot:1
QUIT
+8 IF APCMRPTT=2
Begin DoDot:1
+9 SET APCMP=APCMFAC
+10 IF '$DATA(APCMHVTP(APCMP))
QUIT
+11 DO EN1
+12 QUIT
End DoDot:1
+13 QUIT
EN1 ;set denominator value into field
+1 ;denom field for this measure
SET F=$PIECE(^APCM24OB(APCMIC,0),U,8)
+2 DO S^APCM24E1(APCMRPT,APCMIC,1,APCMP,APCMRPTT,APCMTIME,F)
+3 SET APCMVALU="VISIT: "_$$DATE^APCM1UTL(APCMHVTP(APCMP))
+4 ;numerator?
+5 SET APCMEP=$$HASEN(DFN,APCMBDAT,APCMEDAT,APCMP)
+6 SET APCMVALU=APCMVALU_"|||"_$PIECE(APCMEP,U,2)_"|||"_$PIECE(APCMEP,U,1)
+7 SET F=$PIECE(^APCM24OB(APCMIC,0),U,9)
+8 DO S^APCM24E1(APCMRPT,APCMIC,$PIECE(APCMEP,U,1),APCMP,APCMRPTT,APCMTIME,F)
+9 DO SETLIST^APCM24E1
+10 QUIT
HASEN(P,BD,ED,R) ;does patient have a AN ELECTRONIC NOTE?
+1 ;
+2 NEW A,B,C,D,E,T,N,X,Y,G,X
+3 SET G=""
+4 ;$o through TIU document file AA xref for this patient
+5 ;find first one with ep as author/signer
+6 ;or ep is co signer and author/signor is a student
+7 ;skip notes with report text ="VistA Imaging - Scanned Document
+8 SET T=0
FOR
SET T=$ORDER(^TIU(8925,"AA",P,T))
IF T'=+T!(G)
QUIT
Begin DoDot:1
+9 SET D=0
FOR
SET D=$ORDER(^TIU(8925,"AA",P,T,D))
IF D'=+D!(G)
QUIT
Begin DoDot:2
+10 SET X=0
FOR
SET X=$ORDER(^TIU(8925,"AA",P,T,D,X))
IF X'=+X!(G)
QUIT
Begin DoDot:3
+11 ;check report text
+12 IF $$SCAN(X)
QUIT
+13 ;ADDED LOGIC PER DONNA AND JOANNE 9/3/2014 TO MAKE SURE NOTE IS WITHIN REPORT PERIOD
+14 SET Z=$PIECE($$GET1^DIQ(8925,X,1201,"I"),".")
+15 IF Z<BD
QUIT
+16 IF Z>ED
QUIT
+17 ;not on of this providers
IF '$$PRVD(X)
QUIT
+18 SET G=1_U_"Note: "_$$GET1^DIQ(8925,X,1201)
End DoDot:3
End DoDot:2
End DoDot:1
+19 QUIT G
SCAN(%) ;
+1 NEW A,B,C
+2 SET A=0
SET B=""
FOR
SET A=$ORDER(^TIU(8925,%,"TEXT",A))
IF A'=+A
QUIT
SET B=B_^TIU(8925,%,"TEXT",A,0)
+3 IF $$UP^XLFSTR(B)["VISTA IMAGING - SCANNED DOCUMENT"
QUIT 1
+4 QUIT 0
PRVD(%) ;
+1 NEW A,S,C,D
+2 ;AUTHOR
SET A=$$GET1^DIQ(8925,%,1202,"I")
+3 ;SIGNED BY
SET S=$$GET1^DIQ(8925,%,1502,"I")
+4 ;I A=R,S=R Q 1
+5 IF A=S
IF $$PVCL(A)
QUIT 1
+6 ;CO SIGNER
SET C=$$GET1^DIQ(8925,%,1508,"I")
+7 IF '$$PVCL(C)
QUIT 0
+8 ;I C'=R Q 0
+9 IF '$$ISA^USRLM(A,"STUDENT","",$PIECE($$GET1^DIQ(8925,%,1201,"I"),".",1))
QUIT 0
+10 IF '$$ISA^USRLM(S,"STUDENT","",$PIECE($$GET1^DIQ(8925,%,1201,"I"),".",1))
QUIT 0
+11 QUIT 1
+12 ;
IMGR ;EP - IMAGING RESULTS
+1 ;for each provider or for the facility count all rad EXAM that meet criteria
+2 KILL ^TMP($JOB,"PATSRAD")
+3 KILL APCMRADS
+4 DO IMGR1
+5 KILL ^TMP($JOB,"ORDERSPROCESSED")
+6 NEW APCMP,N,F
+7 SET (APCMD1,APCMN1)=0
+8 IF APCMRPTT=1
SET APCMP=0
FOR
SET APCMP=$ORDER(APCMPRV(APCMP))
IF APCMP'=+APCMP
QUIT
Begin DoDot:1
+9 IF $PIECE($GET(APCMRADS(APCMP)),U,1)<100
SET F=$PIECE(^APCM24OB(APCMIC,0),U,11)
Begin DoDot:2
+10 DO S^APCM24E1(APCMRPT,APCMIC,"Provider is excluded from this measure as he/she had < 100 Radiology EXAMS during the EHR reporting period.",APCMP,APCMRPTT,APCMTIME,F,1)
End DoDot:2
DR ;set denominator value into field
+1 ;denom field for this measure
SET F=$PIECE(^APCM24OB(APCMIC,0),U,8)
+2 ;returns # of prescriptions^# not written by nature of order
SET N=$PIECE($GET(APCMRADS(APCMP)),U,1)
+3 DO S^APCM24E1(APCMRPT,APCMIC,N,APCMP,APCMRPTT,APCMTIME,F)
+4 ;now set patient list for this provider
+5 SET P=0
FOR
SET P=$ORDER(^TMP($JOB,"PATSRAD",APCMP,P))
IF P'=+P
QUIT
Begin DoDot:2
+6 SET D=$PIECE(^TMP($JOB,"PATSRAD",APCMP,P),U,1)
SET N=$PIECE(^TMP($JOB,"PATSRAD",APCMP,P),U,2)
SET APCMVALU="# Orders: "_D_"|||"_"# IMAGE: "_N_" # NO IMAGE: "_(D-N)
+7 SET DFN=P
DO SETLIST^APCM24E1
End DoDot:2
+8 ;numerator?
+9 SET F=$PIECE(^APCM24OB(APCMIC,0),U,9)
+10 SET N=$PIECE($GET(APCMRADS(APCMP)),U,2)
+11 DO S^APCM24E1(APCMRPT,APCMIC,N,APCMP,APCMRPTT,APCMTIME,F)
End DoDot:1
+12 IF APCMRPTT=2
Begin DoDot:1
+13 SET APCMP=APCMFAC
+14 ;denom field for this measure
SET F=$PIECE(^APCM24OB(APCMIC,0),U,8)
+15 ;returns # of prescriptions^# not written by nature of order
SET N=$PIECE($GET(APCMRADS(APCMFAC)),U,1)
+16 DO S^APCM24E1(APCMRPT,APCMIC,N,APCMFAC,APCMRPTT,APCMTIME,F)
+17 ;now set patient list for this FACILITY
+18 SET P=0
FOR
SET P=$ORDER(^TMP($JOB,"PATSRAD",APCMFAC,P))
IF P'=+P
QUIT
Begin DoDot:2
+19 SET D=$PIECE(^TMP($JOB,"PATSRAD",APCMFAC,P),U,1)
SET N=$PIECE(^TMP($JOB,"PATSRAD",APCMFAC,P),U,2)
SET APCMVALU="# Orders: "_D_"|||"_"# IMAGE: "_N_" # NO IMAGE: "_(D-N)
+20 SET DFN=P
DO SETLIST^APCM24E1
End DoDot:2
+21 ;numerator?
+22 SET F=$PIECE(^APCM24OB(APCMIC,0),U,9)
+23 SET N=$PIECE($GET(APCMRADS(APCMFAC)),U,2)
+24 DO S^APCM24E1(APCMRPT,APCMIC,N,APCMFAC,APCMRPTT,APCMTIME,F)
End DoDot:1
+25 KILL ^TMP($JOB,"PATSRAD"),^TMP($JOB,"ORDERSPROCESSED"),APCMRADS
+26 QUIT
IMGR1 ;EP -
+1 ;between BD and ED
+2 ;SET ARRAY APCMRADS to APCMRADS(prov ien)=denom^numer
+3 NEW ID,C,Y,X,D,S,N,A,B,R,PAT,G,IEN,ORPFILE,ORPTST,PATLOC,ORDEB,PATSTA,CN
+4 SET ID=$$FMADD^XLFDT(APCMBDAT,-1)
SET ID=ID_".9999"
+5 FOR
SET ID=$ORDER(^RADPT("AR",ID))
IF ID'=+ID!($PIECE(ID,".")>APCMEDAT)
QUIT
Begin DoDot:1
+6 SET PAT=0
FOR
SET PAT=$ORDER(^RADPT("AR",ID,PAT))
IF PAT'=+PAT
QUIT
Begin DoDot:2
+7 ;Quit if demo patient
IF $$DEMO^APCLUTL(PAT,APCMDEMO)
QUIT
+8 SET IEN=0
FOR
SET IEN=$ORDER(^RADPT("AR",ID,PAT,IEN))
IF IEN'=+IEN
QUIT
Begin DoDot:3
+9 SET EIEN=0
FOR
SET EIEN=$ORDER(^RADPT(PAT,"DT",IEN,"P",EIEN))
IF EIEN'=+EIEN
QUIT
Begin DoDot:4
+10 ;CHECK STATUS, MUST BE EXAMINED OR COMPLETE
+11 SET S=$$GET1^DIQ(70.03,EIEN_","_IEN_","_PAT,3)
+12 IF S'="EXAMINED"
IF S'="COMPLETE"
QUIT
+13 SET G=0
+14 IF APCMRPTT=1
Begin DoDot:5
+15 ;quit if ordering provider doesn't match user selected provider
SET ORPVID=$$GET1^DIQ(70.03,EIEN_","_IEN_","_PAT,14,"I")
IF '$DATA(APCMPRV(ORPVID))
QUIT
+16 SET PATSTA=$$GET1^DIQ(70.03,EIEN_","_IEN_","_PAT,4,"I")
+17 IF PATSTA'="O"
QUIT
+18 SET C=""
+19 SET PATLOC=$$GET1^DIQ(70.03,EIEN_","_IEN_","_PAT,8,"I")
+20 ;IF ER IN HOSP LOC Q
IF PATLOC
IF $DATA(^SC(PATLOC,0))
SET C=$PIECE(^SC(PATLOC,0),U,7)
IF C
IF $PIECE($GET(^DIC(40.7,C,0)),U,2)=30
QUIT
+21 SET G=1
End DoDot:5
+22 IF APCMRPTT=2
Begin DoDot:5
+23 ;is provider authorized?
+24 SET ORPVID=$$GET1^DIQ(70.03,EIEN_","_IEN_","_PAT,14,"I")
+25 ;Q:'$$ORES^APCM24E9(ORPVID,ID)
+26 SET PATSTA=$$GET1^DIQ(70.03,EIEN_","_IEN_","_PAT,4,"I")
+27 IF PATSTA="I"
SET G=1
QUIT
+28 IF APCMMETH="O"
QUIT
+29 IF PATSTA'="O"
QUIT
+30 SET C=""
+31 SET PATLOC=$$GET1^DIQ(70.03,EIEN_","_IEN_","_PAT,8,"I")
+32 ;IF ER IN HOSP LOC Q
IF PATLOC
IF $DATA(^SC(PATLOC,0))
SET C=$PIECE(^SC(PATLOC,0),U,7)
IF C
IF $PIECE($GET(^DIC(40.7,C,0)),U,2)'=30
QUIT
+33 SET G=1
End DoDot:5
+34 IF 'G
QUIT
+35 ;I DUZ=2793 W !,"PAT: ",$P(^DPT(PAT,0),U,1),"DATE: ",$$FMTE^XLFDT(ID)," ORDER: ",ORIEN," NATURE: ",ORORD
+36 IF APCMRPTT=1
SET $PIECE(APCMRADS(ORPVID),U,1)=$PIECE($GET(APCMRADS(ORPVID)),U,1)+1
SET $PIECE(^TMP($JOB,"PATSRAD",ORPVID,PAT),U,1)=$PIECE($GET(^TMP($JOB,"PATSRAD",ORPVID,PAT)),U,1)+1
+37 IF APCMRPTT=2
SET $PIECE(APCMRADS(APCMFAC),U,1)=$PIECE($GET(APCMRADS(APCMFAC)),U,1)+1
SET $PIECE(^TMP($JOB,"PATSRAD",APCMFAC,PAT),U,1)=$PIECE($GET(^TMP($JOB,"PATSRAD",APCMFAC,PAT)),U,1)+1
+38 ;now check to see if it has REPORT TEXT
+39 SET CN=$$GET1^DIQ(70.03,EIEN_","_IEN_","_PAT,17,"I")
+40 ;no entry in report text file
IF 'CN
QUIT
+41 ;no image
IF '$ORDER(^RARPT(CN,2005,0))
QUIT
+42 IF APCMRPTT=1
SET $PIECE(APCMRADS(ORPVID),U,2)=$PIECE(APCMRADS(ORPVID),U,2)+1
SET $PIECE(^TMP($JOB,"PATSRAD",ORPVID,PAT),U,2)=$PIECE($GET(^TMP($JOB,"PATSRAD",ORPVID,PAT)),U,2)+1
+43 IF APCMRPTT=2
SET $PIECE(APCMRADS(APCMFAC),U,2)=$PIECE($GET(APCMRADS(APCMFAC)),U,2)+1
SET $PIECE(^TMP($JOB,"PATSRAD",APCMFAC,PAT),U,2)=$PIECE($GET(^TMP($JOB,"PATSRAD",APCMFAC,PAT)),U,2)+1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+44 QUIT
FH ;EP - FAMILY HX
+1 ;for each provider or for the facility find out if this
+2 ;patient had a visit of A, O, R, S to this provider or facility
+3 ;if so, then check to see if they have FAMILY HX documented anytime before end of report period
+4 NEW APCMP
+5 SET (APCMD1,APCMN1)=0
+6 IF APCMRPTT=1
Begin DoDot:1
+7 SET APCMP=0
FOR
SET APCMP=$ORDER(APCMPRV(APCMP))
IF APCMP'=+APCMP
QUIT
Begin DoDot:2
+8 ;no visits to this provider for this patient so don't bother, the patient is not in the denominator
IF '$DATA(APCMHVTP(APCMP))
QUIT
+9 DO FH1
End DoDot:2
End DoDot:1
QUIT
+10 IF APCMRPTT=2
Begin DoDot:1
+11 SET APCMP=APCMFAC
+12 IF '$DATA(APCMHVTP(APCMP))
QUIT
+13 DO FH1
+14 QUIT
End DoDot:1
+15 QUIT
FH1 ;set denominator value into field
+1 ;denom field for this measure
SET F=$PIECE(^APCM24OB(APCMIC,0),U,8)
+2 DO S^APCM24E1(APCMRPT,APCMIC,1,APCMP,APCMRPTT,APCMTIME,F)
+3 SET APCMVALU="VISIT: "_$$DATE^APCM1UTL(APCMHVTP(APCMP))
+4 ;numerator?
+5 SET APCMEP=$$HASFH(DFN,$$DOB^AUPNPAT(DFN),APCMEDAT)
+6 SET APCMVALU=APCMVALU_"|||"_$PIECE(APCMEP,U,2)_"|||"_$PIECE(APCMEP,U,1)
+7 SET F=$PIECE(^APCM24OB(APCMIC,0),U,9)
+8 DO S^APCM24E1(APCMRPT,APCMIC,$PIECE(APCMEP,U,1),APCMP,APCMRPTT,APCMTIME,F)
+9 DO SETLIST^APCM24E1
+10 QUIT
HASFH(P,BD,ED) ;does patient have a SMOKING STATUS
+1 ;
+2 NEW A,B,C,D,E,HF
+3 SET C=0
+4 SET HF=""
+5 ;CHECK AUPNFH
+6 SET A=0
FOR
SET A=$ORDER(^AUPNFH("AC",P,A))
IF A'=+A!(HF)
QUIT
Begin DoDot:1
+7 IF '$DATA(^AUPNFH(A,0))
QUIT
+8 ;documentd after time period
IF $$GET1^DIQ(9000014,A,.03)>ED
QUIT
+9 SET B=$$GET1^DIQ(9000014,A,.03)
+10 IF B'["NATURAL"
IF B'["UNKNOWN"
QUIT
+11 SET HF=1_U_B
End DoDot:1
+12 IF HF
QUIT HF
+13 SET A=0
FOR
SET A=$ORDER(^AUPNFHR("AA",P,A))
IF A'=+A!(HF)
QUIT
Begin DoDot:1
+14 SET B=$PIECE($GET(^AUTTRLSH(A,0)),U,1)
+15 IF B'["NATURAL"
IF B'["UNKNOWN"
QUIT
+16 SET HF=1_U_B
End DoDot:1
+17 QUIT HF
