Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ONCP2P2

ONCP2P2.m

Go to the documentation of this file. 
  1. ONCP2P2 ;HINES CIOFO/GWB - 1998 Prostate Cancer Study - Table II ;6/1/98
  1.  ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
  1.  K TABLE,HTABLE
  1.  S TABLE("10. CLASS OF CASE")="COC"
  1.  S TABLE("11. SYMPTOMS PRESENT AT INITIAL DIAGNOSIS")="SPAID"
  1.  S TABLE("12. INITIAL METHODS OF DIAGNOSIS")="IMOD"
  1.  S TABLE("13. DIAGNOSTIC EVALUATION")="DE"
  1.  S TABLE("14. RESULTS OF MOST RECENT PRE-TREATMENT PSA TEST")="ROPP"
  1.  S TABLE("15. DATE OF INITIAL DIAGNOSIS")="DOID"
  1.  S TABLE("16. PRIMARY SITE (ICD-O-2)")="PS"
  1.  S TABLE("17. HISTOLOGY (ICD-O-2)")="HIST"
  1.  S TABLE("18. BEHAVIOR CODE(ICD-O-2)")="BC"
  1.  S TABLE("19. GRADE")="GRADE"
  1.  S TABLE("20. BIOPSY PROCEDURE")="BP"
  1.  S TABLE("21. GUIDANCE OF BIOPSY TO PRIMARY")="GOBTP"
  1.  S TABLE("22. BIOPSY APPROACH FOR PRIMARY")="BAFP"
  1.  S TABLE("23. BIOPSY OF OTHER THAN PRIMARY")="BOOTP"
  1.  S TABLE("24. DIAGNOSTIC CONFIRMATION")="DC"
  1.  S TABLE("25. GLEASON'S SCORE FOR BIOPSY, LOCAL RESECTION, OR SIMPLE PROSTATECTOMY")="GSFSP"
  1.  S TABLE("26. GLEASON'S SCORE FOR RADICAL PROSTATECTOMY")="GSFRP"
  1.  S HTABLE(1)="10. CLASS OF CASE"
  1.  S HTABLE(2)="11. SYMPTOMS PRESENT AT INITIAL DIAGNOSIS"
  1.  S HTABLE(3)="12. INITIAL METHODS OF DIAGNOSIS"
  1.  S HTABLE(4)="13. DIAGNOSTIC EVALUATION"
  1.  S HTABLE(5)="14. RESULTS OF MOST RECENT PRE-TREATMENT PSA TEST"
  1.  S HTABLE(6)="15. DATE OF INITIAL DIAGNOSIS"
  1.  S HTABLE(7)="16. PRIMARY SITE (ICD-O-2)"
  1.  S HTABLE(8)="17. HISTOLOGY (ICD-O-2)"
  1.  S HTABLE(9)="18. BEHAVIOR CODE (ICD-O-2)"
  1.  S HTABLE(10)="19. GRADE"
  1.  S HTABLE(11)="20. BIOPSY PROCEDURE"
  1.  S HTABLE(12)="21. GUIDANCE OF BIOPSY TO PRIMARY"
  1.  S HTABLE(13)="22. BIOPSY APPROACH FOR PRIMARY"
  1.  S HTABLE(14)="23. BIOPSY OF OTHER THAN PRIMARY"
  1.  S HTABLE(15)="24. DIAGNOSTIC CONFIRMATION"
  1.  S HTABLE(16)="25. GLEASON'S SCORE FOR BIOPSY, LOCAL RESECTION, OR SIMPLE PROSTATECTOMY"
  1.  S HTABLE(17)="26. GLEASON'S SCORE FOR RADICAL PROSTATECTOMY"
  1.  S CHOICES=17
  1.  K DIQ S DIC="^ONCO(165.5,",DR=".04;22;58.1;58.2",DA=ONCONUM,DIQ="ONC",DIQ(0)="IE"
  1.  D EN^DIQ1
  1.  S NCDS=$E(ONC(165.5,ONCONUM,58.1,"E"),1,2)
  1.  S CDS=$E(ONC(165.5,ONCONUM,58.2,"E"),1,2)
  1.  F SUB="02","03","04","05","06","07" S NCDS(SUB)=""
  1.  F SUB=10,11,12,13,14,15,16,17,30,40 S CDS(SUB)=""
  1.  S DIE="^ONCO(165.5,",DA=ONCONUM
  1.  W @IOF D HEAD^ONCP2P0
  1.  W !," TABLE II - INITIAL DIAGNOSIS"
  1.  W !," ----------------------------"
  1. COC W !," 10. CLASS OF CASE................: ",ONC(165.5,ONCONUM,.04,"E")
  1. SPAID W !!," 11. SYMPTOMS PRESENT AT INITIAL DIAGNOSIS:",!
  1.  S DR="658     HEMATURIA...................." D ^DIE G:$D(Y) JUMP
  1.  S DR="659     LOWER BACK PAIN.............." D ^DIE G:$D(Y) JUMP
  1.  S DR="660     TROUBLE URINATING............" D ^DIE G:$D(Y) JUMP
  1. IMOD W !!," 12. INITIAL METHOD OF DIAGNOSIS:",!
  1.  S DR="661     CLINICAL DX WITH BONE LESION." D ^DIE G:$D(Y) JUMP
  1.  S DR="662     CLINICAL DX BY RECTAL EXAM..." D ^DIE G:$D(Y) JUMP
  1.  S DR="663     CYTOLOGY....................." D ^DIE G:$D(Y) JUMP
  1.  S DR="664     DIGITAL TRANSRECTAL BIOPSY..." D ^DIE G:$D(Y) JUMP
  1.  S DR="665     INCIDENTAL FINDING IN TURP                                                      FOR BENIGN DISEASE..........." D ^DIE G:$D(Y) JUMP
  1.  S DR="666     NEEDLE BIOPSY, NOS..........." D ^DIE G:$D(Y) JUMP
  1.  S DR="667     PERINEAL BIOPSY.............." D ^DIE G:$D(Y) JUMP
  1.  S DR="668     PSA.........................." D ^DIE G:$D(Y) JUMP
  1.  S DR="669     TRUS GUIDED BIOPSY..........." D ^DIE G:$D(Y) JUMP
  1.  S DR="670     TURP, NOS...................." D ^DIE G:$D(Y) JUMP
  1. DE W !!," 13. DIAGNOSTIC EVALUATION:",!
  1.  S DR="671     BONE MARROW ASPIRATION......." D ^DIE G:$D(Y) JUMP
  1.  S DR="672     BONE SCAN...................." D ^DIE G:$D(Y) JUMP
  1.  S DR="673     BONE X-RAY..................." D ^DIE G:$D(Y) JUMP
  1.  S DR="674     CHEST X-RAY.................." D ^DIE G:$D(Y) JUMP
  1.  S DR="675     CT SCAN OF ABDOMEN..........." D ^DIE G:$D(Y) JUMP
  1.  S DR="676     CT SCAN OF PELVIS............" D ^DIE G:$D(Y) JUMP
  1.  S DR="677     IVP.........................." D ^DIE G:$D(Y) JUMP
  1.  S DR="678     MRI.........................." D ^DIE G:$D(Y) JUMP
  1.  S DR="679     PELVIC LYMPH NODE DISSECTION." D ^DIE G:$D(Y) JUMP
  1.  S DR="680     PCR.........................." D ^DIE G:$D(Y) JUMP
  1.  S DR="681     PAP.........................." D ^DIE G:$D(Y) JUMP
  1.  S DR="682     PSA.........................." D ^DIE G:$D(Y) JUMP
  1.  S DR="683     ULTRASOUND OF ABDOMEN........" D ^DIE G:$D(Y) JUMP
  1.  W !
  1. ROPP S DR="684 14. RESULTS OF MOST RECENT PRE-                                                     TREATMENT PSA TEST..........." D ^DIE G:$D(Y) JUMP
  1. DOID S DOID=$E(DATEDX,4,5)_"/"_$E(DATEDX,6,7)_"/"_(1700+$E(DATEDX,1,3))
  1.  W !," 15. DATE OF INITIAL DIAGNOSIS....: ",DOID
  1. PS W !," 16. PRIMARY SITE (ICD-O-2).......: C61.9"
  1. HIST W !," 17. HISTOLOGY (ICD-O-2)..........: ",$E(ONC(165.5,ONCONUM,22,"I"),1,4)
  1. BC W !," 18. BEHAVIOR CODE (ICD-O-2)......: ",$E(ONC(165.5,ONCONUM,22,"I"),5)
  1. GRADE S DR="24 19. GRADE........................" D ^DIE G:$D(Y) JUMP
  1. BP S DR="141 20. BIOSPY PROCEDURE............." D ^DIE G:$D(Y) JUMP
  1.  I $G(X)=1 D  G BOOTP
  1.  .S $P(^ONCO(165.5,ONCONUM,2.1),U,15)=1
  1.  .S $P(^ONCO(165.5,ONCONUM,2.1),U,18)=0
  1.  .W !," 21. GUIDANCE OF BIOPSY TO PRIMARY: Not guided, no biopsy"
  1.  .W !," 22. BIOPSY APPROACH FOR PRIMARY..: No biopsy"
  1.  I $G(X)=6 D  G BOOTP
  1.  .S $P(^ONCO(165.5,ONCONUM,2.1),U,15)=5
  1.  .S $P(^ONCO(165.5,ONCONUM,2.1),U,18)=9
  1.  .W !," 21. GUIDANCE OF BIOPSY TO PRIMARY: Unknown/death cert only"
  1.  .W !," 22. BIOPSY APPROACH FOR PRIMARY..: Unknown/death cert only"
  1. GOBTP S DR="142 21. GUIDANCE OF BIOSPY TO PRIMARY" D ^DIE G:$D(Y) JUMP
  1. BAFP S DR="145 22. BIOSPY APPROACH FOR PRIMARY.." D ^DIE G:$D(Y) JUMP
  1. BOOTP S DR="146 23. BIOSPY OF OTHER THAN PRIMARY." D ^DIE G:$D(Y) JUMP
  1. DC S DR="26 24. DIAGNOSTIC CONFIRMATION......" D ^DIE G:$D(Y) JUMP
  1. GSFSP W !," 25. GLEASON'S SCORE FOR BIOPSY, LOCAL RESECTION, OR SIMPLE PROSTATECTOMY:",!
  1.  I NCDS'="",$D(NCDS(NCDS)) G PP25
  1.  I CDS'="",$D(CDS(CDS)) G PP25
  1.  E  D  G GSFRP
  1.  .W !,"     Surgery codes not 02 through 40",!
  1.  .K DR S DR=""
  1.  .S DR(1,165.5,1)="623.1///9"
  1.  .S DR(1,165.5,2)="623.2///9"
  1.  .S DR(1,165.5,3)="623///99"
  1.  .D ^DIE
  1.  .W !,"     PREDOMINENT (PRIMARY) PATTERN: 9"
  1.  .W !,"     LESSER (SECONDARY) PATTERN...: 9"
  1.  .W !,"     GLEASON SCORE................: 99 Unknown, not reported, or NA"
  1. PP25 S DR="623.1     PREDOMINENT (PRIMARY) PATTERN" D ^DIE G:$D(Y) JUMP
  1.  I $P($G(^ONCO(165.5,ONCONUM,"PRO2")),U,43)=0 D  G GS25
  1.  .S DR="623.2///0" D ^DIE
  1.  .W !,"     LESSER (SECONDARY) PATTERN...: 0"
  1.  I $P($G(^ONCO(165.5,ONCONUM,"PRO2")),U,43)=9 D  G GSFRP
  1.  .S DR="623///99;623.2///9" D ^DIE
  1.  .W !,"     LESSER (SECONDARY) PATTERN...: 9"
  1.  .W !,"     GLEASON SCORE................: 99 Unknown, not reported, or NA"
  1. LP25 S DR="623.2     LESSER (SECONDARY) PATTERN..." D ^DIE G:$D(Y) JUMP
  1.  S PP=$P($G(^ONCO(165.5,D0,"PRO2")),U,43)
  1.  S LP=$P($G(^ONCO(165.5,D0,"PRO2")),U,44)
  1.  I PP>0,PP<6,(X=0)!(X=9) W *7,"??" G LP25
  1.  I ((PP>0)&(PP<6))&((LP>0)&(LP<6)) S GS=PP+LP S:$L(GS)=1 GS="0"_GS D  G GSFRP
  1.  .S DR="623///"_GS D ^DIE
  1.  .W !,"     GLEASON SCORE................: ",GS
  1. GS25 S DR="623     GLEASON SCORE................" D ^DIE G:$D(Y) JUMP
  1. GSFRP W !!," 26. GLEASON'S SCORE FOR RADICAL PROSTATECTOMY:",!
  1.  I (CDS=50)!(CDS=70) G PP26
  1.  E  D  G PRTC
  1.  .W !,"     Surgery codes not 50 through 70",!
  1.  .K DR S DR=""
  1.  .S DR(1,165.5,1)="623.4///9"
  1.  .S DR(1,165.5,2)="623.5///9"
  1.  .S DR(1,165.5,3)="623.3///99"
  1.  .D ^DIE
  1.  .W !,"     PREDOMINENT (PRIMARY) PATTERN: 9"
  1.  .W !,"     LESSER (SECONDARY) PATTERN...: 9"
  1.  .W !,"     GLEASON SCORE................: 99 Unknown, not reported, or NA"
  1. PP26 S DR="623.4     PREDOMINENT (PRIMARY) PATTERN" D ^DIE G:$D(Y) JUMP
  1.  I $P($G(^ONCO(165.5,ONCONUM,"PRO2")),U,46)=0 D  G GS26
  1.  .S DR="623.5///0" D ^DIE
  1.  .W !,"     LESSER (SECONDARY) PATTERN...: 0"
  1.  I $P($G(^ONCO(165.5,ONCONUM,"PRO2")),U,46)=9 D  G PRTC
  1.  .S DR="623.3///99;623.5///9" D ^DIE
  1.  .W !,"     LESSER (SECONDARY) PATTERN...: 9"
  1.  .W !,"     GLEASON SCORE................: 99 Unknown, not reported, or NA"
  1. LP26 S DR="623.5     LESSER (SECONDARY) PATTERN..." D ^DIE G:$D(Y) JUMP
  1.  S PP=$P($G(^ONCO(165.5,D0,"PRO2")),U,46)
  1.  S LP=$P($G(^ONCO(165.5,D0,"PRO2")),U,47)
  1.  I PP>0,PP<6,(X=0)!(X=9) W *7,"??" G LP26
  1.  I ((PP>0)&(PP<6))&((LP>0)&(LP<6)) S GS=PP+LP S:$L(GS)=1 GS="0"_GS D  G PRTC
  1.  .S DR="623.3///"_GS D ^DIE
  1.  .W !,"     GLEASON SCORE................: ",GS
  1. GS26 S DR="623.3     GLEASON SCORE................" D ^DIE G:$D(Y) JUMP
  1. PRTC W ! K DIR S DIR(0)="E" D ^DIR S:$D(DIRUT) OUT="Y"
  1.  G EXIT
  1. JUMP ;Jump to prompts
  1.  S XX="" R !!," GO TO ITEM NUMBER: ",X:DTIME I (X="")!(X[U) S OUT="Y" G EXIT
  1.  I X["?" D  G JUMP
  1.  .W !," CHOOSE FROM:" F I=1:1:CHOICES W !,?5,HTABLE(I)
  1.  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
  1.  .W !," CHOOSE FROM:" F I=1:1:CHOICES W !,?5,HTABLE(I)
  1.  S X=TABLE(X)
  1.  G @X
  1. EXIT K CHOICES,HTABLE,TABLE
  1.  K DOID,NCDS,CDS,PP,LP,GS,PIECE
  1.  K DA,DIE,DIR,DIROUT,DIRUT,DR,DTOUT,DUOUT,X,XX,Y
  1.  Q