ONCCPC0 ;HIRMFO/GWB - PCE Study of Colorectal Cancer;2/7/97
;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
;Check PCE eligibility
;Check if ACCESSION YEAR = 1997
I $P(^ONCO(165.5,ONCONUM,0),U,7)'=1997 S MSG="The Accession Year is not 1997." D ERRMSG G EXIT
;Check if microscopically confirmed
S DC=$P($G(^ONCO(165.5,ONCONUM,2)),U,6) I (DC'=1)&(DC'=2)&(DC'=4) S MSG="The Diagnostic Confirmation code is not 1, 2 or 4." D ERRMSG G EXIT
;Check if Class of Case is either 1, 2 or 6.
S COC=$P($G(^ONCO(165.5,ONCONUM,0)),U,4) I (COC'=1)&(COC'=2)&(COC'=6) S MSG="The Class of Case code is not 1, 2 or 6." D ERRMSG G EXIT
;Check if HISTOLOGY and BEHAVIOR is eligible
S HIST=$P($G(^ONCO(165.5,ONCONUM,2)),U,3)
S HIST1234=$E(HIST,1,4),BEH=$E(HIST,5)
I HIST="" S MSG="There is no HISTOLOGY for this primary." D ERRMSG G EXIT
I (BEH'=2)&(BEH'=3) S MSG="The BEHAVIOR code is not 2 (in situ) or 3 (malignant)." D ERRMSG G EXIT
S HIST(8140)=""
S HIST(8141)=""
S HIST(8143)=""
S HIST(8144)=""
S HIST(8145)=""
S HIST(8147)=""
S HIST(8150)=""
S HIST(8154)=""
S HIST(8160)=""
S HIST(8190)=""
S HIST(8200)=""
S HIST(8210)=""
S HIST(8211)=""
S HIST(8220)=""
S HIST(8221)=""
S HIST(8244)=""
S HIST(8250)=""
S HIST(8251)=""
S HIST(8260)=""
S HIST(8261)=""
S HIST(8262)=""
S HIST(8263)=""
S HIST(8270)=""
S HIST(8280)=""
S HIST(8290)=""
S HIST(8300)=""
S HIST(8310)=""
S HIST(8312)=""
S HIST(8320)=""
S HIST(8322)=""
S HIST(8323)=""
S HIST(8330)=""
S HIST(8331)=""
S HIST(8332)=""
S HIST(8340)=""
S HIST(8350)=""
S HIST(8370)=""
S HIST(8380)=""
S HIST(8400)=""
S HIST(8401)=""
S HIST(8410)=""
S HIST(8420)=""
S HIST(8441)=""
S HIST(8450)=""
S HIST(8460)=""
S HIST(8470)=""
S HIST(8480)=""
S HIST(8481)=""
S HIST(8490)=""
S HIST(8500)=""
S HIST(8503)=""
S HIST(8504)=""
S HIST(8510)=""
S HIST(8520)=""
S HIST(8530)=""
S HIST(8550)=""
S HIST(8560)=""
S HIST(8570)=""
S HIST(8571)=""
S HIST(8572)=""
S HIST(8573)=""
S HIST(9070)=""
S HIST(9110)=""
I '$D(HIST(HIST1234)) S MSG="The Histology of "_$E(HIST,1,4)_"/"_$E(HIST,5)_" is not eligible." D ERRMSG G EXIT
S $P(^ONCO(165.5,ONCONUM,7),U,15)="COL"
S ^ONCO(165.5,"APCE","COL",ONCONUM)=""
K DIR D HEAD
S DIR(0)="SO^1:General Information;2:Initial Diagnosis/Cancer Identification;3:Extent of Disease and AJCC Stage;4:First Course of Treatment;5:Quality of Life;6:First Recurrence;7:Status at Last Contact;8:All;"
S DIR(0)=DIR(0)_"9:Print Colorectal Cancer PCE"
S DIR("A")="Select Table" D ^DIR
G:$D(DIRUT)!($D(DIROUT)) EXIT
I Y=8 S OUT="" D G MENU
.D ^ONCCPC1 Q:$G(OUT)="Y"
.D ^ONCCPC2 Q:$G(OUT)="Y"
.D ^ONCCPC3 Q:$G(OUT)="Y"
.D ^ONCCPC4 Q:$G(OUT)="Y"
.D ^ONCCPC5 Q:$G(OUT)="Y"
.D ^ONCCPC6 Q:$G(OUT)="Y"
.D ^ONCCPC7 Q:$G(OUT)="Y"
I Y=9 D ^ONCCPC9 G MENU
S SUB="^ONCCPC"_Y D @SUB G MENU
ERRMSG ;Error message
I ONCOANS=5 W !!,?10,"This primary does not satisfy the PCE eligibility criteria:",!,?10,MSG R Z:10
K MSG Q
HEAD ;Colorectal Cancer PCE header
W @IOF,!,?1,PATNAM,?SITTAB,SITEGP,!,?1,SSN,?TOPTAB,TOPNAM," ",TOPCOD,!,DASHES
S HDL=$L("Patient Care Evaluation Study of Colorectal Cancer"),TAB=(80-HDL)\2,TAB=TAB-1
W !,?TAB,"Patient Care Evaluation Study of Colorectal Cancer",!,DASHES
Q
EXIT ;Kill variables and exit
K COC,DC,HDL,HIST,HIS1234,BEH,MSG,ONCONUM,ONCOPA,OUT,SUB,TAB
K DIC,DIQ,DIR,DIROUT,DIRUT,DLAYGO,DTOUT,DUOUT,X,Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCCPC0 3495 printed Apr 09, 2024@21:30:52 Page 2
ONCCPC0 ;HIRMFO/GWB - PCE Study of Colorectal Cancer;2/7/97
+1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
+2 ;Check PCE eligibility
+3 ;Check if ACCESSION YEAR = 1997
+4 IF $PIECE(^ONCO(165.5,ONCONUM,0),U,7)'=1997
SET MSG="The Accession Year is not 1997."
DO ERRMSG
GOTO EXIT
+5 ;Check if microscopically confirmed
+6 SET DC=$PIECE($GET(^ONCO(165.5,ONCONUM,2)),U,6)
IF (DC'=1)&(DC'=2)&(DC'=4)
SET MSG="The Diagnostic Confirmation code is not 1, 2 or 4."
DO ERRMSG
GOTO EXIT
+7 ;Check if Class of Case is either 1, 2 or 6.
+8 SET COC=$PIECE($GET(^ONCO(165.5,ONCONUM,0)),U,4)
IF (COC'=1)&(COC'=2)&(COC'=6)
SET MSG="The Class of Case code is not 1, 2 or 6."
DO ERRMSG
GOTO EXIT
+9 ;Check if HISTOLOGY and BEHAVIOR is eligible
+10 SET HIST=$PIECE($GET(^ONCO(165.5,ONCONUM,2)),U,3)
+11 SET HIST1234=$EXTRACT(HIST,1,4)
SET BEH=$EXTRACT(HIST,5)
+12 IF HIST=""
SET MSG="There is no HISTOLOGY for this primary."
DO ERRMSG
GOTO EXIT
+13 IF (BEH'=2)&(BEH'=3)
SET MSG="The BEHAVIOR code is not 2 (in situ) or 3 (malignant)."
DO ERRMSG
GOTO EXIT
+14 SET HIST(8140)=""
+15 SET HIST(8141)=""
+16 SET HIST(8143)=""
+17 SET HIST(8144)=""
+18 SET HIST(8145)=""
+19 SET HIST(8147)=""
+20 SET HIST(8150)=""
+21 SET HIST(8154)=""
+22 SET HIST(8160)=""
+23 SET HIST(8190)=""
+24 SET HIST(8200)=""
+25 SET HIST(8210)=""
+26 SET HIST(8211)=""
+27 SET HIST(8220)=""
+28 SET HIST(8221)=""
+29 SET HIST(8244)=""
+30 SET HIST(8250)=""
+31 SET HIST(8251)=""
+32 SET HIST(8260)=""
+33 SET HIST(8261)=""
+34 SET HIST(8262)=""
+35 SET HIST(8263)=""
+36 SET HIST(8270)=""
+37 SET HIST(8280)=""
+38 SET HIST(8290)=""
+39 SET HIST(8300)=""
+40 SET HIST(8310)=""
+41 SET HIST(8312)=""
+42 SET HIST(8320)=""
+43 SET HIST(8322)=""
+44 SET HIST(8323)=""
+45 SET HIST(8330)=""
+46 SET HIST(8331)=""
+47 SET HIST(8332)=""
+48 SET HIST(8340)=""
+49 SET HIST(8350)=""
+50 SET HIST(8370)=""
+51 SET HIST(8380)=""
+52 SET HIST(8400)=""
+53 SET HIST(8401)=""
+54 SET HIST(8410)=""
+55 SET HIST(8420)=""
+56 SET HIST(8441)=""
+57 SET HIST(8450)=""
+58 SET HIST(8460)=""
+59 SET HIST(8470)=""
+60 SET HIST(8480)=""
+61 SET HIST(8481)=""
+62 SET HIST(8490)=""
+63 SET HIST(8500)=""
+64 SET HIST(8503)=""
+65 SET HIST(8504)=""
+66 SET HIST(8510)=""
+67 SET HIST(8520)=""
+68 SET HIST(8530)=""
+69 SET HIST(8550)=""
+70 SET HIST(8560)=""
+71 SET HIST(8570)=""
+72 SET HIST(8571)=""
+73 SET HIST(8572)=""
+74 SET HIST(8573)=""
+75 SET HIST(9070)=""
+76 SET HIST(9110)=""
+77 IF '$DATA(HIST(HIST1234))
SET MSG="The Histology of "_$EXTRACT(HIST,1,4)_"/"_$EXTRACT(HIST,5)_" is not eligible."
DO ERRMSG
GOTO EXIT
+1 SET $PIECE(^ONCO(165.5,ONCONUM,7),U,15)="COL"
+2 SET ^ONCO(165.5,"APCE","COL",ONCONUM)=""
+3 KILL DIR
DO HEAD
+4 SET DIR(0)="SO^1:General Information;2:Initial Diagnosis/Cancer Identification;3:Extent of Disease and AJCC Stage;4:First Course of Treatment;5:Quality of Life;6:First Recurrence;7:Status at Last Contact;8:All;"
+5 SET DIR(0)=DIR(0)_"9:Print Colorectal Cancer PCE"
+6 SET DIR("A")="Select Table"
DO ^DIR
+7 if $DATA(DIRUT)!($DATA(DIROUT))
GOTO EXIT
+8 IF Y=8
SET OUT=""
Begin DoDot:1
+9 DO ^ONCCPC1
if $GET(OUT)="Y"
QUIT
+10 DO ^ONCCPC2
if $GET(OUT)="Y"
QUIT
+11 DO ^ONCCPC3
if $GET(OUT)="Y"
QUIT
+12 DO ^ONCCPC4
if $GET(OUT)="Y"
QUIT
+13 DO ^ONCCPC5
if $GET(OUT)="Y"
QUIT
+14 DO ^ONCCPC6
if $GET(OUT)="Y"
QUIT
+15 DO ^ONCCPC7
if $GET(OUT)="Y"
QUIT
End DoDot:1
GOTO MENU
+16 IF Y=9
DO ^ONCCPC9
GOTO MENU
+17 SET SUB="^ONCCPC"_Y
DO @SUB
GOTO MENU
ERRMSG ;Error message
+1 IF ONCOANS=5
WRITE !!,?10,"This primary does not satisfy the PCE eligibility criteria:",!,?10,MSG
READ Z:10
+2 KILL MSG
QUIT
HEAD ;Colorectal Cancer PCE header
+1 WRITE @IOF,!,?1,PATNAM,?SITTAB,SITEGP,!,?1,SSN,?TOPTAB,TOPNAM," ",TOPCOD,!,DASHES
+2 SET HDL=$LENGTH("Patient Care Evaluation Study of Colorectal Cancer")
SET TAB=(80-HDL)\2
SET TAB=TAB-1
+3 WRITE !,?TAB,"Patient Care Evaluation Study of Colorectal Cancer",!,DASHES
+4 QUIT
EXIT ;Kill variables and exit
+1 KILL COC,DC,HDL,HIST,HIS1234,BEH,MSG,ONCONUM,ONCOPA,OUT,SUB,TAB
+2 KILL DIC,DIQ,DIR,DIROUT,DIRUT,DLAYGO,DTOUT,DUOUT,X,Y
+3 QUIT
