- 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 Jan 18, 2025@03:27:06 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