ONCHPC4 ;Hines OIFO/GWB - 2000 Hepatocellular Cancers PCE Study ;01/10/00
 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
 ;First Course of Treatment 
 K TABLE,HTABLE
 S TABLE("29. DATE OF FIRST COURSE OF TREATMENT")="DFCT^ONCHPC4"
 S TABLE("30. DATE OF INPATIENT ADMISSION")="DIA^ONCHPC4"
 S TABLE("31. DATE OF INPATIENT DISCHARGE")="DID^ONCHPC4"
 S TABLE("SURGERY")="S^ONCHPC4"
 S TABLE("32. DATE OF NON CANCER-DIRECTED SURGERY")="DNCDS^ONCHPC4"
 S TABLE("33. NON CANCER-DIRECTED SURGERY")="NCDS^ONCHPC4"
 S TABLE("34. DATE OF CANCER-DIRECTED SURGERY")="DCDS^ONCHPC4"
 S TABLE("35. SURGICAL APPROACH")="SA^ONCHPC4"
 S TABLE("36. SURGERY OF PRIMARY SITE")="SPS^ONCHPC4"
 S TABLE("37. RADIO-FREQUENCY DESTRUCTION OF TUMOR")="RFDT^ONCHPC4"
 S TABLE("38. ABLATION & RESECTION")="AR^ONCHPC4"
 S TABLE("39. SURGICAL MARGINS")="SM^ONCHPC4"
 S TABLE("40. DISTANCE OF TUMOR TO CLOSEST MARGIN")="DTCM^ONCHPC4"
 S TABLE("41. SURGERY OF REGIONAL SITE(S), DISTANT SITE(S), OR DISTANT LYMPH NODE(S)")="SORS^ONCHPC4"
 S TABLE("42. SURGICAL TREATMENT OF RESIDUAL PRIMARY TUMOR")="STRPT^ONCHPC4"
 S TABLE("43. RECONSTRUCTION/RESTORATION-FIRST COURSE")="RR^ONCHPC4"
 S TABLE("RADIATION THERAPY")="R^ONCHPC4A"
 S TABLE("44. DATE RADIATION STARTED")="DRS^ONCHPC4A"
 S TABLE("45. RADIATION THERAPY")="RT^ONCHPC4A"
 S TABLE("CHEMOTHERAPY")="C^ONCHPC4A"
 S TABLE("46. DATE CHEMOTHERAPY STARTED")="DCS^ONCHPC4A"
 S TABLE("47. CHEMOTHERAPY")="CT^ONCHPC4A"
 S TABLE("48. TYPE OF CHEMOTHERAPEUTIC AGENTS ADMINISTERED")="TCAA^ONCHPC4A"
 S TABLE("49. ROUTE CHEMOTHERAPY ADMINISTERED")="RCA^ONCHPC4A"
 S TABLE("50. CHEMOTHERAPY/SURGERY SEQUENCE")="CSS^ONCHPC4A"
 S TABLE("OTHER THERAPY")="O^ONCHPC4A"
 S TABLE("51. DATE OTHER TREATMENT STARTED")="DOTS^ONCHPC4A"
 S TABLE("52. OTHER TREATMENT")="OT^ONCHPC4A"
 S TABLE("53. ARTERIAL EMBOLIZATION")="AE^ONCHPC4A"
 S TABLE("54. DEATH WITHIN30 DAYS OF START OF INTIIAL COURSE OF THERAPY")="DWTD^ONCHPC4A"
 S HTABLE(1)="29. DATE OF FIRST COURSE OF TREATMENT"
 S HTABLE(2)="30. DATE OF INPATIENT ADMISSION"
 S HTABLE(3)="31. DATE OF INPATIENT DISCHARGE"
 S HTABLE(4)=""
 S HTABLE(5)="SURGERY"
 S HTABLE(6)=""
 S HTABLE(7)="32. DATE OF NON CANCER-DIRECTED SURGERY"
 S HTABLE(8)="33. NON CANCER-DIRECTED SURGERY"
 S HTABLE(9)="34. DATE OF CANCER-DIRECTED SURGERY"
 S HTABLE(10)="35. SURGICAL APPROACH"
 S HTABLE(11)="36. SURGERY OF PRIMARY SITE"
 S HTABLE(12)="37. RADIO-FREQUENCY DESTRUCTION OF TUMOR"
 S HTABLE(13)="38. ABLATION & RESECTION"
 S HTABLE(14)="39. SURGICAL MARGINS"
 S HTABLE(15)="40. DISTANCE OF TUMOR TO CLOSEST MARGIN"
 S HTABLE(16)="41. SURGERY OF REGIONAL SITE(S), DISTANT SITE(S), OR DISTANT LYMPH NODE(S)"
 S HTABLE(17)="42. SURGICAL TREATMENT OF RESIDUAL PRIMARY TUMOR"
 S HTABLE(18)="43. RECONSTRUCTION/RESTORATION-FIRST COURSE"
 S HTABLE(19)=""
 S HTABLE(20)="RADIATION THERAPY"
 S HTABLE(21)=""
 S HTABLE(22)="44. DATE RADIATION STARTED"
 S HTABLE(23)="45. RADIATION THERAPY"
 S HTABLE(24)=""
 S HTABLE(25)="CHEMOTHERAPY"
 S HTABLE(26)=""
 S HTABLE(27)="46. DATE CHEMOTHERAPY STARTED"
 S HTABLE(28)="47. CHEMOTHERAPY"
 S HTABLE(29)="48. TYPE OF CHEMOTHERAPEUTIC AGENTS ADMINISTERED"
 S HTABLE(30)="49. ROUTE CHEMOTHERAPY ADMINISTERED"
 S HTABLE(31)="50. CHEMOTHERAPY/SURGERY SEQUENCE"
 S HTABLE(32)=""
 S HTABLE(33)="OTHER THERAPY"
 S HTABLE(34)=""
 S HTABLE(35)="51. DATE OTHER TREATMENT STARTED"
 S HTABLE(36)="52. OTHER TREATMENT"
 S HTABLE(37)="53. ARTERIAL EMBOLIZATION"
 S HTABLE(38)="54. DEATH WITHIN30 DAYS OF START OF INTIIAL COURSE OF THERAPY"
 S CHOICES=38
 S IE=ONCONUM
 W @IOF D HEAD^ONCHPC0
 W !," FIRST COURSE OF TREATMENT"
 W !," -------------------------"
 S DIE="^ONCO(165.5,",DA=ONCONUM
 S CDS=$$GET1^DIQ(165.5,IE,58.2)
 S RAD=$$GET1^DIQ(165.5,IE,51.2,"I")
 S CHE=$$GET1^DIQ(165.5,IE,53.2,"I")
