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

ONCBPC4.m

Go to the documentation of this file.
ONCBPC4 ;HIRMFO/GWB - PCE Study of Cancers of the Urinary Bladder Table IV;6/19/96
 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
 K ONC,TABLE,HTABLE
 S TABLE("DATE OF INITIAL TREATMENT")="DOIT^ONCBPC4"
 S TABLE("PROTOCOL ELIGIBILITY STATUS")="PES^ONCBPC4"
 S TABLE("MANAGING PHYSICIANS")="MP^ONCBPC4"
 S TABLE("SURGERY")="SUR^ONCBPC4"
 S TABLE("RADIATION THERAPY")="RAD^ONCBPC4A"
 S TABLE("CHEMOTHERAPY")="CHEMO^ONCBPC4A"
 S TABLE("IMMUNOTHERAPY")="BRM^ONCBPC4A"
 S HTABLE(1)="DATE OF INITIAL TREATMENT"
 S HTABLE(2)="PROTOCOL ELIGIBILITY STATUS"
 S HTABLE(3)="MANAGING PHYSICIANS"
 S HTABLE(4)="SURGERY"
 S HTABLE(5)="RADIATION THERAPY"
 S HTABLE(6)="CHEMOTHERAPY"
 S HTABLE(7)="IMMUNOTHERAPY"
 S CHOICES=7
 S D0=ONCONUM D DFC^ONCOCOM S DOIT=Y
 S DIC="^ONCO(165.5,",DR="51.2;53.2;55.2;58.1;58.2",DA=ONCONUM,DIQ="ONC"
 S DIQ(0)="IE" D EN^DIQ1
 W @IOF D HEAD^ONCBPC0 W !?22,"TABLE IV - FIRST COURSE OF TREATMENT",!
DOIT W !,"DATE OF INITIAL TREATMENT...........: ",DOIT
 S DIE="^ONCO(165.5,",DA=ONCONUM
PES S DR="346PROTOCOL ELIGIBILITY STATUS........." D ^DIE G:$D(Y) JUMP
MP W !!,"MANAGING PHYSICIANS:",!
 S DR="347  PRIMARY PHYSICIAN................." D ^DIE G:$D(Y) JUMP
 S DR="348  SECONDARY PHYSICIAN..............." D ^DIE G:$D(Y) JUMP
SUR W !!,"SURGERY:",!
 S NCDS=ONC(165.5,ONCONUM,58.1,"I"),NCDSOT=ONC(165.5,ONCONUM,58.1,"E")
 S CDS=ONC(165.5,ONCONUM,58.2,"I"),CDSOT=ONC(165.5,ONCONUM,58.2,"E")
 I (CDS="")!(CDS="00") D
 .S SURG=NCDSOT,SURGDT=$P($G(^ONCO(165.5,ONCONUM,3)),U,31)
 I ((CDS'="")&(CDS'="00"))!(NCDS="") D
 .S SURG=CDSOT,SURGDT=$P($G(^ONCO(165.5,ONCONUM,3)),U,1)
 S (SURG1,SURG2)="",LOS=$L(SURG) I LOS<43 S SURG1=SURG G DOS
 S NOP=$L($E(SURG,1,42)," ")
 S SURG1=$P(SURG," ",1,NOP-1),SURG2=$P(SURG," ",NOP,999)
DOS S Y=SURGDT D DATEOT^ONCOPCE S SURGDT=Y
 W !,"  DATE OF SURGERY...................: ",SURGDT
 W !,"  TYPE OF SURGERY...................: ",SURG1
 W:SURG2'="" !,?41,SURG2
