ONCODSR ;HINES OIFO/GWB - Surgery of Primary Site ;06/23/10
;;2.2;ONCOLOGY;**1,5,10,12,15**;Jul 31, 2013;Build 5
;
;^ONCO(164.2,9,"S",1-10) hold SURGICAL DX/STAGING PROC codes 0-9
;^ONCO(164.2,SITE/GP,"S",11-100) holds surgery coes 10-99
;
CDSIT ;SURGERY OF PRIMARY SITE (165.5,58.2) INPUT TRANSFORM
N T,TOPGRPHY,SS
K:$L(X)>2!(X'?1.N) X G EX:'$D(X)
I X="00" D EN^DDIOL(" 00 No surgical procedure") G EX
S TOPGRPHY=$$TOPGRPHY(D0) G ER:TOPGRPHY=""
S SS=+$P($G(^ONCO(164,TOPGRPHY,"SR")),U,$$EDITION^ONCOU55(D0))
I '$D(^ONCO(164.5,SS,1,X+1,0)) K X G EX
I ($P(^ONCO(165.5,D0,0),U,16)>2951231),$E(X,2)=8 K X G EX
D EN^DDIOL(" "_^ONCO(164.5,SS,1,X+1,0)) G EX
;
NCDSIT ;SURGICAL DX/STAGING PROC (165.5,58.1) INPUT TRANSFORM
I '$D(^ONCO(160.14,"B",X)) K X G EX
I $L(X)'=2 K X G EX
S NCDSIEN=$O(^ONCO(160.14,"B",X,0))
D EN^DDIOL(" "_$P(^ONCO(160.14,NCDSIEN,0),U,2))
K NCDSIEN Q
;
NCDSOT ;SURGICAL DX/STAGING PROC (165.5,58.1 & 58.4) OUTPUT TRANSFORM
Q:Y=""
N NCDSIEN
S NCDSIEN=$O(^ONCO(160.14,"B",Y,0))
I NCDSIEN'="" S Y=Y_" "_$P(^ONCO(160.14,NCDSIEN,0),U,2)
Q
;
HP0 ;SURGICAL DX/STAGING PROC (165.5,58.1) HELP
F XX="00","01","02","03","04","05","06","07","09" S NCDSIEN=$O(^ONCO(160.14,"B",XX,0)) D EN^DDIOL($P(^ONCO(160.14,NCDSIEN,0),U,1)_" "_$P(^ONCO(160.14,NCDSIEN,0),U,2),,"!?2")
K NCDSIEN G EX
;
CDSOT ;SURGERY OF PRIMARY SITE (165.5,58.2) OUTPUT TRANSFORM
I Y="00" S Y="00 No surgical procedure" G EX
N TOPGRPHY,SS
S TOPGRPHY=$$TOPGRPHY(D0) G EX:TOPGRPHY=""
S SS=+$P($G(^ONCO(164,TOPGRPHY,"SR")),U,$$EDITION^ONCOU55(D0))
S Y=Y_" "_$G(^ONCO(164.5,SS,1,Y+1,0)) G EX
;
HP1 ;SURGERY OF PRIMARY SITE (165.5,58.2) HELP
N TOPGRPHY,TPGRPHYR,SS,XX,XXX
S TOPGRPHY=$$TOPGRPHY(D0) G:TOPGRPHY="" ER
S TPGRPHYR=^ONCO(164,TOPGRPHY,0)
S SS=$P($G(^ONCO(164,TOPGRPHY,"SR")),U,$$EDITION^ONCOU55(D0))
D EN^DDIOL("SURGERY OF PRIMARY SITE Codes for site "_$P(TPGRPHYR,U,2)_" "_$P(TPGRPHYR,U),,"!?5")
D EN^DDIOL("("_$P(^ONCO(164.5,SS,0),U)_")",,"!?5")
D EN^DDIOL("00 No surgical procedure",,"!!?1")
D EN^DDIOL(,,"!")
S XX=10 F S XX=$O(^ONCO(164.5,SS,1,XX)) Q:XX'=+XX D
.S XXX=XX-1
.I ($P(^ONCO(165.5,D0,0),U,16)<2960000)!($E(XXX,2)'=8) D EN^DDIOL(" "_(XX-1)_" "_^ONCO(164.5,SS,1,XX,0))
G EX
;
ER ;ERROR
D EN^DDIOL("ICDO CODE NOT defined!! - cannot continue",,"!!?10")
G EX
;
EX ;EXIT
K AN,SS,ONCOSR
D EN^DDIOL(,,"!")
Q
;
TOPGRPHY(PRIMIX) ; returns ICDO-2 topography code for primary site PRIMIX
Q $P($G(^ONCO(165.5,PRIMIX,2)),U)
;
ESSPIT ;INPUT TRANSFORM FOR EXTRANODAL SITE SURGICAL PROCEDURE #856
N T,TOPGRPHY,SS
K:$L(X)>2!(X'?1.N) X G EX:'$D(X)
I X="00" D EN^DDIOL(" No additional surgical procedure") G EX
S TOPGRPHY=$P($G(^ONCO(165.5,D0,"NHL2")),U,10) G ER:TOPGRPHY=""
I TOPGRPHY="C888"!(TOPGRPHY="C999") K X G EX
S TOPGRPHY="67"_$E(TOPGRPHY,2,4)
S SS=+$P($G(^ONCO(164,TOPGRPHY,"SR")),U,$$EDITION^ONCOU55(D0))
I '$D(^ONCO(164.5,SS,1,X+1,0)) K X G EX
I ($P(^ONCO(165.5,D0,0),U,16)>2951231),$E(X,2)=8 K X G EX
D EN^DDIOL(^ONCO(164.5,SS,1,X+1,0),,"!?2") G EX
;
ESSPOT ;OUTPUT TRANSFORM FOR EXTRANODAL SITE SURGICAL PROCEDURE #856
I Y="00" S Y=Y_" No additional surgical procedure" G EX
N TOPGRPHY,SS
S TOPGRPHY=$P($G(^ONCO(165.5,D0,"NHL2")),U,10) G EX:TOPGRPHY=""
I TOPGRPHY="C888"!(TOPGRPHY="C999") G EX
S TOPGRPHY="67"_$E(TOPGRPHY,2,4)
S SS=+$P($G(^ONCO(164,TOPGRPHY,"SR")),U,$$EDITION^ONCOU55(D0))
S Y=Y_" "_$G(^ONCO(164.5,SS,1,Y+1,0)) G EX
;
ESSHP ;EXECUTABLE HELP FOR EXTRANODAL SITE SURGICAL PROCEDURE #856
N TOPGRPHY,TPGRPHYR,SS,XX
S TOPGRPHY=$P($G(^ONCO(165.5,D0,"NHL2")),U,10) G ER:TOPGRPHY=""
I TOPGRPHY="C888"!(TOPGRPHY="C999") D EN^DDIOL("No extranodal site or unknown extranodal site!!",,"!!?5") D EN^DDIOL("00 No additional surgical procedure",,"!?5") G EX
S TOPGRPHY="67"_$E(TOPGRPHY,2,4)
S TPGRPHYR=^ONCO(164,TOPGRPHY,0)
S SS=$P($G(^ONCO(164,TOPGRPHY,"SR")),U,$$EDITION^ONCOU55(D0))
D EN^DDIOL("SURGERY OF PRIMARY SITE Codes for site ",$P(TPGRPHYR,U,2)_" "_$P(TPGRPHYR,U),,"!!")
D EN^DDIOL("("_$P(^ONCO(164.5,SS,0),U)_")",,"!")
D EN^DDIOL("00 No additional surgical procedure",,"!!?1")
D EN^DDIOL(,,"!")
S XX=10 F S XX=$O(^ONCO(164.5,SS,1,XX)) Q:XX'=+XX D
.S XXX=XX-1
.I ($P(^ONCO(165.5,D0,0),U,16)<2960000)!($E(XXX,2)'=8) D EN^DDIOL(" "_(XX-1)_" "_^ONCO(164.5,SS,1,XX,0)) D EN^DDIOL(,,"!")
D EN^DDIOL("Enter a code from the above list.",,"!") G EX
Q
;
FADIT ;DATE OF FIRST CONTACT (165.5,155) Input Transform
D NINES Q:'$D(X) Q:X=9999999
I $D(X) S %DT="EP",%DT(0)="-NOW" D ^%DT S X=Y K:Y<1 X K %DT
Q
;
DSDTIT ;DATE OF INPATIENT DISCHARGE (165.5,1.1) Input Transform
;Must be >= DATE OF INPATIENT ADMISSION (165.5,1)
N FAD
D ZS9S Q:'$D(X) Q:(X="0000000")!(X=9999999)
I $D(X) S %DT="EP",%DT(0)="-NOW" D ^%DT S X=Y K:Y<1 X I $D(X) S FAD=$P($G(^ONCO(165.5,D0,0)),U,8) I FAD'="" K:X<FAD X K %DT
Q
;
DFSPIT ;DATE FIRST SURGICAL PROCEDURE (165.5,170) Input Transform
D ZS9S Q:'$D(X) Q:(X="0000000")!(X=9999999)
I $D(X) S %DT="EP",%DT(0)="-NOW" D ^%DT S X=Y K:Y<1 X K %DT
I $D(X) S SDT=$P($G(^ONCO(165.5,D0,3)),U,1) I SDT'="",SDT'="0000000",SDT'="9999999" I X>SDT K X D EN^DDIOL("DATE FIRST SURGICAL PROCEDURE later than MOST DEFINITIVE SURG DATE",,"!!?3") K %DT,SDT Q
I $D(X) S SDT=$P($G(^ONCO(165.5,D0,3.1)),U,8) I SDT'="",SDT'="0000000",SDT'="9999999" I X>SDT K X D EN^DDIOL("DATE FIRST SURGICAL PROCEDURE later than MOST DEFINITIVE SURG @FAC DATE",,"!!") K %DT,SDT Q
I $D(X) S SDT=$P($G(^ONCO(165.5,D0,3.1)),U,22) I SDT'="",SDT'="0000000",SDT'="9999999" I X>SDT K X D EN^DDIOL("DATE FIRST SURGICAL PROCEDURE later than SCOPE OF LN SURGERY DATE",,"!!") K %DT,SDT Q
I $D(X) S SDT=$P($G(^ONCO(165.5,D0,3.1)),U,23) I SDT'="",SDT'="0000000",SDT'="9999999" I X>SDT K X D EN^DDIOL("DATE FIRST SURGICAL PROCEDURE later than SCOPE OF LN SURGERY @FAC DATE",,"!!") K %DT,SDT Q
I $D(X) S SDT=$P($G(^ONCO(165.5,D0,3.1)),U,24) I SDT'="",SDT'="0000000",SDT'="9999999" I X>SDT K X D EN^DDIOL("DATE FIRST SURGICAL PROCEDURE later than SURG PROC/OTHER SITE DATE",,"!!")
I $D(X) S SDT=$P($G(^ONCO(165.5,D0,3.1)),U,25) I SDT'="",SDT'="0000000",SDT'="9999999" I X>SDT K X D EN^DDIOL("DATE FIRST SURGICAL PROCEDURE later than SURG PROC/OTHER SITE @FAC DATE",,"!!")
K %DT,SDT
Q
;
DFIT ;INPUT TRANSFORM for date fields
;No future dates and date must be > or = DATE DX (165.5,3)
N DFSP,DTDXE,DTDXI,FAIL,ZS9S
I $G(DIFLD)=124 S NTDD=""
D ZS9S Q:ZS9S=1
S %DT="EP"
I $G(DIFLD)=90 S %DT="ESTX" ;added in p5
S %DT(0)="-NOW" D ^%DT
S X=Y I Y<1 K X D EN^DDIOL("Future dates are not allowed.",,"!!?5") K %DT Q
S X=X
I $G(DIFLD)=255 Q
I $G(DIFLD)=256 Q
S DTDXI=$$GET1^DIQ(165.5,D0,3,"I")
I (DTDXI=8888888)!(DTDXI=9999999) Q
S DTDXE=$$GET1^DIQ(165.5,D0,3,"E")
S FAIL=""
I X<DTDXI S FAIL=FAIL_"X"
I FAIL'="" D Q
.K X
.D EN^DDIOL("The date entered must be later than or equal to the",,"!!?5")
.I FAIL["X" D EN^DDIOL("DATE DX which is "_DTDXE_($S(FAIL["A":" and the",1:".")),,"!?5")
.D EN^DDIOL(,,"!")
S DFSP=$P($G(^ONCO(165.5,D0,3.1)),U,38)
I $D(X),$G(DIFLD)=50 D D EN^DDIOL(,,"!") Q
.I DFSP'="",DFSP'="0000000",DFSP'="9999999" I X<DFSP K X D EN^DDIOL("MOST DEFINITIVE SURG DATE earlier than DATE FIRST SURGICAL PROCEDURE",,"!!?3")
I $D(X),$G(DIFLD)=50.3 D Q
.I DFSP'="",DFSP'="0000000",DFSP'="9999999" I X<DFSP K X D EN^DDIOL("MOST DEFINITIVE SURG @FAC DATE earlier than DATE FIRST SURGICAL PROCEDURE",,"!!?3")
I $D(X),$G(DIFLD)=138.2 D Q
.I DFSP'="",DFSP'="0000000",DFSP'="9999999" I X<DFSP K X D EN^DDIOL("SCOPE OF LN SURGERY DATE earlier than DATE FIRST SURGICAL PROCEDURE",,"!!?3")
I $D(X),$G(DIFLD)=138.3 D Q
.I DFSP'="",DFSP'="0000000",DFSP'="9999999" I X<DFSP K X D EN^DDIOL("SCOPE OF LN SURGERY @FAC DATE earlier than DATE FIRST SURGICAL PROCEDURE",,"!!?3")
I $D(X),$G(DIFLD)=139.2 D Q
.I DFSP'="",DFSP'="0000000",DFSP'="9999999" I X<DFSP K X D EN^DDIOL("SURG PROC/OTHER SITE DATE earlier than DATE FIRST SURGICAL PROCEDURE",,"!!?3")
I $D(X),$G(DIFLD)=139.3 D Q
.I DFSP'="",DFSP'="0000000",DFSP'="9999999" I X<DFSP K X D EN^DDIOL("SURG PROC/OTHER SITE @FAC DATE earlier than DATE FIRST SURGICAL PROCEDURE",,"!!?3")
Q
;
NTIT ;DATE OF NO TREATMENT (165.5,124) INPUT TRANSFORM
;(NO FUTURE DATES AND >= DATE DX)
N DTDX
S NTDD=""
I (X="00/00/00")!(X="00/00/0000")!(X="00000000") K X Q
I (X="99/99/99")!(X="99/99/9999")!(X="99999999") K X Q
S %DT="EP",%DT(0)="-NOW" D ^%DT S X=Y I Y<1 K X D EN^DDIOL("Future dates are not allowed.",,"!!?5") K %DT Q
S DTDX=$P($G(^ONCO(165.5,D0,0)),U,16)
I DTDX=8888888!9999999 Q
I DTDX'="" I X<DTDX K X D EN^DDIOL("This date must be later than or equal to the DATE DX of "_$E(DTDX,4,5)_"/"_$E(DTDX,6,7)_"/"_($E(DTDX,1,3)+1700)_".",,"!!?5") K DTDX Q
Q
;
NT ;DATE OF NO TREATMENT (Input transform for treatment fields)
S NTDD=$P($G(^ONCO(165.5,D0,2.1)),U,11)
I $G(ONC138P2)="YES",$P($G(^ONCO(165.5,D0,0)),"^",16)>3201231 K ONC138P2,NTDD,V Q
I (NTDD'="")&(X'=V) K X D EN^DDIOL("This primary has a DATE OF NO TREATMENT of "_$E(NTDD,4,5)_"/"_$E(NTDD,6,7)_"/"_($E(NTDD,1,3)+1700)_".",,"!!?5") D EN^DDIOL("Treatments are not allowed unless the DATE OF NO TREATMENT is deleted.",,"!!?5")
K NTDD,ONC138P2,V Q
;
CHKTS ;Check TREATMENT STATUS (165.5,235)
N TS,TSI
S TS=$$GET1^DIQ(165.5,D0,235)
S TSI=$$GET1^DIQ(165.5,D0,235,"I")
I (TSI=0)!(TSI=2) D
.D EN^DDIOL("TREATMENT STATUS = "_TS,,"!!?5")
.D EN^DDIOL("DATE OF NO TREATMENT cannot be blank.",,"!!?5")
.D EN^DDIOL(,,"!")
.S Y=124
E S Y="@41"
Q
;
DBTS ;DATE BRACHYTHERAPY STARTED INPUT TRANSFORM (NOT FUTURE, DX<=DBS<=DBE)
N DBE
S %DT="EP",%DT(0)="-NOW" D ^%DT S X=Y K:Y<1 X Q:'$D(X)
S DBE=$P($G(^ONCO(165.5,D0,"STS2")),U,13),DTDX=$P($G(^ONCO(165.5,D0,0)),U,16)
I DBE'="" K:X>DBE X Q:'$D(X)
I DTDX'="" K:X<DTDX X K %DT
Q
;
DBTE ;DATE BRACHYTHERAPY ENDED INPUT TRANSFORM (NOT FUTURE, DBS<=DBE)
N DBS
S %DT="EP",%DT(0)="-NOW" D ^%DT S X=Y K:Y<1 X I $D(X) S DBS=$P($G(^ONCO(165.5,D0,"STS2")),U,12) I DBS'="" K:X<DBS X K %DT
Q
;
ZS9S ;00/00/0000, 88/88/8888 and 99/99/9999 INPUT TRANSFORMS
S ZS9S=1
I X="00/00/00" D EN^DDIOL("00/00/00 is ambiguous. Enter a 4 digit year. ",,"!?5") K X Q
I X="00/00/0000" S X="0000000" Q
I X="00000000" S X="0000000" Q
;
NINES ;99/99/9999 INPUT TRANSFORM
I X="99/99/99" D EN^DDIOL("99/99/99 is ambiguous. Enter a 4 digit year. ",,"!?5") K X Q
I X="99/99/9999" S X=9999999 Q
I X="99999999" S X=9999999 Q
;
EIGHTS ;88/88/8888 INPUT TRANSFORM
I ($G(DIFLD)=193)!($G(DIFLD)=195) D K FLD Q:'$D(X) Q:X=8888888
.I X="88/88/88" D EN^DDIOL("88/88/88 is ambiguous. Enter a 4 digit year. ",,"!?5") K X Q
.I X="88/88/8888" S X=8888888
.I X="88888888" S X=8888888
S ZS9S=0
Q
;
CLEANUP ;Cleanup
K D0,DIFLD,Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCODSR 10814 printed Dec 13, 2024@02:24:52 Page 2
ONCODSR ;HINES OIFO/GWB - Surgery of Primary Site ;06/23/10
+1 ;;2.2;ONCOLOGY;**1,5,10,12,15**;Jul 31, 2013;Build 5
+2 ;
+3 ;^ONCO(164.2,9,"S",1-10) hold SURGICAL DX/STAGING PROC codes 0-9
+4 ;^ONCO(164.2,SITE/GP,"S",11-100) holds surgery coes 10-99
+5 ;
CDSIT ;SURGERY OF PRIMARY SITE (165.5,58.2) INPUT TRANSFORM
+1 NEW T,TOPGRPHY,SS
+2 if $LENGTH(X)>2!(X'?1.N)
KILL X
if '$DATA(X)
GOTO EX
+3 IF X="00"
DO EN^DDIOL(" 00 No surgical procedure")
GOTO EX
+4 SET TOPGRPHY=$$TOPGRPHY(D0)
if TOPGRPHY=""
GOTO ER
+5 SET SS=+$PIECE($GET(^ONCO(164,TOPGRPHY,"SR")),U,$$EDITION^ONCOU55(D0))
+6 IF '$DATA(^ONCO(164.5,SS,1,X+1,0))
KILL X
GOTO EX
+7 IF ($PIECE(^ONCO(165.5,D0,0),U,16)>2951231)
IF $EXTRACT(X,2)=8
KILL X
GOTO EX
+8 DO EN^DDIOL(" "_^ONCO(164.5,SS,1,X+1,0))
GOTO EX
+9 ;
NCDSIT ;SURGICAL DX/STAGING PROC (165.5,58.1) INPUT TRANSFORM
+1 IF '$DATA(^ONCO(160.14,"B",X))
KILL X
GOTO EX
+2 IF $LENGTH(X)'=2
KILL X
GOTO EX
+3 SET NCDSIEN=$ORDER(^ONCO(160.14,"B",X,0))
+4 DO EN^DDIOL(" "_$PIECE(^ONCO(160.14,NCDSIEN,0),U,2))
+5 KILL NCDSIEN
QUIT
+6 ;
NCDSOT ;SURGICAL DX/STAGING PROC (165.5,58.1 & 58.4) OUTPUT TRANSFORM
+1 if Y=""
QUIT
+2 NEW NCDSIEN
+3 SET NCDSIEN=$ORDER(^ONCO(160.14,"B",Y,0))
+4 IF NCDSIEN'=""
SET Y=Y_" "_$PIECE(^ONCO(160.14,NCDSIEN,0),U,2)
+5 QUIT
+6 ;
HP0 ;SURGICAL DX/STAGING PROC (165.5,58.1) HELP
+1 FOR XX="00","01","02","03","04","05","06","07","09"
SET NCDSIEN=$ORDER(^ONCO(160.14,"B",XX,0))
DO EN^DDIOL($PIECE(^ONCO(160.14,NCDSIEN,0),U,1)_" "_$PIECE(^ONCO(160.14,NCDSIEN,0),U,2),,"!?2")
+2 KILL NCDSIEN
GOTO EX
+3 ;
CDSOT ;SURGERY OF PRIMARY SITE (165.5,58.2) OUTPUT TRANSFORM
+1 IF Y="00"
SET Y="00 No surgical procedure"
GOTO EX
+2 NEW TOPGRPHY,SS
+3 SET TOPGRPHY=$$TOPGRPHY(D0)
if TOPGRPHY=""
GOTO EX
+4 SET SS=+$PIECE($GET(^ONCO(164,TOPGRPHY,"SR")),U,$$EDITION^ONCOU55(D0))
+5 SET Y=Y_" "_$GET(^ONCO(164.5,SS,1,Y+1,0))
GOTO EX
+6 ;
HP1 ;SURGERY OF PRIMARY SITE (165.5,58.2) HELP
+1 NEW TOPGRPHY,TPGRPHYR,SS,XX,XXX
+2 SET TOPGRPHY=$$TOPGRPHY(D0)
if TOPGRPHY=""
GOTO ER
+3 SET TPGRPHYR=^ONCO(164,TOPGRPHY,0)
+4 SET SS=$PIECE($GET(^ONCO(164,TOPGRPHY,"SR")),U,$$EDITION^ONCOU55(D0))
+5 DO EN^DDIOL("SURGERY OF PRIMARY SITE Codes for site "_$PIECE(TPGRPHYR,U,2)_" "_$PIECE(TPGRPHYR,U),,"!?5")
+6 DO EN^DDIOL("("_$PIECE(^ONCO(164.5,SS,0),U)_")",,"!?5")
+7 DO EN^DDIOL("00 No surgical procedure",,"!!?1")
+8 DO EN^DDIOL(,,"!")
+9 SET XX=10
FOR
SET XX=$ORDER(^ONCO(164.5,SS,1,XX))
if XX'=+XX
QUIT
Begin DoDot:1
+10 SET XXX=XX-1
+11 IF ($PIECE(^ONCO(165.5,D0,0),U,16)<2960000)!($EXTRACT(XXX,2)'=8)
DO EN^DDIOL(" "_(XX-1)_" "_^ONCO(164.5,SS,1,XX,0))
End DoDot:1
+12 GOTO EX
+13 ;
ER ;ERROR
+1 DO EN^DDIOL("ICDO CODE NOT defined!! - cannot continue",,"!!?10")
+2 GOTO EX
+3 ;
EX ;EXIT
+1 KILL AN,SS,ONCOSR
+2 DO EN^DDIOL(,,"!")
+3 QUIT
+4 ;
TOPGRPHY(PRIMIX) ; returns ICDO-2 topography code for primary site PRIMIX
+1 QUIT $PIECE($GET(^ONCO(165.5,PRIMIX,2)),U)
+2 ;
ESSPIT ;INPUT TRANSFORM FOR EXTRANODAL SITE SURGICAL PROCEDURE #856
+1 NEW T,TOPGRPHY,SS
+2 if $LENGTH(X)>2!(X'?1.N)
KILL X
if '$DATA(X)
GOTO EX
+3 IF X="00"
DO EN^DDIOL(" No additional surgical procedure")
GOTO EX
+4 SET TOPGRPHY=$PIECE($GET(^ONCO(165.5,D0,"NHL2")),U,10)
if TOPGRPHY=""
GOTO ER
+5 IF TOPGRPHY="C888"!(TOPGRPHY="C999")
KILL X
GOTO EX
+6 SET TOPGRPHY="67"_$EXTRACT(TOPGRPHY,2,4)
+7 SET SS=+$PIECE($GET(^ONCO(164,TOPGRPHY,"SR")),U,$$EDITION^ONCOU55(D0))
+8 IF '$DATA(^ONCO(164.5,SS,1,X+1,0))
KILL X
GOTO EX
+9 IF ($PIECE(^ONCO(165.5,D0,0),U,16)>2951231)
IF $EXTRACT(X,2)=8
KILL X
GOTO EX
+10 DO EN^DDIOL(^ONCO(164.5,SS,1,X+1,0),,"!?2")
GOTO EX
+11 ;
ESSPOT ;OUTPUT TRANSFORM FOR EXTRANODAL SITE SURGICAL PROCEDURE #856
+1 IF Y="00"
SET Y=Y_" No additional surgical procedure"
GOTO EX
+2 NEW TOPGRPHY,SS
+3 SET TOPGRPHY=$PIECE($GET(^ONCO(165.5,D0,"NHL2")),U,10)
if TOPGRPHY=""
GOTO EX
+4 IF TOPGRPHY="C888"!(TOPGRPHY="C999")
GOTO EX
+5 SET TOPGRPHY="67"_$EXTRACT(TOPGRPHY,2,4)
+6 SET SS=+$PIECE($GET(^ONCO(164,TOPGRPHY,"SR")),U,$$EDITION^ONCOU55(D0))
+7 SET Y=Y_" "_$GET(^ONCO(164.5,SS,1,Y+1,0))
GOTO EX
+8 ;
ESSHP ;EXECUTABLE HELP FOR EXTRANODAL SITE SURGICAL PROCEDURE #856
+1 NEW TOPGRPHY,TPGRPHYR,SS,XX
+2 SET TOPGRPHY=$PIECE($GET(^ONCO(165.5,D0,"NHL2")),U,10)
if TOPGRPHY=""
GOTO ER
+3 IF TOPGRPHY="C888"!(TOPGRPHY="C999")
DO EN^DDIOL("No extranodal site or unknown extranodal site!!",,"!!?5")
DO EN^DDIOL("00 No additional surgical procedure",,"!?5")
GOTO EX
+4 SET TOPGRPHY="67"_$EXTRACT(TOPGRPHY,2,4)
+5 SET TPGRPHYR=^ONCO(164,TOPGRPHY,0)
+6 SET SS=$PIECE($GET(^ONCO(164,TOPGRPHY,"SR")),U,$$EDITION^ONCOU55(D0))
+7 DO EN^DDIOL("SURGERY OF PRIMARY SITE Codes for site ",$PIECE(TPGRPHYR,U,2)_" "_$PIECE(TPGRPHYR,U),,"!!")
+8 DO EN^DDIOL("("_$PIECE(^ONCO(164.5,SS,0),U)_")",,"!")
+9 DO EN^DDIOL("00 No additional surgical procedure",,"!!?1")
+10 DO EN^DDIOL(,,"!")
+11 SET XX=10
FOR
SET XX=$ORDER(^ONCO(164.5,SS,1,XX))
if XX'=+XX
QUIT
Begin DoDot:1
+12 SET XXX=XX-1
+13 IF ($PIECE(^ONCO(165.5,D0,0),U,16)<2960000)!($EXTRACT(XXX,2)'=8)
DO EN^DDIOL(" "_(XX-1)_" "_^ONCO(164.5,SS,1,XX,0))
DO EN^DDIOL(,,"!")
End DoDot:1
+14 DO EN^DDIOL("Enter a code from the above list.",,"!")
GOTO EX
+15 QUIT
+16 ;
FADIT ;DATE OF FIRST CONTACT (165.5,155) Input Transform
+1 DO NINES
if '$DATA(X)
QUIT
if X=9999999
QUIT
+2 IF $DATA(X)
SET %DT="EP"
SET %DT(0)="-NOW"
DO ^%DT
SET X=Y
if Y<1
KILL X
KILL %DT
+3 QUIT
+4 ;
DSDTIT ;DATE OF INPATIENT DISCHARGE (165.5,1.1) Input Transform
+1 ;Must be >= DATE OF INPATIENT ADMISSION (165.5,1)
+2 NEW FAD
+3 DO ZS9S
if '$DATA(X)
QUIT
if (X="0000000")!(X=9999999)
QUIT
+4 IF $DATA(X)
SET %DT="EP"
SET %DT(0)="-NOW"
DO ^%DT
SET X=Y
if Y<1
KILL X
IF $DATA(X)
SET FAD=$PIECE($GET(^ONCO(165.5,D0,0)),U,8)
IF FAD'=""
if X<FAD
KILL X
KILL %DT
+5 QUIT
+6 ;
DFSPIT ;DATE FIRST SURGICAL PROCEDURE (165.5,170) Input Transform
+1 DO ZS9S
if '$DATA(X)
QUIT
if (X="0000000")!(X=9999999)
QUIT
+2 IF $DATA(X)
SET %DT="EP"
SET %DT(0)="-NOW"
DO ^%DT
SET X=Y
if Y<1
KILL X
KILL %DT
+3 IF $DATA(X)
SET SDT=$PIECE($GET(^ONCO(165.5,D0,3)),U,1)
IF SDT'=""
IF SDT'="0000000"
IF SDT'="9999999"
IF X>SDT
KILL X
DO EN^DDIOL("DATE FIRST SURGICAL PROCEDURE later than MOST DEFINITIVE SURG DATE",,"!!?3")
KILL %DT,SDT
QUIT
+4 IF $DATA(X)
SET SDT=$PIECE($GET(^ONCO(165.5,D0,3.1)),U,8)
IF SDT'=""
IF SDT'="0000000"
IF SDT'="9999999"
IF X>SDT
KILL X
DO EN^DDIOL("DATE FIRST SURGICAL PROCEDURE later than MOST DEFINITIVE SURG @FAC DATE",,"!!")
KILL %DT,SDT
QUIT
+5 IF $DATA(X)
SET SDT=$PIECE($GET(^ONCO(165.5,D0,3.1)),U,22)
IF SDT'=""
IF SDT'="0000000"
IF SDT'="9999999"
IF X>SDT
KILL X
DO EN^DDIOL("DATE FIRST SURGICAL PROCEDURE later than SCOPE OF LN SURGERY DATE",,"!!")
KILL %DT,SDT
QUIT
+6 IF $DATA(X)
SET SDT=$PIECE($GET(^ONCO(165.5,D0,3.1)),U,23)
IF SDT'=""
IF SDT'="0000000"
IF SDT'="9999999"
IF X>SDT
KILL X
DO EN^DDIOL("DATE FIRST SURGICAL PROCEDURE later than SCOPE OF LN SURGERY @FAC DATE",,"!!")
KILL %DT,SDT
QUIT
+7 IF $DATA(X)
SET SDT=$PIECE($GET(^ONCO(165.5,D0,3.1)),U,24)
IF SDT'=""
IF SDT'="0000000"
IF SDT'="9999999"
IF X>SDT
KILL X
DO EN^DDIOL("DATE FIRST SURGICAL PROCEDURE later than SURG PROC/OTHER SITE DATE",,"!!")
+8 IF $DATA(X)
SET SDT=$PIECE($GET(^ONCO(165.5,D0,3.1)),U,25)
IF SDT'=""
IF SDT'="0000000"
IF SDT'="9999999"
IF X>SDT
KILL X
DO EN^DDIOL("DATE FIRST SURGICAL PROCEDURE later than SURG PROC/OTHER SITE @FAC DATE",,"!!")
+9 KILL %DT,SDT
+10 QUIT
+11 ;
DFIT ;INPUT TRANSFORM for date fields
+1 ;No future dates and date must be > or = DATE DX (165.5,3)
+2 NEW DFSP,DTDXE,DTDXI,FAIL,ZS9S
+3 IF $GET(DIFLD)=124
SET NTDD=""
+4 DO ZS9S
if ZS9S=1
QUIT
+5 SET %DT="EP"
+6 ;added in p5
IF $GET(DIFLD)=90
SET %DT="ESTX"
+7 SET %DT(0)="-NOW"
DO ^%DT
+8 SET X=Y
IF Y<1
KILL X
DO EN^DDIOL("Future dates are not allowed.",,"!!?5")
KILL %DT
QUIT
+9 SET X=X
+10 IF $GET(DIFLD)=255
QUIT
+11 IF $GET(DIFLD)=256
QUIT
+12 SET DTDXI=$$GET1^DIQ(165.5,D0,3,"I")
+13 IF (DTDXI=8888888)!(DTDXI=9999999)
QUIT
+14 SET DTDXE=$$GET1^DIQ(165.5,D0,3,"E")
+15 SET FAIL=""
+16 IF X<DTDXI
SET FAIL=FAIL_"X"
+17 IF FAIL'=""
Begin DoDot:1
+18 KILL X
+19 DO EN^DDIOL("The date entered must be later than or equal to the",,"!!?5")
+20 IF FAIL["X"
DO EN^DDIOL("DATE DX which is "_DTDXE_($SELECT(FAIL["A":" and the",1:".")),,"!?5")
+21 DO EN^DDIOL(,,"!")
End DoDot:1
QUIT
+22 SET DFSP=$PIECE($GET(^ONCO(165.5,D0,3.1)),U,38)
+23 IF $DATA(X)
IF $GET(DIFLD)=50
Begin DoDot:1
+24 IF DFSP'=""
IF DFSP'="0000000"
IF DFSP'="9999999"
IF X<DFSP
KILL X
DO EN^DDIOL("MOST DEFINITIVE SURG DATE earlier than DATE FIRST SURGICAL PROCEDURE",,"!!?3")
End DoDot:1
DO EN^DDIOL(,,"!")
QUIT
+25 IF $DATA(X)
IF $GET(DIFLD)=50.3
Begin DoDot:1
+26 IF DFSP'=""
IF DFSP'="0000000"
IF DFSP'="9999999"
IF X<DFSP
KILL X
DO EN^DDIOL("MOST DEFINITIVE SURG @FAC DATE earlier than DATE FIRST SURGICAL PROCEDURE",,"!!?3")
End DoDot:1
QUIT
+27 IF $DATA(X)
IF $GET(DIFLD)=138.2
Begin DoDot:1
+28 IF DFSP'=""
IF DFSP'="0000000"
IF DFSP'="9999999"
IF X<DFSP
KILL X
DO EN^DDIOL("SCOPE OF LN SURGERY DATE earlier than DATE FIRST SURGICAL PROCEDURE",,"!!?3")
End DoDot:1
QUIT
+29 IF $DATA(X)
IF $GET(DIFLD)=138.3
Begin DoDot:1
+30 IF DFSP'=""
IF DFSP'="0000000"
IF DFSP'="9999999"
IF X<DFSP
KILL X
DO EN^DDIOL("SCOPE OF LN SURGERY @FAC DATE earlier than DATE FIRST SURGICAL PROCEDURE",,"!!?3")
End DoDot:1
QUIT
+31 IF $DATA(X)
IF $GET(DIFLD)=139.2
Begin DoDot:1
+32 IF DFSP'=""
IF DFSP'="0000000"
IF DFSP'="9999999"
IF X<DFSP
KILL X
DO EN^DDIOL("SURG PROC/OTHER SITE DATE earlier than DATE FIRST SURGICAL PROCEDURE",,"!!?3")
End DoDot:1
QUIT
+33 IF $DATA(X)
IF $GET(DIFLD)=139.3
Begin DoDot:1
+34 IF DFSP'=""
IF DFSP'="0000000"
IF DFSP'="9999999"
IF X<DFSP
KILL X
DO EN^DDIOL("SURG PROC/OTHER SITE @FAC DATE earlier than DATE FIRST SURGICAL PROCEDURE",,"!!?3")
End DoDot:1
QUIT
+35 QUIT
+36 ;
NTIT ;DATE OF NO TREATMENT (165.5,124) INPUT TRANSFORM
+1 ;(NO FUTURE DATES AND >= DATE DX)
+2 NEW DTDX
+3 SET NTDD=""
+4 IF (X="00/00/00")!(X="00/00/0000")!(X="00000000")
KILL X
QUIT
+5 IF (X="99/99/99")!(X="99/99/9999")!(X="99999999")
KILL X
QUIT
+6 SET %DT="EP"
SET %DT(0)="-NOW"
DO ^%DT
SET X=Y
IF Y<1
KILL X
DO EN^DDIOL("Future dates are not allowed.",,"!!?5")
KILL %DT
QUIT
+7 SET DTDX=$PIECE($GET(^ONCO(165.5,D0,0)),U,16)
+8 IF DTDX=8888888!9999999
QUIT
+9 IF DTDX'=""
IF X<DTDX
KILL X
DO EN^DDIOL("This date must be later than or equal to the DATE DX of "_$EXTRACT(DTDX,4,5)_"/"_$EXTRACT(DTDX,6,7)_"/"_($EXTRACT(DTDX,1,3)+1700)_".",,"!!?5")
KILL DTDX
QUIT
+10 QUIT
+11 ;
NT ;DATE OF NO TREATMENT (Input transform for treatment fields)
+1 SET NTDD=$PIECE($GET(^ONCO(165.5,D0,2.1)),U,11)
+2 IF $GET(ONC138P2)="YES"
IF $PIECE($GET(^ONCO(165.5,D0,0)),"^",16)>3201231
KILL ONC138P2,NTDD,V
QUIT
+3 IF (NTDD'="")&(X'=V)
KILL X
DO EN^DDIOL("This primary has a DATE OF NO TREATMENT of "_$EXTRACT(NTDD,4,5)_"/"_$EXTRACT(NTDD,6,7)_"/"_($EXTRACT(NTDD,1,3)+1700)_".",,"!!?5")
DO EN^DDIOL("Treatments are not allowed unless the DATE OF NO TREATMENT is deleted.",,"!!?5")
+4 KILL NTDD,ONC138P2,V
QUIT
+5 ;
CHKTS ;Check TREATMENT STATUS (165.5,235)
+1 NEW TS,TSI
+2 SET TS=$$GET1^DIQ(165.5,D0,235)
+3 SET TSI=$$GET1^DIQ(165.5,D0,235,"I")
+4 IF (TSI=0)!(TSI=2)
Begin DoDot:1
+5 DO EN^DDIOL("TREATMENT STATUS = "_TS,,"!!?5")
+6 DO EN^DDIOL("DATE OF NO TREATMENT cannot be blank.",,"!!?5")
+7 DO EN^DDIOL(,,"!")
+8 SET Y=124
End DoDot:1
+9 IF '$TEST
SET Y="@41"
+10 QUIT
+11 ;
DBTS ;DATE BRACHYTHERAPY STARTED INPUT TRANSFORM (NOT FUTURE, DX<=DBS<=DBE)
+1 NEW DBE
+2 SET %DT="EP"
SET %DT(0)="-NOW"
DO ^%DT
SET X=Y
if Y<1
KILL X
if '$DATA(X)
QUIT
+3 SET DBE=$PIECE($GET(^ONCO(165.5,D0,"STS2")),U,13)
SET DTDX=$PIECE($GET(^ONCO(165.5,D0,0)),U,16)
+4 IF DBE'=""
if X>DBE
KILL X
if '$DATA(X)
QUIT
+5 IF DTDX'=""
if X<DTDX
KILL X
KILL %DT
+6 QUIT
+7 ;
DBTE ;DATE BRACHYTHERAPY ENDED INPUT TRANSFORM (NOT FUTURE, DBS<=DBE)
+1 NEW DBS
+2 SET %DT="EP"
SET %DT(0)="-NOW"
DO ^%DT
SET X=Y
if Y<1
KILL X
IF $DATA(X)
SET DBS=$PIECE($GET(^ONCO(165.5,D0,"STS2")),U,12)
IF DBS'=""
if X<DBS
KILL X
KILL %DT
+3 QUIT
+4 ;
ZS9S ;00/00/0000, 88/88/8888 and 99/99/9999 INPUT TRANSFORMS
+1 SET ZS9S=1
+2 IF X="00/00/00"
DO EN^DDIOL("00/00/00 is ambiguous. Enter a 4 digit year. ",,"!?5")
KILL X
QUIT
+3 IF X="00/00/0000"
SET X="0000000"
QUIT
+4 IF X="00000000"
SET X="0000000"
QUIT
+5 ;
NINES ;99/99/9999 INPUT TRANSFORM
+1 IF X="99/99/99"
DO EN^DDIOL("99/99/99 is ambiguous. Enter a 4 digit year. ",,"!?5")
KILL X
QUIT
+2 IF X="99/99/9999"
SET X=9999999
QUIT
+3 IF X="99999999"
SET X=9999999
QUIT
+4 ;
EIGHTS ;88/88/8888 INPUT TRANSFORM
+1 IF ($GET(DIFLD)=193)!($GET(DIFLD)=195)
Begin DoDot:1
+2 IF X="88/88/88"
DO EN^DDIOL("88/88/88 is ambiguous. Enter a 4 digit year. ",,"!?5")
KILL X
QUIT
+3 IF X="88/88/8888"
SET X=8888888
+4 IF X="88888888"
SET X=8888888
End DoDot:1
KILL FLD
if '$DATA(X)
QUIT
if X=8888888
QUIT
+5 SET ZS9S=0
+6 QUIT
+7 ;
CLEANUP ;Cleanup
+1 KILL D0,DIFLD,Y
