ONCBPC1 ;Hines OIFO/GWB - PCE Study of Cancers of the Urinary Bladder ;5/30/00
;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
;Table I
K TABLE,HTABLE
S TABLE("ACCESSION/SEQUENCE NUMBER")="ACC"
S TABLE("CLASS OF CASE")="CLA"
S TABLE("REFERRED FOR TREATMENT TO")="PATR"
S TABLE("ZIP AT DIAGNOSIS")="ZIP"
S TABLE("DATE OF BIRTH")="DAT"
S TABLE("RACE")="RAC"
S TABLE("SPANISH ORIGIN")="SPA"
S TABLE("SEX")="SEX"
S TABLE("PRIMARY PAYER AT DIAGNOSIS")="PRI"
S TABLE("LENGTH OF STAY")="LEN"
S TABLE("PATIENT HISTORY OF OTHER CANCER")="PATH"
S TABLE("FAMILY HISTORY OF CANCER")="FAM"
S TABLE("SMOKING HISTORY")="SMO"
S TABLE("DURATION OF SMOKING HISTORY")="DOSH"
S TABLE("DURATION OF SMOKE-FREE HISTORY")="DOSFH"
S HTABLE(1)="ACCESSION/SEQUENCE NUMBER"
S HTABLE(2)="CLASS OF CASE"
S HTABLE(3)="REFERRED FOR TREATMENT TO"
S HTABLE(4)="ZIP AT DIAGNOSIS"
S HTABLE(5)="DATE OF BIRTH"
S HTABLE(6)="RACE"
S HTABLE(7)="SPANISH ORIGIN"
S HTABLE(8)="SEX"
S HTABLE(9)="PRIMARY PAYER AT DIAGNOSIS"
S HTABLE(10)="LENGTH OF STAY"
S HTABLE(11)="PATIENT HISTORY OF OTHER CANCER"
S HTABLE(12)="FAMILY HISTORY OF CANCER"
S HTABLE(13)="SMOKING HISTORY"
S HTABLE(14)="DURATION OF SMOKING HISTORY"
S HTABLE(15)="DURATION OF SMOKE-FREE HISTORY"
S CHOICES=15
S PRINODE0=^ONCO(165.5,ONCONUM,0)
S ACCSEQ=$P(PRINODE0,U,5)_"/"_$P(PRINODE0,U,6)
S COCIN=$P(PRINODE0,U,4),Y=COCIN,C=$P(^DD(165.5,.04,0),U,2) D Y^DIQ
S COCEX=Y
S D0=ONCOPA D DOB1^ONCOES S Y=X D DATEOT^ONCOPCE S DOB=Y
W @IOF D HEAD^ONCBPC0 W !?25,"TABLE I - GENERAL INFORMATION",!
ACC W !,"ACCESSION/SEQUENCE NUMBER.....: ",ACCSEQ
CLA W !,"CLASS OF CASE.................: ",COCEX
PATR S DIE="^ONCO(165.5,",DA=ONCONUM
S DR="300REFERRED FOR TREATMENT TO....." D ^DIE G:$D(Y) JUMP
ZIP S DIE="^ONCO(165.5,",DA=ONCONUM
S DR="9ZIP AT DIAGNOSIS.............." D ^DIE G:$D(Y) JUMP
DAT W !,"DATE OF BIRTH.................: ",DOB
RAC S DIE="^ONCO(160,",DA=ONCOPA
S DR="8RACE.........................." D ^DIE G:$D(Y) JUMP
SPA S DIE="^ONCO(160,",DA=ONCOPA
S DR="9SPANISH ORIGIN................" D ^DIE G:$D(Y) JUMP
SEX S DIE="^ONCO(160,",DA=ONCOPA
S DR="10SEX..........................." D ^DIE G:$D(Y) JUMP
PRI S DIE="^ONCO(165.5,",DA=ONCONUM
S DR="18PRIMARY PAYER AT DIAGNOSIS...." D ^DIE G:$D(Y) JUMP
LEN S DIE="^ONCO(165.5,",DA=ONCONUM
S DR="301LENGTH OF STAY................" D ^DIE G:$D(Y) JUMP
PATH W !!,"PATIENT HISTORY OF OTHER CANCER:",!
S DIE="^ONCO(165.5,",DA=ONCONUM
S DR="302 CERVIX......................" D ^DIE G:$D(Y) JUMP
S DR="303 COLON......................." D ^DIE G:$D(Y) JUMP
S DR="304 BLADDER....................." D ^DIE G:$D(Y) JUMP
S DR="305 HEAD AND NECK..............." D ^DIE G:$D(Y) JUMP
S DR="306 KIDNEY......................" D ^DIE G:$D(Y) JUMP
S DR="307 PROSTATE...................." D ^DIE G:$D(Y) JUMP
S DR="308 OTHER......................." D ^DIE G:$D(Y) JUMP
FAM W !!,"FAMILY HISTORY OF CANCER:",!
S DIE="^ONCO(165.5,",DA=ONCONUM
S DR="309 BLADDER....................." D ^DIE G:$D(Y) JUMP
S DR="310 COLON......................." D ^DIE G:$D(Y) JUMP
S DR="311 LUNG........................" D ^DIE G:$D(Y) JUMP
S DR="312 PROSTATE...................." D ^DIE G:$D(Y) JUMP
S DR="313 OTHER......................." D ^DIE G:$D(Y) JUMP
W !
SMO S DIE="^ONCO(165.5,",DA=ONCONUM
S DR="314SMOKING HISTORY (PACKS/DAY)..." D ^DIE G:$D(Y) JUMP
DOSH S DIE="^ONCO(165.5,",DA=ONCONUM
S DR="315DURATION OF SMOKING HISTORY..." D ^DIE G:$D(Y) JUMP
DOSFH S DIE="^ONCO(165.5,",DA=ONCONUM
S DR="316DURATION OF SMOKE-FREE HISTORY" D ^DIE G:$D(Y) JUMP
W ! K DIR S DIR(0)="E" D ^DIR
G EXIT
JUMP ;Jump to prompts
S XX="" R !!,"GO TO: ",X:DTIME I (X="")!(X[U) S OUT="Y" G EXIT
I X["?" D G JUMP
.W !,"CHOOSE FROM:" F I=1:1:CHOICES W !,?5,HTABLE(I)
I '$D(TABLE(X)) S XX=X,X=$O(TABLE(X)) I ($P(X,XX,1)'="")!(X="") W *7,"??" D G JUMP
.W !,"CHOOSE FROM:" F I=1:1:CHOICES W !,?5,HTABLE(I)
S X=TABLE(X)
G @X
EXIT K HTABLE,TABLE,CHOICES
K ACCSEQ,COCIN,COCEX,C,DOB,PRINODE0
K DA,DR,DIE,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,XX,Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCBPC1 4126 printed Oct 16, 2024@18:22:49 Page 2
ONCBPC1 ;Hines OIFO/GWB - PCE Study of Cancers of the Urinary Bladder ;5/30/00
+1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
+2 ;Table I
+3 KILL TABLE,HTABLE
+4 SET TABLE("ACCESSION/SEQUENCE NUMBER")="ACC"
+5 SET TABLE("CLASS OF CASE")="CLA"
+6 SET TABLE("REFERRED FOR TREATMENT TO")="PATR"
+7 SET TABLE("ZIP AT DIAGNOSIS")="ZIP"
+8 SET TABLE("DATE OF BIRTH")="DAT"
+9 SET TABLE("RACE")="RAC"
+10 SET TABLE("SPANISH ORIGIN")="SPA"
+11 SET TABLE("SEX")="SEX"
+12 SET TABLE("PRIMARY PAYER AT DIAGNOSIS")="PRI"
+13 SET TABLE("LENGTH OF STAY")="LEN"
+14 SET TABLE("PATIENT HISTORY OF OTHER CANCER")="PATH"
+15 SET TABLE("FAMILY HISTORY OF CANCER")="FAM"
+16 SET TABLE("SMOKING HISTORY")="SMO"
+17 SET TABLE("DURATION OF SMOKING HISTORY")="DOSH"
+18 SET TABLE("DURATION OF SMOKE-FREE HISTORY")="DOSFH"
+19 SET HTABLE(1)="ACCESSION/SEQUENCE NUMBER"
+20 SET HTABLE(2)="CLASS OF CASE"
+21 SET HTABLE(3)="REFERRED FOR TREATMENT TO"
+22 SET HTABLE(4)="ZIP AT DIAGNOSIS"
+23 SET HTABLE(5)="DATE OF BIRTH"
+24 SET HTABLE(6)="RACE"
+25 SET HTABLE(7)="SPANISH ORIGIN"
+26 SET HTABLE(8)="SEX"
+27 SET HTABLE(9)="PRIMARY PAYER AT DIAGNOSIS"
+28 SET HTABLE(10)="LENGTH OF STAY"
+29 SET HTABLE(11)="PATIENT HISTORY OF OTHER CANCER"
+30 SET HTABLE(12)="FAMILY HISTORY OF CANCER"
+31 SET HTABLE(13)="SMOKING HISTORY"
+32 SET HTABLE(14)="DURATION OF SMOKING HISTORY"
+33 SET HTABLE(15)="DURATION OF SMOKE-FREE HISTORY"
+34 SET CHOICES=15
+35 SET PRINODE0=^ONCO(165.5,ONCONUM,0)
+36 SET ACCSEQ=$PIECE(PRINODE0,U,5)_"/"_$PIECE(PRINODE0,U,6)
+37 SET COCIN=$PIECE(PRINODE0,U,4)
SET Y=COCIN
SET C=$PIECE(^DD(165.5,.04,0),U,2)
DO Y^DIQ
+38 SET COCEX=Y
+39 SET D0=ONCOPA
DO DOB1^ONCOES
SET Y=X
DO DATEOT^ONCOPCE
SET DOB=Y
+40 WRITE @IOF
DO HEAD^ONCBPC0
WRITE !?25,"TABLE I - GENERAL INFORMATION",!
ACC WRITE !,"ACCESSION/SEQUENCE NUMBER.....: ",ACCSEQ
CLA WRITE !,"CLASS OF CASE.................: ",COCEX
PATR SET DIE="^ONCO(165.5,"
SET DA=ONCONUM
+1 SET DR="300REFERRED FOR TREATMENT TO....."
DO ^DIE
if $DATA(Y)
GOTO JUMP
ZIP SET DIE="^ONCO(165.5,"
SET DA=ONCONUM
+1 SET DR="9ZIP AT DIAGNOSIS.............."
DO ^DIE
if $DATA(Y)
GOTO JUMP
DAT WRITE !,"DATE OF BIRTH.................: ",DOB
RAC SET DIE="^ONCO(160,"
SET DA=ONCOPA
+1 SET DR="8RACE.........................."
DO ^DIE
if $DATA(Y)
GOTO JUMP
SPA SET DIE="^ONCO(160,"
SET DA=ONCOPA
+1 SET DR="9SPANISH ORIGIN................"
DO ^DIE
if $DATA(Y)
GOTO JUMP
SEX SET DIE="^ONCO(160,"
SET DA=ONCOPA
+1 SET DR="10SEX..........................."
DO ^DIE
if $DATA(Y)
GOTO JUMP
PRI SET DIE="^ONCO(165.5,"
SET DA=ONCONUM
+1 SET DR="18PRIMARY PAYER AT DIAGNOSIS...."
DO ^DIE
if $DATA(Y)
GOTO JUMP
LEN SET DIE="^ONCO(165.5,"
SET DA=ONCONUM
+1 SET DR="301LENGTH OF STAY................"
DO ^DIE
if $DATA(Y)
GOTO JUMP
PATH WRITE !!,"PATIENT HISTORY OF OTHER CANCER:",!
+1 SET DIE="^ONCO(165.5,"
SET DA=ONCONUM
+2 SET DR="302 CERVIX......................"
DO ^DIE
if $DATA(Y)
GOTO JUMP
+3 SET DR="303 COLON......................."
DO ^DIE
if $DATA(Y)
GOTO JUMP
+4 SET DR="304 BLADDER....................."
DO ^DIE
if $DATA(Y)
GOTO JUMP
+5 SET DR="305 HEAD AND NECK..............."
DO ^DIE
if $DATA(Y)
GOTO JUMP
+6 SET DR="306 KIDNEY......................"
DO ^DIE
if $DATA(Y)
GOTO JUMP
+7 SET DR="307 PROSTATE...................."
DO ^DIE
if $DATA(Y)
GOTO JUMP
+8 SET DR="308 OTHER......................."
DO ^DIE
if $DATA(Y)
GOTO JUMP
FAM WRITE !!,"FAMILY HISTORY OF CANCER:",!
+1 SET DIE="^ONCO(165.5,"
SET DA=ONCONUM
+2 SET DR="309 BLADDER....................."
DO ^DIE
if $DATA(Y)
GOTO JUMP
+3 SET DR="310 COLON......................."
DO ^DIE
if $DATA(Y)
GOTO JUMP
+4 SET DR="311 LUNG........................"
DO ^DIE
if $DATA(Y)
GOTO JUMP
+5 SET DR="312 PROSTATE...................."
DO ^DIE
if $DATA(Y)
GOTO JUMP
+6 SET DR="313 OTHER......................."
DO ^DIE
if $DATA(Y)
GOTO JUMP
+7 WRITE !
SMO SET DIE="^ONCO(165.5,"
SET DA=ONCONUM
+1 SET DR="314SMOKING HISTORY (PACKS/DAY)..."
DO ^DIE
if $DATA(Y)
GOTO JUMP
DOSH SET DIE="^ONCO(165.5,"
SET DA=ONCONUM
+1 SET DR="315DURATION OF SMOKING HISTORY..."
DO ^DIE
if $DATA(Y)
GOTO JUMP
DOSFH SET DIE="^ONCO(165.5,"
SET DA=ONCONUM
+1 SET DR="316DURATION OF SMOKE-FREE HISTORY"
DO ^DIE
if $DATA(Y)
GOTO JUMP
+2 WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
+3 GOTO EXIT
JUMP ;Jump to prompts
+1 SET XX=""
READ !!,"GO TO: ",X:DTIME
IF (X="")!(X[U)
SET OUT="Y"
GOTO EXIT
+2 IF X["?"
Begin DoDot:1
+3 WRITE !,"CHOOSE FROM:"
FOR I=1:1:CHOICES
WRITE !,?5,HTABLE(I)
End DoDot:1
GOTO JUMP
+4 IF '$DATA(TABLE(X))
SET XX=X
SET X=$ORDER(TABLE(X))
IF ($PIECE(X,XX,1)'="")!(X="")
WRITE *7,"??"
Begin DoDot:1
+5 WRITE !,"CHOOSE FROM:"
FOR I=1:1:CHOICES
WRITE !,?5,HTABLE(I)
End DoDot:1
GOTO JUMP
+6 SET X=TABLE(X)
+7 GOTO @X
EXIT KILL HTABLE,TABLE,CHOICES
+1 KILL ACCSEQ,COCIN,COCEX,C,DOB,PRINODE0
+2 KILL DA,DR,DIE,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,XX,Y
+3 QUIT