TURB I (SURG="")!($E(SURG,1)=0)!($E(SURG,1,2)'=10)!(TOPCOD="C68.0") D  G TOUD
 .S $P(^ONCO(165.5,ONCONUM,"BLA2"),U,4)=8
 .W !,"  TUMOR RESECTION DURING TURB.......: Not applicable"
 S DR="349  TUMOR RESECTION DURING TURB......." D ^DIE G:$D(Y) JUMP
TOUD I (SURG="")!($E(SURG,1)=0)!($E(SURG,1,2)<20)!($E(SURG,1,2)>70) D  G PLND
 .S $P(^ONCO(165.5,ONCONUM,"BLA2"),U,5)=8
 .W !,"  TYPE OF URINARY DIVERSION.........: Not applicable"
 S DR="350  TYPE OF URINARY DIVERSION........." D ^DIE G:$D(Y) JUMP
PLND I (SURG="")!($E(SURG,1)=0)!($E(SURG,1,2)'=70) D  G SC
 .S $P(^ONCO(165.5,ONCONUM,"BLA2"),U,6)=8
 .W !,"  PELVIC LYMPH NODE DISSECTION......: Not applicable"
 S DR="351  PELVIC LYMPH NODE DISSECTION......" D ^DIE G:$D(Y) JUMP
SC I (SURG="")!($E(SURG,1)=0) D  G:(Y=0)!(Y="") EXIT W @IOF G RAD^ONCBPC4A
 .W !!,"  SURGICAL COMPLICATIONS:",!
 .S $P(^ONCO(165.5,ONCONUM,"BLA2"),U,7)=0
 .W !,"    BLEEDING REQUIRING TRANSFUSION..: No"
 .S $P(^ONCO(165.5,ONCONUM,"BLA2"),U,8)=0
 .W !,"    DEEP VENOUS THROMBOSIS..........: No"
 .S $P(^ONCO(165.5,ONCONUM,"BLA2"),U,9)=0
 .W !,"    MYOCARDIAL INFARCTION/ARRHYTHMIA: No"
 .S $P(^ONCO(165.5,ONCONUM,"BLA2"),U,10)=0
 .W !,"    PELVIC ABSCESS..................: No"
 .S $P(^ONCO(165.5,ONCONUM,"BLA2"),U,11)=0
 .W !,"    PNEUMONIA REQUIRING ANTIBIOTICS.: No"
 .S $P(^ONCO(165.5,ONCONUM,"BLA2"),U,12)=0
 .W !,"    POST-OPERATIVE DEATH (30 DAYS)..: No"
 .S $P(^ONCO(165.5,ONCONUM,"BLA2"),U,13)=0
 .W !,"    PULMONARY EMBOLISM/THROMBOSIS...: No"
 .S $P(^ONCO(165.5,ONCONUM,"BLA2"),U,14)=0
 .W !,"    REOPERATION.....................: No"
 .S $P(^ONCO(165.5,ONCONUM,"BLA2"),U,15)=0
 .W !,"    OTHER...........................: No"
 .W ! K DIR S DIR(0)="E" D ^DIR
 W !!,"  SURGICAL COMPLICATIONS:",!
 S DR="352    BLEEDING REQUIRING TRANSFUSION.." D ^DIE G:$D(Y) JUMP
 S DR="353    DEEP VENOUS THROMBOSIS.........." D ^DIE G:$D(Y) JUMP
 S DR="354    MYOCARDIAL INFARCTION/ARRHYTHMIA" D ^DIE G:$D(Y) JUMP
 S DR="355    PELVIC ABSCESS.................." D ^DIE G:$D(Y) JUMP
 S DR="356    PNEUMONIA REQUIRING ANTIBIOTICS." D ^DIE G:$D(Y) JUMP
 S DR="357    POST-OPERATIVE DEATH (30 DAYS).." D ^DIE G:$D(Y) JUMP
 S DR="358    PULMONARY EMBOLISM/THROMBOSIS..." D ^DIE G:$D(Y) JUMP
 S DR="359    REOPERATION....................." D ^DIE G:$D(Y) JUMP
 S DR="360    OTHER..........................." D ^DIE G:$D(Y) JUMP
 G ^ONCBPC4A
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 CHOICES,HTABLE,TABLE
 K CDS,CDSOT,CHEDT,CHEMO,DOIT,LOS,NCDS,NCDSOT,NOP,RAD,RADDT,SURG,SURG1
 K SURG2,SURGDT
 K DIC
 Q