APCM11E2 ; IHS/CMI/LAB - IHS MU ;
;;1.0;IHS MU PERFORMANCE REPORTS;**1,2,4,5,6**;MAR 26, 2012;Build 65
;;;;;;Build 3
CPOE ;EP - CALCULATE CPOE MEDICATIONS MEASURE
;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 had any prescription in file 52
;with an issue date in the EHR reporting period, if so they are in the
;denominator for that provider/facility and then update counter
;
;if they had any prescription that had a nature of order of electronic
;they are in the numerator
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 $D(APCM100R(APCMP,APCMTIME)) S F=$P(^APCMMUM(APCMIC,0),U,11) D S^APCM11E1(APCMRPT,APCMIC,"Provider is excluded from this measure as he/she had < 100 prescriptions issued during the EHR reporting period.",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 CPOE1
.Q
I APCMRPTT=2 D
.S APCMP=APCMFAC
.Q:'$D(APCMHVTP(APCMP))
.D CPOE1
.Q
Q
CPOE1 ;
S APCMHP=$$HADRX(DFN,APCMBDAT,APCMEDAT)
Q:APCMHP="" ;no prescriptions with an issue date in report period
;set denominator value into field
S F=$P(^APCMMUM(APCMIC,0),U,8) ;denom field for this measure
D S^APCM11E1(APCMRPT,APCMIC,1,APCMP,APCMRPTT,APCMTIME,F)
S APCMVALU="VISIT: "_$$DATE^APCM1UTL(APCMHVTP(APCMP))_" RX: "_$$DATE^APCM1UTL($P(APCMHP,U))_";"_$P(APCMHP,U,2)
;numerator?
S APCMEP=$$HADNOEP(DFN,APCMBDAT,APCMEDAT)
G:APCMEP="" CPOEL
S APCMVALU=APCMVALU_"|||"_$$DATE^APCM1UTL($P(APCMEP,U))_";"_$P(APCMEP,U,2)_" Order #: "_$P(APCMEP,U,3)_"|||"_$S($P(APCMEP,U,2)]"":1,1:"")
S F=$P(^APCMMUM(APCMIC,0),U,9)
D S^APCM11E1(APCMRPT,APCMIC,1,APCMP,APCMRPTT,APCMTIME,F)
CPOEL D SETLIST^APCM11E1
Q
HADRX(P,BD,ED) ;EP - did patient have a RX in file 52 with an issue date
;between BD and ED
I '$G(P) Q ""
I '$G(BD) Q ""
I '$G(ED) Q ""
I '$D(^AUPNPAT(P,0)) Q ""
NEW EXDT,IFN,ID,G,APCMUD,D,R
S G=""
I APCMRPTT=2 G UD
S EXDT=$$FMADD^XLFDT(BD,-730)
F S EXDT=$O(^PS(55,P,"P","A",EXDT)) Q:'EXDT!(G]"") S IFN=0 F S IFN=$O(^PS(55,P,"P","A",EXDT,IFN)) Q:'IFN!(G]"") D:$D(^PSRX(IFN,0))
.Q:$P($G(^PSRX(IFN,"STA")),"^")=13
.S ID=$P(^PSRX(IFN,0),U,13)
.Q:ID<BD
.Q:ID>ED
.S G=ID_U_$$VAL^XBDIQ1(52,IFN,.01)
I G Q G
I APCMRPTT=1 Q ""
UD ;
S APCMUD=0,G="" F S APCMUD=$O(^PS(55,P,5,APCMUD)) Q:APCMUD'=+APCMUD!(G) D
.Q:'$D(^PS(55,P,5,APCMUD,0))
.S D=$P($P(^PS(55,P,5,APCMUD,0),U,14),".")
.Q:D<BD
.Q:D>ED
.S R=$O(^PS(55,P,5,APCMUD,1,0)) Q:'R ;NO DRUG
.S R=$P(^PS(55,P,5,APCMUD,1,R,0),U,1)
.S R=$P(^PSDRUG(R,0),U,1)
.S G=D_U_"UNIT DOSE: "_R
I G Q G
;IV
S APCMUD=0,G="" F S APCMUD=$O(^PS(55,P,"IV",APCMUD)) Q:APCMUD'=+APCMUD!(G) D
.Q:'$D(^PS(55,P,"IV",APCMUD,0))
.S D=$P($P(^PS(55,P,"IV",APCMUD,0),U,2),".")
.Q:D<BD
.Q:D>ED
.S R=$P($G(^PS(55,P,"IV",APCMUD,.2)),U,1)
.I 'R S R=""
.I R S R=$P($G(^PS(50.7,R,0)),U,1)
.S G=D_U_"IV: "_R
Q G
ORES(R,D) ;EP - DID PROVIDER HAVE ORES OR ORESLE ON DATE D
I '$G(R) Q ""
I '$D(^VA(200,R,0)) Q ""
NEW K,J
S K=$O(^DIC(19.1,"B","ORES",0))
S J=$O(^DIC(19.1,"B","ORELSE",0))
I $D(^VA(200,R,51,K,0)),$P(^VA(200,R,51,K,0),U,3)'>D Q 1
I $D(^VA(200,R,51,J,0)),$P(^VA(200,R,51,J,0),U,3)'>D Q 1
Q ""
HADNOEP(P,BD,ED) ;EP - did patient have a RX in file 52 with an issue date
;between BD and ED
I '$G(P) Q ""
I '$G(BD) Q ""
I '$G(ED) Q ""
I '$D(^AUPNPAT(P,0)) Q ""
NEW EXDT,IFN,ID,O,N,A,B
S N=""
I APCMRPTT=2 G UD1
S EXDT=$$FMADD^XLFDT(BD,-730)
F S EXDT=$O(^PS(55,P,"P","A",EXDT)) Q:'EXDT!(N]"") S IFN=0 F S IFN=$O(^PS(55,P,"P","A",EXDT,IFN)) Q:'IFN!(N]"") D:$D(^PSRX(IFN,0))
.Q:$P($G(^PSRX(IFN,"STA")),"^")=13
.S ID=$P(^PSRX(IFN,0),U,13)
.Q:ID<BD
.Q:ID>ED
.;check nature of order
.S O=$P($G(^PSRX(IFN,"OR1")),U,2) ;order number
.Q:O=""
.S B=$P($G(^OR(100,O,0)),U,6)
.Q:B=""
.;Q:'$$ORES(B,ID)
.S A=0 F S A=$O(^OR(100,O,8,A)) Q:A'=+A!(N]"") D
..Q:'$D(^OR(100,O,8,A,0))
..S B=$P(^OR(100,O,8,A,0),U,12)
..Q:B=1
..Q:B=""
..S N=$P($P(^OR(100,O,8,A,0),U),".")_U_$P(^ORD(100.02,B,0),U,1)_U_$P(^OR(100,O,0),U)
I N Q N
I APCMRPTT=1 Q ""
UD1 ;
S G="",N=""
S APCMUD=0 F S APCMUD=$O(^PS(55,P,5,APCMUD)) Q:APCMUD'=+APCMUD!(N]"") D
.Q:'$D(^PS(55,P,5,APCMUD,0))
.S D=$P($P(^PS(55,P,5,APCMUD,0),U,14),".")
.Q:D<BD
.Q:D>ED
.;GET ORDER #
.S O=$P($P(^PS(55,P,5,APCMUD,0),U,21),";")
.Q:O=""
.S B=$P($G(^OR(100,O,0)),U,6)
.Q:B=""
.;Q:'$$ORES(B,D)
.S A=0 F S A=$O(^OR(100,O,8,A)) Q:A'=+A!(N]"") D
..Q:'$D(^OR(100,O,8,A,0))
..S B=$P(^OR(100,O,8,A,0),U,12)
..Q:B=1
..Q:B=""
..S N=$P($P(^OR(100,O,8,A,0),U),".")_U_$P(^ORD(100.02,B,0),U,1)_U_$P(^OR(100,O,0),U)
I N Q N
;CHECK IV
S G="",N=""
S APCMUD=0 F S APCMUD=$O(^PS(55,P,"IV",APCMUD)) Q:APCMUD'=+APCMUD!(N]"") D
.Q:'$D(^PS(55,P,"IV",APCMUD,0))
.S D=$P($P(^PS(55,P,"IV",APCMUD,0),U,2),".")
.Q:D<BD
.Q:D>ED
.;GET ORDER #
.S O=$P($P(^PS(55,P,"IV",APCMUD,0),U,21),";")
.Q:O=""
.S B=$P($G(^OR(100,O,0)),U,6)
.Q:B=""
.;Q:'$$ORES(B,D)
.S A=0 F S A=$O(^OR(100,O,8,A)) Q:A'=+A!(N]"") D
..Q:'$D(^OR(100,O,8,A,0))
..S B=$P(^OR(100,O,8,A,0),U,12)
..Q:B=1
..Q:B=""
..S N=$P($P(^OR(100,O,8,A,0),U),".")_U_$P(^ORD(100.02,B,0),U,1)_U_$P(^OR(100,O,0),U)
I N Q N
Q ""
DEMO ;EP - CALCULATE DEMOGRAPHICS
;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 had dob, preferred language, gender, race, ethnicity recorded
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)) ;DID NOT SEE THIS PATIENT
..D DEMO1
I APCMRPTT=2 D
.S APCMP=APCMFAC
.Q:'$D(APCMHVTP(APCMP))
.D DEMO1
.Q
Q
DEMO1 ;set denominator value into field
S F=$P(^APCMMUM(APCMIC,0),U,8) ;denom field for this measure
D S^APCM11E1(APCMRPT,APCMIC,1,APCMP,APCMRPTT,APCMTIME,F)
S APCMVALU="VISIT: "_$$DATE^APCM1UTL(APCMHVTP(APCMP))
;numerator?
S APCMEP=$$HASDEMO(DFN,APCMBDAT,APCMEDAT,APCMRPTT,$G(APCMVDOD))
S APCMVALU=APCMVALU_"|||"_$S($P(APCMEP,U,1)=1:"METS OBJECTIVE: ",1:"DOES NOT MEET OBJECTIVE: ")_$P(APCMEP,U,2)_"|||"_$P(APCMEP,U,1)
S F=$P(^APCMMUM(APCMIC,0),U,9)
D S^APCM11E1(APCMRPT,APCMIC,$P(APCMEP,U,1),APCMP,APCMRPTT,APCMTIME,F)
D SETLIST^APCM11E1
Q
HASDEMO(P,BD,ED,T,DODV) ;
NEW PL,G,R,E,D,C,Y,X,B,Z
S C=0
S T=$G(T)
S DODV=$G(DODV)
S (PL,G,R,E,D)=""
;preferred language
S X=0 F S X=$O(^AUPNPAT(P,86,X)) Q:X'=+X!(PL]"") D
.S B=$P(^AUPNPAT(P,86,X,0),U)
.Q:B>ED
.S C=C+1,PL="Preferred Language"
S G=$P(^DPT(P,0),U,2) I G]"" S C=C+1,G="Gender"
S R=""
I $T(RACE^AGUTL)]"" S R=$$RACE^AGUTL(P)
I R S C=C+1,R="Race" I 1
E S R=$$VAL^XBDIQ1(2,P,.06) I R]"" S C=C+1,R="Race"
S Z=0 F S Z=$O(^DPT(P,.06,Z)) Q:Z'=+Z!(E]"") D
.S E=$P($G(^DPT(P,.06,Z,0)),U,1)
.Q:E=""
.S E="Ethnicity",C=C+1
.Q
I $P(^DPT(P,0),U,3)]"" S D="DOB",C=C+1
I T=2,$G(DODV) G HASDEMOH
I C=5 Q 1_U_"Has: "_PL_";"_G_";"_R_";"_E_";"_D
Q 0_U_"Has: "_PL_";"_G_";"_R_";"_E_";"_D
HASDEMOH ;did patient die in the hospital during report period? if so is dod and underlying cause there?
NEW VDOD,L,UCD
S UCD=""
S VDOD=$$DOD^AUPNPAT(P)
I VDOD]"" S C=C+1,VDOD="DOD"
S L=$$VAL^XBDIQ1(9000001,P,1114)
I L]"" S C=C+1,UCD="UCD"
I C=7 Q 1_U_"Has: "_PL_";"_G_";"_R_";"_E_";"_D_";"_VDOD_";"_UCD
Q 0_U_"Has: "_PL_";"_G_";"_R_";"_E_";"_D_";"_VDOD_";"_UCD
;
PL ;EP - CALCULATE PROBLEM LIST
;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 any problems on their problem list (skip deleted) or a NAP documented in 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 PL1
..Q
I APCMRPTT=2 D
.S APCMP=APCMFAC
.Q:'$D(APCMHVTP(APCMP))
.D PL1
.Q
Q
PL1 ;set denominator value into field
S F=$P(^APCMMUM(APCMIC,0),U,8) ;denom field for this measure
D S^APCM11E1(APCMRPT,APCMIC,1,APCMP,APCMRPTT,APCMTIME,F)
S APCMVALU="VISIT: "_$$DATE^APCM1UTL(APCMHVTP(APCMP))
;numerator?
S APCMEP=$$HASPL(DFN,APCMBDAT,APCMEDAT)
S APCMVALU=APCMVALU_"|||"_$P(APCMEP,U,2)_"|||"_$P(APCMEP,U,1)
S F=$P(^APCMMUM(APCMIC,0),U,9)
D S^APCM11E1(APCMRPT,APCMIC,$P(APCMEP,U,1),APCMP,APCMRPTT,APCMTIME,F)
D SETLIST^APCM11E1
Q
HASPL(P,BD,ED) ;does patient have a problem entered before end of report period
;
NEW A,B,C,D,E
S E=""
S A=0 F S A=$O(^AUPNPROB("AC",P,A)) Q:A'=+A!(E]"") D
.;if date entered is after the ED don't count it
.Q:'$D(^AUPNPROB(A,0))
.Q:$P(^AUPNPROB(A,0),U,8)>ED ;after end date of report period
.I $P(^AUPNPROB(A,0),U,12)'="D" S E=1_U_"Problem Entry: "_$$VAL^XBDIQ1(9000011,A,.01)_" entered on "_$$VAL^XBDIQ1(9000011,A,.08) Q
.;since it's deleted, deletion date must not be before time period
.S D=$P($P($G(^AUPNPROB(A,2)),U,2),".") ;date deleted
.Q:D>ED
.Q:D<BD
.S E="1^Problem Entry: "_$$VAL^XBDIQ1(9000011,A,.01)_" entered on "_$$VAL^XBDIQ1(9000011,A,.08)
I E]"" Q E
;no problems on PL so how about a NAP before end of time period
S C=$O(^AUTTCRA("B","NO ACTIVE PROBLEMS",0))
I 'C Q ""
S A=0 F S A=$O(^AUPNVRUP("AC",P,A)) Q:A'=+A!(E]"") D
.Q:'$D(^AUPNVRUP(A,0)) ;oops
.Q:$P(^AUPNVRUP(A,0),U,1)'=C ;not NAP
.S D=$$VD^APCLV($P(^AUPNVRUP(A,0),U,3))
.Q:D>ED
.S E="1^No Active Problems on "_$$DATE^APCM1UTL(D)
Q E
MEDL ;EP - CALCULATE MEDICATION LIST
;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
;d
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 MEDL1
..Q
.Q
I APCMRPTT=2 D
.S APCMP=APCMFAC
.Q:'$D(APCMHVTP(APCMP))
.D MEDL1
.Q
Q
MEDL1 ;set denominator value into field
S F=$P(^APCMMUM(APCMIC,0),U,8) ;denom field for this measure
D S^APCM11E1(APCMRPT,APCMIC,1,APCMP,APCMRPTT,APCMTIME,F)
S APCMVALU="VISIT: "_$$DATE^APCM1UTL(APCMHVTP(APCMP))
;numerator?
S APCMEP=$$HASML(DFN,APCMBDAT,APCMEDAT)
S APCMVALU=APCMVALU_"|||"_$P(APCMEP,U,2)_"|||"_$P(APCMEP,U,1)
S F=$P(^APCMMUM(APCMIC,0),U,9)
D S^APCM11E1(APCMRPT,APCMIC,$P(APCMEP,U,1),APCMP,APCMRPTT,APCMTIME,F)
D SETLIST^APCM11E1
Q
HASML(P,BDT,EDT) ;EP
N RXIEN,ACTIEN,RTSDT,FILLDT,A0,FDTLP,IEN,G,DC,EXP,SDT,X,I,DRG,L,V,EXDT,IFN,ID,D365
;between BD and ED
I '$G(P) Q ""
I '$G(BDT) Q ""
I '$G(EDT) Q ""
I '$D(^AUPNPAT(P,0)) Q ""
S G=""
NAM ;look for "No Active Medications" anytime during the report period
S C=$O(^AUTTCRA("B","NO ACTIVE MEDICATIONS",0))
I 'C G RXS
;GET most recent visit date
S A=0 F S A=$O(^AUPNVRUP("AC",P,A)) Q:A'=+A!(G]"") D
.Q:'$D(^AUPNVRUP(A,0)) ;oops
.Q:$P(^AUPNVRUP(A,0),U,1)'=C ;not NAM
.S D=$$VD^APCLV($P(^AUPNVRUP(A,0),U,3))
.Q:D<BDT ;before beg date
.Q:D>EDT ;after end date
.S G="1^No Active Medications on "_$$DATE^APCM1UTL(D)
I G Q G
RXS ;
S G=""
S D365=$$FMADD^XLFDT(BDT,-365)
S EXDT=$$FMADD^XLFDT(BDT,-(365*3))
F S EXDT=$O(^PS(55,P,"P","A",EXDT)) Q:'EXDT!(G]"") S IFN=0 F S IFN=$O(^PS(55,P,"P","A",EXDT,IFN)) Q:'IFN!(G]"") D:$D(^PSRX(IFN,0))
.Q:$P($G(^PSRX(IFN,"STA")),"^")=13 ;deleted
.Q:'$P(^PSRX(IFN,0),U,6) ; Prescription must have a drug
.S ID=$P(^PSRX(IFN,0),U,13) ;issue date
.Q:ID<D365
.Q:ID>EDT
.S DC=$P($G(^PSRX(IFN,3)),U,5) ;dc date
.I DC]"" Q:DC<BDT ;IF DC'ED DATE IF MUST BE ON OR AFTER 1ST DATE OF TIME PERIOD
.S G=1_U_$$DATE^APCM1UTL(ID)_" Rx: "_$P(^PSRX(IFN,0),U,1) Q
I G]"" Q G
;now check NVA meds
NVA ; Set Non-VA Med Orders in the ^TMP Global
S G=""
F I=0:0 S I=$O(^PS(55,P,"NVA",I)) Q:'I!(G]"") S X=$G(^PS(55,P,"NVA",I,0)) D
.Q:'$P(X,"^")
.S DRG=$S($P(X,"^",2):$P($G(^PSDRUG($P(X,"^",2),0)),"^"),1:$P(^PS(50.7,$P(X,"^"),0),"^")_" "_$P(^PS(50.606,$P(^PS(50.7,$P(X,"^"),0),"^",2),0),"^"))
.I $P(X,"^",7),$P(X,"^",7)<BDT Q ;DC'ED
.S SDT=$P(X,"^",10) I 'SDT Q ;NO documented date
.I SDT>EDT Q ;documented date after end date
.Q:$P(X,U,6)]""
.S G=1_U_"NVA: "_$$DATE^APCM1UTL($P(X,U,10))_" Item: "_DRG
I G]"" Q G
Q G
; Return boolean flag indicating valid patient
PATVRY(RX,PAT) ;EP
Q:PAT="*" 1
Q +$P($G(^PSRX(RX,0)),U,2)=PAT
; Return release date for dispense
DSPRDT(RX,TYP,SIEN) ;EP
Q $S($G(SIEN):+$P($G(^PSRX(RX,$S(TYP="ADP":"P",1:1),SIEN,0)),U,$S(TYP="ADP":19,1:18)),1:+$P(^PSRX(RX,2),U,13))
APCM11E2 ; IHS/CMI/LAB - IHS MU ;
+1 ;;1.0;IHS MU PERFORMANCE REPORTS;**1,2,4,5,6**;MAR 26, 2012;Build 65
+2 ;;;;;;Build 3
CPOE ;EP - CALCULATE CPOE MEDICATIONS MEASURE
+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 had any prescription in file 52
+4 ;with an issue date in the EHR reporting period, if so they are in the
+5 ;denominator for that provider/facility and then update counter
+6 ;
+7 ;if they had any prescription that had a nature of order of electronic
+8 ;they are in the numerator
+9 NEW APCMP
+10 SET (APCMD1,APCMN1)=0
+11 IF APCMRPTT=1
Begin DoDot:1
+12 SET APCMP=0
FOR
SET APCMP=$ORDER(APCMPRV(APCMP))
IF APCMP'=+APCMP
QUIT
Begin DoDot:2
+13 IF $DATA(APCM100R(APCMP,APCMTIME))
SET F=$PIECE(^APCMMUM(APCMIC,0),U,11)
DO S^APCM11E1(APCMRPT,APCMIC,"Provider is excluded from this measure as he/she had < 100 prescriptions issued during the EHR reporting period.",APCMP,APCMRPTT,APCMTIME,F,1)
+14 ;no visits to this provider for this patient so don't bother, the patient is not in the denominator
IF '$DATA(APCMHVTP(APCMP))
QUIT
+15 DO CPOE1
End DoDot:2
+16 QUIT
End DoDot:1
QUIT
+17 IF APCMRPTT=2
Begin DoDot:1
+18 SET APCMP=APCMFAC
+19 IF '$DATA(APCMHVTP(APCMP))
QUIT
+20 DO CPOE1
+21 QUIT
End DoDot:1
+22 QUIT
CPOE1 ;
+1 SET APCMHP=$$HADRX(DFN,APCMBDAT,APCMEDAT)
+2 ;no prescriptions with an issue date in report period
IF APCMHP=""
QUIT
+3 ;set denominator value into field
+4 ;denom field for this measure
SET F=$PIECE(^APCMMUM(APCMIC,0),U,8)
+5 DO S^APCM11E1(APCMRPT,APCMIC,1,APCMP,APCMRPTT,APCMTIME,F)
+6 SET APCMVALU="VISIT: "_$$DATE^APCM1UTL(APCMHVTP(APCMP))_" RX: "_$$DATE^APCM1UTL($PIECE(APCMHP,U))_";"_$PIECE(APCMHP,U,2)
+7 ;numerator?
+8 SET APCMEP=$$HADNOEP(DFN,APCMBDAT,APCMEDAT)
+9 IF APCMEP=""
GOTO CPOEL
+10 SET APCMVALU=APCMVALU_"|||"_$$DATE^APCM1UTL($PIECE(APCMEP,U))_";"_$PIECE(APCMEP,U,2)_" Order #: "_$PIECE(APCMEP,U,3)_"|||"_$SELECT($PIECE(APCMEP,U,2)]"":1,1:"")
+11 SET F=$PIECE(^APCMMUM(APCMIC,0),U,9)
+12 DO S^APCM11E1(APCMRPT,APCMIC,1,APCMP,APCMRPTT,APCMTIME,F)
CPOEL DO SETLIST^APCM11E1
+1 QUIT
HADRX(P,BD,ED) ;EP - did patient have a RX in file 52 with an issue date
+1 ;between BD and ED
+2 IF '$GET(P)
QUIT ""
+3 IF '$GET(BD)
QUIT ""
+4 IF '$GET(ED)
QUIT ""
+5 IF '$DATA(^AUPNPAT(P,0))
QUIT ""
+6 NEW EXDT,IFN,ID,G,APCMUD,D,R
+7 SET G=""
+8 IF APCMRPTT=2
GOTO UD
+9 SET EXDT=$$FMADD^XLFDT(BD,-730)
+10 FOR
SET EXDT=$ORDER(^PS(55,P,"P","A",EXDT))
IF 'EXDT!(G]"")
QUIT
SET IFN=0
FOR
SET IFN=$ORDER(^PS(55,P,"P","A",EXDT,IFN))
IF 'IFN!(G]"")
QUIT
IF $DATA(^PSRX(IFN,0))
Begin DoDot:1
+11 IF $PIECE($GET(^PSRX(IFN,"STA")),"^")=13
QUIT
+12 SET ID=$PIECE(^PSRX(IFN,0),U,13)
+13 IF ID<BD
QUIT
+14 IF ID>ED
QUIT
+15 SET G=ID_U_$$VAL^XBDIQ1(52,IFN,.01)
End DoDot:1
+16 IF G
QUIT G
+17 IF APCMRPTT=1
QUIT ""
UD ;
+1 SET APCMUD=0
SET G=""
FOR
SET APCMUD=$ORDER(^PS(55,P,5,APCMUD))
IF APCMUD'=+APCMUD!(G)
QUIT
Begin DoDot:1
+2 IF '$DATA(^PS(55,P,5,APCMUD,0))
QUIT
+3 SET D=$PIECE($PIECE(^PS(55,P,5,APCMUD,0),U,14),".")
+4 IF D<BD
QUIT
+5 IF D>ED
QUIT
+6 ;NO DRUG
SET R=$ORDER(^PS(55,P,5,APCMUD,1,0))
IF 'R
QUIT
+7 SET R=$PIECE(^PS(55,P,5,APCMUD,1,R,0),U,1)
+8 SET R=$PIECE(^PSDRUG(R,0),U,1)
+9 SET G=D_U_"UNIT DOSE: "_R
End DoDot:1
+10 IF G
QUIT G
+11 ;IV
+12 SET APCMUD=0
SET G=""
FOR
SET APCMUD=$ORDER(^PS(55,P,"IV",APCMUD))
IF APCMUD'=+APCMUD!(G)
QUIT
Begin DoDot:1
+13 IF '$DATA(^PS(55,P,"IV",APCMUD,0))
QUIT
+14 SET D=$PIECE($PIECE(^PS(55,P,"IV",APCMUD,0),U,2),".")
+15 IF D<BD
QUIT
+16 IF D>ED
QUIT
+17 SET R=$PIECE($GET(^PS(55,P,"IV",APCMUD,.2)),U,1)
+18 IF 'R
SET R=""
+19 IF R
SET R=$PIECE($GET(^PS(50.7,R,0)),U,1)
+20 SET G=D_U_"IV: "_R
End DoDot:1
+21 QUIT G
ORES(R,D) ;EP - DID PROVIDER HAVE ORES OR ORESLE ON DATE D
+1 IF '$GET(R)
QUIT ""
+2 IF '$DATA(^VA(200,R,0))
QUIT ""
+3 NEW K,J
+4 SET K=$ORDER(^DIC(19.1,"B","ORES",0))
+5 SET J=$ORDER(^DIC(19.1,"B","ORELSE",0))
+6 IF $DATA(^VA(200,R,51,K,0))
IF $PIECE(^VA(200,R,51,K,0),U,3)'>D
QUIT 1
+7 IF $DATA(^VA(200,R,51,J,0))
IF $PIECE(^VA(200,R,51,J,0),U,3)'>D
QUIT 1
+8 QUIT ""
HADNOEP(P,BD,ED) ;EP - did patient have a RX in file 52 with an issue date
+1 ;between BD and ED
+2 IF '$GET(P)
QUIT ""
+3 IF '$GET(BD)
QUIT ""
+4 IF '$GET(ED)
QUIT ""
+5 IF '$DATA(^AUPNPAT(P,0))
QUIT ""
+6 NEW EXDT,IFN,ID,O,N,A,B
+7 SET N=""
+8 IF APCMRPTT=2
GOTO UD1
+9 SET EXDT=$$FMADD^XLFDT(BD,-730)
+10 FOR
SET EXDT=$ORDER(^PS(55,P,"P","A",EXDT))
IF 'EXDT!(N]"")
QUIT
SET IFN=0
FOR
SET IFN=$ORDER(^PS(55,P,"P","A",EXDT,IFN))
IF 'IFN!(N]"")
QUIT
IF $DATA(^PSRX(IFN,0))
Begin DoDot:1
+11 IF $PIECE($GET(^PSRX(IFN,"STA")),"^")=13
QUIT
+12 SET ID=$PIECE(^PSRX(IFN,0),U,13)
+13 IF ID<BD
QUIT
+14 IF ID>ED
QUIT
+15 ;check nature of order
+16 ;order number
SET O=$PIECE($GET(^PSRX(IFN,"OR1")),U,2)
+17 IF O=""
QUIT
+18 SET B=$PIECE($GET(^OR(100,O,0)),U,6)
+19 IF B=""
QUIT
+20 ;Q:'$$ORES(B,ID)
+21 SET A=0
FOR
SET A=$ORDER(^OR(100,O,8,A))
IF A'=+A!(N]"")
QUIT
Begin DoDot:2
+22 IF '$DATA(^OR(100,O,8,A,0))
QUIT
+23 SET B=$PIECE(^OR(100,O,8,A,0),U,12)
+24 IF B=1
QUIT
+25 IF B=""
QUIT
+26 SET N=$PIECE($PIECE(^OR(100,O,8,A,0),U),".")_U_$PIECE(^ORD(100.02,B,0),U,1)_U_$PIECE(^OR(100,O,0),U)
End DoDot:2
End DoDot:1
+27 IF N
QUIT N
+28 IF APCMRPTT=1
QUIT ""
UD1 ;
+1 SET G=""
SET N=""
+2 SET APCMUD=0
FOR
SET APCMUD=$ORDER(^PS(55,P,5,APCMUD))
IF APCMUD'=+APCMUD!(N]"")
QUIT
Begin DoDot:1
+3 IF '$DATA(^PS(55,P,5,APCMUD,0))
QUIT
+4 SET D=$PIECE($PIECE(^PS(55,P,5,APCMUD,0),U,14),".")
+5 IF D<BD
QUIT
+6 IF D>ED
QUIT
+7 ;GET ORDER #
+8 SET O=$PIECE($PIECE(^PS(55,P,5,APCMUD,0),U,21),";")
+9 IF O=""
QUIT
+10 SET B=$PIECE($GET(^OR(100,O,0)),U,6)
+11 IF B=""
QUIT
+12 ;Q:'$$ORES(B,D)
+13 SET A=0
FOR
SET A=$ORDER(^OR(100,O,8,A))
IF A'=+A!(N]"")
QUIT
Begin DoDot:2
+14 IF '$DATA(^OR(100,O,8,A,0))
QUIT
+15 SET B=$PIECE(^OR(100,O,8,A,0),U,12)
+16 IF B=1
QUIT
+17 IF B=""
QUIT
+18 SET N=$PIECE($PIECE(^OR(100,O,8,A,0),U),".")_U_$PIECE(^ORD(100.02,B,0),U,1)_U_$PIECE(^OR(100,O,0),U)
End DoDot:2
End DoDot:1
+19 IF N
QUIT N
+20 ;CHECK IV
+21 SET G=""
SET N=""
+22 SET APCMUD=0
FOR
SET APCMUD=$ORDER(^PS(55,P,"IV",APCMUD))
IF APCMUD'=+APCMUD!(N]"")
QUIT
Begin DoDot:1
+23 IF '$DATA(^PS(55,P,"IV",APCMUD,0))
QUIT
+24 SET D=$PIECE($PIECE(^PS(55,P,"IV",APCMUD,0),U,2),".")
+25 IF D<BD
QUIT
+26 IF D>ED
QUIT
+27 ;GET ORDER #
+28 SET O=$PIECE($PIECE(^PS(55,P,"IV",APCMUD,0),U,21),";")
+29 IF O=""
QUIT
+30 SET B=$PIECE($GET(^OR(100,O,0)),U,6)
+31 IF B=""
QUIT
+32 ;Q:'$$ORES(B,D)
+33 SET A=0
FOR
SET A=$ORDER(^OR(100,O,8,A))
IF A'=+A!(N]"")
QUIT
Begin DoDot:2
+34 IF '$DATA(^OR(100,O,8,A,0))
QUIT
+35 SET B=$PIECE(^OR(100,O,8,A,0),U,12)
+36 IF B=1
QUIT
+37 IF B=""
QUIT
+38 SET N=$PIECE($PIECE(^OR(100,O,8,A,0),U),".")_U_$PIECE(^ORD(100.02,B,0),U,1)_U_$PIECE(^OR(100,O,0),U)
End DoDot:2
End DoDot:1
+39 IF N
QUIT N
+40 QUIT ""
DEMO ;EP - CALCULATE DEMOGRAPHICS
+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 had dob, preferred language, gender, race, ethnicity recorded
+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 ;DID NOT SEE THIS PATIENT
IF '$DATA(APCMHVTP(APCMP))
QUIT
+9 DO DEMO1
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 DEMO1
+14 QUIT
End DoDot:1
+15 QUIT
DEMO1 ;set denominator value into field
+1 ;denom field for this measure
SET F=$PIECE(^APCMMUM(APCMIC,0),U,8)
+2 DO S^APCM11E1(APCMRPT,APCMIC,1,APCMP,APCMRPTT,APCMTIME,F)
+3 SET APCMVALU="VISIT: "_$$DATE^APCM1UTL(APCMHVTP(APCMP))
+4 ;numerator?
+5 SET APCMEP=$$HASDEMO(DFN,APCMBDAT,APCMEDAT,APCMRPTT,$GET(APCMVDOD))
+6 SET APCMVALU=APCMVALU_"|||"_$SELECT($PIECE(APCMEP,U,1)=1:"METS OBJECTIVE: ",1:"DOES NOT MEET OBJECTIVE: ")_$PIECE(APCMEP,U,2)_"|||"_$PIECE(APCMEP,U,1)
+7 SET F=$PIECE(^APCMMUM(APCMIC,0),U,9)
+8 DO S^APCM11E1(APCMRPT,APCMIC,$PIECE(APCMEP,U,1),APCMP,APCMRPTT,APCMTIME,F)
+9 DO SETLIST^APCM11E1
+10 QUIT
HASDEMO(P,BD,ED,T,DODV) ;
+1 NEW PL,G,R,E,D,C,Y,X,B,Z
+2 SET C=0
+3 SET T=$GET(T)
+4 SET DODV=$GET(DODV)
+5 SET (PL,G,R,E,D)=""
+6 ;preferred language
+7 SET X=0
FOR
SET X=$ORDER(^AUPNPAT(P,86,X))
IF X'=+X!(PL]"")
QUIT
Begin DoDot:1
+8 SET B=$PIECE(^AUPNPAT(P,86,X,0),U)
+9 IF B>ED
QUIT
+10 SET C=C+1
SET PL="Preferred Language"
End DoDot:1
+11 SET G=$PIECE(^DPT(P,0),U,2)
IF G]""
SET C=C+1
SET G="Gender"
+12 SET R=""
+13 IF $TEXT(RACE^AGUTL)]""
SET R=$$RACE^AGUTL(P)
+14 IF R
SET C=C+1
SET R="Race"
IF 1
+15 IF '$TEST
SET R=$$VAL^XBDIQ1(2,P,.06)
IF R]""
SET C=C+1
SET R="Race"
+16 SET Z=0
FOR
SET Z=$ORDER(^DPT(P,.06,Z))
IF Z'=+Z!(E]"")
QUIT
Begin DoDot:1
+17 SET E=$PIECE($GET(^DPT(P,.06,Z,0)),U,1)
+18 IF E=""
QUIT
+19 SET E="Ethnicity"
SET C=C+1
+20 QUIT
End DoDot:1
+21 IF $PIECE(^DPT(P,0),U,3)]""
SET D="DOB"
SET C=C+1
+22 IF T=2
IF $GET(DODV)
GOTO HASDEMOH
+23 IF C=5
QUIT 1_U_"Has: "_PL_";"_G_";"_R_";"_E_";"_D
+24 QUIT 0_U_"Has: "_PL_";"_G_";"_R_";"_E_";"_D
HASDEMOH ;did patient die in the hospital during report period? if so is dod and underlying cause there?
+1 NEW VDOD,L,UCD
+2 SET UCD=""
+3 SET VDOD=$$DOD^AUPNPAT(P)
+4 IF VDOD]""
SET C=C+1
SET VDOD="DOD"
+5 SET L=$$VAL^XBDIQ1(9000001,P,1114)
+6 IF L]""
SET C=C+1
SET UCD="UCD"
+7 IF C=7
QUIT 1_U_"Has: "_PL_";"_G_";"_R_";"_E_";"_D_";"_VDOD_";"_UCD
+8 QUIT 0_U_"Has: "_PL_";"_G_";"_R_";"_E_";"_D_";"_VDOD_";"_UCD
+9 ;
PL ;EP - CALCULATE PROBLEM LIST
+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 any problems on their problem list (skip deleted) or a NAP documented in 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 PL1
+10 QUIT
End DoDot:2
End DoDot:1
QUIT
+11 IF APCMRPTT=2
Begin DoDot:1
+12 SET APCMP=APCMFAC
+13 IF '$DATA(APCMHVTP(APCMP))
QUIT
+14 DO PL1
+15 QUIT
End DoDot:1
+16 QUIT
PL1 ;set denominator value into field
+1 ;denom field for this measure
SET F=$PIECE(^APCMMUM(APCMIC,0),U,8)
+2 DO S^APCM11E1(APCMRPT,APCMIC,1,APCMP,APCMRPTT,APCMTIME,F)
+3 SET APCMVALU="VISIT: "_$$DATE^APCM1UTL(APCMHVTP(APCMP))
+4 ;numerator?
+5 SET APCMEP=$$HASPL(DFN,APCMBDAT,APCMEDAT)
+6 SET APCMVALU=APCMVALU_"|||"_$PIECE(APCMEP,U,2)_"|||"_$PIECE(APCMEP,U,1)
+7 SET F=$PIECE(^APCMMUM(APCMIC,0),U,9)
+8 DO S^APCM11E1(APCMRPT,APCMIC,$PIECE(APCMEP,U,1),APCMP,APCMRPTT,APCMTIME,F)
+9 DO SETLIST^APCM11E1
+10 QUIT
HASPL(P,BD,ED) ;does patient have a problem entered before end of report period
+1 ;
+2 NEW A,B,C,D,E
+3 SET E=""
+4 SET A=0
FOR
SET A=$ORDER(^AUPNPROB("AC",P,A))
IF A'=+A!(E]"")
QUIT
Begin DoDot:1
+5 ;if date entered is after the ED don't count it
+6 IF '$DATA(^AUPNPROB(A,0))
QUIT
+7 ;after end date of report period
IF $PIECE(^AUPNPROB(A,0),U,8)>ED
QUIT
+8 IF $PIECE(^AUPNPROB(A,0),U,12)'="D"
SET E=1_U_"Problem Entry: "_$$VAL^XBDIQ1(9000011,A,.01)_" entered on "_$$VAL^XBDIQ1(9000011,A,.08)
QUIT
+9 ;since it's deleted, deletion date must not be before time period
+10 ;date deleted
SET D=$PIECE($PIECE($GET(^AUPNPROB(A,2)),U,2),".")
+11 IF D>ED
QUIT
+12 IF D<BD
QUIT
+13 SET E="1^Problem Entry: "_$$VAL^XBDIQ1(9000011,A,.01)_" entered on "_$$VAL^XBDIQ1(9000011,A,.08)
End DoDot:1
+14 IF E]""
QUIT E
+15 ;no problems on PL so how about a NAP before end of time period
+16 SET C=$ORDER(^AUTTCRA("B","NO ACTIVE PROBLEMS",0))
+17 IF 'C
QUIT ""
+18 SET A=0
FOR
SET A=$ORDER(^AUPNVRUP("AC",P,A))
IF A'=+A!(E]"")
QUIT
Begin DoDot:1
+19 ;oops
IF '$DATA(^AUPNVRUP(A,0))
QUIT
+20 ;not NAP
IF $PIECE(^AUPNVRUP(A,0),U,1)'=C
QUIT
+21 SET D=$$VD^APCLV($PIECE(^AUPNVRUP(A,0),U,3))
+22 IF D>ED
QUIT
+23 SET E="1^No Active Problems on "_$$DATE^APCM1UTL(D)
End DoDot:1
+24 QUIT E
MEDL ;EP - CALCULATE MEDICATION LIST
+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 ;d
+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 MEDL1
+10 QUIT
End DoDot:2
+11 QUIT
End DoDot:1
QUIT
+12 IF APCMRPTT=2
Begin DoDot:1
+13 SET APCMP=APCMFAC
+14 IF '$DATA(APCMHVTP(APCMP))
QUIT
+15 DO MEDL1
+16 QUIT
End DoDot:1
+17 QUIT
MEDL1 ;set denominator value into field
+1 ;denom field for this measure
SET F=$PIECE(^APCMMUM(APCMIC,0),U,8)
+2 DO S^APCM11E1(APCMRPT,APCMIC,1,APCMP,APCMRPTT,APCMTIME,F)
+3 SET APCMVALU="VISIT: "_$$DATE^APCM1UTL(APCMHVTP(APCMP))
+4 ;numerator?
+5 SET APCMEP=$$HASML(DFN,APCMBDAT,APCMEDAT)
+6 SET APCMVALU=APCMVALU_"|||"_$PIECE(APCMEP,U,2)_"|||"_$PIECE(APCMEP,U,1)
+7 SET F=$PIECE(^APCMMUM(APCMIC,0),U,9)
+8 DO S^APCM11E1(APCMRPT,APCMIC,$PIECE(APCMEP,U,1),APCMP,APCMRPTT,APCMTIME,F)
+9 DO SETLIST^APCM11E1
+10 QUIT
HASML(P,BDT,EDT) ;EP
+1 NEW RXIEN,ACTIEN,RTSDT,FILLDT,A0,FDTLP,IEN,G,DC,EXP,SDT,X,I,DRG,L,V,EXDT,IFN,ID,D365
+2 ;between BD and ED
+3 IF '$GET(P)
QUIT ""
+4 IF '$GET(BDT)
QUIT ""
+5 IF '$GET(EDT)
QUIT ""
+6 IF '$DATA(^AUPNPAT(P,0))
QUIT ""
+7 SET G=""
NAM ;look for "No Active Medications" anytime during the report period
+1 SET C=$ORDER(^AUTTCRA("B","NO ACTIVE MEDICATIONS",0))
+2 IF 'C
GOTO RXS
+3 ;GET most recent visit date
+4 SET A=0
FOR
SET A=$ORDER(^AUPNVRUP("AC",P,A))
IF A'=+A!(G]"")
QUIT
Begin DoDot:1
+5 ;oops
IF '$DATA(^AUPNVRUP(A,0))
QUIT
+6 ;not NAM
IF $PIECE(^AUPNVRUP(A,0),U,1)'=C
QUIT
+7 SET D=$$VD^APCLV($PIECE(^AUPNVRUP(A,0),U,3))
+8 ;before beg date
IF D<BDT
QUIT
+9 ;after end date
IF D>EDT
QUIT
+10 SET G="1^No Active Medications on "_$$DATE^APCM1UTL(D)
End DoDot:1
+11 IF G
QUIT G
RXS ;
+1 SET G=""
+2 SET D365=$$FMADD^XLFDT(BDT,-365)
+3 SET EXDT=$$FMADD^XLFDT(BDT,-(365*3))
+4 FOR
SET EXDT=$ORDER(^PS(55,P,"P","A",EXDT))
IF 'EXDT!(G]"")
QUIT
SET IFN=0
FOR
SET IFN=$ORDER(^PS(55,P,"P","A",EXDT,IFN))
IF 'IFN!(G]"")
QUIT
IF $DATA(^PSRX(IFN,0))
Begin DoDot:1
+5 ;deleted
IF $PIECE($GET(^PSRX(IFN,"STA")),"^")=13
QUIT
+6 ; Prescription must have a drug
IF '$PIECE(^PSRX(IFN,0),U,6)
QUIT
+7 ;issue date
SET ID=$PIECE(^PSRX(IFN,0),U,13)
+8 IF ID<D365
QUIT
+9 IF ID>EDT
QUIT
+10 ;dc date
SET DC=$PIECE($GET(^PSRX(IFN,3)),U,5)
+11 ;IF DC'ED DATE IF MUST BE ON OR AFTER 1ST DATE OF TIME PERIOD
IF DC]""
IF DC<BDT
QUIT
+12 SET G=1_U_$$DATE^APCM1UTL(ID)_" Rx: "_$PIECE(^PSRX(IFN,0),U,1)
QUIT
End DoDot:1
+13 IF G]""
QUIT G
+14 ;now check NVA meds
NVA ; Set Non-VA Med Orders in the ^TMP Global
+1 SET G=""
+2 FOR I=0:0
SET I=$ORDER(^PS(55,P,"NVA",I))
IF 'I!(G]"")
QUIT
SET X=$GET(^PS(55,P,"NVA",I,0))
Begin DoDot:1
+3 IF '$PIECE(X,"^")
QUIT
+4 SET DRG=$SELECT($PIECE(X,"^",2):$PIECE($GET(^PSDRUG($PIECE(X,"^",2),0)),"^"),1:$PIECE(^PS(50.7,$PIECE(X,"^"),0),"^")_" "_$PIECE(^PS(50.606,$PIECE(^PS(50.7,$PIECE(X,"^"),0),"^",2),0),"^"))
+5 ;DC'ED
IF $PIECE(X,"^",7)
IF $PIECE(X,"^",7)<BDT
QUIT
+6 ;NO documented date
SET SDT=$PIECE(X,"^",10)
IF 'SDT
QUIT
+7 ;documented date after end date
IF SDT>EDT
QUIT
+8 IF $PIECE(X,U,6)]""
QUIT
+9 SET G=1_U_"NVA: "_$$DATE^APCM1UTL($PIECE(X,U,10))_" Item: "_DRG
End DoDot:1
+10 IF G]""
QUIT G
+11 QUIT G
+12 ; Return boolean flag indicating valid patient
PATVRY(RX,PAT) ;EP
+1 IF PAT="*"
QUIT 1
+2 QUIT +$PIECE($GET(^PSRX(RX,0)),U,2)=PAT
+3 ; Return release date for dispense
DSPRDT(RX,TYP,SIEN) ;EP
+1 QUIT $SELECT($GET(SIEN):+$PIECE($GET(^PSRX(RX,$SELECT(TYP="ADP":"P",1:1),SIEN,0)),U,$SELECT(TYP="ADP":19,1:18)),1:+$PIECE(^PSRX(RX,2),U,13))
