- 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 Jan 18, 2025@03:28:17 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