- ONCOAIP2 ;HINES OIFO/GWB,RTK - ONCO ABSTRACT-I SUB-ROUTINES ;04/12/01
- ;;2.2;ONCOLOGY;**1,4,5,6,10,12,13,17**;Jul 31, 2013;Build 6
- ;
- LEUKEMIA(REC) ;Systemic diseases
- N H,HISTNAM,HSTFLD,ICDFILE,ICDNUM
- S L=0
- S H=$E($$HIST^ONCFUNC(REC,.HSTFLD,.HISTNAM,.ICDFILE,.ICDNUM),1,4)
- I ICDNUM=2 I ((H'<9720)&(H'>9732))!((H'<9760)&(H'>9989)) S L=1
- I ICDNUM=3 I ((H'<9731)&(H'>9734))!((H'<9750)&(H'>9989)) S L=1
- Q L
- ;
- MO ;ASSOCIATED WITH HIV (165.5,41)
- S M=$$HIST^ONCFUNC(D0)
- S AWHFLG=0
- I $$LYMPHOMA^ONCFUNC(D0) S Y=41,AWHFLG=1 Q
- S M=$E(M,1,4)
- I M=9140 S Y=41
- E S Y=227
- Q:Y=227 S $P(^ONCO(165.5,D0,2),U,9)=999
- K M
- Q
- ;
- BLOOD ;PERIPHERAL BLOOD INVOLVEMENT (165.5,30.5)
- ; called from input transform -- only for Pre 2018 cases
- ; Mycosis fungoides and Sezary's Disease (9700-9701)
- N CHK,TMP
- S TMP=$$HIST^ONCFUNC(DA),Y="@301"
- I '$D(DATEDX) Q
- I DATEDX>3171231 Q
- F CHK="97002","97003","97012","97013" I CHK=TMP S Y=30.5 Q
- Q
- ;
- PGPE ;PATHOLOGIC EXTENSION (165.5,30.1)
- ;Prostate C61.9
- S Y="@231"
- I $P($G(^ONCO(165.5,D0,0)),U,16)<3180000 D
- .N TMP S TMP=$P($G(^ONCO(165.5,DA,2)),U,1)
- .I TMP=67619 S Y=30.1 Q
- .S $P(^ONCO(165.5,DA,2.2),U,2)=""
- .Q
- Q
- PGPE18 ;PROSTATE PATH EXT (165.5,3919)
- S Y="@3919"
- I $P($G(^ONCO(165.5,D0,0)),U,16)>3171231 D
- .N TMP S TMP=$P($G(^ONCO(165.5,DA,2)),U,1)
- .I TMP=67619 D
- ..N DI,DIC,DR,DA,DIQ,ONC
- ..S DIC="^ONCO(165.5,",DR="30.1",DA=D0,DIQ="ONC" D EN^DIQ1
- ..W !,"*** Display of retired Pathologic Exension value for reference ***"
- ..W !," Pathologic Extension......: ",ONC(165.5,D0,30.1),!
- ..S Y=3919 Q
- .Q
- Q
- ;
- LN ;BRAIN AND CEREBRAL MENINGES (SEER EOD)
- ;OTHER PARTS OF CENTRAL NERVOUS SYSTEM (SEER EOD)
- N T
- S T=$P($G(^ONCO(165.5,D0,2)),U,1)
- I (T=67700)!($E(T,3,4)=71)!($E(T,3,4)=72) D
- .I $P($G(^ONCO(165.5,D0,0)),U,16)<3160101 S $P(^ONCO(165.5,D0,2),U,11)=9
- .S $P(^ONCO(165.5,D0,2),U,12)=99 ;Regional Nodes Positive
- .S $P(^ONCO(165.5,D0,2),U,13)=99 ;Regional Nodes Examined
- .I $P($G(^ONCO(165.5,D0,0)),U,16)<3160101 W !,"LYMPH NODES............: Not Applicable"
- .W !,"REGIONAL NODES EXAMINED: Unk; not stated; death cert only"
- .W !,"REGIONAL NODES POSITIVE: Unk if nodes + or -, NA"
- .I $P($G(^ONCO(165.5,D0,0)),U,16)<3180000 S Y="@26" Q
- .I $P($G(^ONCO(165.5,D0,0)),U,16)>3171231 S Y=1772 Q
- .Q
- ;else just exit back to code where called [in ABS edit template]
- Q
- ;
- EDTMOD ;EXTRACT EDITS THAT NEED TO BE MANUALLY FIXED TO PASS
- S SECTION="EDITS Modifications" D SECTION^ONCOAIP
- N DI,DIC,DR,DA,DIQ,ONC
- S DIC="^ONCO(165.5,"
- S DR="999.1:999.99;7014;7018"
- S DA=D0,DIQ="ONC" D EN^DIQ1
- ;S X=ONC(165.5,D0,91) D UCASE^ONCPCI S ONC(165.5,D0,91)=X
- W !," Address at DX--State........: ",ONC(165.5,D0,999.26),?40,"Address at DX--Country......: ",ONC(165.5,D0,999.27)
- W !," Address Current--State......: ",ONC(165.5,D0,999.28),?40,"Address Current--Country....: ",ONC(165.5,D0,999.29)
- W !," Address Current--Postal Code: ",ONC(165.5,D0,999.289)
- I $P($G(^ONCO(165.5,D0,0)),U,16)>3221231 D
- .W !?4,"*** THE DATE FLAG FIELDS ARE OBSOLETE FOR 2023+ CASES AND ***"
- .W !?4,"*** ARE NO LONGER ACCESSIBLE ***"
- I $P($G(^ONCO(165.5,D0,0)),U,16)<3230000 D
- .W !!," Date of Diagnosis Flag......: ",ONC(165.5,D0,999.1),?40,"RX Date-Systemic Flag.......: ",ONC(165.5,D0,999.14)
- .W !," Date Conclusive DX Flag.....: ",ONC(165.5,D0,999.2),?40,"RX Date-Chemo Flag..........: ",ONC(165.5,D0,999.15)
- .W !," Date of Mult Tumors Flag....: ",ONC(165.5,D0,999.3),?40,"RX Date-Hormone Flag........: ",ONC(165.5,D0,999.16)
- .W !," Date of First Contact Flag..: ",ONC(165.5,D0,999.4),?40,"RX Date-BRM Flag............: ",ONC(165.5,D0,999.17)
- .W !," Date of Inpt Adm Flag.......: ",ONC(165.5,D0,999.5),?40,"RX Date-Other Flag..........: ",ONC(165.5,D0,999.18)
- .W !," Date of Inpt Disch Flag.....: ",ONC(165.5,D0,999.6),?40,"RX Date-DX/Stg Proc Flag....: ",ONC(165.5,D0,999.19)
- .W !," Date 1st CRS RX Flag........: ",ONC(165.5,D0,999.7),?40,"Recurrence Date-1st Flag....: ",ONC(165.5,D0,999.21)
- .W !," RX Date-Surgery Flag........: ",ONC(165.5,D0,999.8),?40,"Date of Last Contact Flag...: ",ONC(165.5,D0,999.22)
- .W !," RX Date-Mst Defn Srg Flag...: ",ONC(165.5,D0,999.9),?40,"Subsq RX 2nd Crs Date Flag..: ",ONC(165.5,D0,999.23)
- .W !," RX Date-Surg Disch Flag.....: ",ONC(165.5,D0,999.11),?40,"Subsq RX 3rd Crs Date Flag..: ",ONC(165.5,D0,999.24)
- .W !," RX Date-Radiation Flag......: ",ONC(165.5,D0,999.12),?40,"Subsq RX 4th Crs Date Flag..: ",ONC(165.5,D0,999.25)
- .W !," RX Date-Rad Ended Flag......: ",ONC(165.5,D0,999.13)
- .W !!," Date Regional LN Disx Flag..: ",ONC(165.5,D0,7014),?40,"Date Sentinel LN Biopsy Flag: ",ONC(165.5,D0,7018)
- W !,DASHES
- W !,"* * * These fields should ONLY be used to correct an EDIT that cannot * * *",!,"* * * be cleared. Otherwise these fields should NOT be modified. * * *"
- Q
- ;
- UDFMOD ;ALLOW USERS TO ENTER/EDIT USER-DEFINED FIELDS
- S SECTION="User Defined Fields" D SECTION^ONCOAIP
- N DI,DIC,DR,DA,DIQ,ONC,OSPIEN
- S DIC="^ONCO(165.5,"
- S DR="284:285"
- S DA=D0,DIQ="ONC" D EN^DIQ1
- W !," User Defined Field #1........: ",ONC(165.5,D0,284),?40," User Defined Field #2........: ",ONC(165.5,D0,284.1)
- W !," User Defined Field #3........: ",ONC(165.5,D0,284.2),?40," User Defined Field #4........: ",ONC(165.5,D0,284.3)
- W !," User Defined Field #5........: ",ONC(165.5,D0,284.4),?40," User Defined Field #6........: ",ONC(165.5,D0,284.5)
- W !," User Defined Field #7........: ",ONC(165.5,D0,284.6),?40," User Defined Field #8........: ",ONC(165.5,D0,284.7)
- W !," User Defined Field #9........: ",ONC(165.5,D0,284.8),?40," User Defined Field #10.......: ",ONC(165.5,D0,284.9)
- W !,DASHES
- Q
- ;
- EXTLN ;Display retired <2018 EOD Extension & LN fields (removed this in P13)
- Q
- CLINTNM ;Display retired <2018 Clin TNM fields (removed this in P13)
- Q
- PATHTNM ;Display retired <2018 Path TNM fields (removed this in P13)
- Q
- RADRET ;Display retired <2018 Rad fields (removed this in P13)
- Q
- RADSKP ;
- I $P($G(^ONCO(165.5,D0,"RAD18")),"^",1)'="" Q
- I $P($G(^ONCO(165.5,D0,"RAD18")),"^",2)'="" Q
- I $P($G(^ONCO(165.5,D0,"RAD18")),"^",3)'="" Q
- I $P($G(^ONCO(165.5,D0,"RAD18")),"^",4)'="" Q
- I $P($G(^ONCO(165.5,D0,"RAD18")),"^",5)'="" Q
- I $P($G(^ONCO(165.5,D0,"RAD18")),"^",6)'="" Q
- I $P($G(^ONCO(165.5,D0,"RAD18")),"^",7)'="" Q
- W ! S Y="@49" ;if all 7 above = "" then skip PHASE II & III fields
- Q
- RADSTF ;
- ;PART 1 IF = 00
- I $P($G(^ONCO(165.5,D0,"RAD18")),"^",4)=1 D ;IF PHASE 1 RAD = 00
- .S $P(^ONCO(165.5,D0,"RAD18"),"^",5)=1
- .S $P(^ONCO(165.5,D0,"RAD18"),"^",6)=1
- .S $P(^ONCO(165.5,D0,"RAD18"),"^",2)=1
- .S $P(^ONCO(165.5,D0,"RAD18"),"^",1)="00000"
- .S $P(^ONCO(165.5,D0,"RAD18"),"^",3)="000"
- .S $P(^ONCO(165.5,D0,"RAD18"),"^",7)="000000"
- .W !,"PHASE 1 RADIATION TREATMENT VOLUME...: 00 NO RADIATION TREATMENT"
- .W !,"PHASE 1 RAD TO DRAINING LYMPH NODE...: 00 NO RADIATION TREATMENT"
- .W !,"PHASE 1 RADIATION TREATMENT MODALITY.: 00 NO RADIATION TREATMENT"
- .W !,"PHASE 1 RAD EXTERNAL BEAM PLAN TECH..: 00 NO RADIATION TREATMENT"
- .W !,"PHASE 1 DOSE PER FRACTION............: 00000"
- .W !,"PHASE 1 NUMBER OF FRACTIONS..........: 000"
- .W !,"PHASE 1 TOTAL DOSE...................: 000000"
- .S $P(^ONCO(165.5,DA,"NCR18B"),U,1)="00"
- .S $P(^ONCO(165.5,DA,"NCR18B"),U,2)="00"
- .S $P(^ONCO(165.5,DA,"NCR18B"),U,3)="000000"
- .S $P(^ONCO(165.5,D0,"RAD18"),"^",11)=1
- .D RADSTF2 ;If no PHASE I Rad then stuff/skip PHASE II & III fields
- ;
- ;PART 2 IF = 99
- I $P($G(^ONCO(165.5,D0,"RAD18")),"^",4)=70 D ;IF PHASE 1 RAD = 99
- .S $P(^ONCO(165.5,D0,"RAD18"),"^",5)=11
- .S $P(^ONCO(165.5,D0,"RAD18"),"^",6)=18
- .S $P(^ONCO(165.5,D0,"RAD18"),"^",2)=14
- .S $P(^ONCO(165.5,D0,"RAD18"),"^",1)="99999"
- .S $P(^ONCO(165.5,D0,"RAD18"),"^",3)="999"
- .S $P(^ONCO(165.5,D0,"RAD18"),"^",7)="999999"
- .W !,"PHASE 1 RADIATION TREATMENT VOLUME...: 99 UNKNOWN"
- .W !,"PHASE 1 RAD TO DRAINING LYMPH NODE...: 99 UNKNOWN"
- .W !,"PHASE 1 RADIATION TREATMENT MODALITY.: 99 UNKNOWN"
- .W !,"PHASE 1 RAD EXTERNAL BEAM PLAN TECH..: 99 UNKNOWN"
- .W !,"PHASE 1 DOSE PER FRACTION............: 99999"
- .W !,"PHASE 1 NUMBER OF FRACTIONS..........: 999"
- .W !,"PHASE 1 TOTAL DOSE...................: 999999"
- .S $P(^ONCO(165.5,DA,"NCR18B"),U,1)="99"
- .S $P(^ONCO(165.5,DA,"NCR18B"),U,2)="99"
- .S $P(^ONCO(165.5,DA,"NCR18B"),U,3)="999999"
- .S $P(^ONCO(165.5,D0,"RAD18"),"^",11)=70
- .D RADSTF2 ;If no PHASE I Rad then stuff/skip PHASE II & III fields
- Q
- RADSTF2 ;
- ;PART 1 IF = 00
- I $P($G(^ONCO(165.5,D0,"RAD18")),"^",11)=1 D
- .S $P(^ONCO(165.5,D0,"RAD18"),"^",12)=1
- .S $P(^ONCO(165.5,D0,"RAD18"),"^",13)=1
- .S $P(^ONCO(165.5,D0,"RAD18"),"^",9)=1
- .S $P(^ONCO(165.5,D0,"RAD18"),"^",8)="00000"
- .S $P(^ONCO(165.5,D0,"RAD18"),"^",10)="000"
- .S $P(^ONCO(165.5,D0,"RAD18"),"^",14)="000000"
- .W !,"PHASE 2 RADIATION TREATMENT VOLUME...: 00 NO RADIATION TREATMENT"
- .W !,"PHASE 2 RAD TO DRAINING LYMPH NODE...: 00 NO RADIATION TREATMENT"
- .W !,"PHASE 2 RADIATION TREATMENT MODALITY.: 00 NO RADIATION TREATMENT"
- .W !,"PHASE 2 RAD EXTERNAL BEAM PLAN TECH..: 00 NO RADIATION TREATMENT"
- .W !,"PHASE 2 DOSE PER FRACTION............: 00000"
- .W !,"PHASE 2 NUMBER OF FRACTIONS..........: 000"
- .W !,"PHASE 2 TOTAL DOSE...................: 000000"
- .S $P(^ONCO(165.5,D0,"RAD18"),"^",18)=1
- .D RADSTF3 ;If no PHASE II Rad then stuff/skip PHASE III fields
- ;
- ;PART 2 IF = 99
- I $P($G(^ONCO(165.5,D0,"RAD18")),"^",11)=70 D
- .S $P(^ONCO(165.5,D0,"RAD18"),"^",12)=11
- .S $P(^ONCO(165.5,D0,"RAD18"),"^",13)=18
- .S $P(^ONCO(165.5,D0,"RAD18"),"^",9)=14
- .S $P(^ONCO(165.5,D0,"RAD18"),"^",8)="99999"
- .S $P(^ONCO(165.5,D0,"RAD18"),"^",10)="999"
- .S $P(^ONCO(165.5,D0,"RAD18"),"^",14)="999999"
- .W !,"PHASE 2 RADIATION TREATMENT VOLUME...: 99 UNKNOWN"
- .W !,"PHASE 2 RAD TO DRAINING LYMPH NODE...: 99 UNKNOWN"
- .W !,"PHASE 2 RADIATION TREATMENT MODALITY.: 99 UNKNOWN"
- .W !,"PHASE 2 RAD EXTERNAL BEAM PLAN TECH..: 99 UNKNOWN"
- .W !,"PHASE 2 DOSE PER FRACTION............: 99999"
- .W !,"PHASE 2 NUMBER OF FRACTIONS..........: 999"
- .W !,"PHASE 2 TOTAL DOSE...................: 999999"
- .S $P(^ONCO(165.5,D0,"RAD18"),"^",18)=70
- .D RADSTF3 ;If no PHASE II Rad then stuff/skip PHASE III fields
- Q
- RADSTF3 ;
- I $P($G(^ONCO(165.5,D0,"RAD18")),"^",18)=1 D
- .S $P(^ONCO(165.5,D0,"RAD18"),"^",19)=1
- .S $P(^ONCO(165.5,D0,"RAD18"),"^",20)=1
- .S $P(^ONCO(165.5,D0,"RAD18"),"^",16)=1
- .S $P(^ONCO(165.5,D0,"RAD18"),"^",15)="00000"
- .S $P(^ONCO(165.5,D0,"RAD18"),"^",17)="000"
- .S $P(^ONCO(165.5,D0,"RAD18"),"^",21)="000000"
- .W !,"PHASE 3 RADIATION TREATMENT VOLUME...: 00 NO RADIATION TREATMENT"
- .W !,"PHASE 3 RAD TO DRAINING LYMPH NODE...: 00 NO RADIATION TREATMENT"
- .W !,"PHASE 3 RADIATION TREATMENT MODALITY.: 00 NO RADIATION TREATMENT"
- .W !,"PHASE 3 RAD EXTERNAL BEAM PLAN TECH..: 00 NO RADIATION TREATMENT"
- .W !,"PHASE 3 DOSE PER FRACTION............: 00000"
- .W !,"PHASE 3 NUMBER OF FRACTIONS..........: 000"
- .W !,"PHASE 3 TOTAL DOSE...................: 000000"
- .S Y=7024 ;If no PHASE III Rad then stuff and jump over
- I $P($G(^ONCO(165.5,D0,"RAD18")),"^",18)=70 D
- .S $P(^ONCO(165.5,D0,"RAD18"),"^",19)=11
- .S $P(^ONCO(165.5,D0,"RAD18"),"^",20)=18
- .S $P(^ONCO(165.5,D0,"RAD18"),"^",16)=14
- .S $P(^ONCO(165.5,D0,"RAD18"),"^",15)="99999"
- .S $P(^ONCO(165.5,D0,"RAD18"),"^",17)="999"
- .S $P(^ONCO(165.5,D0,"RAD18"),"^",21)="999999"
- .W !,"PHASE 3 RADIATION TREATMENT VOLUME...: 99 UNKNOWN"
- .W !,"PHASE 3 RAD TO DRAINING LYMPH NODE...: 99 UNKNOWN"
- .W !,"PHASE 3 RADIATION TREATMENT MODALITY.: 99 UNKNOWN"
- .W !,"PHASE 3 RAD EXTERNAL BEAM PLAN TECH..: 99 UNKNOWN"
- .W !,"PHASE 3 DOSE PER FRACTION............: 99999"
- .W !,"PHASE 3 NUMBER OF FRACTIONS..........: 999"
- .W !,"PHASE 3 TOTAL DOSE...................: 999999"
- .S Y=7024 ;If no PHASE III Rad then stuff and jump over
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOAIP2 11921 printed Feb 18, 2025@23:50:45 Page 2
- ONCOAIP2 ;HINES OIFO/GWB,RTK - ONCO ABSTRACT-I SUB-ROUTINES ;04/12/01
- +1 ;;2.2;ONCOLOGY;**1,4,5,6,10,12,13,17**;Jul 31, 2013;Build 6
- +2 ;
- LEUKEMIA(REC) ;Systemic diseases
- +1 NEW H,HISTNAM,HSTFLD,ICDFILE,ICDNUM
- +2 SET L=0
- +3 SET H=$EXTRACT($$HIST^ONCFUNC(REC,.HSTFLD,.HISTNAM,.ICDFILE,.ICDNUM),1,4)
- +4 IF ICDNUM=2
- IF ((H'<9720)&(H'>9732))!((H'<9760)&(H'>9989))
- SET L=1
- +5 IF ICDNUM=3
- IF ((H'<9731)&(H'>9734))!((H'<9750)&(H'>9989))
- SET L=1
- +6 QUIT L
- +7 ;
- MO ;ASSOCIATED WITH HIV (165.5,41)
- +1 SET M=$$HIST^ONCFUNC(D0)
- +2 SET AWHFLG=0
- +3 IF $$LYMPHOMA^ONCFUNC(D0)
- SET Y=41
- SET AWHFLG=1
- QUIT
- +4 SET M=$EXTRACT(M,1,4)
- +5 IF M=9140
- SET Y=41
- +6 IF '$TEST
- SET Y=227
- +7 if Y=227
- QUIT
- SET $PIECE(^ONCO(165.5,D0,2),U,9)=999
- +8 KILL M
- +9 QUIT
- +10 ;
- BLOOD ;PERIPHERAL BLOOD INVOLVEMENT (165.5,30.5)
- +1 ; called from input transform -- only for Pre 2018 cases
- +2 ; Mycosis fungoides and Sezary's Disease (9700-9701)
- +3 NEW CHK,TMP
- +4 SET TMP=$$HIST^ONCFUNC(DA)
- SET Y="@301"
- +5 IF '$DATA(DATEDX)
- QUIT
- +6 IF DATEDX>3171231
- QUIT
- +7 FOR CHK="97002","97003","97012","97013"
- IF CHK=TMP
- SET Y=30.5
- QUIT
- +8 QUIT
- +9 ;
- PGPE ;PATHOLOGIC EXTENSION (165.5,30.1)
- +1 ;Prostate C61.9
- +2 SET Y="@231"
- +3 IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)<3180000
- Begin DoDot:1
- +4 NEW TMP
- SET TMP=$PIECE($GET(^ONCO(165.5,DA,2)),U,1)
- +5 IF TMP=67619
- SET Y=30.1
- QUIT
- +6 SET $PIECE(^ONCO(165.5,DA,2.2),U,2)=""
- +7 QUIT
- End DoDot:1
- +8 QUIT
- PGPE18 ;PROSTATE PATH EXT (165.5,3919)
- +1 SET Y="@3919"
- +2 IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)>3171231
- Begin DoDot:1
- +3 NEW TMP
- SET TMP=$PIECE($GET(^ONCO(165.5,DA,2)),U,1)
- +4 IF TMP=67619
- Begin DoDot:2
- +5 NEW DI,DIC,DR,DA,DIQ,ONC
- +6 SET DIC="^ONCO(165.5,"
- SET DR="30.1"
- SET DA=D0
- SET DIQ="ONC"
- DO EN^DIQ1
- +7 WRITE !,"*** Display of retired Pathologic Exension value for reference ***"
- +8 WRITE !," Pathologic Extension......: ",ONC(165.5,D0,30.1),!
- +9 SET Y=3919
- QUIT
- End DoDot:2
- +10 QUIT
- End DoDot:1
- +11 QUIT
- +12 ;
- LN ;BRAIN AND CEREBRAL MENINGES (SEER EOD)
- +1 ;OTHER PARTS OF CENTRAL NERVOUS SYSTEM (SEER EOD)
- +2 NEW T
- +3 SET T=$PIECE($GET(^ONCO(165.5,D0,2)),U,1)
- +4 IF (T=67700)!($EXTRACT(T,3,4)=71)!($EXTRACT(T,3,4)=72)
- Begin DoDot:1
- +5 IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)<3160101
- SET $PIECE(^ONCO(165.5,D0,2),U,11)=9
- +6 ;Regional Nodes Positive
- SET $PIECE(^ONCO(165.5,D0,2),U,12)=99
- +7 ;Regional Nodes Examined
- SET $PIECE(^ONCO(165.5,D0,2),U,13)=99
- +8 IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)<3160101
- WRITE !,"LYMPH NODES............: Not Applicable"
- +9 WRITE !,"REGIONAL NODES EXAMINED: Unk; not stated; death cert only"
- +10 WRITE !,"REGIONAL NODES POSITIVE: Unk if nodes + or -, NA"
- +11 IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)<3180000
- SET Y="@26"
- QUIT
- +12 IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)>3171231
- SET Y=1772
- QUIT
- +13 QUIT
- End DoDot:1
- +14 ;else just exit back to code where called [in ABS edit template]
- +15 QUIT
- +16 ;
- EDTMOD ;EXTRACT EDITS THAT NEED TO BE MANUALLY FIXED TO PASS
- +1 SET SECTION="EDITS Modifications"
- DO SECTION^ONCOAIP
- +2 NEW DI,DIC,DR,DA,DIQ,ONC
- +3 SET DIC="^ONCO(165.5,"
- +4 SET DR="999.1:999.99;7014;7018"
- +5 SET DA=D0
- SET DIQ="ONC"
- DO EN^DIQ1
- +6 ;S X=ONC(165.5,D0,91) D UCASE^ONCPCI S ONC(165.5,D0,91)=X
- +7 WRITE !," Address at DX--State........: ",ONC(165.5,D0,999.26),?40,"Address at DX--Country......: ",ONC(165.5,D0,999.27)
- +8 WRITE !," Address Current--State......: ",ONC(165.5,D0,999.28),?40,"Address Current--Country....: ",ONC(165.5,D0,999.29)
- +9 WRITE !," Address Current--Postal Code: ",ONC(165.5,D0,999.289)
- +10 IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)>3221231
- Begin DoDot:1
- +11 WRITE !?4,"*** THE DATE FLAG FIELDS ARE OBSOLETE FOR 2023+ CASES AND ***"
- +12 WRITE !?4,"*** ARE NO LONGER ACCESSIBLE ***"
- End DoDot:1
- +13 IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)<3230000
- Begin DoDot:1
- +14 WRITE !!," Date of Diagnosis Flag......: ",ONC(165.5,D0,999.1),?40,"RX Date-Systemic Flag.......: ",ONC(165.5,D0,999.14)
- +15 WRITE !," Date Conclusive DX Flag.....: ",ONC(165.5,D0,999.2),?40,"RX Date-Chemo Flag..........: ",ONC(165.5,D0,999.15)
- +16 WRITE !," Date of Mult Tumors Flag....: ",ONC(165.5,D0,999.3),?40,"RX Date-Hormone Flag........: ",ONC(165.5,D0,999.16)
- +17 WRITE !," Date of First Contact Flag..: ",ONC(165.5,D0,999.4),?40,"RX Date-BRM Flag............: ",ONC(165.5,D0,999.17)
- +18 WRITE !," Date of Inpt Adm Flag.......: ",ONC(165.5,D0,999.5),?40,"RX Date-Other Flag..........: ",ONC(165.5,D0,999.18)
- +19 WRITE !," Date of Inpt Disch Flag.....: ",ONC(165.5,D0,999.6),?40,"RX Date-DX/Stg Proc Flag....: ",ONC(165.5,D0,999.19)
- +20 WRITE !," Date 1st CRS RX Flag........: ",ONC(165.5,D0,999.7),?40,"Recurrence Date-1st Flag....: ",ONC(165.5,D0,999.21)
- +21 WRITE !," RX Date-Surgery Flag........: ",ONC(165.5,D0,999.8),?40,"Date of Last Contact Flag...: ",ONC(165.5,D0,999.22)
- +22 WRITE !," RX Date-Mst Defn Srg Flag...: ",ONC(165.5,D0,999.9),?40,"Subsq RX 2nd Crs Date Flag..: ",ONC(165.5,D0,999.23)
- +23 WRITE !," RX Date-Surg Disch Flag.....: ",ONC(165.5,D0,999.11),?40,"Subsq RX 3rd Crs Date Flag..: ",ONC(165.5,D0,999.24)
- +24 WRITE !," RX Date-Radiation Flag......: ",ONC(165.5,D0,999.12),?40,"Subsq RX 4th Crs Date Flag..: ",ONC(165.5,D0,999.25)
- +25 WRITE !," RX Date-Rad Ended Flag......: ",ONC(165.5,D0,999.13)
- +26 WRITE !!," Date Regional LN Disx Flag..: ",ONC(165.5,D0,7014),?40,"Date Sentinel LN Biopsy Flag: ",ONC(165.5,D0,7018)
- End DoDot:1
- +27 WRITE !,DASHES
- +28 WRITE !,"* * * These fields should ONLY be used to correct an EDIT that cannot * * *",!,"* * * be cleared. Otherwise these fields should NOT be modified. * * *"
- +29 QUIT
- +30 ;
- UDFMOD ;ALLOW USERS TO ENTER/EDIT USER-DEFINED FIELDS
- +1 SET SECTION="User Defined Fields"
- DO SECTION^ONCOAIP
- +2 NEW DI,DIC,DR,DA,DIQ,ONC,OSPIEN
- +3 SET DIC="^ONCO(165.5,"
- +4 SET DR="284:285"
- +5 SET DA=D0
- SET DIQ="ONC"
- DO EN^DIQ1
- +6 WRITE !," User Defined Field #1........: ",ONC(165.5,D0,284),?40," User Defined Field #2........: ",ONC(165.5,D0,284.1)
- +7 WRITE !," User Defined Field #3........: ",ONC(165.5,D0,284.2),?40," User Defined Field #4........: ",ONC(165.5,D0,284.3)
- +8 WRITE !," User Defined Field #5........: ",ONC(165.5,D0,284.4),?40," User Defined Field #6........: ",ONC(165.5,D0,284.5)
- +9 WRITE !," User Defined Field #7........: ",ONC(165.5,D0,284.6),?40," User Defined Field #8........: ",ONC(165.5,D0,284.7)
- +10 WRITE !," User Defined Field #9........: ",ONC(165.5,D0,284.8),?40," User Defined Field #10.......: ",ONC(165.5,D0,284.9)
- +11 WRITE !,DASHES
- +12 QUIT
- +13 ;
- EXTLN ;Display retired <2018 EOD Extension & LN fields (removed this in P13)
- +1 QUIT
- CLINTNM ;Display retired <2018 Clin TNM fields (removed this in P13)
- +1 QUIT
- PATHTNM ;Display retired <2018 Path TNM fields (removed this in P13)
- +1 QUIT
- RADRET ;Display retired <2018 Rad fields (removed this in P13)
- +1 QUIT
- RADSKP ;
- +1 IF $PIECE($GET(^ONCO(165.5,D0,"RAD18")),"^",1)'=""
- QUIT
- +2 IF $PIECE($GET(^ONCO(165.5,D0,"RAD18")),"^",2)'=""
- QUIT
- +3 IF $PIECE($GET(^ONCO(165.5,D0,"RAD18")),"^",3)'=""
- QUIT
- +4 IF $PIECE($GET(^ONCO(165.5,D0,"RAD18")),"^",4)'=""
- QUIT
- +5 IF $PIECE($GET(^ONCO(165.5,D0,"RAD18")),"^",5)'=""
- QUIT
- +6 IF $PIECE($GET(^ONCO(165.5,D0,"RAD18")),"^",6)'=""
- QUIT
- +7 IF $PIECE($GET(^ONCO(165.5,D0,"RAD18")),"^",7)'=""
- QUIT
- +8 ;if all 7 above = "" then skip PHASE II & III fields
- WRITE !
- SET Y="@49"
- +9 QUIT
- RADSTF ;
- +1 ;PART 1 IF = 00
- +2 ;IF PHASE 1 RAD = 00
- IF $PIECE($GET(^ONCO(165.5,D0,"RAD18")),"^",4)=1
- Begin DoDot:1
- +3 SET $PIECE(^ONCO(165.5,D0,"RAD18"),"^",5)=1
- +4 SET $PIECE(^ONCO(165.5,D0,"RAD18"),"^",6)=1
- +5 SET $PIECE(^ONCO(165.5,D0,"RAD18"),"^",2)=1
- +6 SET $PIECE(^ONCO(165.5,D0,"RAD18"),"^",1)="00000"
- +7 SET $PIECE(^ONCO(165.5,D0,"RAD18"),"^",3)="000"
- +8 SET $PIECE(^ONCO(165.5,D0,"RAD18"),"^",7)="000000"
- +9 WRITE !,"PHASE 1 RADIATION TREATMENT VOLUME...: 00 NO RADIATION TREATMENT"
- +10 WRITE !,"PHASE 1 RAD TO DRAINING LYMPH NODE...: 00 NO RADIATION TREATMENT"
- +11 WRITE !,"PHASE 1 RADIATION TREATMENT MODALITY.: 00 NO RADIATION TREATMENT"
- +12 WRITE !,"PHASE 1 RAD EXTERNAL BEAM PLAN TECH..: 00 NO RADIATION TREATMENT"
- +13 WRITE !,"PHASE 1 DOSE PER FRACTION............: 00000"
- +14 WRITE !,"PHASE 1 NUMBER OF FRACTIONS..........: 000"
- +15 WRITE !,"PHASE 1 TOTAL DOSE...................: 000000"
- +16 SET $PIECE(^ONCO(165.5,DA,"NCR18B"),U,1)="00"
- +17 SET $PIECE(^ONCO(165.5,DA,"NCR18B"),U,2)="00"
- +18 SET $PIECE(^ONCO(165.5,DA,"NCR18B"),U,3)="000000"
- +19 SET $PIECE(^ONCO(165.5,D0,"RAD18"),"^",11)=1
- +20 ;If no PHASE I Rad then stuff/skip PHASE II & III fields
- DO RADSTF2
- End DoDot:1
- +21 ;
- +22 ;PART 2 IF = 99
- +23 ;IF PHASE 1 RAD = 99
- IF $PIECE($GET(^ONCO(165.5,D0,"RAD18")),"^",4)=70
- Begin DoDot:1
- +24 SET $PIECE(^ONCO(165.5,D0,"RAD18"),"^",5)=11
- +25 SET $PIECE(^ONCO(165.5,D0,"RAD18"),"^",6)=18
- +26 SET $PIECE(^ONCO(165.5,D0,"RAD18"),"^",2)=14
- +27 SET $PIECE(^ONCO(165.5,D0,"RAD18"),"^",1)="99999"
- +28 SET $PIECE(^ONCO(165.5,D0,"RAD18"),"^",3)="999"
- +29 SET $PIECE(^ONCO(165.5,D0,"RAD18"),"^",7)="999999"
- +30 WRITE !,"PHASE 1 RADIATION TREATMENT VOLUME...: 99 UNKNOWN"
- +31 WRITE !,"PHASE 1 RAD TO DRAINING LYMPH NODE...: 99 UNKNOWN"
- +32 WRITE !,"PHASE 1 RADIATION TREATMENT MODALITY.: 99 UNKNOWN"
- +33 WRITE !,"PHASE 1 RAD EXTERNAL BEAM PLAN TECH..: 99 UNKNOWN"
- +34 WRITE !,"PHASE 1 DOSE PER FRACTION............: 99999"
- +35 WRITE !,"PHASE 1 NUMBER OF FRACTIONS..........: 999"
- +36 WRITE !,"PHASE 1 TOTAL DOSE...................: 999999"
- +37 SET $PIECE(^ONCO(165.5,DA,"NCR18B"),U,1)="99"
- +38 SET $PIECE(^ONCO(165.5,DA,"NCR18B"),U,2)="99"
- +39 SET $PIECE(^ONCO(165.5,DA,"NCR18B"),U,3)="999999"
- +40 SET $PIECE(^ONCO(165.5,D0,"RAD18"),"^",11)=70
- +41 ;If no PHASE I Rad then stuff/skip PHASE II & III fields
- DO RADSTF2
- End DoDot:1
- +42 QUIT
- RADSTF2 ;
- +1 ;PART 1 IF = 00
- +2 IF $PIECE($GET(^ONCO(165.5,D0,"RAD18")),"^",11)=1
- Begin DoDot:1
- +3 SET $PIECE(^ONCO(165.5,D0,"RAD18"),"^",12)=1
- +4 SET $PIECE(^ONCO(165.5,D0,"RAD18"),"^",13)=1
- +5 SET $PIECE(^ONCO(165.5,D0,"RAD18"),"^",9)=1
- +6 SET $PIECE(^ONCO(165.5,D0,"RAD18"),"^",8)="00000"
- +7 SET $PIECE(^ONCO(165.5,D0,"RAD18"),"^",10)="000"
- +8 SET $PIECE(^ONCO(165.5,D0,"RAD18"),"^",14)="000000"
- +9 WRITE !,"PHASE 2 RADIATION TREATMENT VOLUME...: 00 NO RADIATION TREATMENT"
- +10 WRITE !,"PHASE 2 RAD TO DRAINING LYMPH NODE...: 00 NO RADIATION TREATMENT"
- +11 WRITE !,"PHASE 2 RADIATION TREATMENT MODALITY.: 00 NO RADIATION TREATMENT"
- +12 WRITE !,"PHASE 2 RAD EXTERNAL BEAM PLAN TECH..: 00 NO RADIATION TREATMENT"
- +13 WRITE !,"PHASE 2 DOSE PER FRACTION............: 00000"
- +14 WRITE !,"PHASE 2 NUMBER OF FRACTIONS..........: 000"
- +15 WRITE !,"PHASE 2 TOTAL DOSE...................: 000000"
- +16 SET $PIECE(^ONCO(165.5,D0,"RAD18"),"^",18)=1
- +17 ;If no PHASE II Rad then stuff/skip PHASE III fields
- DO RADSTF3
- End DoDot:1
- +18 ;
- +19 ;PART 2 IF = 99
- +20 IF $PIECE($GET(^ONCO(165.5,D0,"RAD18")),"^",11)=70
- Begin DoDot:1
- +21 SET $PIECE(^ONCO(165.5,D0,"RAD18"),"^",12)=11
- +22 SET $PIECE(^ONCO(165.5,D0,"RAD18"),"^",13)=18
- +23 SET $PIECE(^ONCO(165.5,D0,"RAD18"),"^",9)=14
- +24 SET $PIECE(^ONCO(165.5,D0,"RAD18"),"^",8)="99999"
- +25 SET $PIECE(^ONCO(165.5,D0,"RAD18"),"^",10)="999"
- +26 SET $PIECE(^ONCO(165.5,D0,"RAD18"),"^",14)="999999"
- +27 WRITE !,"PHASE 2 RADIATION TREATMENT VOLUME...: 99 UNKNOWN"
- +28 WRITE !,"PHASE 2 RAD TO DRAINING LYMPH NODE...: 99 UNKNOWN"
- +29 WRITE !,"PHASE 2 RADIATION TREATMENT MODALITY.: 99 UNKNOWN"
- +30 WRITE !,"PHASE 2 RAD EXTERNAL BEAM PLAN TECH..: 99 UNKNOWN"
- +31 WRITE !,"PHASE 2 DOSE PER FRACTION............: 99999"
- +32 WRITE !,"PHASE 2 NUMBER OF FRACTIONS..........: 999"
- +33 WRITE !,"PHASE 2 TOTAL DOSE...................: 999999"
- +34 SET $PIECE(^ONCO(165.5,D0,"RAD18"),"^",18)=70
- +35 ;If no PHASE II Rad then stuff/skip PHASE III fields
- DO RADSTF3
- End DoDot:1
- +36 QUIT
- RADSTF3 ;
- +1 IF $PIECE($GET(^ONCO(165.5,D0,"RAD18")),"^",18)=1
- Begin DoDot:1
- +2 SET $PIECE(^ONCO(165.5,D0,"RAD18"),"^",19)=1
- +3 SET $PIECE(^ONCO(165.5,D0,"RAD18"),"^",20)=1
- +4 SET $PIECE(^ONCO(165.5,D0,"RAD18"),"^",16)=1
- +5 SET $PIECE(^ONCO(165.5,D0,"RAD18"),"^",15)="00000"
- +6 SET $PIECE(^ONCO(165.5,D0,"RAD18"),"^",17)="000"
- +7 SET $PIECE(^ONCO(165.5,D0,"RAD18"),"^",21)="000000"
- +8 WRITE !,"PHASE 3 RADIATION TREATMENT VOLUME...: 00 NO RADIATION TREATMENT"
- +9 WRITE !,"PHASE 3 RAD TO DRAINING LYMPH NODE...: 00 NO RADIATION TREATMENT"
- +10 WRITE !,"PHASE 3 RADIATION TREATMENT MODALITY.: 00 NO RADIATION TREATMENT"
- +11 WRITE !,"PHASE 3 RAD EXTERNAL BEAM PLAN TECH..: 00 NO RADIATION TREATMENT"
- +12 WRITE !,"PHASE 3 DOSE PER FRACTION............: 00000"
- +13 WRITE !,"PHASE 3 NUMBER OF FRACTIONS..........: 000"
- +14 WRITE !,"PHASE 3 TOTAL DOSE...................: 000000"
- +15 ;If no PHASE III Rad then stuff and jump over
- SET Y=7024
- End DoDot:1
- +16 IF $PIECE($GET(^ONCO(165.5,D0,"RAD18")),"^",18)=70
- Begin DoDot:1
- +17 SET $PIECE(^ONCO(165.5,D0,"RAD18"),"^",19)=11
- +18 SET $PIECE(^ONCO(165.5,D0,"RAD18"),"^",20)=18
- +19 SET $PIECE(^ONCO(165.5,D0,"RAD18"),"^",16)=14
- +20 SET $PIECE(^ONCO(165.5,D0,"RAD18"),"^",15)="99999"
- +21 SET $PIECE(^ONCO(165.5,D0,"RAD18"),"^",17)="999"
- +22 SET $PIECE(^ONCO(165.5,D0,"RAD18"),"^",21)="999999"
- +23 WRITE !,"PHASE 3 RADIATION TREATMENT VOLUME...: 99 UNKNOWN"
- +24 WRITE !,"PHASE 3 RAD TO DRAINING LYMPH NODE...: 99 UNKNOWN"
- +25 WRITE !,"PHASE 3 RADIATION TREATMENT MODALITY.: 99 UNKNOWN"
- +26 WRITE !,"PHASE 3 RAD EXTERNAL BEAM PLAN TECH..: 99 UNKNOWN"
- +27 WRITE !,"PHASE 3 DOSE PER FRACTION............: 99999"
- +28 WRITE !,"PHASE 3 NUMBER OF FRACTIONS..........: 999"
- +29 WRITE !,"PHASE 3 TOTAL DOSE...................: 999999"
- +30 ;If no PHASE III Rad then stuff and jump over
- SET Y=7024
- End DoDot:1
- +31 QUIT