APCM24E7 ;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(^APCM24OB(APCMIC,0),U,11) D S^APCM24E1(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(^APCM24OB(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^APCM24E1(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^APCM24E1 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^APCM24E1
.;numerator?
.S F=$P(^APCM24OB(APCMIC,0),U,9)
.S N=$P($G(APCMLABS(APCMP)),U,2)
.D S^APCM24E1(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^APCM24E6(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
;
MEDREC ;EP
;for each provider count each Visit that is a new patient visit and of those # with snomed in v updated/reviewed
K ^TMP($J,"TRANS")
NEW APCMLABS,MMR
D TOTMEDR
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(MMR(APCMP)),U,1) D Q
..S F=$P(^APCM24OB(APCMIC,0),U,11) D S^APCM24E1(APCMRPT,APCMIC,"Provider is excluded from this measure as he/she did not have any transitions during the EHR reporting period.",APCMP,APCMRPTT,APCMTIME,F,1) Q
.;set denominator value into field
.S F=$P(^APCM24OB(APCMIC,0),U,8) ;denom field for this measure
.S N=$P($G(MMR(APCMP)),U,1) ;returns # of transS^# with mmr
.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,"TRANS",APCMP,P)) Q:P'=+P D
..I $P(^TMP($J,"TRANS",APCMP,P),U,1)=$P(^TMP($J,"TRANS",APCMP,P),U,2) S APCMVALU="# transitions: "_$P(^TMP($J,"TRANS",APCMP,P),U,1)_"|||"_" # w/mmr: "_+$P(^TMP($J,"TRANS",APCMP,P),U,2)_" "_$P(^TMP($J,"TRANS",APCMP,P),U,3)_"|||1" D Q
...S DFN=P D SETLIST^APCM24E1 Q
..S DFN=P,APCMVALU="# transitions: "_$P(^TMP($J,"TRANS",APCMP,P),U,1)_"|||"_" # w/mmr: "_+$P(^TMP($J,"TRANS",APCMP,P),U,2)_" "_$P(^TMP($J,"TRANS",APCMP,P),U,3)_"|||0" D SETLIST^APCM24E1
.;numerator?
.S F=$P(^APCM24OB(APCMIC,0),U,9)
.S N=$P($G(MMR(APCMP)),U,2)
.D S^APCM24E1(APCMRPT,APCMIC,N,APCMP,APCMRPTT,APCMTIME,F)
K ^TMP($J,"TRANS")
Q
TOTMEDR ;EP - ep MR
;SET ARRAY MMR to MMR(prov ien)=denom^numer
;IF DENOM =0 THEN PROVIDER EXCLUSION
NEW T,C,PAT,N,APCMX,R,C,G
S C=0,N=0,PAT=""
S T=$O(^APCMMUCN("B","INTERIM STAGE 2 2014",0))
;GO THROUGH EACH PATIENT WHO HAS VISITS
S PAT=0 F S PAT=$O(^AUPNVSIT("AA",PAT)) Q:PAT'=+PAT D TOTMEDR1
Q
TOTMEDR1 ;
NEW APCMLAB
S APCMLAB="APCMLAB"
D ALLV^APCLAPIU(PAT,APCMBDAT,APCMEDAT,APCMLAB) ;get all visits for this patient in time period
S APCMX=0 F S APCMX=$O(APCMLAB(APCMX)) Q:APCMX'=+APCMX D
.S V=$P(APCMLAB(APCMX),U,5) ;VISIT IEN
.Q:'$D(^AUPNVSIT(V,0)) ;NO VISIT??
.S R=$$PRIMPROV^APCLV(V,"I") ;primary provider IEN
.Q:'R
.I '$D(APCMPRV(R)) Q ;not a provider of interest for this report
.Q:"AOSM"'[$P(^AUPNVSIT(V,0),U,7)
.S C=$$CLINIC^APCLV(V,"C")
.Q:C=30
.I C]"",T,$D(^APCMMUCN(T,14,"B",C)) Q ;don't count these clinics
.;IS THERE A V CPT OR IMAGE
.S G=$$CPT(V)
.I G G NUM
.S G=$$IMAGE(V,R)
.I 'G Q
NUM .;
.I '$D(MMR(R)) S MMR(R)=""
.S $P(MMR(R),U,1)=$P(MMR(R),U,1)+1 D
..S $P(^TMP($J,"TRANS",R,PAT),U,1)=$P($G(^TMP($J,"TRANS",R,PAT)),U,1)+1
..S $P(^TMP($J,"TRANS",R,PAT),U,3)=$P(^TMP($J,"TRANS",R,PAT),U,3)_" "_$$VD^APCLV(V,"S")
.;now check numerator
.S G=$$HASMMR(PAT,APCMBDAT,APCMEDAT)
.I 'G S $P(^TMP($J,"TRANS",R,PAT),U,3)=$P(^TMP($J,"TRANS",R,PAT),U,3)_";NO MMR" Q
.S $P(MMR(R),U,2)=$P(MMR(R),U,2)+1 D
..S $P(^TMP($J,"TRANS",R,PAT),U,2)=$P($G(^TMP($J,"TRANS",R,PAT)),U,2)+1
..S $P(^TMP($J,"TRANS",R,PAT),U,3)=$P(^TMP($J,"TRANS",R,PAT),U,3)_";YES MMR"
Q
;
CPT(V) ;was there a 99201-99205 or 99381-99387 on this visit
NEW X,C,A
S A=""
S X=0 F S X=$O(^AUPNVCPT("AD",V,X)) Q:X'=+X!(A) D
.S C=$$GET1^DIQ(9000010.18,X,.01)
.I C>99200,C<99206 S A=1 Q
.I C>99380,C<99388 S A=1 Q
Q A
IMAGE(V,R) ;WAS THERE AN IMAGE BEFORE VISIT DATE AND IF SO WAS THIS THE FIRST VISIT AFTER THE IMAGE DATE
NEW D,A,B,C,P,X,Y,T,G,Z,VST
S P=$P(^AUPNVSIT(V,0),U,5)
I '$D(^MAG(2005,"AC",P)) Q 0 ;no images
S G=""
S D=$$VDTM^APCLV(V) ;fileman visit date/time
S B=0 F S B=$O(^MAG(2005,"AC",P,B)) Q:B'=+B!(G) D
.Q:$$UP^XLFSTR($$GET1^DIQ(2005,B,42))'="CCD-SUMMARY"
.S C=$$GET1^DIQ(2005,B,7,"I")
.Q:C>D ;image save after visit date/time
.;is this the first visit after the image date/time to the EP?
.S X=C
.S T=$O(^APCMMUCN("B","INTERIM STAGE 2 2014",0))
.K VST
.D ALLV^APCLAPIU(P,$P(C,"."),$$FMADD^XLFDT($P(D,"."),1),"VST")
.;now reorder by visit/date time
.S X=0 F S X=$O(VST(X)) Q:X'=+X S VST("DTM",$$VDTM^APCLV($P(VST(X),U,5)),X)=$P(VST(X),U,5)
.S Y=0 F S Y=$O(VST("DTM",Y)) Q:Y'=+Y!(G) D
..S B=0 F S B=$O(VST("DTM",Y,B)) Q:B'=+B!(G) D
...S Z=VST("DTM",Y,B)
...Q:'$D(^AUPNVSIT(Z,0))
...Q:$$PRIMPROV^APCLV(Z,"I")'=R
...Q:"AOSM"'[$P(^AUPNVSIT(Z,0),U,7)
...S C=$$CLINIC^APCLV(Z,"C")
...Q:C=30
...I C]"",T,$D(^APCMMUCN(T,14,"B",C)) Q ;don't count these clinics
...Q:Z'=V
...S G=1
Q G
;
HASMMR(P,BDD,EDD) ;does patient have a m-mr ON this visit in v updated/reviewed
;
NEW X,Y,Z,B,W,E,D,T
;V UPDATED REVIEWED SNOMED 2 WEEKS BEFORE REPORT PERIOD UP THROUGH TODAY
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
..S E=""
..S D=$P($$GET1^DIQ(9000010.54,W,1201,"I"),".")
..I D<BDD Q
..I D>EDD Q
SNN ..S Z=1
Q Z
SEM ;EP
NEW APCMP
S (APCMD1,APCMN1)=0
I APCMRPTT=1 D Q
.S APCMP=0 F S APCMP=$O(APCMPRV(APCMP)) Q:APCMP'=+APCMP D
..I APCMATTE("S2.026.EP",APCMP)="Yes" S F=$P(^APCM24OB(APCMIC,0),U,11) D S^APCM24E1(APCMRPT,APCMIC,"BROADBAND",APCMP,APCMRPTT,APCMTIME,F,1)
..Q:'$D(APCMHVTP(APCMP)) ;no visits to this provider for this patient so don't bother, the patient is not in the denominator
..D ST1
Q
ST1 ;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 V="" I $T(PHR^BPHRMUPM)]"" D PHR^BPHRMUPM(DFN,APCMBDAT,APCMEDAT,.V)
S APCMVALU=APCMVALU_"|||"_"Secure message sent: " D
.I $P($P(V,U,6),".")<APCMBDAT Q
.I $P($P(V,U,6),".")>APCMEDAT Q
.S APCMVALU=APCMVALU_$$DATE^APCM1UTL($P(V,U,6))_"|||"_$P(V,U,5)
.S F=$P(^APCM24OB(APCMIC,0),U,9)
.D S^APCM24E1(APCMRPT,APCMIC,$P(V,U,5),APCMP,APCMRPTT,APCMTIME,F)
D SETLIST^APCM24E1
Q
ERX ;EPRESCRIBING HOSPITAL
;loop through file 52 and find all prescriptions filled during report period and have a Y for discharge med
;numerator = nature of order not equal written
K ^TMP($J,"PATSRX")
K APCMRXS
D TOTRX
NEW APCMP,N,F
S (APCMD1,APCMN1)=0
I APCMRPTT=2 S APCMP=APCMFAC
S I=$P(^APCM24OB(APCMIC,0),U,1)
I $G(APCMATTE(I,APCMP))="No" S F=$P(^APCM24OB(APCMIC,0),U,11) D Q
.D S^APCM24E1(APCMRPT,APCMIC,"NO ONSITE PHARMACY.",APCMP,APCMRPTT,APCMTIME,F,1)
D ;set denominator value into field
S F=$P(^APCM24OB(APCMIC,0),U,8) ;denom field for this measure
S N=$P($G(APCMRXS(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,"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="# Prescriptions: "_$P(^TMP($J,"PATSRX",APCMP,P),U,1)_"|||"_" # transmitted electronically: "_+$P(^TMP($J,"PATSRX",APCMP,P),U,2)_"|||1" D Q
..S DFN=P D SETLIST^APCM24E1 Q
.S S="",APCMVALU="Not transmitted electronically: "
.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 Prescriptions: "_$P(^TMP($J,"PATSRX",APCMP,P),U,1)_" # transmitted electronically: "_+$P(^TMP($J,"PATSRX",APCMP,P),U,2)_"|||"_APCMVALU,$P(APCMVALU,"|||",3)=0 D SETLIST^APCM24E1
;numerator?
S F=$P(^APCM24OB(APCMIC,0),U,9)
S N=$P($G(APCMRXS(APCMP)),U,2)
D S^APCM24E1(APCMRPT,APCMIC,N,APCMP,APCMRPTT,APCMTIME,F)
K ^TMP($J,"PATSRX")
Q
TOTRX ;EP -SET ARRAY APCMRXS to APCMRXS(FACILITY)=denom^numer
NEW ID,C,Y,X,D,S,N,A,B,R,PAT,G,OS,DIVI
S C=0,N=0
S ID=$$FMADD^XLFDT(APCMBDAT,-1)
F S ID=$O(^PSRX("AC",ID)) Q:ID'=+ID!(ID>APCMEDAT) D
.S X=0 F S X=$O(^PSRX("AC",ID,X)) Q:X'=+X D
..Q:$$GET1^DIQ(52,X,9999999.28)'="YES" ;MUST BE A DISCHARGE MED
..;if in obs method skip any with a visit of "A"
..S V=$P($G(^PSRX(X,999999911)),U,1)
..I V,APCMMETH="O" Q:'$D(^AUPNVMED(V,0)) S V=$P($G(^AUPNVMED(V,0)),U,3) Q:'$D(^AUPNVSIT(V,0)) Q:$P(^AUPNVSIT(V,0),U,7)="A"
..I '$D(APCMRXS(APCMFAC)) S APCMRXS(APCMFAC)=""
..Q:$P($G(^PSRX(X,"STA")),"^")=13 ;DELETED
..S D=$P(^PSRX(X,0),U,6) ;CONTROLLED SUBSTANCE
..S S=$P($G(^PSDRUG(D,0)),U,3)
..Q:S[5
..Q:S[4
..Q:S[3
..Q:S[2
..Q:S[1
..;S S=$P($G(^PSRX(X,3)),U,7)
..;Q:$$UP^XLFSTR(S)["ADMINISTERED IN CLINIC"
..S PAT=$P(^PSRX(X,0),U,2)
..;quit if demo patient
..Q:$$DEMO^APCLUTL(PAT,$G(APCMDEMO))
..;facility and make sure it matches APCMFAC
..S OS=$$GET1^DIQ(52,X,20,"I") ;OUTPATIENT SITE
..S DIVI=$$GET1^DIQ(59,OS,100,"I") ;DIVISION
..Q:APCMFAC'=DIVI
..S $P(APCMRXS(APCMFAC),U,1)=$P(APCMRXS(APCMFAC),U,1)+1,$P(^TMP($J,"PATSRX",APCMFAC,PAT),U,1)=$P($G(^TMP($J,"PATSRX",APCMFAC,PAT)),U,1)+1,^TMP($J,"PATSRX",APCMFAC,PAT,"SCRIPTS",$P(^PSRX(X,0),U,1))=""
..;
..;now check to see if it has a nature of order not equal to 1-written
..S G=0
..I $E($P(^PSRX(X,0),U,1))?1N D
...S O=$P($G(^PSRX(X,"OR1")),U,2) ;order number
...Q:O=""
...S B=$P($G(^OR(100,O,0)),U,6)
...Q:B=""
...S A=0,G=0 F S A=$O(^OR(100,O,8,A)) Q:A'=+A!(G) D
....S B=$P($G(^OR(100,O,8,A,0)),U,12)
....Q:B=1
....Q:B=""
....S G=1
...S $P(APCMRXS(APCMFAC),U,2)=$P(APCMRXS(APCMFAC),U,2)+G,$P(^TMP($J,"PATSRX",APCMFAC,PAT),U,2)=$P($G(^TMP($J,"PATSRX",APCMFAC,PAT)),U,2)+G I G S ^TMP($J,"PATSRX",APCMFAC,PAT,"ELEC",$P(^PSRX(X,0),U,1))="" ;S N=N+G
..S B=0 I $E($P(^PSRX(X,0),U,1))="X" D
...S A=0 F S A=$O(^PSRX(X,"A",A)) Q:A'=+A!(B) D
....I $P(^PSRX(X,"A",A,0),U,5)["E-Prescribe" S B=1
....I $P(^PSRX(X,"A",A,0),U,5)["eRx" S B=1
...S $P(APCMRXS(APCMFAC),U,2)=$P(APCMRXS(APCMFAC),U,2)+B,$P(^TMP($J,"PATSRX",APCMFAC,PAT),U,2)=$P($G(^TMP($J,"PATSRX",APCMFAC,PAT)),U,2)+B I B S ^TMP($J,"PATSRX",APCMFAC,PAT,"ELEC",$P(^PSRX(X,0),U,1))=""
Q
APCM24E7 ;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(^APCM24OB(APCMIC,0),U,11) D S^APCM24E1(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(^APCM24OB(APCMIC,0),U,8)
+11 ;returns # of LABS^# not Structured data
SET N=$PIECE($GET(APCMLABS(APCMP)),U,1)
+12 DO S^APCM24E1(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^APCM24E1
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^APCM24E1
End DoDot:2
+23 ;numerator?
+24 SET F=$PIECE(^APCM24OB(APCMIC,0),U,9)
+25 SET N=$PIECE($GET(APCMLABS(APCMP)),U,2)
+26 DO S^APCM24E1(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^APCM24E6(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
+6 ;
MEDREC ;EP
+1 ;for each provider count each Visit that is a new patient visit and of those # with snomed in v updated/reviewed
+2 KILL ^TMP($JOB,"TRANS")
+3 NEW APCMLABS,MMR
+4 DO TOTMEDR
+5 NEW APCMP,N,F
+6 SET (APCMD1,APCMN1)=0
+7 IF APCMRPTT=1
SET APCMP=0
FOR
SET APCMP=$ORDER(APCMPRV(APCMP))
IF APCMP'=+APCMP
QUIT
Begin DoDot:1
+8 IF '$PIECE($GET(MMR(APCMP)),U,1)
Begin DoDot:2
+9 SET F=$PIECE(^APCM24OB(APCMIC,0),U,11)
DO S^APCM24E1(APCMRPT,APCMIC,"Provider is excluded from this measure as he/she did not have any transitions during the EHR reporting period.",APCMP,APCMRPTT,APCMTIME,F,1)
QUIT
End DoDot:2
QUIT
+10 ;set denominator value into field
+11 ;denom field for this measure
SET F=$PIECE(^APCM24OB(APCMIC,0),U,8)
+12 ;returns # of transS^# with mmr
SET N=$PIECE($GET(MMR(APCMP)),U,1)
+13 DO S^APCM24E1(APCMRPT,APCMIC,N,APCMP,APCMRPTT,APCMTIME,F)
+14 ;now set patient list for this provider
+15 SET P=0
FOR
SET P=$ORDER(^TMP($JOB,"TRANS",APCMP,P))
IF P'=+P
QUIT
Begin DoDot:2
+16 IF $PIECE(^TMP($JOB,"TRANS",APCMP,P),U,1)=$PIECE(^TMP($JOB,"TRANS",APCMP,P),U,2)
SET APCMVALU="# transitions: "_$PIECE(^TMP($JOB,"TRANS",APCMP,P),U,1)_"|||"_" # w/mmr: "_+$PIECE(^TMP($JOB,"TRANS",APCMP,P),U,2)_" "_$PIECE(^TMP($JOB,"TRANS",APCMP,P),U,3)_"|||1"
Begin DoDot:3
+17 SET DFN=P
DO SETLIST^APCM24E1
QUIT
End DoDot:3
QUIT
+18 SET DFN=P
SET APCMVALU="# transitions: "_$PIECE(^TMP($JOB,"TRANS",APCMP,P),U,1)_"|||"_" # w/mmr: "_+$PIECE(^TMP($JOB,"TRANS",APCMP,P),U,2)_" "_$PIECE(^TMP($JOB,"TRANS",APCMP,P),U,3)_"|||0"
DO SETLIST^APCM24E1
End DoDot:2
+19 ;numerator?
+20 SET F=$PIECE(^APCM24OB(APCMIC,0),U,9)
+21 SET N=$PIECE($GET(MMR(APCMP)),U,2)
+22 DO S^APCM24E1(APCMRPT,APCMIC,N,APCMP,APCMRPTT,APCMTIME,F)
End DoDot:1
+23 KILL ^TMP($JOB,"TRANS")
+24 QUIT
TOTMEDR ;EP - ep MR
+1 ;SET ARRAY MMR to MMR(prov ien)=denom^numer
+2 ;IF DENOM =0 THEN PROVIDER EXCLUSION
+3 NEW T,C,PAT,N,APCMX,R,C,G
+4 SET C=0
SET N=0
SET PAT=""
+5 SET T=$ORDER(^APCMMUCN("B","INTERIM STAGE 2 2014",0))
+6 ;GO THROUGH EACH PATIENT WHO HAS VISITS
+7 SET PAT=0
FOR
SET PAT=$ORDER(^AUPNVSIT("AA",PAT))
IF PAT'=+PAT
QUIT
DO TOTMEDR1
+8 QUIT
TOTMEDR1 ;
+1 NEW APCMLAB
+2 SET APCMLAB="APCMLAB"
+3 ;get all visits for this patient in time period
DO ALLV^APCLAPIU(PAT,APCMBDAT,APCMEDAT,APCMLAB)
+4 SET APCMX=0
FOR
SET APCMX=$ORDER(APCMLAB(APCMX))
IF APCMX'=+APCMX
QUIT
Begin DoDot:1
+5 ;VISIT IEN
SET V=$PIECE(APCMLAB(APCMX),U,5)
+6 ;NO VISIT??
IF '$DATA(^AUPNVSIT(V,0))
QUIT
+7 ;primary provider IEN
SET R=$$PRIMPROV^APCLV(V,"I")
+8 IF 'R
QUIT
+9 ;not a provider of interest for this report
IF '$DATA(APCMPRV(R))
QUIT
+10 IF "AOSM"'[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+11 SET C=$$CLINIC^APCLV(V,"C")
+12 IF C=30
QUIT
+13 ;don't count these clinics
IF C]""
IF T
IF $DATA(^APCMMUCN(T,14,"B",C))
QUIT
+14 ;IS THERE A V CPT OR IMAGE
+15 SET G=$$CPT(V)
+16 IF G
GOTO NUM
+17 SET G=$$IMAGE(V,R)
+18 IF 'G
QUIT
NUM ;
+1 IF '$DATA(MMR(R))
SET MMR(R)=""
+2 SET $PIECE(MMR(R),U,1)=$PIECE(MMR(R),U,1)+1
Begin DoDot:2
+3 SET $PIECE(^TMP($JOB,"TRANS",R,PAT),U,1)=$PIECE($GET(^TMP($JOB,"TRANS",R,PAT)),U,1)+1
+4 SET $PIECE(^TMP($JOB,"TRANS",R,PAT),U,3)=$PIECE(^TMP($JOB,"TRANS",R,PAT),U,3)_" "_$$VD^APCLV(V,"S")
End DoDot:2
+5 ;now check numerator
+6 SET G=$$HASMMR(PAT,APCMBDAT,APCMEDAT)
+7 IF 'G
SET $PIECE(^TMP($JOB,"TRANS",R,PAT),U,3)=$PIECE(^TMP($JOB,"TRANS",R,PAT),U,3)_";NO MMR"
QUIT
+8 SET $PIECE(MMR(R),U,2)=$PIECE(MMR(R),U,2)+1
Begin DoDot:2
+9 SET $PIECE(^TMP($JOB,"TRANS",R,PAT),U,2)=$PIECE($GET(^TMP($JOB,"TRANS",R,PAT)),U,2)+1
+10 SET $PIECE(^TMP($JOB,"TRANS",R,PAT),U,3)=$PIECE(^TMP($JOB,"TRANS",R,PAT),U,3)_";YES MMR"
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
CPT(V) ;was there a 99201-99205 or 99381-99387 on this visit
+1 NEW X,C,A
+2 SET A=""
+3 SET X=0
FOR
SET X=$ORDER(^AUPNVCPT("AD",V,X))
IF X'=+X!(A)
QUIT
Begin DoDot:1
+4 SET C=$$GET1^DIQ(9000010.18,X,.01)
+5 IF C>99200
IF C<99206
SET A=1
QUIT
+6 IF C>99380
IF C<99388
SET A=1
QUIT
End DoDot:1
+7 QUIT A
IMAGE(V,R) ;WAS THERE AN IMAGE BEFORE VISIT DATE AND IF SO WAS THIS THE FIRST VISIT AFTER THE IMAGE DATE
+1 NEW D,A,B,C,P,X,Y,T,G,Z,VST
+2 SET P=$PIECE(^AUPNVSIT(V,0),U,5)
+3 ;no images
IF '$DATA(^MAG(2005,"AC",P))
QUIT 0
+4 SET G=""
+5 ;fileman visit date/time
SET D=$$VDTM^APCLV(V)
+6 SET B=0
FOR
SET B=$ORDER(^MAG(2005,"AC",P,B))
IF B'=+B!(G)
QUIT
Begin DoDot:1
+7 IF $$UP^XLFSTR($$GET1^DIQ(2005,B,42))'="CCD-SUMMARY"
QUIT
+8 SET C=$$GET1^DIQ(2005,B,7,"I")
+9 ;image save after visit date/time
IF C>D
QUIT
+10 ;is this the first visit after the image date/time to the EP?
+11 SET X=C
+12 SET T=$ORDER(^APCMMUCN("B","INTERIM STAGE 2 2014",0))
+13 KILL VST
+14 DO ALLV^APCLAPIU(P,$PIECE(C,"."),$$FMADD^XLFDT($PIECE(D,"."),1),"VST")
+15 ;now reorder by visit/date time
+16 SET X=0
FOR
SET X=$ORDER(VST(X))
IF X'=+X
QUIT
SET VST("DTM",$$VDTM^APCLV($PIECE(VST(X),U,5)),X)=$PIECE(VST(X),U,5)
+17 SET Y=0
FOR
SET Y=$ORDER(VST("DTM",Y))
IF Y'=+Y!(G)
QUIT
Begin DoDot:2
+18 SET B=0
FOR
SET B=$ORDER(VST("DTM",Y,B))
IF B'=+B!(G)
QUIT
Begin DoDot:3
+19 SET Z=VST("DTM",Y,B)
+20 IF '$DATA(^AUPNVSIT(Z,0))
QUIT
+21 IF $$PRIMPROV^APCLV(Z,"I")'=R
QUIT
+22 IF "AOSM"'[$PIECE(^AUPNVSIT(Z,0),U,7)
QUIT
+23 SET C=$$CLINIC^APCLV(Z,"C")
+24 IF C=30
QUIT
+25 ;don't count these clinics
IF C]""
IF T
IF $DATA(^APCMMUCN(T,14,"B",C))
QUIT
+26 IF Z'=V
QUIT
+27 SET G=1
End DoDot:3
End DoDot:2
End DoDot:1
+28 QUIT G
+29 ;
HASMMR(P,BDD,EDD) ;does patient have a m-mr ON this visit in v updated/reviewed
+1 ;
+2 NEW X,Y,Z,B,W,E,D,T
+3 ;V UPDATED REVIEWED SNOMED 2 WEEKS BEFORE REPORT PERIOD UP THROUGH TODAY
+4 SET Z=""
SET B=""
+5 SET W=0
FOR
SET W=$ORDER(^AUPNVRUP("AC",P,W))
IF W'=+W!(Z)
QUIT
Begin DoDot:1
+6 SET Y=0
FOR
SET Y=$ORDER(^AUPNVRUP(W,26,Y))
IF Y'=+Y!(Z)
QUIT
Begin DoDot:2
+7 IF $PIECE($GET(^AUPNVRUP(W,26,Y,0)),U,1)'=428191000124101
QUIT
+8 SET E=""
+9 SET D=$PIECE($$GET1^DIQ(9000010.54,W,1201,"I"),".")
+10 IF D<BDD
QUIT
+11 IF D>EDD
QUIT
SNN SET Z=1
End DoDot:2
End DoDot:1
+1 QUIT Z
SEM ;EP
+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 IF APCMATTE("S2.026.EP",APCMP)="Yes"
SET F=$PIECE(^APCM24OB(APCMIC,0),U,11)
DO S^APCM24E1(APCMRPT,APCMIC,"BROADBAND",APCMP,APCMRPTT,APCMTIME,F,1)
+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 ST1
End DoDot:2
End DoDot:1
QUIT
+8 QUIT
ST1 ;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 V=""
IF $TEXT(PHR^BPHRMUPM)]""
DO PHR^BPHRMUPM(DFN,APCMBDAT,APCMEDAT,.V)
+6 SET APCMVALU=APCMVALU_"|||"_"Secure message sent: "
Begin DoDot:1
+7 IF $PIECE($PIECE(V,U,6),".")<APCMBDAT
QUIT
+8 IF $PIECE($PIECE(V,U,6),".")>APCMEDAT
QUIT
+9 SET APCMVALU=APCMVALU_$$DATE^APCM1UTL($PIECE(V,U,6))_"|||"_$PIECE(V,U,5)
+10 SET F=$PIECE(^APCM24OB(APCMIC,0),U,9)
+11 DO S^APCM24E1(APCMRPT,APCMIC,$PIECE(V,U,5),APCMP,APCMRPTT,APCMTIME,F)
End DoDot:1
+12 DO SETLIST^APCM24E1
+13 QUIT
ERX ;EPRESCRIBING HOSPITAL
+1 ;loop through file 52 and find all prescriptions filled during report period and have a Y for discharge med
+2 ;numerator = nature of order not equal written
+3 KILL ^TMP($JOB,"PATSRX")
+4 KILL APCMRXS
+5 DO TOTRX
+6 NEW APCMP,N,F
+7 SET (APCMD1,APCMN1)=0
+8 IF APCMRPTT=2
SET APCMP=APCMFAC
+9 SET I=$PIECE(^APCM24OB(APCMIC,0),U,1)
+10 IF $GET(APCMATTE(I,APCMP))="No"
SET F=$PIECE(^APCM24OB(APCMIC,0),U,11)
Begin DoDot:1
+11 DO S^APCM24E1(APCMRPT,APCMIC,"NO ONSITE PHARMACY.",APCMP,APCMRPTT,APCMTIME,F,1)
End DoDot:1
QUIT
D ;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(APCMRXS(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,"PATSRX",APCMP,P))
IF P'=+P
QUIT
Begin DoDot:1
+6 ;Q:'$P(^TMP($J,"PATSRX",APCMP,P),U,1)
+7 IF $PIECE(^TMP($JOB,"PATSRX",APCMP,P),U,1)=$PIECE(^TMP($JOB,"PATSRX",APCMP,P),U,2)
SET APCMVALU="# Prescriptions: "_$PIECE(^TMP($JOB,"PATSRX",APCMP,P),U,1)_"|||"_" # transmitted electronically: "_+$PIECE(^TMP($JOB,"PATSRX",APCMP,P),U,2)_"|||1"
Begin DoDot:2
+8 SET DFN=P
DO SETLIST^APCM24E1
QUIT
End DoDot:2
QUIT
+9 SET S=""
SET APCMVALU="Not transmitted electronically: "
+10 FOR
SET S=$ORDER(^TMP($JOB,"PATSRX",APCMP,P,"SCRIPTS",S))
IF S=""
QUIT
Begin DoDot:2
+11 IF '$DATA(^TMP($JOB,"PATSRX",APCMP,P,"ELEC",S))
Begin DoDot:3
+12 SET APCMVALU=APCMVALU_S_";"
End DoDot:3
End DoDot:2
+13 SET DFN=P
SET APCMVALU="# of Prescriptions: "_$PIECE(^TMP($JOB,"PATSRX",APCMP,P),U,1)_" # transmitted electronically: "_+$PIECE(^TMP($JOB,"PATSRX",APCMP,P),U,2)_"|||"_APCMVALU
SET $PIECE(APCMVALU,"|||",3)=0
DO SETLIST^APCM24E1
End DoDot:1
+14 ;numerator?
+15 SET F=$PIECE(^APCM24OB(APCMIC,0),U,9)
+16 SET N=$PIECE($GET(APCMRXS(APCMP)),U,2)
+17 DO S^APCM24E1(APCMRPT,APCMIC,N,APCMP,APCMRPTT,APCMTIME,F)
+18 KILL ^TMP($JOB,"PATSRX")
+19 QUIT
TOTRX ;EP -SET ARRAY APCMRXS to APCMRXS(FACILITY)=denom^numer
+1 NEW ID,C,Y,X,D,S,N,A,B,R,PAT,G,OS,DIVI
+2 SET C=0
SET N=0
+3 SET ID=$$FMADD^XLFDT(APCMBDAT,-1)
+4 FOR
SET ID=$ORDER(^PSRX("AC",ID))
IF ID'=+ID!(ID>APCMEDAT)
QUIT
Begin DoDot:1
+5 SET X=0
FOR
SET X=$ORDER(^PSRX("AC",ID,X))
IF X'=+X
QUIT
Begin DoDot:2
+6 ;MUST BE A DISCHARGE MED
IF $$GET1^DIQ(52,X,9999999.28)'="YES"
QUIT
+7 ;if in obs method skip any with a visit of "A"
+8 SET V=$PIECE($GET(^PSRX(X,999999911)),U,1)
+9 IF V
IF APCMMETH="O"
IF '$DATA(^AUPNVMED(V,0))
QUIT
SET V=$PIECE($GET(^AUPNVMED(V,0)),U,3)
IF '$DATA(^AUPNVSIT(V,0))
QUIT
IF $PIECE(^AUPNVSIT(V,0),U,7)="A"
QUIT
+10 IF '$DATA(APCMRXS(APCMFAC))
SET APCMRXS(APCMFAC)=""
+11 ;DELETED
IF $PIECE($GET(^PSRX(X,"STA")),"^")=13
QUIT
+12 ;CONTROLLED SUBSTANCE
SET D=$PIECE(^PSRX(X,0),U,6)
+13 SET S=$PIECE($GET(^PSDRUG(D,0)),U,3)
+14 IF S[5
QUIT
+15 IF S[4
QUIT
+16 IF S[3
QUIT
+17 IF S[2
QUIT
+18 IF S[1
QUIT
+19 ;S S=$P($G(^PSRX(X,3)),U,7)
+20 ;Q:$$UP^XLFSTR(S)["ADMINISTERED IN CLINIC"
+21 SET PAT=$PIECE(^PSRX(X,0),U,2)
+22 ;quit if demo patient
+23 IF $$DEMO^APCLUTL(PAT,$GET(APCMDEMO))
QUIT
+24 ;facility and make sure it matches APCMFAC
+25 ;OUTPATIENT SITE
SET OS=$$GET1^DIQ(52,X,20,"I")
+26 ;DIVISION
SET DIVI=$$GET1^DIQ(59,OS,100,"I")
+27 IF APCMFAC'=DIVI
QUIT
+28 SET $PIECE(APCMRXS(APCMFAC),U,1)=$PIECE(APCMRXS(APCMFAC),U,1)+1
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",$PIECE(^PSRX(X,0),U,1))=""
+29 ;
+30 ;now check to see if it has a nature of order not equal to 1-written
+31 SET G=0
+32 IF $EXTRACT($PIECE(^PSRX(X,0),U,1))?1N
Begin DoDot:3
+33 ;order number
SET O=$PIECE($GET(^PSRX(X,"OR1")),U,2)
+34 IF O=""
QUIT
+35 SET B=$PIECE($GET(^OR(100,O,0)),U,6)
+36 IF B=""
QUIT
+37 SET A=0
SET G=0
FOR
SET A=$ORDER(^OR(100,O,8,A))
IF A'=+A!(G)
QUIT
Begin DoDot:4
+38 SET B=$PIECE($GET(^OR(100,O,8,A,0)),U,12)
+39 IF B=1
QUIT
+40 IF B=""
QUIT
+41 SET G=1
End DoDot:4
+42 ;S N=N+G
SET $PIECE(APCMRXS(APCMFAC),U,2)=$PIECE(APCMRXS(APCMFAC),U,2)+G
SET $PIECE(^TMP($JOB,"PATSRX",APCMFAC,PAT),U,2)=$PIECE($GET(^TMP($JOB,"PATSRX",APCMFAC,PAT)),U,2)+G
IF G
SET ^TMP($JOB,"PATSRX",APCMFAC,PAT,"ELEC",$PIECE(^PSRX(X,0),U,1))=""
End DoDot:3
+43 SET B=0
IF $EXTRACT($PIECE(^PSRX(X,0),U,1))="X"
Begin DoDot:3
+44 SET A=0
FOR
SET A=$ORDER(^PSRX(X,"A",A))
IF A'=+A!(B)
QUIT
Begin DoDot:4
+45 IF $PIECE(^PSRX(X,"A",A,0),U,5)["E-Prescribe"
SET B=1
+46 IF $PIECE(^PSRX(X,"A",A,0),U,5)["eRx"
SET B=1
End DoDot:4
+47 SET $PIECE(APCMRXS(APCMFAC),U,2)=$PIECE(APCMRXS(APCMFAC),U,2)+B
SET $PIECE(^TMP($JOB,"PATSRX",APCMFAC,PAT),U,2)=$PIECE($GET(^TMP($JOB,"PATSRX",APCMFAC,PAT)),U,2)+B
IF B
SET ^TMP($JOB,"PATSRX",APCMFAC,PAT,"ELEC",$PIECE(^PSRX(X,0),U,1))=""
End DoDot:3
End DoDot:2
End DoDot:1
+48 QUIT