DFCT W !," 29. DATE OF FIRST COURSE OF"
 W !,"      TREATMENT....................: ",$$GET1^DIQ(165.5,IE,49)
DIA S DR="1 30. DATE OF INPATIENT ADMISSION..." D ^DIE G:$D(Y) JUMP
DID S DR="1.1 31. DATE OF INPATIENT DISCHARGE..." D ^DIE G:$D(Y) JUMP
S W @IOF D HEAD^ONCHPC0
 W !," SURGERY",!
 W " -------"
DNCDS W !," 32. DATE OF NON CANCER-DIRECTED"
 W !,"      SURGERY......................: ",$$GET1^DIQ(165.5,IE,58.3)
NCDS S NCDS=$$GET1^DIQ(165.5,IE,58.1)
 S (NCDS1,NCDS2)="",LOS=$L(NCDS) I LOS<43 S NCDS1=NCDS G NCDS1
 S NOP=$L($E(NCDS,1,43)," ")
 S NCDS1=$P(NCDS," ",1,NOP-1),NCDS2=$P(NCDS," ",NOP,999)
NCDS1 W !," 33. NON CANCER-DIRECTED SURGERY...: ",NCDS1 W:NCDS2'="" !,?37,NCDS2
DCDS W !," 34. DATE OF CANCER-DIRECTED"
 W !,"      SURGERY......................: ",$$GET1^DIQ(165.5,IE,50)
SA S SA=$$GET1^DIQ(165.5,IE,74)
 S (SA1,SA2)="",LOS=$L(SA) I LOS<43 S SA1=SA G SA1
 S NOP=$L($E(SA,1,43)," "),SA1=$P(SA," ",1,NOP-1),SA2=$P(SA," ",NOP,999)
