ONCATF2 ;HINES OIFO/RTK - New Surgery field defaults/stuffing ;08/27/24
;;2.2;ONCOLOGY;**20**;Jul 31, 2013;Build 5
;
SURG23 ; RX SUMM--SURG PRIM SITE 2023
N TOPSRCDZ
S TOPX=$P($G(^ONCO(165.5,DA,2)),U,1),TOPSRCDZ=$P($G(^ONCO(164,TOPX,0)),U,16)
S SURGSM23=$P($G(^ONCO(165.5,DA,3.2)),U,9)
I (SURGSM23="A000")!(SURGSM23="B000") D
.S TXDT=$P($G(^ONCO(165.5,DA,3)),U,1)_"S1"
.K ^ONCO(165.5,"ATX",DA,TXDT)
.S $P(^ONCO(165.5,DA,3),U,1)="0000000" ;field #50
.S ^ONCO(165.5,"ATX",DA,"0000000S1")="" ;"ATX" x-ref
.S $P(^ONCO(165.5,DA,3),U,28)=8 ;field #59
.S $P(^ONCO(165.5,DA,"THY1"),U,36)="0000000" ;field #435
.S $P(^ONCO(165.5,DA,3.1),U,28)=0 ;field #14
.S $P(^ONCO(165.5,DA,7),U,19)=9 ;field #46
.S $P(^ONCO(165.5,DA,7),U,20)="" ;field #47
.S $P(^ONCO(165.5,DA,3.2),U,8)=SURGSM23 ;field #58.8 = #58.9
.W !!,"MOST DEFINITIVE SURG DATE......: 00/00/0000"
.W !,"DATE MOST DEFINITIVE SURG DIS..: 00/00/0000"
.W !,"READMISSION W/I 30 DAYS SURG...: No surgery/not readmitted"
.W !,"SURGICAL MARGINS...............: No primary site surgery"
.W !,"CAP PROTOCOL REVIEW............: NA or exempt"
.I $P($G(^ONCO(165.5,DA,2)),"^",1)'=67209 S Y="@42"
.I $P($G(^ONCO(165.5,D0,2)),"^",1)=67209 W ! S Y=3950
.Q
I (SURGSM23="A990")!(SURGSM23="B990") D
.S TXDT=$P($G(^ONCO(165.5,DA,3)),U,1)_"S1"
.K ^ONCO(165.5,"ATX",DA,TXDT)
.S $P(^ONCO(165.5,DA,3),U,1)="9999999" ;field #50
.S ^ONCO(165.5,"ATX",DA,"9999999S1")="" ;"ATX" x-ref
.S $P(^ONCO(165.5,DA,3),U,28)=9 ;field #59
.S $P(^ONCO(165.5,DA,"THY1"),U,36)="9999999" ;field #435
.S $P(^ONCO(165.5,DA,3.1),U,28)=9 ;field #14
.S $P(^ONCO(165.5,DA,7),U,19)=9 ;field #46
.S $P(^ONCO(165.5,DA,7),U,20)="" ;field #47
.S $P(^ONCO(165.5,DA,3.2),U,8)=SURGSM23 ;field #58.8 = #58.9
.W !!,"MOST DEFINITIVE SURG DATE......: 99/99/9999"
.W !,"DATE MOST DEFINITIVE SURG DIS..: 99/99/9999"
.W !,"READMISSION W/I 30 DAYS SURG...: Unknown if surgery or readmission"
.W !,"SURGICAL MARGINS...............: Unknown or NA"
.W !,"CAP PROTOCOL REVIEW............: NA or exempt"
.I $P($G(^ONCO(165.5,DA,2)),"^",1)'=67209 S Y="@42"
.I $P($G(^ONCO(165.5,D0,2)),"^",1)=67209 W ! S Y=3950
.Q
Q
;
SURGHO23 ; RX HOSP--SURG PRIM SITE 2023
N TOPSRCDZ
S TOPX=$P($G(^ONCO(165.5,DA,2)),U,1),TOPSRCDZ=$P($G(^ONCO(164,TOPX,0)),U,16)
S SURGHO23=$P($G(^ONCO(165.5,DA,3.2)),U,8)
I (SURGHO23="A000")!(SURGHO23="B000") D
.S $P(^ONCO(165.5,DA,3.1),U,8)="0000000"
.S $P(^ONCO(165.5,DA,2.3),U,4)=0
.W !!,"RX HOSP--SURG APP 2010.........: No surgery/Dx at autopsy"
.W !,"MOST DEFINITIVE SURG @FAC DATE.: 00/00/0000"
.S Y="@43"
I (SURGHO23="A990")!(SURGHO23="B990") D
.S $P(^ONCO(165.5,DA,3.1),U,8)=9999999
.S $P(^ONCO(165.5,DA,2.3),U,4)=9
.W !!,"RX HOSP--SURG APP 2010.........: Not stated/Death cert only"
.W !,"MOST DEFINITIVE SURG @FAC DATE.: 99/99/9999"
.S Y="@43"
.Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCATF2 3029 printed Nov 22, 2024@17:32:09 Page 2
ONCATF2 ;HINES OIFO/RTK - New Surgery field defaults/stuffing ;08/27/24
+1 ;;2.2;ONCOLOGY;**20**;Jul 31, 2013;Build 5
+2 ;
SURG23 ; RX SUMM--SURG PRIM SITE 2023
+1 NEW TOPSRCDZ
+2 SET TOPX=$PIECE($GET(^ONCO(165.5,DA,2)),U,1)
SET TOPSRCDZ=$PIECE($GET(^ONCO(164,TOPX,0)),U,16)
+3 SET SURGSM23=$PIECE($GET(^ONCO(165.5,DA,3.2)),U,9)
+4 IF (SURGSM23="A000")!(SURGSM23="B000")
Begin DoDot:1
+5 SET TXDT=$PIECE($GET(^ONCO(165.5,DA,3)),U,1)_"S1"
+6 KILL ^ONCO(165.5,"ATX",DA,TXDT)
+7 ;field #50
SET $PIECE(^ONCO(165.5,DA,3),U,1)="0000000"
+8 ;"ATX" x-ref
SET ^ONCO(165.5,"ATX",DA,"0000000S1")=""
+9 ;field #59
SET $PIECE(^ONCO(165.5,DA,3),U,28)=8
+10 ;field #435
SET $PIECE(^ONCO(165.5,DA,"THY1"),U,36)="0000000"
+11 ;field #14
SET $PIECE(^ONCO(165.5,DA,3.1),U,28)=0
+12 ;field #46
SET $PIECE(^ONCO(165.5,DA,7),U,19)=9
+13 ;field #47
SET $PIECE(^ONCO(165.5,DA,7),U,20)=""
+14 ;field #58.8 = #58.9
SET $PIECE(^ONCO(165.5,DA,3.2),U,8)=SURGSM23
+15 WRITE !!,"MOST DEFINITIVE SURG DATE......: 00/00/0000"
+16 WRITE !,"DATE MOST DEFINITIVE SURG DIS..: 00/00/0000"
+17 WRITE !,"READMISSION W/I 30 DAYS SURG...: No surgery/not readmitted"
+18 WRITE !,"SURGICAL MARGINS...............: No primary site surgery"
+19 WRITE !,"CAP PROTOCOL REVIEW............: NA or exempt"
+20 IF $PIECE($GET(^ONCO(165.5,DA,2)),"^",1)'=67209
SET Y="@42"
+21 IF $PIECE($GET(^ONCO(165.5,D0,2)),"^",1)=67209
WRITE !
SET Y=3950
+22 QUIT
End DoDot:1
+23 IF (SURGSM23="A990")!(SURGSM23="B990")
Begin DoDot:1
+24 SET TXDT=$PIECE($GET(^ONCO(165.5,DA,3)),U,1)_"S1"
+25 KILL ^ONCO(165.5,"ATX",DA,TXDT)
+26 ;field #50
SET $PIECE(^ONCO(165.5,DA,3),U,1)="9999999"
+27 ;"ATX" x-ref
SET ^ONCO(165.5,"ATX",DA,"9999999S1")=""
+28 ;field #59
SET $PIECE(^ONCO(165.5,DA,3),U,28)=9
+29 ;field #435
SET $PIECE(^ONCO(165.5,DA,"THY1"),U,36)="9999999"
+30 ;field #14
SET $PIECE(^ONCO(165.5,DA,3.1),U,28)=9
+31 ;field #46
SET $PIECE(^ONCO(165.5,DA,7),U,19)=9
+32 ;field #47
SET $PIECE(^ONCO(165.5,DA,7),U,20)=""
+33 ;field #58.8 = #58.9
SET $PIECE(^ONCO(165.5,DA,3.2),U,8)=SURGSM23
+34 WRITE !!,"MOST DEFINITIVE SURG DATE......: 99/99/9999"
+35 WRITE !,"DATE MOST DEFINITIVE SURG DIS..: 99/99/9999"
+36 WRITE !,"READMISSION W/I 30 DAYS SURG...: Unknown if surgery or readmission"
+37 WRITE !,"SURGICAL MARGINS...............: Unknown or NA"
+38 WRITE !,"CAP PROTOCOL REVIEW............: NA or exempt"
+39 IF $PIECE($GET(^ONCO(165.5,DA,2)),"^",1)'=67209
SET Y="@42"
+40 IF $PIECE($GET(^ONCO(165.5,D0,2)),"^",1)=67209
WRITE !
SET Y=3950
+41 QUIT
End DoDot:1
+42 QUIT
+43 ;
SURGHO23 ; RX HOSP--SURG PRIM SITE 2023
+1 NEW TOPSRCDZ
+2 SET TOPX=$PIECE($GET(^ONCO(165.5,DA,2)),U,1)
SET TOPSRCDZ=$PIECE($GET(^ONCO(164,TOPX,0)),U,16)
+3 SET SURGHO23=$PIECE($GET(^ONCO(165.5,DA,3.2)),U,8)
+4 IF (SURGHO23="A000")!(SURGHO23="B000")
Begin DoDot:1
+5 SET $PIECE(^ONCO(165.5,DA,3.1),U,8)="0000000"
+6 SET $PIECE(^ONCO(165.5,DA,2.3),U,4)=0
+7 WRITE !!,"RX HOSP--SURG APP 2010.........: No surgery/Dx at autopsy"
+8 WRITE !,"MOST DEFINITIVE SURG @FAC DATE.: 00/00/0000"
+9 SET Y="@43"
End DoDot:1
+10 IF (SURGHO23="A990")!(SURGHO23="B990")
Begin DoDot:1
+11 SET $PIECE(^ONCO(165.5,DA,3.1),U,8)=9999999
+12 SET $PIECE(^ONCO(165.5,DA,2.3),U,4)=9
+13 WRITE !!,"RX HOSP--SURG APP 2010.........: Not stated/Death cert only"
+14 WRITE !,"MOST DEFINITIVE SURG @FAC DATE.: 99/99/9999"
+15 SET Y="@43"
+16 QUIT
End DoDot:1
+17 QUIT
