ONCHPC0 ;Hines OIFO/GWB - 2000 HEPATOCELLULAR CANCERS PCE STUDY ;01/06/00
;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
;Check PCE eligibility
;
;ACCESSION YEAR (165.5,.07) = 2000
I $P(^ONCO(165.5,ONCONUM,0),U,7)'=2000 S MSG="The Accession Year is not 2000." D ERRMSG G EXIT
;
;DIAGNOSTIC CONFIRMATION (165.5,26) = 1, 2, 4 or 5
S DC=$P($G(^ONCO(165.5,ONCONUM,2)),U,6)
I (DC'=1)&(DC'=2)&(DC'=4)&(DC'=5) S MSG="The Diagnostic Confirmation code is not 1, 2, 4 or 5." D ERRMSG G EXIT
;
;CLASS OF CASE (165.5,.04) = 0, 1 or 2
S COC=$P($G(^ONCO(165.5,ONCONUM,0)),U,4)
I (COC'=0)&(COC'=1)&(COC'=2) S MSG="The Class of Case code is not 0, 1 or 2." D ERRMSG G EXIT
;
;BEHAVIOR = 3.
I BEH'=3 S MSG="The Behavior Code is not 3 (Malignant)." D ERRMSG G EXIT
;
;HISTOLOGY (165.5,22)
S HST(80103)=""
S HST(81403)=""
S HST(81603)=""
S HST(81613)=""
S HST(81703)=""
S HST(81713)=""
S HST(81803)=""
S HST(84403)=""
S HST(88003)=""
S HST(88103)=""
S HST(88143)=""
S HST(88503)=""
S HST(88513)=""
S HST(88523)=""
S HST(88533)=""
S HST(88543)=""
S HST(88553)=""
S HST(88583)=""
S HST(89703)=""
S HST(89913)=""
S HST(91203)=""
S HST(91333)=""
I $D(HST(HIST)) G MENU
I (HIST>95902)&(HIST<97174) G MENU
E S MSG="Invalid Histology code." D ERRMSG G EXIT
;
K HST
S $P(^ONCO(165.5,ONCONUM,7),U,15)="HEP"
S ^ONCO(165.5,"APCE","HEP",ONCONUM)=""
K DIR D HEAD
S DIR(0)="SO^1:Patient Information;2:Tumor Identification;3:Stage of Disease at Diagnosis;4:First Course of Treatment;5:Recurrence;6:Follow-Up;7:All;8:Print Hepatocellular PCE"
S DIR("A")="Select section" D ^DIR
G:$D(DIRUT)!($D(DIROUT)) EXIT
I Y=7 S OUT="" D G MENU
.D ^ONCHPC1 Q:$G(OUT)="Y"
.D ^ONCHPC2 Q:$G(OUT)="Y"
.D ^ONCHPC3 Q:$G(OUT)="Y"
.D ^ONCHPC4 Q:$G(OUT)="Y"
.D ^ONCHPC5 Q:$G(OUT)="Y"
.D ^ONCHPC6 Q:$G(OUT)="Y"
S SUB="^ONCHPC"_Y D @SUB G MENU
;
ERRMSG ;Error message
I ONCOANS=5 W !!,?8,"This primary does not satisfy the PCE eligibility criteria:",!!,?8,MSG R Z:10
K MSG Q
;
HEAD ;PCE header
W @IOF,!,?1,PATNAM,?SITTAB,SITEGP
W !,?1,SSN,?TOPTAB,TOPNAM," ",TOPCOD
W !,DASHES
S HDL=$L("2000 Patient Care Evaluation Study of Hepatocellular Cancers")
S TAB=(80-HDL)\2,TAB=TAB-1
W !,?TAB,"2000 Patient Care Evaluation Study of Hepatocellular Cancers"
W !,DASHES
Q
;
EXIT ;Kill variables and exit
K HDL,ONCONUM,ONCOPA,OUT,SUB,TAB,HST
K DIC,DIR,DIROUT,DIRUT,DLAYGO,DTOUT,DUOUT,X,Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCHPC0 2510 printed Oct 16, 2024@18:23:45 Page 2
ONCHPC0 ;Hines OIFO/GWB - 2000 HEPATOCELLULAR CANCERS PCE STUDY ;01/06/00
+1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
+2 ;Check PCE eligibility
+3 ;
+4 ;ACCESSION YEAR (165.5,.07) = 2000
+5 IF $PIECE(^ONCO(165.5,ONCONUM,0),U,7)'=2000
SET MSG="The Accession Year is not 2000."
DO ERRMSG
GOTO EXIT
+6 ;
+7 ;DIAGNOSTIC CONFIRMATION (165.5,26) = 1, 2, 4 or 5
+8 SET DC=$PIECE($GET(^ONCO(165.5,ONCONUM,2)),U,6)
+9 IF (DC'=1)&(DC'=2)&(DC'=4)&(DC'=5)
SET MSG="The Diagnostic Confirmation code is not 1, 2, 4 or 5."
DO ERRMSG
GOTO EXIT
+10 ;
+11 ;CLASS OF CASE (165.5,.04) = 0, 1 or 2
+12 SET COC=$PIECE($GET(^ONCO(165.5,ONCONUM,0)),U,4)
+13 IF (COC'=0)&(COC'=1)&(COC'=2)
SET MSG="The Class of Case code is not 0, 1 or 2."
DO ERRMSG
GOTO EXIT
+14 ;
+15 ;BEHAVIOR = 3.
+16 IF BEH'=3
SET MSG="The Behavior Code is not 3 (Malignant)."
DO ERRMSG
GOTO EXIT
+17 ;
+18 ;HISTOLOGY (165.5,22)
+19 SET HST(80103)=""
+20 SET HST(81403)=""
+21 SET HST(81603)=""
+22 SET HST(81613)=""
+23 SET HST(81703)=""
+24 SET HST(81713)=""
+25 SET HST(81803)=""
+26 SET HST(84403)=""
+27 SET HST(88003)=""
+28 SET HST(88103)=""
+29 SET HST(88143)=""
+30 SET HST(88503)=""
+31 SET HST(88513)=""
+32 SET HST(88523)=""
+33 SET HST(88533)=""
+34 SET HST(88543)=""
+35 SET HST(88553)=""
+36 SET HST(88583)=""
+37 SET HST(89703)=""
+38 SET HST(89913)=""
+39 SET HST(91203)=""
+40 SET HST(91333)=""
+41 IF $DATA(HST(HIST))
GOTO MENU
+42 IF (HIST>95902)&(HIST<97174)
GOTO MENU
+43 IF '$TEST
SET MSG="Invalid Histology code."
DO ERRMSG
GOTO EXIT
+44 ;
+1 KILL HST
+2 SET $PIECE(^ONCO(165.5,ONCONUM,7),U,15)="HEP"
+3 SET ^ONCO(165.5,"APCE","HEP",ONCONUM)=""
+4 KILL DIR
DO HEAD
+5 SET DIR(0)="SO^1:Patient Information;2:Tumor Identification;3:Stage of Disease at Diagnosis;4:First Course of Treatment;5:Recurrence;6:Follow-Up;7:All;8:Print Hepatocellular PCE"
+6 SET DIR("A")="Select section"
DO ^DIR
+7 if $DATA(DIRUT)!($DATA(DIROUT))
GOTO EXIT
+8 IF Y=7
SET OUT=""
Begin DoDot:1
+9 DO ^ONCHPC1
if $GET(OUT)="Y"
QUIT
+10 DO ^ONCHPC2
if $GET(OUT)="Y"
QUIT
+11 DO ^ONCHPC3
if $GET(OUT)="Y"
QUIT
+12 DO ^ONCHPC4
if $GET(OUT)="Y"
QUIT
+13 DO ^ONCHPC5
if $GET(OUT)="Y"
QUIT
+14 DO ^ONCHPC6
if $GET(OUT)="Y"
QUIT
End DoDot:1
GOTO MENU
+15 SET SUB="^ONCHPC"_Y
DO @SUB
GOTO MENU
+16 ;
ERRMSG ;Error message
+1 IF ONCOANS=5
WRITE !!,?8,"This primary does not satisfy the PCE eligibility criteria:",!!,?8,MSG
READ Z:10
+2 KILL MSG
QUIT
+3 ;
HEAD ;PCE header
+1 WRITE @IOF,!,?1,PATNAM,?SITTAB,SITEGP
+2 WRITE !,?1,SSN,?TOPTAB,TOPNAM," ",TOPCOD
+3 WRITE !,DASHES
+4 SET HDL=$LENGTH("2000 Patient Care Evaluation Study of Hepatocellular Cancers")
+5 SET TAB=(80-HDL)\2
SET TAB=TAB-1
+6 WRITE !,?TAB,"2000 Patient Care Evaluation Study of Hepatocellular Cancers"
+7 WRITE !,DASHES
+8 QUIT
+9 ;
EXIT ;Kill variables and exit
+1 KILL HDL,ONCONUM,ONCOPA,OUT,SUB,TAB,HST
+2 KILL DIC,DIR,DIROUT,DIRUT,DLAYGO,DTOUT,DUOUT,X,Y
+3 QUIT