SA1 W !," 35. SURGICAL APPROACH.............: ",SA1 W:SA2'="" !,?37,SA2
SPS S (CDS1,CDS2)="",LOS=$L(CDS) I LOS<43 S CDS1=CDS G SPS1
 S NOP=$L($E(CDS,1,43)," "),CDS1=$P(CDS," ",1,NOP-1),CDS2=$P(CDS," ",NOP,999)
SPS1 W !," 36. SURGERY OF PRIMARY SITE.......: ",CDS1 W:CDS2'="" !,?37,CDS2
RFDT I $E(CDS,1,2)=99 D  G AR
 .S $P(^ONCO(165.5,D0,"HEP1"),U,57)=9
 .W !," 37. RADIO-FREQUENCY DESTRUCTION OF"
 .W !,"      TUMOR........................: Unknown"
 I $E(CDS,1,2)'=17 D  G AR
 .S $P(^ONCO(165.5,D0,"HEP1"),U,57)=8
 .W !," 37. RADIO-FREQUENCY DESTRUCTION OF"
 .W !,"      TUMOR........................: NA"
 S DR="1056 37. RADIO-FREQUENCY DESTRUCTION OF                                                   TUMOR........................" D ^DIE G:$D(Y) JUMP
AR I ($E(CDS,1,2)="00")!($E(CDS,1,2)=99) D  G SM
 .S $P(^ONCO(165.5,D0,"HEP1"),U,58)=88
 .W !," 38. ABLATION & RESECTION..........: NA"
 I $E(CDS,1,2)<18 D  G SM
 .S $P(^ONCO(165.5,D0,"HEP1"),U,58)="00"
 .W !," 38. ABLATION & RESECTION..........: Ablation & resection not administered"
 S DR="1057 38. ABLATION & RESECTION.........." D ^DIE G:$D(Y) JUMP
SM S SM=$$GET1^DIQ(165.5,IE,59)
 S (SM1,SM2)="",LOS=$L(SM) I LOS<43 S SM1=SM G SM1
 S NOP=$L($E(SM,1,43)," "),SM1=$P(SM," ",1,NOP-1),SM2=$P(SM," ",NOP,999)
SM1 W !," 39. SURGICAL MARGINS..............: ",SM1 W:SM2'="" !,?37,SM2
 I ($E(CDS,1,2)=99)!($E(CDS,1,2)<17) K DIR S DIR(0)="E" D ^DIR G:$D(DIRUT) EXIT W @IOF D HEAD^ONCHPC0
DTCM I ($E(CDS,1,2)<18) D  G SORS
 .S $P(^ONCO(165.5,D0,"HEP1"),U,59)=8
 .W !," 40. DISTANCE OF TUMOR TO CLOSEST"
 .W !,"      MARGIN.......................: NA"
 I $E(CDS,1,2)=99 D  G SORS
 .S $P(^ONCO(165.5,D0,"HEP1"),U,59)=9
 .W !," 40. DISTANCE OF TUMOR TO CLOSEST"
 .W !,"      MARGIN.......................: Unknown"
 S DR="1058 40. DISTANCE OF TUMOR TO CLOSEST                                                     MARGIN......................." D ^DIE G:$D(Y) JUMP
SORS S SORS=$$GET1^DIQ(165.5,IE,139)
 S (SORS1,SORS2)="",LOS=$L(SORS) I LOS<43 S SORS1=SORS G SORS1
 S NOP=$L($E(SORS,1,43)," ")
 S SORS1=$P(SORS," ",1,NOP-1),SORS2=$P(SORS," ",NOP,999)
SORS1 W !," 41. SURGERY OF OTHER REGIONAL"
 W !,"      SITE(S), DISTANT SITE(S),"
 W !,"      OR DISTANT LYMPH NODE(S).....: ",SORS1 W:SORS2'="" !,?37,SORS2
