Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ONCODSR

ONCODSR.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ;^ONCO(164.2,9,"S",1-10) hold SURGICAL DX/STAGING PROC codes 0-9
  1.  ;^ONCO(164.2,SITE/GP,"S",11-100) holds surgery coes 10-99
  1.  ;
  1. CDSIT ;SURGERY OF PRIMARY SITE (165.5,58.2) INPUT TRANSFORM
  1.  N T,TOPGRPHY,SS
  1.  K:$L(X)>2!(X'?1.N) X G EX:'$D(X)
  1.  I X="00" D EN^DDIOL("  00 No surgical procedure") G EX
  1.  S TOPGRPHY=$$TOPGRPHY(D0) G ER:TOPGRPHY=""
  1.  S SS=+$P($G(^ONCO(164,TOPGRPHY,"SR")),U,$$EDITION^ONCOU55(D0))
  1.  I '$D(^ONCO(164.5,SS,1,X+1,0)) K X G EX
  1.  I ($P(^ONCO(165.5,D0,0),U,16)>2951231),$E(X,2)=8 K X G EX
  1.  D EN^DDIOL("  "_^ONCO(164.5,SS,1,X+1,0)) G EX
  1.  ;
  1. NCDSIT ;SURGICAL DX/STAGING PROC (165.5,58.1) INPUT TRANSFORM
  1.  I '$D(^ONCO(160.14,"B",X)) K X G EX
  1.  I $L(X)'=2 K X G EX
  1.  S NCDSIEN=$O(^ONCO(160.14,"B",X,0))
  1.  D EN^DDIOL("  "_$P(^ONCO(160.14,NCDSIEN,0),U,2))
  1.  K NCDSIEN Q
  1.  ;
  1. NCDSOT ;SURGICAL DX/STAGING PROC (165.5,58.1 & 58.4) OUTPUT TRANSFORM
  1.  Q:Y=""
  1.  N NCDSIEN
  1.  S NCDSIEN=$O(^ONCO(160.14,"B",Y,0))
  1.  I NCDSIEN'="" S Y=Y_" "_$P(^ONCO(160.14,NCDSIEN,0),U,2)
  1.  Q
  1.  ;
  1. HP0 ;SURGICAL DX/STAGING PROC (165.5,58.1) HELP
  1.  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")
  1.  K NCDSIEN G EX
  1.  ;
  1. CDSOT ;SURGERY OF PRIMARY SITE (165.5,58.2) OUTPUT TRANSFORM
  1.  I Y="00" S Y="00 No surgical procedure" G EX
  1.  N TOPGRPHY,SS
  1.  S TOPGRPHY=$$TOPGRPHY(D0) G EX:TOPGRPHY=""
  1.  S SS=+$P($G(^ONCO(164,TOPGRPHY,"SR")),U,$$EDITION^ONCOU55(D0))
  1.  S Y=Y_" "_$G(^ONCO(164.5,SS,1,Y+1,0)) G EX
  1.  ;
  1. HP1 ;SURGERY OF PRIMARY SITE (165.5,58.2) HELP
  1.  N TOPGRPHY,TPGRPHYR,SS,XX,XXX
  1.  S TOPGRPHY=$$TOPGRPHY(D0) G:TOPGRPHY="" ER
  1.  S TPGRPHYR=^ONCO(164,TOPGRPHY,0)
  1.  S SS=$P($G(^ONCO(164,TOPGRPHY,"SR")),U,$$EDITION^ONCOU55(D0))
  1.  D EN^DDIOL("SURGERY OF PRIMARY SITE Codes for site "_$P(TPGRPHYR,U,2)_" "_$P(TPGRPHYR,U),,"!?5")
  1.  D EN^DDIOL("("_$P(^ONCO(164.5,SS,0),U)_")",,"!?5")
  1.  D EN^DDIOL("00  No surgical procedure",,"!!?1")
  1.  D EN^DDIOL(,,"!")
  1.  S XX=10 F  S XX=$O(^ONCO(164.5,SS,1,XX)) Q:XX'=+XX  D
  1.  .S XXX=XX-1
  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))
  1.  G EX
  1.  ;
  1. ER ;ERROR
  1.  D EN^DDIOL("ICDO CODE NOT defined!! - cannot continue",,"!!?10")
  1.  G EX
  1.  ;
  1. EX ;EXIT
  1.  K AN,SS,ONCOSR
  1.  D EN^DDIOL(,,"!")
  1.  Q
  1.  ;
  1. TOPGRPHY(PRIMIX) ; returns ICDO-2 topography code for primary site PRIMIX
  1.  Q $P($G(^ONCO(165.5,PRIMIX,2)),U)
  1.  ;
  1. ESSPIT ;INPUT TRANSFORM FOR EXTRANODAL SITE SURGICAL PROCEDURE #856
  1.  N T,TOPGRPHY,SS
  1.  K:$L(X)>2!(X'?1.N) X G EX:'$D(X)
  1.  I X="00" D EN^DDIOL("  No additional surgical procedure") G EX
  1.  S TOPGRPHY=$P($G(^ONCO(165.5,D0,"NHL2")),U,10) G ER:TOPGRPHY=""
  1.  I TOPGRPHY="C888"!(TOPGRPHY="C999") K X G EX
  1.  S TOPGRPHY="67"_$E(TOPGRPHY,2,4)
  1.  S SS=+$P($G(^ONCO(164,TOPGRPHY,"SR")),U,$$EDITION^ONCOU55(D0))
  1.  I '$D(^ONCO(164.5,SS,1,X+1,0)) K X G EX
  1.  I ($P(^ONCO(165.5,D0,0),U,16)>2951231),$E(X,2)=8 K X G EX
  1.  D EN^DDIOL(^ONCO(164.5,SS,1,X+1,0),,"!?2") G EX
  1.  ;
  1. ESSPOT ;OUTPUT TRANSFORM FOR EXTRANODAL SITE SURGICAL PROCEDURE #856
  1.  I Y="00" S Y=Y_"  No additional surgical procedure" G EX
  1.  N TOPGRPHY,SS
  1.  S TOPGRPHY=$P($G(^ONCO(165.5,D0,"NHL2")),U,10) G EX:TOPGRPHY=""
  1.  I TOPGRPHY="C888"!(TOPGRPHY="C999") G EX
  1.  S TOPGRPHY="67"_$E(TOPGRPHY,2,4)
  1.  S SS=+$P($G(^ONCO(164,TOPGRPHY,"SR")),U,$$EDITION^ONCOU55(D0))
  1.  S Y=Y_" "_$G(^ONCO(164.5,SS,1,Y+1,0)) G EX
  1.  ;
  1. ESSHP ;EXECUTABLE HELP FOR EXTRANODAL SITE SURGICAL PROCEDURE #856
  1.  N TOPGRPHY,TPGRPHYR,SS,XX
  1.  S TOPGRPHY=$P($G(^ONCO(165.5,D0,"NHL2")),U,10) G ER:TOPGRPHY=""
  1.  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
  1.  S TOPGRPHY="67"_$E(TOPGRPHY,2,4)
  1.  S TPGRPHYR=^ONCO(164,TOPGRPHY,0)
  1.  S SS=$P($G(^ONCO(164,TOPGRPHY,"SR")),U,$$EDITION^ONCOU55(D0))
  1.  D EN^DDIOL("SURGERY OF PRIMARY SITE Codes for site ",$P(TPGRPHYR,U,2)_" "_$P(TPGRPHYR,U),,"!!")
  1.  D EN^DDIOL("("_$P(^ONCO(164.5,SS,0),U)_")",,"!")
  1.  D EN^DDIOL("00 No additional surgical procedure",,"!!?1")
  1.  D EN^DDIOL(,,"!")
  1.  S XX=10 F  S XX=$O(^ONCO(164.5,SS,1,XX)) Q:XX'=+XX  D
  1.  .S XXX=XX-1
  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(,,"!")
  1.  D EN^DDIOL("Enter a code from the above list.",,"!") G EX
  1.  Q
  1.  ;
  1. FADIT ;DATE OF FIRST CONTACT (165.5,155) Input Transform
  1.  D NINES Q:'$D(X)  Q:X=9999999
  1.  I $D(X) S %DT="EP",%DT(0)="-NOW" D ^%DT S X=Y K:Y<1 X K %DT
  1.  Q
  1.  ;
  1. DSDTIT ;DATE OF INPATIENT DISCHARGE (165.5,1.1) Input Transform
  1.  ;Must be >= DATE OF INPATIENT ADMISSION (165.5,1)
  1.  N FAD
  1.  D ZS9S Q:'$D(X)  Q:(X="0000000")!(X=9999999)
  1.  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
  1.  Q
  1.  ;
  1. DFSPIT ;DATE FIRST SURGICAL PROCEDURE (165.5,170) Input Transform
  1.  D ZS9S Q:'$D(X)  Q:(X="0000000")!(X=9999999)
  1.  I $D(X) S %DT="EP",%DT(0)="-NOW" D ^%DT S X=Y K:Y<1 X K %DT
  1.  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
  1.  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
  1.  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
  1.  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
  1.  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",,"!!")
  1.  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",,"!!")
  1.  K %DT,SDT
  1.  Q
  1.  ;
  1. DFIT ;INPUT TRANSFORM for date fields
  1.  ;No future dates and date must be > or = DATE DX (165.5,3)
  1.  N DFSP,DTDXE,DTDXI,FAIL,ZS9S
  1.  I $G(DIFLD)=124 S NTDD=""
  1.  D ZS9S Q:ZS9S=1 
  1.  S %DT="EP"
  1.  I $G(DIFLD)=90 S %DT="ESTX"  ;added in p5
  1.  S %DT(0)="-NOW" D ^%DT
  1.  S X=Y I Y<1 K X D EN^DDIOL("Future dates are not allowed.",,"!!?5") K %DT Q
  1.  S X=X
  1.  I $G(DIFLD)=255 Q
  1.  I $G(DIFLD)=256 Q
  1.  S DTDXI=$$GET1^DIQ(165.5,D0,3,"I")
  1.  I (DTDXI=8888888)!(DTDXI=9999999) Q
  1.  S DTDXE=$$GET1^DIQ(165.5,D0,3,"E")
  1.  S FAIL=""
  1.  I X<DTDXI S FAIL=FAIL_"X"
  1.  I FAIL'="" D  Q
  1.  .K X
  1.  .D EN^DDIOL("The date entered must be later than or equal to the",,"!!?5")
  1.  .I FAIL["X" D EN^DDIOL("DATE DX which is "_DTDXE_($S(FAIL["A":" and the",1:".")),,"!?5")
  1.  .D EN^DDIOL(,,"!")
  1.  S DFSP=$P($G(^ONCO(165.5,D0,3.1)),U,38)
  1.  I $D(X),$G(DIFLD)=50 D  D EN^DDIOL(,,"!") Q
  1.  .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")
  1.  I $D(X),$G(DIFLD)=50.3 D  Q
  1.  .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")
  1.  I $D(X),$G(DIFLD)=138.2 D  Q
  1.  .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")
  1.  I $D(X),$G(DIFLD)=138.3 D  Q
  1.  .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")
  1.  I $D(X),$G(DIFLD)=139.2 D  Q
  1.  .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")
  1.  I $D(X),$G(DIFLD)=139.3 D  Q
  1.  .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")
  1.  Q
  1.  ;
  1. NTIT ;DATE OF NO TREATMENT (165.5,124) INPUT TRANSFORM
  1.  ;(NO FUTURE DATES AND >= DATE DX)
  1.  N DTDX
  1.  S NTDD=""
  1.  I (X="00/00/00")!(X="00/00/0000")!(X="00000000") K X Q
  1.  I (X="99/99/99")!(X="99/99/9999")!(X="99999999") K X Q
  1.  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
  1.  S DTDX=$P($G(^ONCO(165.5,D0,0)),U,16)
  1.  I DTDX=8888888!9999999 Q
  1.  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
  1.  Q
  1.  ;
  1. NT ;DATE OF NO TREATMENT (Input transform for treatment fields)
  1.  S NTDD=$P($G(^ONCO(165.5,D0,2.1)),U,11)
  1.  I $G(ONC138P2)="YES",$P($G(^ONCO(165.5,D0,0)),"^",16)>3201231 K ONC138P2,NTDD,V Q
  1.  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")
  1.  K NTDD,ONC138P2,V Q
  1.  ;
  1. CHKTS ;Check TREATMENT STATUS (165.5,235)
  1.  N TS,TSI
  1.  S TS=$$GET1^DIQ(165.5,D0,235)
  1.  S TSI=$$GET1^DIQ(165.5,D0,235,"I")
  1.  I (TSI=0)!(TSI=2) D
  1.  .D EN^DDIOL("TREATMENT STATUS = "_TS,,"!!?5")
  1.  .D EN^DDIOL("DATE OF NO TREATMENT cannot be blank.",,"!!?5")
  1.  .D EN^DDIOL(,,"!")
  1.  .S Y=124
  1.  E  S Y="@41"
  1.  Q
  1.  ;
  1. DBTS ;DATE BRACHYTHERAPY STARTED INPUT TRANSFORM (NOT FUTURE, DX<=DBS<=DBE)
  1.  N DBE
  1.  S %DT="EP",%DT(0)="-NOW" D ^%DT S X=Y K:Y<1 X Q:'$D(X)
  1.  S DBE=$P($G(^ONCO(165.5,D0,"STS2")),U,13),DTDX=$P($G(^ONCO(165.5,D0,0)),U,16)
  1.  I DBE'="" K:X>DBE X Q:'$D(X)
  1.  I DTDX'="" K:X<DTDX X K %DT
  1.  Q
  1.  ;
  1. DBTE ;DATE BRACHYTHERAPY ENDED INPUT TRANSFORM (NOT FUTURE, DBS<=DBE)
  1.  N DBS
  1.  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
  1.  Q
  1.  ;
  1. ZS9S ;00/00/0000, 88/88/8888 and 99/99/9999 INPUT TRANSFORMS
  1.  S ZS9S=1
  1.  I X="00/00/00" D EN^DDIOL("00/00/00 is ambiguous.  Enter a 4 digit year. ",,"!?5") K X Q
  1.  I X="00/00/0000" S X="0000000" Q
  1.  I X="00000000" S X="0000000" Q
  1.  ;
  1. NINES ;99/99/9999 INPUT TRANSFORM
  1.  I X="99/99/99" D EN^DDIOL("99/99/99 is ambiguous.  Enter a 4 digit year. ",,"!?5") K X Q
  1.  I X="99/99/9999" S X=9999999 Q
  1.  I X="99999999" S X=9999999 Q
  1.  ;
  1. EIGHTS ;88/88/8888 INPUT TRANSFORM
  1.  I ($G(DIFLD)=193)!($G(DIFLD)=195) D  K FLD Q:'$D(X)  Q:X=8888888
  1.  .I X="88/88/88" D EN^DDIOL("88/88/88 is ambiguous.  Enter a 4 digit year. ",,"!?5") K X Q
  1.  .I X="88/88/8888" S X=8888888
  1.  .I X="88888888" S X=8888888
  1.  S ZS9S=0
  1.  Q
  1.  ;
  1. CLEANUP ;Cleanup
  1.  K D0,DIFLD,Y