BQITRCKN ;VNGT/HS/ALA-CVD Known Treatment Prompts ; 02 Sep 2008 11:51 AM
;;2.5;ICARE MANAGEMENT SYSTEM;**1**;May 24, 2016;Build 17
;
;
ASA(BQDFN) ; EP CVD.TP-1 No ASA/Antiplatelet
; If NOT on ASA OR Warfarin OR other Anti Platelet Medication or
; NOT contraindicated
NEW CT,X,VISIT,VSDTM,MEET,DESC,TIEN,T2,PRGM,QFL,RESULT,IEN
NEW ENDT,C,BQGPRG,BGPDXBD,BGPDXED,TAX,TREF
S MEET=0,DESC=""
D
. ; If not on ASA Medications
. S X=$$TAX^BQITRUTL("","DM AUDIT ASPIRIN DRUGS",1,BQDFN,9000010.14)
. ; if returns a found medication, check if it is an active medication
. I $P(X,U,1)=1 D
.. I $$ACTMED^BKMQQCR4($P(X,U,5)) Q
.. S $P(X,U,1)=0
. I $P(X,U,1)=1 D Q
.. S MEET=0,DESC=DESC_"On ASA Meds ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$$GET1^DIQ(9000010.14,$P(X,U,5)_",",.01,"E")_")"
. S MEET=1,DESC=DESC_"Not on ASA Meds; "
. ; If not on Warfarin Medications
. S X=$$TAX^BQITRUTL("","BGP CMS WARFARIN MEDS",1,BQDFN,9000010.14)
. ; if returns a found medication, check if it is an active medication
. I $P(X,U,1)=1 D
.. I $$ACTMED^BKMQQCR4($P(X,U,5)) Q
.. S $P(X,U,1)=0
. I $P(X,U,1)=1 D Q
.. S MEET=0,DESC=DESC_"On Warfarin Meds ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$$GET1^DIQ(9000010.14,$P(X,U,5)_",",.01,"E")_")"
. S MEET=1,DESC=DESC_"Not on Warfarin Meds; "
. ; If not on other Anti Platelet Medications
. S TREF=$NA(^TMP("BQITAX",UID)) K @TREF
. F TAX="BGP CMS ANTI-PLATELET CLASS","BGP ANTI-PLATELET DRUGS" D BLD^BQITUTL(TAX,TREF)
. S X=$$TAX^BQITRUTL("","",1,BQDFN,9000010.14,"","",.TREF)
. ; if returns a found medication, check if it is an active medication
. I $P(X,U,1)=1 D
.. I $$ACTMED^BKMQQCR4($P(X,U,5)) Q
.. S $P(X,U,1)=0
. I $P(X,U,1)=1 S MEET=0,DESC=DESC_"On Anti-Platelet Meds ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$$GET1^DIQ(9000010.14,$P(X,U,5)_",",.01,"E")_")"
. I $P(X,U,1)=0 S MEET=1,DESC=DESC_"Not on Anti-Platelet Meds"
. K @TREF
D
. ; If ASA/Warfarin/Anti-Platelet Medication contraindication
. S X=$$ASA^BQITRCON(BQDFN,$G(BDATE,""),$G(EDATE,""))
. I $P(X,U,1)=1 S MEET=0,DESC="Has a contraindication: "_$P(X,U,2) Q
. S MEET=$S(MEET:0,1:1)
. ; Check for allergy
. S X=$$ASA^BQITRALG(BQDFN,$G(BDATE,""),$G(EDATE,""))
. I $P(X,U,1)=1 S MEET=0,DESC="Has an allergy: "_$P(X,U,2) Q
. S MEET=$S(MEET:0,1:1)
Q MEET_U_DESC
;
STAT(BQDFN) ; EP CVD.TP-2 No Statin
NEW CT,X,VISIT,VSDTM,MEET,DESC,TIEN,T2,PRGM,QFL,RESULT,TREF
NEW GREF,IEN,ENDT,C,BQGPRG,BGPDXBD,BGPDXED,TAX
S MEET=0,DESC=""
S TREF=$NA(^TMP("BQITAX",UID)) K @TREF
F TAX="BGP HEDIS STATIN MEDS","BGP HEDIS STATIN NDC" D BLD^BQITUTL(TAX,TREF)
S X=$$TAX^BQITRUTL("","",1,BQDFN,9000010.14,"","",.TREF)
; if returns a found medication, check if it is an active medication
I $P(X,U,1)=1 D
. I $$ACTMED^BKMQQCR4($P(X,U,5)) Q
. S $P(X,U,1)=0
I $P(X,U,1)=1 S MEET=0,DESC=DESC_"On Statin Meds ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$$GET1^DIQ(9000010.14,$P(X,U,5)_",",.01,"E")_")"
I $P(X,U,1)=0 S MEET=1,DESC=DESC_"Not on Statin Meds"
D
. ; If Statin Medication is contraindicated
. S X=$$STAT^BQITRCON(BQDFN,$G(BDATE,""),$G(EDATE,""))
. I $P(X,U,1)=1 S MEET=0,DESC="Has a contraindication: "_$P(X,U,2) Q
. S MEET=$S(MEET:0,1:1)
. ; Check for allergy
. S X=$$STAT^BQITRALG(BQDFN,$G(BDATE,""),$G(EDATE,""))
. I $P(X,U,1)=1 S MEET=0,DESC="Has an allergy: "_$P(X,U,2) Q
. S MEET=$S(MEET:0,1:1)
K @TREF
Q MEET_U_DESC
;
BETA(BQDFN,ONF) ;EP CVD.TP-3 No Beta Blocker
; Input parameter
; BQDFN - Patient internal entry number
; ONF - 'On' flag 1=if on medication, 0=if not on medication
NEW CT,X,VISIT,VSDTM,MEET,DESC,TIEN,T2,PRGM,QFL,RESULT,GREF,IEN,ENDT,C,BQGPRG,BGPDXBD,BGPDXED
S MEET=0,DESC=""
S ONF=$G(ONF,0)
;
; If 2 of last 3 non-ER blood pressures in past 2 years are Systolic >130
; or Diastolic >80
S RESULT=$$BP(BQDFN)
I $P(RESULT,U,1)=0 Q RESULT
; And not on Beta Blocker and not contraindicated
I 'ONF S RESULT=$$BETAN(BQDFN)
; And on Beta Blocker and not contraindicated
I ONF S RESULT=$$BETAO(BQDFN)
Q RESULT
;
BETAN(BQDFN) ;EP - Not on Beta Blocker
NEW X,MEET,DESC,TAX,TREF
S MEET=0,DESC=""
S TREF=$NA(^TMP("BQITAX",UID)) K @TREF
F TAX="BGP CMS BETA BLOCKER CLASS","BGP HEDIS BETA BLOCKER MEDS","BGP HEDIS BETA BLOCKER NDC" D BLD^BQITUTL(TAX,TREF)
S X=$$TAX^BQITRUTL("","",1,BQDFN,9000010.14,"","",.TREF)
; if returns a found medication, check if it is an active medication
I $P(X,U,1)=1 D
. I $$ACTMED^BKMQQCR4($P(X,U,5)) Q
. S $P(X,U,1)=0
I $P(X,U,1)=1 S MEET=0,DESC=DESC_"On Beta Blocker Meds ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$$GET1^DIQ(9000010.14,$P(X,U,5)_",",.01,"E")_")"
I $P(X,U,1)=0 S MEET=1,DESC="Not on Beta Blocker Meds"
D
. S X=$$BETA^BQITRCON(BQDFN,$G(BDATE,""),$G(EDATE,""))
. I $P(X,U,1)=1 S MEET=0,DESC="Has a contraindication: "_$P(X,U,2) Q
. S MEET=$S(MEET:0,1:1)
. S X=$$BETA^BQITRALG(BQDFN,$G(BDATE,""),$G(EDATE,""))
. I $P(X,U,1)=1 S MEET=0,DESC="Has an allergy: "_$P(X,U,2) Q
. S MEET=$S(MEET:0,1:1)
K @TREF
Q MEET_U_DESC
;
BETAO(BQDFN) ;EP - On Beta Blocker
NEW X,MEET,DESC,TAX,TREF
S MEET=0,DESC=""
S TREF=$NA(^TMP("BQITAX",UID)) K @TREF
F TAX="BGP CMS BETA BLOCKER CLASS","BGP HEDIS BETA BLOCKER MEDS","BGP HEDIS BETA BLOCKER NDC" D BLD^BQITUTL(TAX,TREF)
S X=$$TAX^BQITRUTL("","",1,BQDFN,9000010.14,"","",.TREF)
; if returns a found medication, check if it is an active medication
I $P(X,U,1)=1 D
. I $$ACTMED^BKMQQCR4($P(X,U,5)) Q
. S $P(X,U,1)=0
I $P(X,U,1)=1 S MEET=1,DESC=DESC_"On Beta Blocker Meds ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$$GET1^DIQ(9000010.14,$P(X,U,5)_",",.01,"E")_")"
I $P(X,U,1)=0 S MEET=0,DESC="Not on Beta Blocker Meds"
K @TREF
D
. S X=$$BETA^BQITRCON(BQDFN,$G(BDATE,""),$G(EDATE,""))
. I $P(X,U,1)=1 S MEET=0,DESC="Has a contraindication: "_$P(X,U,2) Q
. S MEET=$S(MEET:0,1:1)
. S X=$$BETA^BQITRALG(BQDFN,$G(BDATE,""),$G(EDATE,""))
. I $P(X,U,1)=1 S MEET=0,DESC="Has an allergy: "_$P(X,U,2) Q
. S MEET=$S(MEET:0,1:1)
Q MEET_U_DESC
;
ACEI(BQDFN) ;EP CVD.TP-4 (TP-5) No ACEI
; If 2 of last 3 non-ER blood pressures in past 2 years are Systolic >130
; or Diastolic >80 and not on ACEI or ARB and not contraindicated
NEW CT,X,VISIT,VSDTM,MEET,DESC,TIEN,T2,PRGM,QFL,RESULT,TREF,GREF,IEN
NEW ENDT,C,BQGPRG,BGPDXBD,BGPDXED,TAX,TREF,TEXT,BQI,QFL
S MEET=0,DESC="",TEXT=""
S X=$$BP^BQITRUTL("T-24M",BQDFN,130,80,">")
I $P(X,U,2)'="" D
. NEW NDATE
. S QFL=0
. F BQI=1:1:3 D Q:QFL
.. I $P($P(X,U,2),";",BQI)="No BPs in timeframe" S TEXT=$P($P(X,U,2),";",BQI),QFL=1 Q
.. S NDATE=$$FMTE^BQIUL1($P($P(X,U,2),";",BQI))_"("_$P($P(X,U,5),";",BQI)_")",TEXT=TEXT_NDATE_";"
I $P(X,U,1)=0 S MEET=0,DESC="2 of last 3 non-ER BP are not valid values ["_TEXT_"]" Q MEET_U_DESC
I $P(X,U,1)=1 S MEET=1,DESC=DESC_$$PBP(DESC,X)
I 'MEET Q MEET_U_DESC
S TREF=$NA(^TMP("BQITAX",UID)) K @TREF
F TAX="BGP CMS ACEI MEDS CLASS","BGP HEDIS ACEI MEDS","BGP HEDIS ACEI NDC" D BLD^BQITUTL(TAX,TREF)
S X=$$TAX^BQITRUTL("","",1,BQDFN,9000010.14,"","",.TREF)
; if returns a found medication, check if it is an active medication
I $P(X,U,1)=1 D
. I $$ACTMED^BKMQQCR4($P(X,U,5)) Q
. S $P(X,U,1)=0
I $P(X,U,1)=1 S MEET=0,DESC=DESC_"On ACEI Meds ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$$GET1^DIQ(9000010.14,$P(X,U,5)_",",.01,"E")_")"
I $P(X,U,1)=0 S MEET=1,DESC=DESC_" and Not on ACEI Meds"
I MEET D ACCON
K @TREF
I MEET Q MEET_U_DESC
F TAX="BGP CMS ARB MEDS CLASS","BGP HEDIS ARB MEDS","BGP HEDIS ARB NDC" D BLD^BQITUTL(TAX,TREF)
S X=$$TAX^BQITRUTL("","",1,BQDFN,9000010.14,"","",.TREF)
; if returns a found medication, check if it is an active medication
I $P(X,U,1)=1 D
. I $$ACTMED^BKMQQCR4($P(X,U,5)) Q
. S $P(X,U,1)=0
I $P(X,U,1)=1 S MEET=0,DESC=DESC_"On ARB Meds ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$$GET1^DIQ(9000010.14,$P(X,U,5)_",",.01,"E")_")"
I $P(X,U,1)=0 S MEET=1,DESC="Not on ARB Meds"
I MEET D ACCON
K @TREF
Q MEET_U_DESC
;
ACCON ; Check for ACEI contraindication
S X=$$ACEI^BQITRCON(BQDFN,$G(BDATE,""),$G(EDATE,""))
I $P(X,U,1)=1 S MEET=0,DESC="Has a contraindication: "_$P(X,U,2) Q
S MEET=$S(MEET:0,1:1)
S X=$$ACEI^BQITRALG(BQDFN,$G(BDATE,""),$G(EDATE,""))
I $P(X,U,1)=1 S MEET=0,DESC="Has an allergy: "_$P(X,U,2) Q
S MEET=$S(MEET:0,1:1)
Q
;
HBP(BQDFN) ;EP CVD.TP-5 High BP
; If 2 of last 3 non-ER blood pressures in past 2 years are Systolic >130
; or Diastolic >80 and on beta blocker and on ACEI or ARB and not
; contraindicated
NEW RESULT1,RESULT2,X,MEET,DESC
S MEET=0,DESC=""
S RESULT1=$$BETA(BQDFN,1)
; If '0', not on Beta Blocker
I $P(RESULT1,U,1)=0 Q RESULT1
S RESULT2=$$ACEI(BQDFN)
; If '1', not on ACEI
I $P(RESULT2,U,1)=1 Q RESULT2
S MEET=1,DESC=DESC_$P(RESULT1,U,2)_" and "_$P(RESULT2,U,2)
Q MEET_U_DESC
;
HLDL(BQDFN,TMFRAME) ;EP CVD.TP-6 High LDL
; If most recent LDL in past year >100 and on Statin Medication
NEW X,MEET,DESC,TAX,TREF,X1
S MEET=0,DESC=""
S TREF=$NA(^TMP("BQITAX",UID)) K @TREF
F TAX="DM AUDIT LDL CHOLESTEROL TAX","BGP LDL LOINC CODES" D BLD^BQITUTL(TAX,TREF)
S X=$$LAB^BQITRUTL("T-12M",1,BQDFN,"",100,">","","",.TREF)
I $P(X,U,1)=0 S MEET=0,DESC="Most recent LDL not greater than 100 ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$P(X,U,3)_")"
I $P(X,U,1)=1 S MEET=1,DESC="Most recent LDL greater than 100 ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$P(X,U,3)_") and ",X1=X
I 'MEET Q MEET_U_DESC
K @TREF
F TAX="BGP HEDIS STATIN MEDS","BGP HEDIS STATIN NDC" D BLD^BQITUTL(TAX,TREF)
S X=$$TAX^BQITRUTL("","",1,BQDFN,9000010.14,"","",.TREF)
; if returns a found medication, check if it is an active medication
I $P(X,U,1)=1 D
. I $$ACTMED^BKMQQCR4($P(X,U,5)) Q
. S $P(X,U,1)=0
I $P(X,U,1)=0 S MEET=0,DESC=DESC_"Not on Statin Meds "
I $P(X,U,1)=1 S MEET=1,DESC=DESC_"On Statin Meds ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$$GET1^DIQ(9000010.14,$P(X,U,5)_",",.01,"E")_")"
K @TREF
Q MEET_U_DESC_U_$P(X1,U,2,5)
;
LHDL(BQDFN) ;EP CVD.TP-7 Low HDL
; If most recent LDL in past year is <=100 AND HDL in past year is <40
NEW MEET,DESC,X,HDL,LDL,TAX,TREF
S MEET=0,DESC=""
S TREF=$NA(^TMP("BQITAX",UID)) K @TREF
F TAX="DM AUDIT HDL TAX","BGP HDL LOINC CODES" D BLD^BQITUTL(TAX,TREF)
S X=$$LAB^BQITRUTL("T-12M",1,BQDFN,"",40,"<","","",.TREF)
I $P(X,U,1)=1 S HDL=X,MEET=1,DESC="HDL in past year less than 40 ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$P(X,U,3)_") and "
I $P(X,U,1)=0 S MEET=0,DESC="HDL in past year not less than 40 ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$P(X,U,3)_")"
I 'MEET Q MEET_U_DESC
;
K @TREF
F TAX="DM AUDIT LDL CHOLESTEROL TAX","BGP LDL LOINC CODES" D BLD^BQITUTL(TAX,TREF)
S X=$$LAB^BQITRUTL("T-12M",1,BQDFN,"",100,"'>","","",.TREF)
I $P(X,U,1)=1 S LDL=X,MEET=1,DESC=DESC_"LDL in past year not greater than 100 ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$P(X,U,3)_")"_U_$P(X,U,2,5)
I $P(X,U,1)=0 S MEET=0,DESC=DESC_"LDL in past year greater than 100 ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$P(X,U,3)_")"_U_$P(X,U,2,5)
K @TREF
Q MEET_U_DESC
;
NLDL(BQDFN) ;EP CVD.TP-8 No LDL
; No LDL in past year
NEW MEET,DESC,X,TAX,TREF
S MEET=0,DESC=""
S TREF=$NA(^TMP("BQITAX",UID)) K @TREF
F TAX="DM AUDIT LDL CHOLESTEROL TAX","BGP LDL LOINC CODES" D BLD^BQITUTL(TAX,TREF)
S X=$$LAB^BQITRUTL("T-12M",1,BQDFN,"",0,">","","",.TREF)
I $P(X,U,1)=1 S MEET=0,DESC="Has LDL in past year ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$P(X,U,3)_")"_U_$P(X,U,2,5)
I $P(X,U,1)=0 S MEET=1,DESC="No LDL in past year"
K @TREF
Q MEET_U_DESC
;
HTG(BQDFN,TMFRAME) ;EP CVD.TP-9 High TG
; Most recent TG in past year >150
NEW MEET,DESC,X,TAX,TREF
S MEET=0,DESC=""
S TMFRAME=$G(TMFRAME,"")
S TREF=$NA(^TMP("BQITAX",UID)) K @TREF
F TAX="DM AUDIT TRIGLYCERIDE TAX","BGP TRIGLYCERIDE LOINC CODES" D BLD^BQITUTL(TAX,TREF)
S X=$$LAB^BQITRUTL(TMFRAME,1,BQDFN,"",150,">","","",.TREF)
I $P(X,U,2)'="" S $P(X,U,2)=$$DATE^BQIUL1($P(X,U,2))
I $P(X,U,1)=1 S MEET=1,DESC="Most recent Triglyceride in past year greater than 150 ("_$$FMTMDY^BQIUL1($P(X,U,2))_" "_$P(X,U,3)_")"_U_$$FMTMDY^BQIUL1($P(X,U,2))_U_$P(X,U,3,5)
I $P(X,U,1)=0 S MEET=0,DESC="Most recent Triglyceride in past year is not greater than 150 ("_$$FMTMDY^BQIUL1($P(X,U,2))_" "_$P(X,U,3)_")"_U_$$FMTMDY^BQIUL1($P(X,U,2))_U_$P(X,U,3,5)
K @TREF
Q MEET_U_DESC
;
PBP(NDESC,NX) ;EP - Parse Blood Pressure values
NEW DATES,MIENS,DDSC,MDT,MVAL,MIEN
S DATES=$P(NX,U,2),MIENS=$P(NX,U,3),DDSC=""
F BQJ=1:1:$L(DATES,";") S MDT=$P(DATES,";",BQJ) Q:MDT="" D
. S MIEN=$P(MIENS,";",BQJ),MVAL=""
. I MIEN'="" S MVAL=$$GET1^DIQ(9000010.01,MIEN_",",.04,"E")
. S DDSC=DDSC_$$FMTE^BQIUL1(MDT)_" "_MVAL_" "
Q NDESC_" "_DDSC
;
BP(BQDFN) ;EP
; If 2 of last 3 non-ER blood pressures in past 2 years are Systolic >130
; or Diastolic >80
NEW X,DESC,TEXT,BQI,QFL
S DESC="",TEXT=""
S X=$$BP^BQITRUTL("T-24M",BQDFN,130,80,">")
I $P(X,U,2)'="" D
. NEW NDATE
. S QFL=0
. F BQI=1:1:3 D Q:QFL
.. I $P($P(X,U,2),";",BQI)="No BPs in timeframe" S TEXT=$P($P(X,U,2),";",BQI),QFL=1 Q
.. S NDATE=$$FMTE^BQIUL1($P($P(X,U,2),";",BQI))_"("_$P($P(X,U,5),";",BQI)_")",TEXT=TEXT_NDATE_";"
I $P(X,U,1)=0 S DESC="2 of last 3 non-ER BP are not valid values ["_TEXT_"]" Q $P(X,U,1)_U_DESC
I $P(X,U,1)=1 S DESC=DESC_$$PBP(DESC,X)
Q $P(X,U,1)_U_DESC
BQITRCKN ;VNGT/HS/ALA-CVD Known Treatment Prompts ; 02 Sep 2008 11:51 AM
+1 ;;2.5;ICARE MANAGEMENT SYSTEM;**1**;May 24, 2016;Build 17
+2 ;
+3 ;
ASA(BQDFN) ; EP CVD.TP-1 No ASA/Antiplatelet
+1 ; If NOT on ASA OR Warfarin OR other Anti Platelet Medication or
+2 ; NOT contraindicated
+3 NEW CT,X,VISIT,VSDTM,MEET,DESC,TIEN,T2,PRGM,QFL,RESULT,IEN
+4 NEW ENDT,C,BQGPRG,BGPDXBD,BGPDXED,TAX,TREF
+5 SET MEET=0
SET DESC=""
+6 Begin DoDot:1
+7 ; If not on ASA Medications
+8 SET X=$$TAX^BQITRUTL("","DM AUDIT ASPIRIN DRUGS",1,BQDFN,9000010.14)
+9 ; if returns a found medication, check if it is an active medication
+10 IF $PIECE(X,U,1)=1
Begin DoDot:2
+11 IF $$ACTMED^BKMQQCR4($PIECE(X,U,5))
QUIT
+12 SET $PIECE(X,U,1)=0
End DoDot:2
+13 IF $PIECE(X,U,1)=1
Begin DoDot:2
+14 SET MEET=0
SET DESC=DESC_"On ASA Meds ("_$$FMTE^BQIUL1($PIECE(X,U,2))_" "_$$GET1^DIQ(9000010.14,$PIECE(X,U,5)_",",.01,"E")_")"
End DoDot:2
QUIT
+15 SET MEET=1
SET DESC=DESC_"Not on ASA Meds; "
+16 ; If not on Warfarin Medications
+17 SET X=$$TAX^BQITRUTL("","BGP CMS WARFARIN MEDS",1,BQDFN,9000010.14)
+18 ; if returns a found medication, check if it is an active medication
+19 IF $PIECE(X,U,1)=1
Begin DoDot:2
+20 IF $$ACTMED^BKMQQCR4($PIECE(X,U,5))
QUIT
+21 SET $PIECE(X,U,1)=0
End DoDot:2
+22 IF $PIECE(X,U,1)=1
Begin DoDot:2
+23 SET MEET=0
SET DESC=DESC_"On Warfarin Meds ("_$$FMTE^BQIUL1($PIECE(X,U,2))_" "_$$GET1^DIQ(9000010.14,$PIECE(X,U,5)_",",.01,"E")_")"
End DoDot:2
QUIT
+24 SET MEET=1
SET DESC=DESC_"Not on Warfarin Meds; "
+25 ; If not on other Anti Platelet Medications
+26 SET TREF=$NAME(^TMP("BQITAX",UID))
KILL @TREF
+27 FOR TAX="BGP CMS ANTI-PLATELET CLASS","BGP ANTI-PLATELET DRUGS"
DO BLD^BQITUTL(TAX,TREF)
+28 SET X=$$TAX^BQITRUTL("","",1,BQDFN,9000010.14,"","",.TREF)
+29 ; if returns a found medication, check if it is an active medication
+30 IF $PIECE(X,U,1)=1
Begin DoDot:2
+31 IF $$ACTMED^BKMQQCR4($PIECE(X,U,5))
QUIT
+32 SET $PIECE(X,U,1)=0
End DoDot:2
+33 IF $PIECE(X,U,1)=1
SET MEET=0
SET DESC=DESC_"On Anti-Platelet Meds ("_$$FMTE^BQIUL1($PIECE(X,U,2))_" "_$$GET1^DIQ(9000010.14,$PIECE(X,U,5)_",",.01,"E")_")"
+34 IF $PIECE(X,U,1)=0
SET MEET=1
SET DESC=DESC_"Not on Anti-Platelet Meds"
+35 KILL @TREF
End DoDot:1
+36 Begin DoDot:1
+37 ; If ASA/Warfarin/Anti-Platelet Medication contraindication
+38 SET X=$$ASA^BQITRCON(BQDFN,$GET(BDATE,""),$GET(EDATE,""))
+39 IF $PIECE(X,U,1)=1
SET MEET=0
SET DESC="Has a contraindication: "_$PIECE(X,U,2)
QUIT
+40 SET MEET=$SELECT(MEET:0,1:1)
+41 ; Check for allergy
+42 SET X=$$ASA^BQITRALG(BQDFN,$GET(BDATE,""),$GET(EDATE,""))
+43 IF $PIECE(X,U,1)=1
SET MEET=0
SET DESC="Has an allergy: "_$PIECE(X,U,2)
QUIT
+44 SET MEET=$SELECT(MEET:0,1:1)
End DoDot:1
+45 QUIT MEET_U_DESC
+46 ;
STAT(BQDFN) ; EP CVD.TP-2 No Statin
+1 NEW CT,X,VISIT,VSDTM,MEET,DESC,TIEN,T2,PRGM,QFL,RESULT,TREF
+2 NEW GREF,IEN,ENDT,C,BQGPRG,BGPDXBD,BGPDXED,TAX
+3 SET MEET=0
SET DESC=""
+4 SET TREF=$NAME(^TMP("BQITAX",UID))
KILL @TREF
+5 FOR TAX="BGP HEDIS STATIN MEDS","BGP HEDIS STATIN NDC"
DO BLD^BQITUTL(TAX,TREF)
+6 SET X=$$TAX^BQITRUTL("","",1,BQDFN,9000010.14,"","",.TREF)
+7 ; if returns a found medication, check if it is an active medication
+8 IF $PIECE(X,U,1)=1
Begin DoDot:1
+9 IF $$ACTMED^BKMQQCR4($PIECE(X,U,5))
QUIT
+10 SET $PIECE(X,U,1)=0
End DoDot:1
+11 IF $PIECE(X,U,1)=1
SET MEET=0
SET DESC=DESC_"On Statin Meds ("_$$FMTE^BQIUL1($PIECE(X,U,2))_" "_$$GET1^DIQ(9000010.14,$PIECE(X,U,5)_",",.01,"E")_")"
+12 IF $PIECE(X,U,1)=0
SET MEET=1
SET DESC=DESC_"Not on Statin Meds"
+13 Begin DoDot:1
+14 ; If Statin Medication is contraindicated
+15 SET X=$$STAT^BQITRCON(BQDFN,$GET(BDATE,""),$GET(EDATE,""))
+16 IF $PIECE(X,U,1)=1
SET MEET=0
SET DESC="Has a contraindication: "_$PIECE(X,U,2)
QUIT
+17 SET MEET=$SELECT(MEET:0,1:1)
+18 ; Check for allergy
+19 SET X=$$STAT^BQITRALG(BQDFN,$GET(BDATE,""),$GET(EDATE,""))
+20 IF $PIECE(X,U,1)=1
SET MEET=0
SET DESC="Has an allergy: "_$PIECE(X,U,2)
QUIT
+21 SET MEET=$SELECT(MEET:0,1:1)
End DoDot:1
+22 KILL @TREF
+23 QUIT MEET_U_DESC
+24 ;
BETA(BQDFN,ONF) ;EP CVD.TP-3 No Beta Blocker
+1 ; Input parameter
+2 ; BQDFN - Patient internal entry number
+3 ; ONF - 'On' flag 1=if on medication, 0=if not on medication
+4 NEW CT,X,VISIT,VSDTM,MEET,DESC,TIEN,T2,PRGM,QFL,RESULT,GREF,IEN,ENDT,C,BQGPRG,BGPDXBD,BGPDXED
+5 SET MEET=0
SET DESC=""
+6 SET ONF=$GET(ONF,0)
+7 ;
+8 ; If 2 of last 3 non-ER blood pressures in past 2 years are Systolic >130
+9 ; or Diastolic >80
+10 SET RESULT=$$BP(BQDFN)
+11 IF $PIECE(RESULT,U,1)=0
QUIT RESULT
+12 ; And not on Beta Blocker and not contraindicated
+13 IF 'ONF
SET RESULT=$$BETAN(BQDFN)
+14 ; And on Beta Blocker and not contraindicated
+15 IF ONF
SET RESULT=$$BETAO(BQDFN)
+16 QUIT RESULT
+17 ;
BETAN(BQDFN) ;EP - Not on Beta Blocker
+1 NEW X,MEET,DESC,TAX,TREF
+2 SET MEET=0
SET DESC=""
+3 SET TREF=$NAME(^TMP("BQITAX",UID))
KILL @TREF
+4 FOR TAX="BGP CMS BETA BLOCKER CLASS","BGP HEDIS BETA BLOCKER MEDS","BGP HEDIS BETA BLOCKER NDC"
DO BLD^BQITUTL(TAX,TREF)
+5 SET X=$$TAX^BQITRUTL("","",1,BQDFN,9000010.14,"","",.TREF)
+6 ; if returns a found medication, check if it is an active medication
+7 IF $PIECE(X,U,1)=1
Begin DoDot:1
+8 IF $$ACTMED^BKMQQCR4($PIECE(X,U,5))
QUIT
+9 SET $PIECE(X,U,1)=0
End DoDot:1
+10 IF $PIECE(X,U,1)=1
SET MEET=0
SET DESC=DESC_"On Beta Blocker Meds ("_$$FMTE^BQIUL1($PIECE(X,U,2))_" "_$$GET1^DIQ(9000010.14,$PIECE(X,U,5)_",",.01,"E")_")"
+11 IF $PIECE(X,U,1)=0
SET MEET=1
SET DESC="Not on Beta Blocker Meds"
+12 Begin DoDot:1
+13 SET X=$$BETA^BQITRCON(BQDFN,$GET(BDATE,""),$GET(EDATE,""))
+14 IF $PIECE(X,U,1)=1
SET MEET=0
SET DESC="Has a contraindication: "_$PIECE(X,U,2)
QUIT
+15 SET MEET=$SELECT(MEET:0,1:1)
+16 SET X=$$BETA^BQITRALG(BQDFN,$GET(BDATE,""),$GET(EDATE,""))
+17 IF $PIECE(X,U,1)=1
SET MEET=0
SET DESC="Has an allergy: "_$PIECE(X,U,2)
QUIT
+18 SET MEET=$SELECT(MEET:0,1:1)
End DoDot:1
+19 KILL @TREF
+20 QUIT MEET_U_DESC
+21 ;
BETAO(BQDFN) ;EP - On Beta Blocker
+1 NEW X,MEET,DESC,TAX,TREF
+2 SET MEET=0
SET DESC=""
+3 SET TREF=$NAME(^TMP("BQITAX",UID))
KILL @TREF
+4 FOR TAX="BGP CMS BETA BLOCKER CLASS","BGP HEDIS BETA BLOCKER MEDS","BGP HEDIS BETA BLOCKER NDC"
DO BLD^BQITUTL(TAX,TREF)
+5 SET X=$$TAX^BQITRUTL("","",1,BQDFN,9000010.14,"","",.TREF)
+6 ; if returns a found medication, check if it is an active medication
+7 IF $PIECE(X,U,1)=1
Begin DoDot:1
+8 IF $$ACTMED^BKMQQCR4($PIECE(X,U,5))
QUIT
+9 SET $PIECE(X,U,1)=0
End DoDot:1
+10 IF $PIECE(X,U,1)=1
SET MEET=1
SET DESC=DESC_"On Beta Blocker Meds ("_$$FMTE^BQIUL1($PIECE(X,U,2))_" "_$$GET1^DIQ(9000010.14,$PIECE(X,U,5)_",",.01,"E")_")"
+11 IF $PIECE(X,U,1)=0
SET MEET=0
SET DESC="Not on Beta Blocker Meds"
+12 KILL @TREF
+13 Begin DoDot:1
+14 SET X=$$BETA^BQITRCON(BQDFN,$GET(BDATE,""),$GET(EDATE,""))
+15 IF $PIECE(X,U,1)=1
SET MEET=0
SET DESC="Has a contraindication: "_$PIECE(X,U,2)
QUIT
+16 SET MEET=$SELECT(MEET:0,1:1)
+17 SET X=$$BETA^BQITRALG(BQDFN,$GET(BDATE,""),$GET(EDATE,""))
+18 IF $PIECE(X,U,1)=1
SET MEET=0
SET DESC="Has an allergy: "_$PIECE(X,U,2)
QUIT
+19 SET MEET=$SELECT(MEET:0,1:1)
End DoDot:1
+20 QUIT MEET_U_DESC
+21 ;
ACEI(BQDFN) ;EP CVD.TP-4 (TP-5) No ACEI
+1 ; If 2 of last 3 non-ER blood pressures in past 2 years are Systolic >130
+2 ; or Diastolic >80 and not on ACEI or ARB and not contraindicated
+3 NEW CT,X,VISIT,VSDTM,MEET,DESC,TIEN,T2,PRGM,QFL,RESULT,TREF,GREF,IEN
+4 NEW ENDT,C,BQGPRG,BGPDXBD,BGPDXED,TAX,TREF,TEXT,BQI,QFL
+5 SET MEET=0
SET DESC=""
SET TEXT=""
+6 SET X=$$BP^BQITRUTL("T-24M",BQDFN,130,80,">")
+7 IF $PIECE(X,U,2)'=""
Begin DoDot:1
+8 NEW NDATE
+9 SET QFL=0
+10 FOR BQI=1:1:3
Begin DoDot:2
+11 IF $PIECE($PIECE(X,U,2),";",BQI)="No BPs in timeframe"
SET TEXT=$PIECE($PIECE(X,U,2),";",BQI)
SET QFL=1
QUIT
+12 SET NDATE=$$FMTE^BQIUL1($PIECE($PIECE(X,U,2),";",BQI))_"("_$PIECE($PIECE(X,U,5),";",BQI)_")"
SET TEXT=TEXT_NDATE_";"
End DoDot:2
IF QFL
QUIT
End DoDot:1
+13 IF $PIECE(X,U,1)=0
SET MEET=0
SET DESC="2 of last 3 non-ER BP are not valid values ["_TEXT_"]"
QUIT MEET_U_DESC
+14 IF $PIECE(X,U,1)=1
SET MEET=1
SET DESC=DESC_$$PBP(DESC,X)
+15 IF 'MEET
QUIT MEET_U_DESC
+16 SET TREF=$NAME(^TMP("BQITAX",UID))
KILL @TREF
+17 FOR TAX="BGP CMS ACEI MEDS CLASS","BGP HEDIS ACEI MEDS","BGP HEDIS ACEI NDC"
DO BLD^BQITUTL(TAX,TREF)
+18 SET X=$$TAX^BQITRUTL("","",1,BQDFN,9000010.14,"","",.TREF)
+19 ; if returns a found medication, check if it is an active medication
+20 IF $PIECE(X,U,1)=1
Begin DoDot:1
+21 IF $$ACTMED^BKMQQCR4($PIECE(X,U,5))
QUIT
+22 SET $PIECE(X,U,1)=0
End DoDot:1
+23 IF $PIECE(X,U,1)=1
SET MEET=0
SET DESC=DESC_"On ACEI Meds ("_$$FMTE^BQIUL1($PIECE(X,U,2))_" "_$$GET1^DIQ(9000010.14,$PIECE(X,U,5)_",",.01,"E")_")"
+24 IF $PIECE(X,U,1)=0
SET MEET=1
SET DESC=DESC_" and Not on ACEI Meds"
+25 IF MEET
DO ACCON
+26 KILL @TREF
+27 IF MEET
QUIT MEET_U_DESC
+28 FOR TAX="BGP CMS ARB MEDS CLASS","BGP HEDIS ARB MEDS","BGP HEDIS ARB NDC"
DO BLD^BQITUTL(TAX,TREF)
+29 SET X=$$TAX^BQITRUTL("","",1,BQDFN,9000010.14,"","",.TREF)
+30 ; if returns a found medication, check if it is an active medication
+31 IF $PIECE(X,U,1)=1
Begin DoDot:1
+32 IF $$ACTMED^BKMQQCR4($PIECE(X,U,5))
QUIT
+33 SET $PIECE(X,U,1)=0
End DoDot:1
+34 IF $PIECE(X,U,1)=1
SET MEET=0
SET DESC=DESC_"On ARB Meds ("_$$FMTE^BQIUL1($PIECE(X,U,2))_" "_$$GET1^DIQ(9000010.14,$PIECE(X,U,5)_",",.01,"E")_")"
+35 IF $PIECE(X,U,1)=0
SET MEET=1
SET DESC="Not on ARB Meds"
+36 IF MEET
DO ACCON
+37 KILL @TREF
+38 QUIT MEET_U_DESC
+39 ;
ACCON ; Check for ACEI contraindication
+1 SET X=$$ACEI^BQITRCON(BQDFN,$GET(BDATE,""),$GET(EDATE,""))
+2 IF $PIECE(X,U,1)=1
SET MEET=0
SET DESC="Has a contraindication: "_$PIECE(X,U,2)
QUIT
+3 SET MEET=$SELECT(MEET:0,1:1)
+4 SET X=$$ACEI^BQITRALG(BQDFN,$GET(BDATE,""),$GET(EDATE,""))
+5 IF $PIECE(X,U,1)=1
SET MEET=0
SET DESC="Has an allergy: "_$PIECE(X,U,2)
QUIT
+6 SET MEET=$SELECT(MEET:0,1:1)
+7 QUIT
+8 ;
HBP(BQDFN) ;EP CVD.TP-5 High BP
+1 ; If 2 of last 3 non-ER blood pressures in past 2 years are Systolic >130
+2 ; or Diastolic >80 and on beta blocker and on ACEI or ARB and not
+3 ; contraindicated
+4 NEW RESULT1,RESULT2,X,MEET,DESC
+5 SET MEET=0
SET DESC=""
+6 SET RESULT1=$$BETA(BQDFN,1)
+7 ; If '0', not on Beta Blocker
+8 IF $PIECE(RESULT1,U,1)=0
QUIT RESULT1
+9 SET RESULT2=$$ACEI(BQDFN)
+10 ; If '1', not on ACEI
+11 IF $PIECE(RESULT2,U,1)=1
QUIT RESULT2
+12 SET MEET=1
SET DESC=DESC_$PIECE(RESULT1,U,2)_" and "_$PIECE(RESULT2,U,2)
+13 QUIT MEET_U_DESC
+14 ;
HLDL(BQDFN,TMFRAME) ;EP CVD.TP-6 High LDL
+1 ; If most recent LDL in past year >100 and on Statin Medication
+2 NEW X,MEET,DESC,TAX,TREF,X1
+3 SET MEET=0
SET DESC=""
+4 SET TREF=$NAME(^TMP("BQITAX",UID))
KILL @TREF
+5 FOR TAX="DM AUDIT LDL CHOLESTEROL TAX","BGP LDL LOINC CODES"
DO BLD^BQITUTL(TAX,TREF)
+6 SET X=$$LAB^BQITRUTL("T-12M",1,BQDFN,"",100,">","","",.TREF)
+7 IF $PIECE(X,U,1)=0
SET MEET=0
SET DESC="Most recent LDL not greater than 100 ("_$$FMTE^BQIUL1($PIECE(X,U,2))_" "_$PIECE(X,U,3)_")"
+8 IF $PIECE(X,U,1)=1
SET MEET=1
SET DESC="Most recent LDL greater than 100 ("_$$FMTE^BQIUL1($PIECE(X,U,2))_" "_$PIECE(X,U,3)_") and "
SET X1=X
+9 IF 'MEET
QUIT MEET_U_DESC
+10 KILL @TREF
+11 FOR TAX="BGP HEDIS STATIN MEDS","BGP HEDIS STATIN NDC"
DO BLD^BQITUTL(TAX,TREF)
+12 SET X=$$TAX^BQITRUTL("","",1,BQDFN,9000010.14,"","",.TREF)
+13 ; if returns a found medication, check if it is an active medication
+14 IF $PIECE(X,U,1)=1
Begin DoDot:1
+15 IF $$ACTMED^BKMQQCR4($PIECE(X,U,5))
QUIT
+16 SET $PIECE(X,U,1)=0
End DoDot:1
+17 IF $PIECE(X,U,1)=0
SET MEET=0
SET DESC=DESC_"Not on Statin Meds "
+18 IF $PIECE(X,U,1)=1
SET MEET=1
SET DESC=DESC_"On Statin Meds ("_$$FMTE^BQIUL1($PIECE(X,U,2))_" "_$$GET1^DIQ(9000010.14,$PIECE(X,U,5)_",",.01,"E")_")"
+19 KILL @TREF
+20 QUIT MEET_U_DESC_U_$PIECE(X1,U,2,5)
+21 ;
LHDL(BQDFN) ;EP CVD.TP-7 Low HDL
+1 ; If most recent LDL in past year is <=100 AND HDL in past year is <40
+2 NEW MEET,DESC,X,HDL,LDL,TAX,TREF
+3 SET MEET=0
SET DESC=""
+4 SET TREF=$NAME(^TMP("BQITAX",UID))
KILL @TREF
+5 FOR TAX="DM AUDIT HDL TAX","BGP HDL LOINC CODES"
DO BLD^BQITUTL(TAX,TREF)
+6 SET X=$$LAB^BQITRUTL("T-12M",1,BQDFN,"",40,"<","","",.TREF)
+7 IF $PIECE(X,U,1)=1
SET HDL=X
SET MEET=1
SET DESC="HDL in past year less than 40 ("_$$FMTE^BQIUL1($PIECE(X,U,2))_" "_$PIECE(X,U,3)_") and "
+8 IF $PIECE(X,U,1)=0
SET MEET=0
SET DESC="HDL in past year not less than 40 ("_$$FMTE^BQIUL1($PIECE(X,U,2))_" "_$PIECE(X,U,3)_")"
+9 IF 'MEET
QUIT MEET_U_DESC
+10 ;
+11 KILL @TREF
+12 FOR TAX="DM AUDIT LDL CHOLESTEROL TAX","BGP LDL LOINC CODES"
DO BLD^BQITUTL(TAX,TREF)
+13 SET X=$$LAB^BQITRUTL("T-12M",1,BQDFN,"",100,"'>","","",.TREF)
+14 IF $PIECE(X,U,1)=1
SET LDL=X
SET MEET=1
SET DESC=DESC_"LDL in past year not greater than 100 ("_$$FMTE^BQIUL1($PIECE(X,U,2))_" "_$PIECE(X,U,3)_")"_U_$PIECE(X,U,2,5)
+15 IF $PIECE(X,U,1)=0
SET MEET=0
SET DESC=DESC_"LDL in past year greater than 100 ("_$$FMTE^BQIUL1($PIECE(X,U,2))_" "_$PIECE(X,U,3)_")"_U_$PIECE(X,U,2,5)
+16 KILL @TREF
+17 QUIT MEET_U_DESC
+18 ;
NLDL(BQDFN) ;EP CVD.TP-8 No LDL
+1 ; No LDL in past year
+2 NEW MEET,DESC,X,TAX,TREF
+3 SET MEET=0
SET DESC=""
+4 SET TREF=$NAME(^TMP("BQITAX",UID))
KILL @TREF
+5 FOR TAX="DM AUDIT LDL CHOLESTEROL TAX","BGP LDL LOINC CODES"
DO BLD^BQITUTL(TAX,TREF)
+6 SET X=$$LAB^BQITRUTL("T-12M",1,BQDFN,"",0,">","","",.TREF)
+7 IF $PIECE(X,U,1)=1
SET MEET=0
SET DESC="Has LDL in past year ("_$$FMTE^BQIUL1($PIECE(X,U,2))_" "_$PIECE(X,U,3)_")"_U_$PIECE(X,U,2,5)
+8 IF $PIECE(X,U,1)=0
SET MEET=1
SET DESC="No LDL in past year"
+9 KILL @TREF
+10 QUIT MEET_U_DESC
+11 ;
HTG(BQDFN,TMFRAME) ;EP CVD.TP-9 High TG
+1 ; Most recent TG in past year >150
+2 NEW MEET,DESC,X,TAX,TREF
+3 SET MEET=0
SET DESC=""
+4 SET TMFRAME=$GET(TMFRAME,"")
+5 SET TREF=$NAME(^TMP("BQITAX",UID))
KILL @TREF
+6 FOR TAX="DM AUDIT TRIGLYCERIDE TAX","BGP TRIGLYCERIDE LOINC CODES"
DO BLD^BQITUTL(TAX,TREF)
+7 SET X=$$LAB^BQITRUTL(TMFRAME,1,BQDFN,"",150,">","","",.TREF)
+8 IF $PIECE(X,U,2)'=""
SET $PIECE(X,U,2)=$$DATE^BQIUL1($PIECE(X,U,2))
+9 IF $PIECE(X,U,1)=1
SET MEET=1
SET DESC="Most recent Triglyceride in past year greater than 150 ("_$$FMTMDY^BQIUL1($PIECE(X,U,2))_" "_$PIECE(X,U,3)_")"_U_$$FMTMDY^BQIUL1($PIECE(X,U,2))_U_$PIECE(X,U,3,5)
+10 IF $PIECE(X,U,1)=0
SET MEET=0
SET DESC="Most recent Triglyceride in past year is not greater than 150 ("_$$FMTMDY^BQIUL1($PIECE(X,U,2))_" "_$PIECE(X,U,3)_")"_U_$$FMTMDY^BQIUL1($PIECE(X,U,2))_U_$PIECE(X,U,3,5)
+11 KILL @TREF
+12 QUIT MEET_U_DESC
+13 ;
PBP(NDESC,NX) ;EP - Parse Blood Pressure values
+1 NEW DATES,MIENS,DDSC,MDT,MVAL,MIEN
+2 SET DATES=$PIECE(NX,U,2)
SET MIENS=$PIECE(NX,U,3)
SET DDSC=""
+3 FOR BQJ=1:1:$LENGTH(DATES,";")
SET MDT=$PIECE(DATES,";",BQJ)
IF MDT=""
QUIT
Begin DoDot:1
+4 SET MIEN=$PIECE(MIENS,";",BQJ)
SET MVAL=""
+5 IF MIEN'=""
SET MVAL=$$GET1^DIQ(9000010.01,MIEN_",",.04,"E")
+6 SET DDSC=DDSC_$$FMTE^BQIUL1(MDT)_" "_MVAL_" "
End DoDot:1
+7 QUIT NDESC_" "_DDSC
+8 ;
BP(BQDFN) ;EP
+1 ; If 2 of last 3 non-ER blood pressures in past 2 years are Systolic >130
+2 ; or Diastolic >80
+3 NEW X,DESC,TEXT,BQI,QFL
+4 SET DESC=""
SET TEXT=""
+5 SET X=$$BP^BQITRUTL("T-24M",BQDFN,130,80,">")
+6 IF $PIECE(X,U,2)'=""
Begin DoDot:1
+7 NEW NDATE
+8 SET QFL=0
+9 FOR BQI=1:1:3
Begin DoDot:2
+10 IF $PIECE($PIECE(X,U,2),";",BQI)="No BPs in timeframe"
SET TEXT=$PIECE($PIECE(X,U,2),";",BQI)
SET QFL=1
QUIT
+11 SET NDATE=$$FMTE^BQIUL1($PIECE($PIECE(X,U,2),";",BQI))_"("_$PIECE($PIECE(X,U,5),";",BQI)_")"
SET TEXT=TEXT_NDATE_";"
End DoDot:2
IF QFL
QUIT
End DoDot:1
+12 IF $PIECE(X,U,1)=0
SET DESC="2 of last 3 non-ER BP are not valid values ["_TEXT_"]"
QUIT $PIECE(X,U,1)_U_DESC
+13 IF $PIECE(X,U,1)=1
SET DESC=DESC_$$PBP(DESC,X)
+14 QUIT $PIECE(X,U,1)_U_DESC