STRPT W !!," 42. SURGICAL TREATMENT OF RESIDUAL PRIMARY TUMOR:"
 I $E(CDS,1,2)="00" D  G RR
 .S $P(^ONCO(165.5,D0,"HEP1"),U,60)=8
 .S $P(^ONCO(165.5,D0,"HEP1"),U,61)=8
 .W !,"      ABLATION.....................: NA"
 .W !,"      RESECTION....................: NA"
 I $E(CDS,1,2)=99 D  G RR
 .S $P(^ONCO(165.5,D0,"HEP1"),U,60)=9
 .S $P(^ONCO(165.5,D0,"HEP1"),U,61)=9
 .W !,"      ABLATION.....................: Unknown"
 .W !,"      RESECTION....................: Unknown"
 S DR="1059      ABLATION....................." D ^DIE G:$D(Y) JUMP
 S DR="1060      RESECTION...................." D ^DIE G:$D(Y) JUMP
RR S RR=$$GET1^DIQ(165.5,IE,23)
 S (RR1,RR2)="",LOS=$L(RR) I LOS<43 S RR1=RR G RR1
 S NOP=$L($E(RR,1,43)," "),RR1=$P(RR," ",1,NOP-1),RR2=$P(RR," ",NOP,999)
RR1 W !!," 43. RECONSTRUCTION/RESTORATION-"
 W !,"      FIRST COURSE.................: ",RR1 W:RR2'="" !,?37,RR2
PRTC W ! K DIR S DIR(0)="E" D ^DIR G:$D(DIRUT) EXIT
 G R^ONCHPC4A
