ONCOTNE ;Hines OIFO/GWB,RTK - TNM STAGING ERROR & BYPASS MESSAGES ;9/27/93
;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
;
BRST ;Screening or Biopsy Procedures (Breast)
S TOPSITE=$P($G(^ONCO(165.5,D0,2)),U,1) I TOPSITE="" S Y="@395" Q
I TOPSITE>67499,TOPSITE<67510 D Q
.W !!,"------------------------------"
.W !,"SCREENING OR BIOPSY PROCEDURES"
.W !,"------------------------------"
S $P(^ONCO(165.5,D0,2.1),U,14)=0
BRSTF0 S $P(^ONCO(165.5,D0,2.1),U,15)=0
S $P(^ONCO(165.5,D0,2.1),U,16)=0
S $P(^ONCO(165.5,D0,2.1),U,17)=0
S Y="@1445"
Q
BRSTF9 ;
S $P(^ONCO(165.5,D0,2.1),U,15)=9
S $P(^ONCO(165.5,D0,2.1),U,16)=9
S $P(^ONCO(165.5,D0,2.1),U,17)=9
S Y="@1445"
Q
BRWRIT ;
K ONCBR S DIC="^ONCO(165.5,",DA=DA,DIQ="ONCBR(",DIQ(0)="E"
S DR="142;143;144" D EN^DIQ1
F I=142,143,144 S X=ONCBR(165.5,D0,I) D UCASE S ONCBR(165.5,D0,I)=X
W !,"GUIDANCE..............: "_ONCBR(165.5,DA,142,"E")
W !,"PALPABILITY OF PRIMARY: "_ONCBR(165.5,DA,143,"E")
W !,"FIRST DETECTED BY.....: "_ONCBR(165.5,DA,144,"E")
K ONCBR
W ! K DIR S DIR(0)="E" D ^DIR
S Y="@1445"
Q
PRST ;Screening or Biopsy Procedures (Prostate)
S TOPSITE=$P($G(^ONCO(165.5,D0,2)),U,1) I TOPSITE="" S Y="@395" Q
I TOPSITE=67619 D Q
.W !,"------------------------------"
.W !,"SCREENING OR BIOPSY PROCEDURES"
.W !,"------------------------------"
S $P(^ONCO(165.5,D0,2.1),U,18)=0
PRSTF0 S $P(^ONCO(165.5,D0,2.1),U,19)=0
S $P(^ONCO(165.5,D0,2.1),U,20)=0
S $P(^ONCO(165.5,D0,2.1),U,21)=0
S Y="@395"
Q
PRSTF9 ;
S $P(^ONCO(165.5,D0,2.1),U,19)=9
S $P(^ONCO(165.5,D0,2.1),U,20)=9
S $P(^ONCO(165.5,D0,2.1),U,21)=9
S Y="@395"
Q
PRWRIT ;
K ONCPR S DIC="^ONCO(165.5,",DA=DA,DIQ="ONCPR(",DIQ(0)="E"
S DR="146;147;148" D EN^DIQ1
F I=146,147,148 S X=ONCPR(165.5,D0,I) D UCASE S ONCPR(165.5,D0,I)=X
W !,"GUIDANCE......................: "_ONCPR(165.5,DA,146,"E")
W !,"APPROACH FOR BIOPSY OF PRIMARY: "_ONCPR(165.5,DA,147,"E")
W !,"BIOPSY OF OTHER THAN PRIMARY..: "_$E(ONCPR(165.5,DA,148,"E"),1,35)
K ONCPR
W ! K DIR S DIR(0)="E" D ^DIR
S Y="@395"
Q
;
BPGUCHK ; CALLED FROM INPUT TRANFORM OF #141/142 TO CHECK TOPOG
S TOPSITE=$P($G(^ONCO(165.5,D0,2)),U,1) I TOPSITE="" S BPSITE="" Q
S BPSITE=$P($G(^ONCO(164,TOPSITE,0)),U,16)
Q
;
BPCHECK ;SCREENING OR BIOPSY PROCEDURES
S TOPSITE=$P($G(^ONCO(165.5,D0,2)),U,1) I TOPSITE="" S Y="@395" Q
I TOPSITE>67499,TOPSITE<67510 S BPSITE=67500 D DSP Q
I TOPSITE=67619 S BPSITE=67619 D DSP Q
D STUFF0 S Y="@395"
Q
;
DSP ;Display SCREENING OR BIOPSY PROCEDURES
I (COC=5)!(COC=8) D S Y="@395" Q
.S $P(^ONCO(165.5,D0,2.1),U,14)=6
.S:BPSITE=67500 $P(^ONCO(165.5,D0,2.1),U,15)=9
.S:BPSITE=67619 $P(^ONCO(165.5,D0,2.1),U,15)=5
.F PIECE=16:1:19 S $P(^ONCO(165.5,D0,2.1),U,PIECE)=9
I BPSITE=67500 S $P(^ONCO(165.5,D0,2.1),U,18)="",$P(^ONCO(165.5,D0,2.1),U,19)=""
I BPSITE=67619 S $P(^ONCO(165.5,D0,2.1),U,16)="",$P(^ONCO(165.5,D0,2.1),U,17)=""
S HDL=$L("Stage of Disease at Diagnosis"),TAB=(80-HDL)\2,TAB=TAB-1
W @IOF,DASHES
W !,?1,PATNAM,?TAB,"Stage of Disease at Diagnosis",?SITTAB,SITEGP
W !,?1,SSN,?TOPTAB,TOPNAM," ",TOPCOD
W !,DASHES
W !," SCREENING OR BIOPSY PROCEDURES"
W !," ------------------------------"
N DI,DIC,DR,DA,DIQ,ONC
S DIC="^ONCO(165.5,"
S DR="141:146"
S DA=D0,DIQ="ONC" D EN^DIQ1
F I=141,142,143,144,145,146 S X=ONC(165.5,D0,I) D UCASE S ONC(165.5,D0,I)=X
W !," Biopsy procedure..............: ",ONC(165.5,D0,141)
W !," Guidance......................: ",ONC(165.5,D0,142)
W:BPSITE=67500 !," Palpability of primary........: ",ONC(165.5,D0,143)
W:BPSITE=67500 !," First detected by.............: ",ONC(165.5,D0,144)
W:BPSITE=67619 !," Approach for biopsy of primary: ",ONC(165.5,D0,145)
W:BPSITE=67619 !," Biopsy of other than primary..: ",ONC(165.5,D0,146)
W !,DASHES
Q
STUFF0 ; IF SITE DOESN'T HAVE BIOPSY PROCEDURE, STUFF ALL 0'S
S $P(^ONCO(165.5,D0,2.1),U,14)=1
S $P(^ONCO(165.5,D0,2.1),U,15)=1
F PIECE=16:1:19 S $P(^ONCO(165.5,D0,2.1),U,PIECE)=0
Q
NOBP ; IF NO BIOPSY PROCEDURE, STUFF 0'S
; D STUFF0,STFMSG
I BPSITE=67500 D D STFMSG S Y="@1423" Q
.S $P(^ONCO(165.5,D0,2.1),U,15)=1
.S $P(^ONCO(165.5,D0,2.1),U,18)=0
.S $P(^ONCO(165.5,D0,2.1),U,19)=0
.Q
I BPSITE=67619 D D STFMSG S Y="@1456" Q
.S $P(^ONCO(165.5,D0,2.1),U,15)=1
.S $P(^ONCO(165.5,D0,2.1),U,16)=0
.S $P(^ONCO(165.5,D0,2.1),U,17)=0
.S $P(^ONCO(165.5,D0,2.1),U,18)=0
.Q
Q
UNKBP ; IF UNK BIOPSY PROCEDURE, STUFF 9'S
F BP=0:0 S BP=$O(^ONCO(164,BPSITE,"BP5",BP)) Q:BP="B" S LAST=BP
S $P(^ONCO(165.5,D0,2.1),U,14)=LAST
F GU=0:0 S GU=$O(^ONCO(164,BPSITE,"GU5",GU)) Q:GU="B" S LAST=GU
S $P(^ONCO(165.5,D0,2.1),U,15)=LAST
I BPSITE=67500 D D STFMSG S Y="@1423" Q
.S $P(^ONCO(165.5,D0,2.1),U,18)=0
.S $P(^ONCO(165.5,D0,2.1),U,19)=0
.Q
I BPSITE=67619 D D STFMSG S Y="@1456" Q
.S $P(^ONCO(165.5,D0,2.1),U,16)=0
.S $P(^ONCO(165.5,D0,2.1),U,17)=0
.S $P(^ONCO(165.5,D0,2.1),U,18)=9
.Q
Q
STFMSG ;
I BPSITE=67500 D
.K ONCBR S DIC="^ONCO(165.5,",DA=DA,DIQ="ONCBR(",DIQ(0)="E"
.S DR="142" D EN^DIQ1
.F I=142 S X=ONCBR(165.5,D0,I) D UCASE S ONCBR(165.5,D0,I)=X
.W !,"GUIDANCE........: "_ONCBR(165.5,DA,142,"E")
.S Y="@1423"
.K ONCBR Q
I BPSITE=67619 D
.K ONCPR S DIC="^ONCO(165.5,",DA=DA,DIQ="ONCPR(",DIQ(0)="E"
.S DR="142;145" D EN^DIQ1
.F I=142,145 S X=ONCPR(165.5,D0,I) D UCASE S ONCPR(165.5,D0,I)=X
.W !,"GUIDANCE......................: "_ONCPR(165.5,DA,142,"E")
.W !,"APPROACH FOR BIOPSY OF PRIMARY: "_ONCPR(165.5,DA,145,"E")
.S Y="@1456"
.K ONCPR Q
Q
;
UCASE S X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOTNE 5657 printed Dec 13, 2024@02:25:56 Page 2
ONCOTNE ;Hines OIFO/GWB,RTK - TNM STAGING ERROR & BYPASS MESSAGES ;9/27/93
+1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
+2 ;
BRST ;Screening or Biopsy Procedures (Breast)
+1 SET TOPSITE=$PIECE($GET(^ONCO(165.5,D0,2)),U,1)
IF TOPSITE=""
SET Y="@395"
QUIT
+2 IF TOPSITE>67499
IF TOPSITE<67510
Begin DoDot:1
+3 WRITE !!,"------------------------------"
+4 WRITE !,"SCREENING OR BIOPSY PROCEDURES"
+5 WRITE !,"------------------------------"
End DoDot:1
QUIT
+6 SET $PIECE(^ONCO(165.5,D0,2.1),U,14)=0
BRSTF0 SET $PIECE(^ONCO(165.5,D0,2.1),U,15)=0
+1 SET $PIECE(^ONCO(165.5,D0,2.1),U,16)=0
+2 SET $PIECE(^ONCO(165.5,D0,2.1),U,17)=0
+3 SET Y="@1445"
+4 QUIT
BRSTF9 ;
+1 SET $PIECE(^ONCO(165.5,D0,2.1),U,15)=9
+2 SET $PIECE(^ONCO(165.5,D0,2.1),U,16)=9
+3 SET $PIECE(^ONCO(165.5,D0,2.1),U,17)=9
+4 SET Y="@1445"
+5 QUIT
BRWRIT ;
+1 KILL ONCBR
SET DIC="^ONCO(165.5,"
SET DA=DA
SET DIQ="ONCBR("
SET DIQ(0)="E"
+2 SET DR="142;143;144"
DO EN^DIQ1
+3 FOR I=142,143,144
SET X=ONCBR(165.5,D0,I)
DO UCASE
SET ONCBR(165.5,D0,I)=X
+4 WRITE !,"GUIDANCE..............: "_ONCBR(165.5,DA,142,"E")
+5 WRITE !,"PALPABILITY OF PRIMARY: "_ONCBR(165.5,DA,143,"E")
+6 WRITE !,"FIRST DETECTED BY.....: "_ONCBR(165.5,DA,144,"E")
+7 KILL ONCBR
+8 WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
+9 SET Y="@1445"
+10 QUIT
PRST ;Screening or Biopsy Procedures (Prostate)
+1 SET TOPSITE=$PIECE($GET(^ONCO(165.5,D0,2)),U,1)
IF TOPSITE=""
SET Y="@395"
QUIT
+2 IF TOPSITE=67619
Begin DoDot:1
+3 WRITE !,"------------------------------"
+4 WRITE !,"SCREENING OR BIOPSY PROCEDURES"
+5 WRITE !,"------------------------------"
End DoDot:1
QUIT
+6 SET $PIECE(^ONCO(165.5,D0,2.1),U,18)=0
PRSTF0 SET $PIECE(^ONCO(165.5,D0,2.1),U,19)=0
+1 SET $PIECE(^ONCO(165.5,D0,2.1),U,20)=0
+2 SET $PIECE(^ONCO(165.5,D0,2.1),U,21)=0
+3 SET Y="@395"
+4 QUIT
PRSTF9 ;
+1 SET $PIECE(^ONCO(165.5,D0,2.1),U,19)=9
+2 SET $PIECE(^ONCO(165.5,D0,2.1),U,20)=9
+3 SET $PIECE(^ONCO(165.5,D0,2.1),U,21)=9
+4 SET Y="@395"
+5 QUIT
PRWRIT ;
+1 KILL ONCPR
SET DIC="^ONCO(165.5,"
SET DA=DA
SET DIQ="ONCPR("
SET DIQ(0)="E"
+2 SET DR="146;147;148"
DO EN^DIQ1
+3 FOR I=146,147,148
SET X=ONCPR(165.5,D0,I)
DO UCASE
SET ONCPR(165.5,D0,I)=X
+4 WRITE !,"GUIDANCE......................: "_ONCPR(165.5,DA,146,"E")
+5 WRITE !,"APPROACH FOR BIOPSY OF PRIMARY: "_ONCPR(165.5,DA,147,"E")
+6 WRITE !,"BIOPSY OF OTHER THAN PRIMARY..: "_$EXTRACT(ONCPR(165.5,DA,148,"E"),1,35)
+7 KILL ONCPR
+8 WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
+9 SET Y="@395"
+10 QUIT
+11 ;
BPGUCHK ; CALLED FROM INPUT TRANFORM OF #141/142 TO CHECK TOPOG
+1 SET TOPSITE=$PIECE($GET(^ONCO(165.5,D0,2)),U,1)
IF TOPSITE=""
SET BPSITE=""
QUIT
+2 SET BPSITE=$PIECE($GET(^ONCO(164,TOPSITE,0)),U,16)
+3 QUIT
+4 ;
BPCHECK ;SCREENING OR BIOPSY PROCEDURES
+1 SET TOPSITE=$PIECE($GET(^ONCO(165.5,D0,2)),U,1)
IF TOPSITE=""
SET Y="@395"
QUIT
+2 IF TOPSITE>67499
IF TOPSITE<67510
SET BPSITE=67500
DO DSP
QUIT
+3 IF TOPSITE=67619
SET BPSITE=67619
DO DSP
QUIT
+4 DO STUFF0
SET Y="@395"
+5 QUIT
+6 ;
DSP ;Display SCREENING OR BIOPSY PROCEDURES
+1 IF (COC=5)!(COC=8)
Begin DoDot:1
+2 SET $PIECE(^ONCO(165.5,D0,2.1),U,14)=6
+3 if BPSITE=67500
SET $PIECE(^ONCO(165.5,D0,2.1),U,15)=9
+4 if BPSITE=67619
SET $PIECE(^ONCO(165.5,D0,2.1),U,15)=5
+5 FOR PIECE=16:1:19
SET $PIECE(^ONCO(165.5,D0,2.1),U,PIECE)=9
End DoDot:1
SET Y="@395"
QUIT
+6 IF BPSITE=67500
SET $PIECE(^ONCO(165.5,D0,2.1),U,18)=""
SET $PIECE(^ONCO(165.5,D0,2.1),U,19)=""
+7 IF BPSITE=67619
SET $PIECE(^ONCO(165.5,D0,2.1),U,16)=""
SET $PIECE(^ONCO(165.5,D0,2.1),U,17)=""
+8 SET HDL=$LENGTH("Stage of Disease at Diagnosis")
SET TAB=(80-HDL)\2
SET TAB=TAB-1
+9 WRITE @IOF,DASHES
+10 WRITE !,?1,PATNAM,?TAB,"Stage of Disease at Diagnosis",?SITTAB,SITEGP
+11 WRITE !,?1,SSN,?TOPTAB,TOPNAM," ",TOPCOD
+12 WRITE !,DASHES
+13 WRITE !," SCREENING OR BIOPSY PROCEDURES"
+14 WRITE !," ------------------------------"
+15 NEW DI,DIC,DR,DA,DIQ,ONC
+16 SET DIC="^ONCO(165.5,"
+17 SET DR="141:146"
+18 SET DA=D0
SET DIQ="ONC"
DO EN^DIQ1
+19 FOR I=141,142,143,144,145,146
SET X=ONC(165.5,D0,I)
DO UCASE
SET ONC(165.5,D0,I)=X
+20 WRITE !," Biopsy procedure..............: ",ONC(165.5,D0,141)
+21 WRITE !," Guidance......................: ",ONC(165.5,D0,142)
+22 if BPSITE=67500
WRITE !," Palpability of primary........: ",ONC(165.5,D0,143)
+23 if BPSITE=67500
WRITE !," First detected by.............: ",ONC(165.5,D0,144)
+24 if BPSITE=67619
WRITE !," Approach for biopsy of primary: ",ONC(165.5,D0,145)
+25 if BPSITE=67619
WRITE !," Biopsy of other than primary..: ",ONC(165.5,D0,146)
+26 WRITE !,DASHES
+27 QUIT
STUFF0 ; IF SITE DOESN'T HAVE BIOPSY PROCEDURE, STUFF ALL 0'S
+1 SET $PIECE(^ONCO(165.5,D0,2.1),U,14)=1
+2 SET $PIECE(^ONCO(165.5,D0,2.1),U,15)=1
+3 FOR PIECE=16:1:19
SET $PIECE(^ONCO(165.5,D0,2.1),U,PIECE)=0
+4 QUIT
NOBP ; IF NO BIOPSY PROCEDURE, STUFF 0'S
+1 ; D STUFF0,STFMSG
+2 IF BPSITE=67500
Begin DoDot:1
+3 SET $PIECE(^ONCO(165.5,D0,2.1),U,15)=1
+4 SET $PIECE(^ONCO(165.5,D0,2.1),U,18)=0
+5 SET $PIECE(^ONCO(165.5,D0,2.1),U,19)=0
+6 QUIT
End DoDot:1
DO STFMSG
SET Y="@1423"
QUIT
+7 IF BPSITE=67619
Begin DoDot:1
+8 SET $PIECE(^ONCO(165.5,D0,2.1),U,15)=1
+9 SET $PIECE(^ONCO(165.5,D0,2.1),U,16)=0
+10 SET $PIECE(^ONCO(165.5,D0,2.1),U,17)=0
+11 SET $PIECE(^ONCO(165.5,D0,2.1),U,18)=0
+12 QUIT
End DoDot:1
DO STFMSG
SET Y="@1456"
QUIT
+13 QUIT
UNKBP ; IF UNK BIOPSY PROCEDURE, STUFF 9'S
+1 FOR BP=0:0
SET BP=$ORDER(^ONCO(164,BPSITE,"BP5",BP))
if BP="B"
QUIT
SET LAST=BP
+2 SET $PIECE(^ONCO(165.5,D0,2.1),U,14)=LAST
+3 FOR GU=0:0
SET GU=$ORDER(^ONCO(164,BPSITE,"GU5",GU))
if GU="B"
QUIT
SET LAST=GU
+4 SET $PIECE(^ONCO(165.5,D0,2.1),U,15)=LAST
+5 IF BPSITE=67500
Begin DoDot:1
+6 SET $PIECE(^ONCO(165.5,D0,2.1),U,18)=0
+7 SET $PIECE(^ONCO(165.5,D0,2.1),U,19)=0
+8 QUIT
End DoDot:1
DO STFMSG
SET Y="@1423"
QUIT
+9 IF BPSITE=67619
Begin DoDot:1
+10 SET $PIECE(^ONCO(165.5,D0,2.1),U,16)=0
+11 SET $PIECE(^ONCO(165.5,D0,2.1),U,17)=0
+12 SET $PIECE(^ONCO(165.5,D0,2.1),U,18)=9
+13 QUIT
End DoDot:1
DO STFMSG
SET Y="@1456"
QUIT
+14 QUIT
STFMSG ;
+1 IF BPSITE=67500
Begin DoDot:1
+2 KILL ONCBR
SET DIC="^ONCO(165.5,"
SET DA=DA
SET DIQ="ONCBR("
SET DIQ(0)="E"
+3 SET DR="142"
DO EN^DIQ1
+4 FOR I=142
SET X=ONCBR(165.5,D0,I)
DO UCASE
SET ONCBR(165.5,D0,I)=X
+5 WRITE !,"GUIDANCE........: "_ONCBR(165.5,DA,142,"E")
+6 SET Y="@1423"
+7 KILL ONCBR
QUIT
End DoDot:1
+8 IF BPSITE=67619
Begin DoDot:1
+9 KILL ONCPR
SET DIC="^ONCO(165.5,"
SET DA=DA
SET DIQ="ONCPR("
SET DIQ(0)="E"
+10 SET DR="142;145"
DO EN^DIQ1
+11 FOR I=142,145
SET X=ONCPR(165.5,D0,I)
DO UCASE
SET ONCPR(165.5,D0,I)=X
+12 WRITE !,"GUIDANCE......................: "_ONCPR(165.5,DA,142,"E")
+13 WRITE !,"APPROACH FOR BIOPSY OF PRIMARY: "_ONCPR(165.5,DA,145,"E")
+14 SET Y="@1456"
+15 KILL ONCPR
QUIT
End DoDot:1
+16 QUIT
+17 ;
UCASE SET X=$TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+1 QUIT
