- 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 Feb 18, 2025@23:49:31 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