ONCPM ;HINES OIFO/GWB Performance Measures ;08/15/11
;;2.2;ONCOLOGY;**1,17**;Jul 31, 2013;Build 6
;
N COC,ICDO,SITE,Z
N D0,DA,DD,DI,DIC,DIE,DIEL,DINUM,DIR,DK,DL,DLAYGO,DM,DO,DOV,DP,DQ,DR
K PCEITC
W !!,?10,"Performance Measures are no longer being collected..." R Z:10 G EXIT
;Build PCEITC array of eligible topography codes
S PCEITC("C18.0")="" ;Cecum
S PCEITC("C18.1")="" ;Appendix
S PCEITC("C18.2")="" ;Ascending
S PCEITC("C18.3")="" ;Hepatic flexure
S PCEITC("C18.4")="" ;Transverse
S PCEITC("C18.5")="" ;Splenic flexure
S PCEITC("C18.6")="" ;Descending
S PCEITC("C18.7")="" ;Sigmoid
S PCEITC("C18.8")="" ;Overlapping lesion
S PCEITC("C18.9")="" ;Colon, NOS
S PCEITC("C19.9")="" ;Rectosigmoid junction
S PCEITC("C20.9")="" ;Rectum
S PCEITC("C34.0")="" ;Main Bronchus
S PCEITC("C34.1")="" ;Upper lobe lung
S PCEITC("C34.2")="" ;Middle lobe lung
S PCEITC("C34.3")="" ;Lower lobe lung
S PCEITC("C34.8")="" ;Overlapping lesion of lung
S PCEITC("C34.9")="" ;Lung, NOS
S PCEITC("C50.0")="" ;Nipple
S PCEITC("C50.1")="" ;Central portion breast
S PCEITC("C50.2")="" ;Upper-inner quadrant breast
S PCEITC("C50.3")="" ;Lower-inner quadrant breast
S PCEITC("C50.4")="" ;Upper-outer quadrant breast
S PCEITC("C50.5")="" ;Lower-outer quadrant breast
S PCEITC("C50.6")="" ;Axillary tail breast
S PCEITC("C50.8")="" ;Overlapping lesion breast
S PCEITC("C50.9")="" ;Breast, NOS
S PCEITC("C61.9")="" ;Prostate
;
;Check PRIMARY SITE (165.5,2)
; CLASS OF CASE (165.5,.04)
; DATE DX (165.5,3)
S SITE=$P($G(^ONCO(165.5,ONCONUM,2)),U,1)
S ICDO=0
I SITE'="" S ICDO=$P(^ONCO(164,SITE,0),U,2)
S COC=$E($$GET1^DIQ(165.5,ONCONUM,.04),1,2)
I SITE="" W !!,?10,"There is no PRIMARY SITE for this primary." R Z:10 G EXIT
I COC="" W !!,?10,"There is no CLASS OF CASE for this primary." R Z:10 G EXIT
I COC>22 W !!,?10,"CLASS OF CASE = ",COC," (non-anlytic)." R Z:10 G EXIT
I DATEDX<3120000 W !!,?10,"DATE DX is before 2012." R Z:10 G EXIT
I '$D(PCEITC(ICDO)) W !!,?10,"Performance Measures are not being recorded for this primary site" R Z:10 G EXIT
I $E(ICDO,2,3)=34 D ^ONCPML G EXIT
I ($E(ICDO,2,3)=18)!($E(ICDO,2,3)=19)!($E(ICDO,2,3)=20) D ^ONCPMC G EXIT
I $E(ICDO,2,3)=50 D ^ONCPMB G EXIT
I ICDO="C61.9" D ^ONCPMP G EXIT
Q
;
EXIT ;Exit
K PCEITC
Q
;
CLEANUP ;Cleanup
K DATEDX,ONCONUM
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCPM 2396 printed Apr 09, 2024@21:26:34 Page 2
ONCPM ;HINES OIFO/GWB Performance Measures ;08/15/11
+1 ;;2.2;ONCOLOGY;**1,17**;Jul 31, 2013;Build 6
+2 ;
+3 NEW COC,ICDO,SITE,Z
+4 NEW D0,DA,DD,DI,DIC,DIE,DIEL,DINUM,DIR,DK,DL,DLAYGO,DM,DO,DOV,DP,DQ,DR
+5 KILL PCEITC
+6 WRITE !!,?10,"Performance Measures are no longer being collected..."
READ Z:10
GOTO EXIT
+7 ;Build PCEITC array of eligible topography codes
+8 ;Cecum
SET PCEITC("C18.0")=""
+9 ;Appendix
SET PCEITC("C18.1")=""
+10 ;Ascending
SET PCEITC("C18.2")=""
+11 ;Hepatic flexure
SET PCEITC("C18.3")=""
+12 ;Transverse
SET PCEITC("C18.4")=""
+13 ;Splenic flexure
SET PCEITC("C18.5")=""
+14 ;Descending
SET PCEITC("C18.6")=""
+15 ;Sigmoid
SET PCEITC("C18.7")=""
+16 ;Overlapping lesion
SET PCEITC("C18.8")=""
+17 ;Colon, NOS
SET PCEITC("C18.9")=""
+18 ;Rectosigmoid junction
SET PCEITC("C19.9")=""
+19 ;Rectum
SET PCEITC("C20.9")=""
+20 ;Main Bronchus
SET PCEITC("C34.0")=""
+21 ;Upper lobe lung
SET PCEITC("C34.1")=""
+22 ;Middle lobe lung
SET PCEITC("C34.2")=""
+23 ;Lower lobe lung
SET PCEITC("C34.3")=""
+24 ;Overlapping lesion of lung
SET PCEITC("C34.8")=""
+25 ;Lung, NOS
SET PCEITC("C34.9")=""
+26 ;Nipple
SET PCEITC("C50.0")=""
+27 ;Central portion breast
SET PCEITC("C50.1")=""
+28 ;Upper-inner quadrant breast
SET PCEITC("C50.2")=""
+29 ;Lower-inner quadrant breast
SET PCEITC("C50.3")=""
+30 ;Upper-outer quadrant breast
SET PCEITC("C50.4")=""
+31 ;Lower-outer quadrant breast
SET PCEITC("C50.5")=""
+32 ;Axillary tail breast
SET PCEITC("C50.6")=""
+33 ;Overlapping lesion breast
SET PCEITC("C50.8")=""
+34 ;Breast, NOS
SET PCEITC("C50.9")=""
+35 ;Prostate
SET PCEITC("C61.9")=""
+36 ;
+37 ;Check PRIMARY SITE (165.5,2)
+38 ; CLASS OF CASE (165.5,.04)
+39 ; DATE DX (165.5,3)
+40 SET SITE=$PIECE($GET(^ONCO(165.5,ONCONUM,2)),U,1)
+41 SET ICDO=0
+42 IF SITE'=""
SET ICDO=$PIECE(^ONCO(164,SITE,0),U,2)
+43 SET COC=$EXTRACT($$GET1^DIQ(165.5,ONCONUM,.04),1,2)
+44 IF SITE=""
WRITE !!,?10,"There is no PRIMARY SITE for this primary."
READ Z:10
GOTO EXIT
+45 IF COC=""
WRITE !!,?10,"There is no CLASS OF CASE for this primary."
READ Z:10
GOTO EXIT
+46 IF COC>22
WRITE !!,?10,"CLASS OF CASE = ",COC," (non-anlytic)."
READ Z:10
GOTO EXIT
+47 IF DATEDX<3120000
WRITE !!,?10,"DATE DX is before 2012."
READ Z:10
GOTO EXIT
+48 IF '$DATA(PCEITC(ICDO))
WRITE !!,?10,"Performance Measures are not being recorded for this primary site"
READ Z:10
GOTO EXIT
+49 IF $EXTRACT(ICDO,2,3)=34
DO ^ONCPML
GOTO EXIT
+50 IF ($EXTRACT(ICDO,2,3)=18)!($EXTRACT(ICDO,2,3)=19)!($EXTRACT(ICDO,2,3)=20)
DO ^ONCPMC
GOTO EXIT
+51 IF $EXTRACT(ICDO,2,3)=50
DO ^ONCPMB
GOTO EXIT
+52 IF ICDO="C61.9"
DO ^ONCPMP
GOTO EXIT
+53 QUIT
+54 ;
EXIT ;Exit
+1 KILL PCEITC
+2 QUIT
+3 ;
CLEANUP ;Cleanup
+1 KILL DATEDX,ONCONUM