JUMP ;Jump to prompts
 S XX="" R !!," GO TO ITEM: ",X:DTIME I (X="")!(X[U) S OUT="Y" G EXIT
 I X["?" D  G:$D(DIRUT) EXIT G JUMP
 .W @IOF,!," CHOOSE FROM:" F I=1:1:CHOICES W !,?5,HTABLE(I) I I=18 W ! K DIR S DIR(0)="E" D ^DIR Q:$D(DIRUT)  W @IOF,!," CHOOSE FROM:"
 I '$D(TABLE(X)) S:X?1.2N X=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) I I=18 W ! K DIR S DIR(0)="E" D ^DIR Q:$D(DIRUT)  W @IOF,!," CHOOSE FROM:"
 S X=TABLE(X)
 G @X
EXIT S:$D(DIRUT) OUT="Y"
 K CHOICES,PIECE,HTABLE,TABLE
 K CDS,CHE,IE,LOS,NCDS,NOP,RAD,SA,SA1,SA2,SM,SM1,SM2
 K DA,DIE,DIR,DIROUT,DIRUT,DR,DTOUT,DUOUT,X,XX,Y
 Q
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCHPC4   8744     printed  Sep 23, 2025@19:59:15                                                                                                                                                                                                     Page 2
ONCHPC4   ;Hines OIFO/GWB - 2000 Hepatocellular Cancers PCE Study ;01/10/00
 +1       ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
 +2       ;First Course of Treatment 
 +3        KILL TABLE,HTABLE
 +4        SET TABLE("29. DATE OF FIRST COURSE OF TREATMENT")="DFCT^ONCHPC4"
 +5        SET TABLE("30. DATE OF INPATIENT ADMISSION")="DIA^ONCHPC4"
 +6        SET TABLE("31. DATE OF INPATIENT DISCHARGE")="DID^ONCHPC4"
 +7        SET TABLE("SURGERY")="S^ONCHPC4"
 +8        SET TABLE("32. DATE OF NON CANCER-DIRECTED SURGERY")="DNCDS^ONCHPC4"
 +9        SET TABLE("33. NON CANCER-DIRECTED SURGERY")="NCDS^ONCHPC4"
 +10       SET TABLE("34. DATE OF CANCER-DIRECTED SURGERY")="DCDS^ONCHPC4"
 +11       SET TABLE("35. SURGICAL APPROACH")="SA^ONCHPC4"
 +12       SET TABLE("36. SURGERY OF PRIMARY SITE")="SPS^ONCHPC4"
 +13       SET TABLE("37. RADIO-FREQUENCY DESTRUCTION OF TUMOR")="RFDT^ONCHPC4"
 +14       SET TABLE("38. ABLATION & RESECTION")="AR^ONCHPC4"
 +15       SET TABLE("39. SURGICAL MARGINS")="SM^ONCHPC4"
 +16       SET TABLE("40. DISTANCE OF TUMOR TO CLOSEST MARGIN")="DTCM^ONCHPC4"
 +17       SET TABLE("41. SURGERY OF REGIONAL SITE(S), DISTANT SITE(S), OR DISTANT LYMPH NODE(S)")="SORS^ONCHPC4"
 +18       SET TABLE("42. SURGICAL TREATMENT OF RESIDUAL PRIMARY TUMOR")="STRPT^ONCHPC4"
 +19       SET TABLE("43. RECONSTRUCTION/RESTORATION-FIRST COURSE")="RR^ONCHPC4"
 +20       SET TABLE("RADIATION THERAPY")="R^ONCHPC4A"
 +21       SET TABLE("44. DATE RADIATION STARTED")="DRS^ONCHPC4A"
 +22       SET TABLE("45. RADIATION THERAPY")="RT^ONCHPC4A"
 +23       SET TABLE("CHEMOTHERAPY")="C^ONCHPC4A"
 +24       SET TABLE("46. DATE CHEMOTHERAPY STARTED")="DCS^ONCHPC4A"
 +25       SET TABLE("47. CHEMOTHERAPY")="CT^ONCHPC4A"
 +26       SET TABLE("48. TYPE OF CHEMOTHERAPEUTIC AGENTS ADMINISTERED")="TCAA^ONCHPC4A"
 +27       SET TABLE("49. ROUTE CHEMOTHERAPY ADMINISTERED")="RCA^ONCHPC4A"
 +28       SET TABLE("50. CHEMOTHERAPY/SURGERY SEQUENCE")="CSS^ONCHPC4A"
 +29       SET TABLE("OTHER THERAPY")="O^ONCHPC4A"
 +30       SET TABLE("51. DATE OTHER TREATMENT STARTED")="DOTS^ONCHPC4A"
 +31       SET TABLE("52. OTHER TREATMENT")="OT^ONCHPC4A"
 +32       SET TABLE("53. ARTERIAL EMBOLIZATION")="AE^ONCHPC4A"
 +33       SET TABLE("54. DEATH WITHIN30 DAYS OF START OF INTIIAL COURSE OF THERAPY")="DWTD^ONCHPC4A"
 +34       SET HTABLE(1)="29. DATE OF FIRST COURSE OF TREATMENT"
 +35       SET HTABLE(2)="30. DATE OF INPATIENT ADMISSION"
 +36       SET HTABLE(3)="31. DATE OF INPATIENT DISCHARGE"
 +37       SET HTABLE(4)=""
 +38       SET HTABLE(5)="SURGERY"
 +39       SET HTABLE(6)=""
 +40       SET HTABLE(7)="32. DATE OF NON CANCER-DIRECTED SURGERY"
 +41       SET HTABLE(8)="33. NON CANCER-DIRECTED SURGERY"
 +42       SET HTABLE(9)="34. DATE OF CANCER-DIRECTED SURGERY"
 +43       SET HTABLE(10)="35. SURGICAL APPROACH"
 +44       SET HTABLE(11)="36. SURGERY OF PRIMARY SITE"
 +45       SET HTABLE(12)="37. RADIO-FREQUENCY DESTRUCTION OF TUMOR"
 +46       SET HTABLE(13)="38. ABLATION & RESECTION"
 +47       SET HTABLE(14)="39. SURGICAL MARGINS"
 +48       SET HTABLE(15)="40. DISTANCE OF TUMOR TO CLOSEST MARGIN"
 +49       SET HTABLE(16)="41. SURGERY OF REGIONAL SITE(S), DISTANT SITE(S), OR DISTANT LYMPH NODE(S)"
 +50       SET HTABLE(17)="42. SURGICAL TREATMENT OF RESIDUAL PRIMARY TUMOR"
 +51       SET HTABLE(18)="43. RECONSTRUCTION/RESTORATION-FIRST COURSE"
 +52       SET HTABLE(19)=""
 +53       SET HTABLE(20)="RADIATION THERAPY"
 +54       SET HTABLE(21)=""
 +55       SET HTABLE(22)="44. DATE RADIATION STARTED"
 +56       SET HTABLE(23)="45. RADIATION THERAPY"
 +57       SET HTABLE(24)=""
 +58       SET HTABLE(25)="CHEMOTHERAPY"
 +59       SET HTABLE(26)=""
 +60       SET HTABLE(27)="46. DATE CHEMOTHERAPY STARTED"
 +61       SET HTABLE(28)="47. CHEMOTHERAPY"
 +62       SET HTABLE(29)="48. TYPE OF CHEMOTHERAPEUTIC AGENTS ADMINISTERED"
 +63       SET HTABLE(30)="49. ROUTE CHEMOTHERAPY ADMINISTERED"
 +64       SET HTABLE(31)="50. CHEMOTHERAPY/SURGERY SEQUENCE"
 +65       SET HTABLE(32)=""
 +66       SET HTABLE(33)="OTHER THERAPY"
 +67       SET HTABLE(34)=""
 +68       SET HTABLE(35)="51. DATE OTHER TREATMENT STARTED"
 +69       SET HTABLE(36)="52. OTHER TREATMENT"
 +70       SET HTABLE(37)="53. ARTERIAL EMBOLIZATION"
 +71       SET HTABLE(38)="54. DEATH WITHIN30 DAYS OF START OF INTIIAL COURSE OF THERAPY"
 +72       SET CHOICES=38
 +73       SET IE=ONCONUM
 +74       WRITE @IOF
           DO HEAD^ONCHPC0
 +75       WRITE !," FIRST COURSE OF TREATMENT"
 +76       WRITE !," -------------------------"
 +77       SET DIE="^ONCO(165.5,"
           SET DA=ONCONUM
 +78       SET CDS=$$GET1^DIQ(165.5,IE,58.2)
 +79       SET RAD=$$GET1^DIQ(165.5,IE,51.2,"I")
 +80       SET CHE=$$GET1^DIQ(165.5,IE,53.2,"I")
DFCT       WRITE !," 29. DATE OF FIRST COURSE OF"
 +1        WRITE !,"      TREATMENT....................: ",$$GET1^DIQ(165.5,IE,49)
DIA        SET DR="1 30. DATE OF INPATIENT ADMISSION..."
           DO ^DIE
           if $DATA(Y)
               GOTO JUMP
DID        SET DR="1.1 31. DATE OF INPATIENT DISCHARGE..."
           DO ^DIE
           if $DATA(Y)
               GOTO JUMP
S          WRITE @IOF
           DO HEAD^ONCHPC0
 +1        WRITE !," SURGERY",!
 +2        WRITE " -------"
DNCDS      WRITE !," 32. DATE OF NON CANCER-DIRECTED"
 +1        WRITE !,"      SURGERY......................: ",$$GET1^DIQ(165.5,IE,58.3)
NCDS       SET NCDS=$$GET1^DIQ(165.5,IE,58.1)
 +1        SET (NCDS1,NCDS2)=""
           SET LOS=$LENGTH(NCDS)
           IF LOS<43
               SET NCDS1=NCDS
               GOTO NCDS1
 +2        SET NOP=$LENGTH($EXTRACT(NCDS,1,43)," ")
 +3        SET NCDS1=$PIECE(NCDS," ",1,NOP-1)
           SET NCDS2=$PIECE(NCDS," ",NOP,999)
NCDS1      WRITE !," 33. NON CANCER-DIRECTED SURGERY...: ",NCDS1
           if NCDS2'=""
               WRITE !,?37,NCDS2
DCDS       WRITE !," 34. DATE OF CANCER-DIRECTED"
 +1        WRITE !,"      SURGERY......................: ",$$GET1^DIQ(165.5,IE,50)
SA         SET SA=$$GET1^DIQ(165.5,IE,74)
 +1        SET (SA1,SA2)=""
           SET LOS=$LENGTH(SA)
           IF LOS<43
               SET SA1=SA
               GOTO SA1
 +2        SET NOP=$LENGTH($EXTRACT(SA,1,43)," ")
           SET SA1=$PIECE(SA," ",1,NOP-1)
           SET SA2=$PIECE(SA," ",NOP,999)
SA1        WRITE !," 35. SURGICAL APPROACH.............: ",SA1
           if SA2'=""
               WRITE !,?37,SA2
SPS        SET (CDS1,CDS2)=""
           SET LOS=$LENGTH(CDS)
           IF LOS<43
               SET CDS1=CDS
               GOTO SPS1
 +1        SET NOP=$LENGTH($EXTRACT(CDS,1,43)," ")
           SET CDS1=$PIECE(CDS," ",1,NOP-1)
           SET CDS2=$PIECE(CDS," ",NOP,999)
SPS1       WRITE !," 36. SURGERY OF PRIMARY SITE.......: ",CDS1
           if CDS2'=""
               WRITE !,?37,CDS2
RFDT       IF $EXTRACT(CDS,1,2)=99
               Begin DoDot:1
 +1                SET $PIECE(^ONCO(165.5,D0,"HEP1"),U,57)=9
 +2                WRITE !," 37. RADIO-FREQUENCY DESTRUCTION OF"
 +3                WRITE !,"      TUMOR........................: Unknown"
               End DoDot:1
               GOTO AR
 +4        IF $EXTRACT(CDS,1,2)'=17
               Begin DoDot:1
 +5                SET $PIECE(^ONCO(165.5,D0,"HEP1"),U,57)=8
 +6                WRITE !," 37. RADIO-FREQUENCY DESTRUCTION OF"
 +7                WRITE !,"      TUMOR........................: NA"
               End DoDot:1
               GOTO AR
 +8        SET DR="1056 37. RADIO-FREQUENCY DESTRUCTION OF                                                   TUMOR........................"
           DO ^DIE
           if $DATA(Y)
               GOTO JUMP
AR         IF ($EXTRACT(CDS,1,2)="00")!($EXTRACT(CDS,1,2)=99)
               Begin DoDot:1
 +1                SET $PIECE(^ONCO(165.5,D0,"HEP1"),U,58)=88
 +2                WRITE !," 38. ABLATION & RESECTION..........: NA"
               End DoDot:1
               GOTO SM
 +3        IF $EXTRACT(CDS,1,2)<18
               Begin DoDot:1
 +4                SET $PIECE(^ONCO(165.5,D0,"HEP1"),U,58)="00"
 +5                WRITE !," 38. ABLATION & RESECTION..........: Ablation & resection not administered"
               End DoDot:1
               GOTO SM
 +6        SET DR="1057 38. ABLATION & RESECTION.........."
           DO ^DIE
           if $DATA(Y)
               GOTO JUMP
SM         SET SM=$$GET1^DIQ(165.5,IE,59)
 +1        SET (SM1,SM2)=""
           SET LOS=$LENGTH(SM)
           IF LOS<43
               SET SM1=SM
               GOTO SM1
 +2        SET NOP=$LENGTH($EXTRACT(SM,1,43)," ")
           SET SM1=$PIECE(SM," ",1,NOP-1)
           SET SM2=$PIECE(SM," ",NOP,999)
SM1        WRITE !," 39. SURGICAL MARGINS..............: ",SM1
           if SM2'=""
               WRITE !,?37,SM2
 +1        IF ($EXTRACT(CDS,1,2)=99)!($EXTRACT(CDS,1,2)<17)
               KILL DIR
               SET DIR(0)="E"
               DO ^DIR
               if $DATA(DIRUT)
                   GOTO EXIT
               WRITE @IOF
               DO HEAD^ONCHPC0
DTCM       IF ($EXTRACT(CDS,1,2)<18)
               Begin DoDot:1
 +1                SET $PIECE(^ONCO(165.5,D0,"HEP1"),U,59)=8
 +2                WRITE !," 40. DISTANCE OF TUMOR TO CLOSEST"
 +3                WRITE !,"      MARGIN.......................: NA"
               End DoDot:1
               GOTO SORS
 +4        IF $EXTRACT(CDS,1,2)=99
               Begin DoDot:1
 +5                SET $PIECE(^ONCO(165.5,D0,"HEP1"),U,59)=9
 +6                WRITE !," 40. DISTANCE OF TUMOR TO CLOSEST"
 +7                WRITE !,"      MARGIN.......................: Unknown"
               End DoDot:1
               GOTO SORS
 +8        SET DR="1058 40. DISTANCE OF TUMOR TO CLOSEST                                                     MARGIN......................."
           DO ^DIE
           if $DATA(Y)
               GOTO JUMP
SORS       SET SORS=$$GET1^DIQ(165.5,IE,139)
 +1        SET (SORS1,SORS2)=""
           SET LOS=$LENGTH(SORS)
           IF LOS<43
               SET SORS1=SORS
               GOTO SORS1
 +2        SET NOP=$LENGTH($EXTRACT(SORS,1,43)," ")
 +3        SET SORS1=$PIECE(SORS," ",1,NOP-1)
           SET SORS2=$PIECE(SORS," ",NOP,999)
SORS1      WRITE !," 41. SURGERY OF OTHER REGIONAL"
 +1        WRITE !,"      SITE(S), DISTANT SITE(S),"
 +2        WRITE !,"      OR DISTANT LYMPH NODE(S).....: ",SORS1
           if SORS2'=""
               WRITE !,?37,SORS2
STRPT      WRITE !!," 42. SURGICAL TREATMENT OF RESIDUAL PRIMARY TUMOR:"
 +1        IF $EXTRACT(CDS,1,2)="00"
               Begin DoDot:1
 +2                SET $PIECE(^ONCO(165.5,D0,"HEP1"),U,60)=8
 +3                SET $PIECE(^ONCO(165.5,D0,"HEP1"),U,61)=8
 +4                WRITE !,"      ABLATION.....................: NA"
 +5                WRITE !,"      RESECTION....................: NA"
               End DoDot:1
               GOTO RR
 +6        IF $EXTRACT(CDS,1,2)=99
               Begin DoDot:1
 +7                SET $PIECE(^ONCO(165.5,D0,"HEP1"),U,60)=9
 +8                SET $PIECE(^ONCO(165.5,D0,"HEP1"),U,61)=9
 +9                WRITE !,"      ABLATION.....................: Unknown"
 +10               WRITE !,"      RESECTION....................: Unknown"
               End DoDot:1
               GOTO RR
 +11       SET DR="1059      ABLATION....................."
           DO ^DIE
           if $DATA(Y)
               GOTO JUMP
 +12       SET DR="1060      RESECTION...................."
           DO ^DIE
           if $DATA(Y)
               GOTO JUMP
RR         SET RR=$$GET1^DIQ(165.5,IE,23)
 +1        SET (RR1,RR2)=""
           SET LOS=$LENGTH(RR)
           IF LOS<43
               SET RR1=RR
               GOTO RR1
 +2        SET NOP=$LENGTH($EXTRACT(RR,1,43)," ")
           SET RR1=$PIECE(RR," ",1,NOP-1)
           SET RR2=$PIECE(RR," ",NOP,999)
RR1        WRITE !!," 43. RECONSTRUCTION/RESTORATION-"
 +1        WRITE !,"      FIRST COURSE.................: ",RR1
           if RR2'=""
               WRITE !,?37,RR2
PRTC       WRITE !
           KILL DIR
           SET DIR(0)="E"
           DO ^DIR
           if $DATA(DIRUT)
               GOTO EXIT
 +1        GOTO R^ONCHPC4A
JUMP      ;Jump to prompts
 +1        SET XX=""
           READ !!," GO TO ITEM: ",X:DTIME
           IF (X="")!(X[U)
               SET OUT="Y"
               GOTO EXIT
 +2        IF X["?"
               Begin DoDot:1
 +3                WRITE @IOF,!," CHOOSE FROM:"
                   FOR I=1:1:CHOICES
                       WRITE !,?5,HTABLE(I)
                       IF I=18
                           WRITE !
                           KILL DIR
                           SET DIR(0)="E"
                           DO ^DIR
                           if $DATA(DIRUT)
                               QUIT 
                           WRITE @IOF,!," CHOOSE FROM:"
               End DoDot:1
               if $DATA(DIRUT)
                   GOTO EXIT
               GOTO JUMP
 +4        IF '$DATA(TABLE(X))
               if X?1.2N
                   SET X=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)
                           IF I=18
                               WRITE !
                               KILL DIR
                               SET DIR(0)="E"
                               DO ^DIR
                               if $DATA(DIRUT)
                                   QUIT 
                               WRITE @IOF,!," CHOOSE FROM:"
                   End DoDot:1
                   GOTO JUMP
 +6        SET X=TABLE(X)
 +7        GOTO @X
EXIT       if $DATA(DIRUT)
               SET OUT="Y"
 +1        KILL CHOICES,PIECE,HTABLE,TABLE
 +2        KILL CDS,CHE,IE,LOS,NCDS,NOP,RAD,SA,SA1,SA2,SM,SM1,SM2
 +3        KILL DA,DIE,DIR,DIROUT,DIRUT,DR,DTOUT,DUOUT,X,XX,Y
 +4        QUIT