ONCCS ;HINES OIFO/GWB - Collaborative Staging ;06/23/10
;;2.2;ONCOLOGY;**1,4,5,10,19**;Jul 31, 2013;Build 4
;
N DIR,IEN,LV,PS,RC,X
W !
S DIR("A")=" Compute Collaborative Staging"
S DIR(0)="Y",DIR("B")="Yes" D ^DIR
I (Y=0)!(Y="")!(Y[U) S Y=$S(ONCOANS="A":"@4",1:"@0") Q
;
;re-initialize if 96703
I ($P($G(^ONCO(165.5,D0,2.2)),U,3)=96703),($P($G(^ONCO(165.5,D0,0)),U,16)>3120000) D Q
.D CLNCS
.W !!,"96703 is obsolete for primaries starting 2012!!!"
;
S IEN=D0
S $P(^ONCO(165.5,IEN,"CS1"),U,1,9)=U_U_U_U_U_U_U_U
S $P(^ONCO(165.5,IEN,"CS1"),U,11)=""
;
K INPUT,STORE,DISPLAY,STATUS,ONCSAPI
D CLEAR^ONCSAPIE(1)
;
S PS=$$GET1^DIQ(165.5,IEN,20,"I")
S:PS'="" PS=$TR($$GET1^DIQ(164,PS,1,"I"),".","")
S INPUT("SITE")=PS
;
S INPUT("HIST")=$E($$GET1^DIQ(165.5,IEN,22.3,"I"),1,4)
;
S INPUT("DIAGNOSIS_YEAR")=$E($$DATE^ONCACDU1($$GET1^DIQ(165.5,IEN,3,"I")),1,4)
;
;S INPUT("CSVER_ORIGINAL")=$P($$VERSION^ONCSAPIV,U,2)
;S:INPUT("CSVER_ORIGINAL")="" INPUT("CSVER_ORIGINAL")=$P($$VERSION^ONCSAPIV,U,2)
S INPUT("CSVER_ORIGINAL")=$$GET1^DIQ(165.5,IEN,169.1,"I")
S:INPUT("CSVER_ORIGINAL")="" INPUT("CSVER_ORIGINAL")="020550"
;
S INPUT("BEHAV")=$E($$GET1^DIQ(165.5,IEN,22.3,"I"),5)
;
S INPUT("GRADE")=$$GET1^DIQ(165.5,IEN,24,"I")
;
S INPUT("AGE")=$$AGEDX^ONCACDU1(IEN)
S:$L(INPUT("AGE"))=1 INPUT("AGE")="00"_INPUT("AGE")
S:$L(INPUT("AGE"))=2 INPUT("AGE")=0_INPUT("AGE")
;
S LV=$$GET1^DIQ(165.5,IEN,149,"I")_$$GET1^DIQ(165.5,IEN,151,"I")
S INPUT("LVI")=$S(LV[1:1,LV[2:1,LV[0:0,LV["X":9,1:8)
;
S INPUT("SIZE")=$$GET1^DIQ(165.5,IEN,29.2,"I")
;
S INPUT("EXT")=$$GET1^DIQ(165.5,IEN,30.2,"I")
;
S INPUT("EXTEVAL")=$$GET1^DIQ(165.5,IEN,29.1,"I")
;
S INPUT("NODES")=$$GET1^DIQ(165.5,IEN,31.1,"I")
;
S INPUT("LNPOS")=$$GET1^DIQ(165.5,IEN,32,"I")
S:$L(INPUT("LNPOS"))=1 INPUT("LNPOS")=0_INPUT("LNPOS")
;
S INPUT("LNEXAM")=$$GET1^DIQ(165.5,IEN,33,"I")
S:$L(INPUT("LNEXAM"))=1 INPUT("LNEXAM")=0_INPUT("LNEXAM")
;
S INPUT("NODESEVAL")=$$GET1^DIQ(165.5,IEN,32.1,"I")
;
S INPUT("METS")=$$GET1^DIQ(165.5,IEN,34.3,"I")
;
S INPUT("METSEVAL")=$$GET1^DIQ(165.5,IEN,34.4,"I")
;
S INPUT("SSF1")=$$GET1^DIQ(165.5,IEN,44.1,"I")
S INPUT("SSF2")=$$GET1^DIQ(165.5,IEN,44.2,"I")
S INPUT("SSF3")=$$GET1^DIQ(165.5,IEN,44.3,"I")
S INPUT("SSF4")=$$GET1^DIQ(165.5,IEN,44.4,"I")
S INPUT("SSF5")=$$GET1^DIQ(165.5,IEN,44.5,"I")
S INPUT("SSF6")=$$GET1^DIQ(165.5,IEN,44.6,"I")
S INPUT("SSF7")=$$GET1^DIQ(165.5,IEN,44.7,"I")
S INPUT("SSF8")=$$GET1^DIQ(165.5,IEN,44.8,"I")
S INPUT("SSF9")=$$GET1^DIQ(165.5,IEN,44.9,"I")
S INPUT("SSF10")=$$GET1^DIQ(165.5,IEN,44.101,"I")
S INPUT("SSF11")=$$GET1^DIQ(165.5,IEN,44.11,"I")
S INPUT("SSF12")=$$GET1^DIQ(165.5,IEN,44.12,"I")
S INPUT("SSF13")=$$GET1^DIQ(165.5,IEN,44.13,"I")
S INPUT("SSF14")=$$GET1^DIQ(165.5,IEN,44.14,"I")
S INPUT("SSF15")=$$GET1^DIQ(165.5,IEN,44.15,"I")
S INPUT("SSF16")=$$GET1^DIQ(165.5,IEN,44.16,"I")
S INPUT("SSF17")=$$GET1^DIQ(165.5,IEN,44.17,"I")
S INPUT("SSF18")=$$GET1^DIQ(165.5,IEN,44.18,"I")
S INPUT("SSF19")=$$GET1^DIQ(165.5,IEN,44.19,"I")
S INPUT("SSF20")=$$GET1^DIQ(165.5,IEN,44.201,"I")
S INPUT("SSF21")=$$GET1^DIQ(165.5,IEN,44.21,"I")
S INPUT("SSF22")=$$GET1^DIQ(165.5,IEN,44.22,"I")
S INPUT("SSF23")=$$GET1^DIQ(165.5,IEN,44.23,"I")
S INPUT("SSF24")=$$GET1^DIQ(165.5,IEN,44.24,"I")
I $P($G(^ONCO(165.5,IEN,"CS3")),U,1)'="" D
.S $P(^ONCO(165.5,IEN,"CS2"),U,19)=$P($G(^ONCO(165.5,IEN,"CS3")),U,1)
S INPUT("SSF25")=$$GET1^DIQ(165.5,IEN,44.25,"I")
;patch 19 - stuff with BLANKS for NULL: cloud server migration
S:INPUT("EXT")="" INPUT("EXT")=" "
S:INPUT("EXTEVAL")="" INPUT("EXTEVAL")=" "
S:INPUT("GRADE")="" INPUT("GRADE")=" "
S:INPUT("METS")="" INPUT("METS")=" "
S:INPUT("METSEVAL")="" INPUT("METSEVAL")=" "
S:INPUT("NODES")="" INPUT("NODES")=" "
S:INPUT("NODESEVAL")="" INPUT("NODESEVAL")=" "
S:INPUT("SIZE")="" INPUT("SIZE")=" "
S:INPUT("SSF1")="" INPUT("SSF1")=" "
S:INPUT("SSF2")="" INPUT("SSF2")=" "
S:INPUT("SSF3")="" INPUT("SSF3")=" "
S:INPUT("SSF4")="" INPUT("SSF4")=" "
S:INPUT("SSF5")="" INPUT("SSF5")=" "
S:INPUT("SSF6")="" INPUT("SSF6")=" "
S:INPUT("SSF7")="" INPUT("SSF7")=" "
S:INPUT("SSF8")="" INPUT("SSF8")=" "
S:INPUT("SSF9")="" INPUT("SSF9")=" "
S:INPUT("SSF10")="" INPUT("SSF10")=" "
S:INPUT("SSF11")="" INPUT("SSF11")=" "
S:INPUT("SSF12")="" INPUT("SSF12")=" "
S:INPUT("SSF13")="" INPUT("SSF13")=" "
S:INPUT("SSF14")="" INPUT("SSF14")=" "
S:INPUT("SSF15")="" INPUT("SSF15")=" "
S:INPUT("SSF16")="" INPUT("SSF16")=" "
S:INPUT("SSF17")="" INPUT("SSF17")=" "
S:INPUT("SSF18")="" INPUT("SSF18")=" "
S:INPUT("SSF19")="" INPUT("SSF19")=" "
S:INPUT("SSF20")="" INPUT("SSF20")=" "
S:INPUT("SSF21")="" INPUT("SSF21")=" "
S:INPUT("SSF22")="" INPUT("SSF22")=" "
S:INPUT("SSF23")="" INPUT("SSF23")=" "
S:INPUT("SSF24")="" INPUT("SSF24")=" "
S:INPUT("SSF25")="" INPUT("SSF25")=" "
D XMLREQ
;
K ^TMP("ONCCSRSP",$J) S ONCEXEC="P" D TCS^ONCWEB1
S ERRFLG=0 D PARSECS^ONCWEBP2
I ERRFLG=1 D DISERR^ONCWEBP2 W !," You have encountered a CS error/warning" G CSERR
I ERRFLG=2 W !," You have encountered an XML/server problem" G CSERR
; S RC=$$CALC^ONCSAPI3(.ONCSAPI,.INPUT,.STORE,.DISPLAY,.STATUS)
; I RC D PRTERRS^ONCSAPIE() R "Press return to continue",X:DTIME
;
I ONCSTORE("AJCC7-M")=" " S ONCSTORE("AJCC7-M")=""
I ONCSTORE("AJCC7-MDESCR")=" " S ONCSTORE("AJCC7-MDESCR")=""
I ONCSTORE("AJCC7-N")=" " S ONCSTORE("AJCC7-N")=""
I ONCSTORE("AJCC7-NDESCR")=" " S ONCSTORE("AJCC7-NDESCR")=""
I ONCSTORE("AJCC7-STAGE")=" " S ONCSTORE("AJCC7-STAGE")=""
I ONCSTORE("AJCC7-T")=" " S ONCSTORE("AJCC7-T")=""
I ONCSTORE("AJCC7-TDESCR")=" " S ONCSTORE("AJCC7-TDESCR")=""
S $P(^ONCO(165.5,IEN,"CS1"),U,1)=ONCSTORE("T")
S $P(^ONCO(165.5,IEN,"CS1"),U,2)=ONCSTORE("TDESCR")
S $P(^ONCO(165.5,IEN,"CS1"),U,3)=ONCSTORE("N")
S $P(^ONCO(165.5,IEN,"CS1"),U,4)=ONCSTORE("NDESCR")
S $P(^ONCO(165.5,IEN,"CS1"),U,5)=ONCSTORE("M")
S $P(^ONCO(165.5,IEN,"CS1"),U,6)=ONCSTORE("MDESCR")
S $P(^ONCO(165.5,IEN,"CS1"),U,7)=ONCSTORE("AJCC")
S $P(^ONCO(165.5,IEN,"CS1"),U,13)=ONCSTORE("AJCC7-T")
S $P(^ONCO(165.5,IEN,"CS1"),U,14)=ONCSTORE("AJCC7-TDESCR")
S $P(^ONCO(165.5,IEN,"CS1"),U,15)=ONCSTORE("AJCC7-N")
S $P(^ONCO(165.5,IEN,"CS1"),U,16)=ONCSTORE("AJCC7-NDESCR")
S $P(^ONCO(165.5,IEN,"CS1"),U,17)=ONCSTORE("AJCC7-M")
S $P(^ONCO(165.5,IEN,"CS1"),U,18)=ONCSTORE("AJCC7-MDESCR")
S $P(^ONCO(165.5,IEN,"CS1"),U,19)=ONCSTORE("AJCC7-STAGE")
S $P(^ONCO(165.5,IEN,"CS1"),U,8)=ONCSTORE("SS1977")
S $P(^ONCO(165.5,IEN,"CS1"),U,9)=ONCSTORE("SS2000")
;I $D(ONCAPIVR) W !!,"ONCAPIVR=",ONCAPIVR
;I $D(ONCVERSN) W !!,"ONCVERSN=",ONCVERSN
;S ONCAPIVR=020550 ;this line would hard set the CS version: cloud migration
S $P(^ONCO(165.5,IEN,"CS1"),U,11)=$G(ONCAPIVR)
S:$P(^ONCO(165.5,IEN,"CS1"),U,12)="" $P(^ONCO(165.5,IEN,"CS1"),U,12)=$G(ONCAPIVR)
D ^ONCPCS
I ERRFLG=0 W !," Collaborative Staging was successful" Q
;
;I $P(RC,U,1)=0 W !," Collaborative Staging was successful" Q
;I $P(RC,U,1)=-10 W !," CS server unavailable. Contact IRM." Q
;I $P(RC,U,1)=-22 W !," Invalid COLLABORATIVE STAGING URL value in ONCOLOGY SITE PARAMETERS" Q
;I $P(RC,U,1)<0 W !," You have encountered a CS error" G CSERR
;I $P(RC,U,1)>0 W !," You have encountered a CS warning" G CSERR
;
CSERR N DIR,X
S DIR("A")="Do you wish to re-enter the CS input values"
S DIR(0)="Y",DIR("B")="Yes" D ^DIR
I Y=1 S Y="@292" Q
I Y[U S Y="@0" Q
S Y=$S(ONCOANS="A":"@4",1:"@0")
Q
;
XMLREQ ;Build the XML Request for cloud server from INPUT array
K ^TMP("ONCINPUT",$J)
N ONCTAG,ONCN
S ONCN=1
S ^TMP("ONCINPUT",$J,ONCN)="<?xml version=""1.0"" encoding=""UTF-8""?>"
S ONCN=ONCN+1
S ^TMP("ONCINPUT",$J,ONCN)="<CS-CALCULATE xmlns=""http://websrv.oncology.domain.ext"">"
S ONCTAG="" F S ONCTAG=$O(INPUT(ONCTAG)) Q:ONCTAG="" D
.S ONCN=ONCN+1
.I ONCTAG="SITE",$L(INPUT(ONCTAG))=4 S ^TMP("ONCINPUT",$J,ONCN)="<"_ONCTAG_">"_INPUT(ONCTAG)_" </"_ONCTAG_">" Q
.S ^TMP("ONCINPUT",$J,ONCN)="<"_ONCTAG_">"_INPUT(ONCTAG)_"</"_ONCTAG_">"
S ONCN=ONCN+1
S ^TMP("ONCINPUT",$J,ONCN)="</CS-CALCULATE>"
Q
;
INIT ;Initialize CS fields when HISTOLOGY (ICD-O-3) (165.5,22.3) changes
N FND,HISTNAM,HSTFLD,HSTI,LNS,LSC,MEL,OLDHST,SITEGRP,TEXT,Z,ZZHSTLST
;
I ($P($G(^ONCO(165.5,D0,0)),U,16)>3010000),(X=94211) D Q
.W !!,"94211 is obsolete for primaries starting 2001!!!"
.K X
I ($P($G(^ONCO(165.5,D0,0)),U,16)>3120000),(X=96703) D Q
.W !!,"96703 is obsolete for primaries starting 2012!!!"
.K X
I $P($G(^ONCO(165.5,D0,0)),U,16)>3100000 D I FND=1 Q
.S FND=0
.S ZZHSTLST="96543^96613^96623^96643^96653^96673^96703^96753^96843^97283^97293^97333^97503^97511^97521^97531^97543^97603^97643^98053^98353^98363^99603^99843^99873"
.F Z=1:1:27 I $P(ZZHSTLST,U,Z)=X S FND=1
.I FND=1 W !!,X," is obsolete for primaries starting 2010!!!" K X
S LNS=$O(^ONCO(164.2,"B","LUNG NOS",0))
S LSC=$O(^ONCO(164.2,"B","LUNG SMALL CELL",0))
S MEL=$O(^ONCO(164.2,"B","MELANOMA",0))
S SITEGRP=$P($G(^ONCO(165.5,D0,0)),U,1)
S OLDHST=$P($G(^ONCO(165.5,D0,2.2)),U,3)
I (OLDHST=96703),($P($G(^ONCO(165.5,D0,0)),U,16)>3120000) D CLNCS ;re-initialized if 96703, obsolete histology.
I X=OLDHST Q
I SITEGRP=LNS D
.I ($E(X,1,4)=8041)!($E(X,1,4)=8042)!($E(X,1,4)=8043)!($E(X,1,4)=8044)!($E(X,1,4)=8045)!($E(X,1,4)=8246) D W !!," SITE/GP changed to LUNG SMALL CELL",!
..S $P(^ONCO(165.5,D0,0),U,1)=LSC
..K ^ONCO(165.5,"B",LNS,D0)
..S ^ONCO(165.5,"B",LSC,D0)=""
I SITEGRP=LSC D
.I ($E(X,1,4)'=8041)&($E(X,1,4)'=8042)&($E(X,1,4)'=8043)&($E(X,1,4)'=8044)&($E(X,1,4)'=8045)&($E(X,1,4)'=8246) D W !!," SITE/GP changed to LUNG NOS",!
..S $P(^ONCO(165.5,D0,0),U,1)=LNS
..K ^ONCO(165.5,"B",LSC,D0)
..S ^ONCO(165.5,"B",LNS,D0)=""
I SITEGRP'=MEL D
.I (X'<87200)&(X<87910) D W !!," SITE/GP changed to MELANOMA",!
..S $P(^ONCO(165.5,D0,0),U,1)=MEL
..K ^ONCO(165.5,"B",SITEGRP,D0)
..S ^ONCO(165.5,"B",MEL,D0)=""
I SITEGRP=MEL D
.I (X<87200)!(X>87900) D
..W !
..W !," WARNING: SITE/GP and HISTOLOGY discrepancy"
..W !," SITE/GP = MELANOMA"
..W !," HISTOLOGY = ",$P(Y,U,1)," ",$P(Y,U,2)
..W !
I OLDHST="" Q
S HSTI=$$HIST^ONCFUNC(D0,.HSTFLD,.HISTNAM)
S TEXT=HISTNAM
S $P(^ONCO(165.5,D0,8),U,2)=$E(TEXT,1,40)
I $P($G(^ONCO(165.5,D0,0)),U,16)<3040000 Q
I $P($G(^ONCO(165.5,D0,0)),U,16)>3171231 D CL2018 Q
W !
W !?3,"You have changed the HISTOLOGY (ICD-O-3). This change may"
W !?3,"affect the validity of the COLLABORATIVE STAGING data."
W !?3,"Therefore, the CS fields have been initialized and need to"
W !?3,"be re-entered."
W !
CLNCS ;re-initialize if Histology 96703
F PIECE=1:1:12 S $P(^ONCO(165.5,D0,"CS"),U,PIECE)=""
F PIECE=1:1:19 S $P(^ONCO(165.5,D0,"CS1"),U,PIECE)=""
F PIECE=1:1:19 S $P(^ONCO(165.5,D0,"CS2"),U,PIECE)=""
S $P(^ONCO(165.5,D0,"CS3"),U,1)=""
K PIECE
Q
;
CL2018 ;
W !
W !?3,"You have changed the HISTOLOGY (ICD-O-3). This change may"
W !?3,"affect the validity of the SITE-SPECIFIC DATA ITEMS."
W !?3,"Therefore, the SSDi fields have been initialized and need to"
W !?3,"be re-entered."
W !
F PIECE=12:1:14 S $P(^ONCO(165.5,D0,2.3),U,PIECE)=""
F PIECE=1:1:35 S $P(^ONCO(165.5,D0,"SSD1"),U,PIECE)=""
F PIECE=1:1:36 S $P(^ONCO(165.5,D0,"SSD2"),U,PIECE)=""
F PIECE=1:1:34 S $P(^ONCO(165.5,D0,"SSD3"),U,PIECE)=""
F PIECE=1:1:33 S $P(^ONCO(165.5,D0,"SSD4"),U,PIECE)=""
K PIECE
D CLNCS
Q
CLEANUP ;Cleanup
K D0,ONCOANS,Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCCS 11621 printed Dec 13, 2024@02:22:39 Page 2
ONCCS ;HINES OIFO/GWB - Collaborative Staging ;06/23/10
+1 ;;2.2;ONCOLOGY;**1,4,5,10,19**;Jul 31, 2013;Build 4
+2 ;
+3 NEW DIR,IEN,LV,PS,RC,X
+4 WRITE !
+5 SET DIR("A")=" Compute Collaborative Staging"
+6 SET DIR(0)="Y"
SET DIR("B")="Yes"
DO ^DIR
+7 IF (Y=0)!(Y="")!(Y[U)
SET Y=$SELECT(ONCOANS="A":"@4",1:"@0")
QUIT
+8 ;
+9 ;re-initialize if 96703
+10 IF ($PIECE($GET(^ONCO(165.5,D0,2.2)),U,3)=96703)
IF ($PIECE($GET(^ONCO(165.5,D0,0)),U,16)>3120000)
Begin DoDot:1
+11 DO CLNCS
+12 WRITE !!,"96703 is obsolete for primaries starting 2012!!!"
End DoDot:1
QUIT
+13 ;
+14 SET IEN=D0
+15 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,1,9)=U_U_U_U_U_U_U_U
+16 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,11)=""
+17 ;
+18 KILL INPUT,STORE,DISPLAY,STATUS,ONCSAPI
+19 DO CLEAR^ONCSAPIE(1)
+20 ;
+21 SET PS=$$GET1^DIQ(165.5,IEN,20,"I")
+22 if PS'=""
SET PS=$TRANSLATE($$GET1^DIQ(164,PS,1,"I"),".","")
+23 SET INPUT("SITE")=PS
+24 ;
+25 SET INPUT("HIST")=$EXTRACT($$GET1^DIQ(165.5,IEN,22.3,"I"),1,4)
+26 ;
+27 SET INPUT("DIAGNOSIS_YEAR")=$EXTRACT($$DATE^ONCACDU1($$GET1^DIQ(165.5,IEN,3,"I")),1,4)
+28 ;
+29 ;S INPUT("CSVER_ORIGINAL")=$P($$VERSION^ONCSAPIV,U,2)
+30 ;S:INPUT("CSVER_ORIGINAL")="" INPUT("CSVER_ORIGINAL")=$P($$VERSION^ONCSAPIV,U,2)
+31 SET INPUT("CSVER_ORIGINAL")=$$GET1^DIQ(165.5,IEN,169.1,"I")
+32 if INPUT("CSVER_ORIGINAL")=""
SET INPUT("CSVER_ORIGINAL")="020550"
+33 ;
+34 SET INPUT("BEHAV")=$EXTRACT($$GET1^DIQ(165.5,IEN,22.3,"I"),5)
+35 ;
+36 SET INPUT("GRADE")=$$GET1^DIQ(165.5,IEN,24,"I")
+37 ;
+38 SET INPUT("AGE")=$$AGEDX^ONCACDU1(IEN)
+39 if $LENGTH(INPUT("AGE"))=1
SET INPUT("AGE")="00"_INPUT("AGE")
+40 if $LENGTH(INPUT("AGE"))=2
SET INPUT("AGE")=0_INPUT("AGE")
+41 ;
+42 SET LV=$$GET1^DIQ(165.5,IEN,149,"I")_$$GET1^DIQ(165.5,IEN,151,"I")
+43 SET INPUT("LVI")=$SELECT(LV[1:1,LV[2:1,LV[0:0,LV["X":9,1:8)
+44 ;
+45 SET INPUT("SIZE")=$$GET1^DIQ(165.5,IEN,29.2,"I")
+46 ;
+47 SET INPUT("EXT")=$$GET1^DIQ(165.5,IEN,30.2,"I")
+48 ;
+49 SET INPUT("EXTEVAL")=$$GET1^DIQ(165.5,IEN,29.1,"I")
+50 ;
+51 SET INPUT("NODES")=$$GET1^DIQ(165.5,IEN,31.1,"I")
+52 ;
+53 SET INPUT("LNPOS")=$$GET1^DIQ(165.5,IEN,32,"I")
+54 if $LENGTH(INPUT("LNPOS"))=1
SET INPUT("LNPOS")=0_INPUT("LNPOS")
+55 ;
+56 SET INPUT("LNEXAM")=$$GET1^DIQ(165.5,IEN,33,"I")
+57 if $LENGTH(INPUT("LNEXAM"))=1
SET INPUT("LNEXAM")=0_INPUT("LNEXAM")
+58 ;
+59 SET INPUT("NODESEVAL")=$$GET1^DIQ(165.5,IEN,32.1,"I")
+60 ;
+61 SET INPUT("METS")=$$GET1^DIQ(165.5,IEN,34.3,"I")
+62 ;
+63 SET INPUT("METSEVAL")=$$GET1^DIQ(165.5,IEN,34.4,"I")
+64 ;
+65 SET INPUT("SSF1")=$$GET1^DIQ(165.5,IEN,44.1,"I")
+66 SET INPUT("SSF2")=$$GET1^DIQ(165.5,IEN,44.2,"I")
+67 SET INPUT("SSF3")=$$GET1^DIQ(165.5,IEN,44.3,"I")
+68 SET INPUT("SSF4")=$$GET1^DIQ(165.5,IEN,44.4,"I")
+69 SET INPUT("SSF5")=$$GET1^DIQ(165.5,IEN,44.5,"I")
+70 SET INPUT("SSF6")=$$GET1^DIQ(165.5,IEN,44.6,"I")
+71 SET INPUT("SSF7")=$$GET1^DIQ(165.5,IEN,44.7,"I")
+72 SET INPUT("SSF8")=$$GET1^DIQ(165.5,IEN,44.8,"I")
+73 SET INPUT("SSF9")=$$GET1^DIQ(165.5,IEN,44.9,"I")
+74 SET INPUT("SSF10")=$$GET1^DIQ(165.5,IEN,44.101,"I")
+75 SET INPUT("SSF11")=$$GET1^DIQ(165.5,IEN,44.11,"I")
+76 SET INPUT("SSF12")=$$GET1^DIQ(165.5,IEN,44.12,"I")
+77 SET INPUT("SSF13")=$$GET1^DIQ(165.5,IEN,44.13,"I")
+78 SET INPUT("SSF14")=$$GET1^DIQ(165.5,IEN,44.14,"I")
+79 SET INPUT("SSF15")=$$GET1^DIQ(165.5,IEN,44.15,"I")
+80 SET INPUT("SSF16")=$$GET1^DIQ(165.5,IEN,44.16,"I")
+81 SET INPUT("SSF17")=$$GET1^DIQ(165.5,IEN,44.17,"I")
+82 SET INPUT("SSF18")=$$GET1^DIQ(165.5,IEN,44.18,"I")
+83 SET INPUT("SSF19")=$$GET1^DIQ(165.5,IEN,44.19,"I")
+84 SET INPUT("SSF20")=$$GET1^DIQ(165.5,IEN,44.201,"I")
+85 SET INPUT("SSF21")=$$GET1^DIQ(165.5,IEN,44.21,"I")
+86 SET INPUT("SSF22")=$$GET1^DIQ(165.5,IEN,44.22,"I")
+87 SET INPUT("SSF23")=$$GET1^DIQ(165.5,IEN,44.23,"I")
+88 SET INPUT("SSF24")=$$GET1^DIQ(165.5,IEN,44.24,"I")
+89 IF $PIECE($GET(^ONCO(165.5,IEN,"CS3")),U,1)'=""
Begin DoDot:1
+90 SET $PIECE(^ONCO(165.5,IEN,"CS2"),U,19)=$PIECE($GET(^ONCO(165.5,IEN,"CS3")),U,1)
End DoDot:1
+91 SET INPUT("SSF25")=$$GET1^DIQ(165.5,IEN,44.25,"I")
+92 ;patch 19 - stuff with BLANKS for NULL: cloud server migration
+93 if INPUT("EXT")=""
SET INPUT("EXT")=" "
+94 if INPUT("EXTEVAL")=""
SET INPUT("EXTEVAL")=" "
+95 if INPUT("GRADE")=""
SET INPUT("GRADE")=" "
+96 if INPUT("METS")=""
SET INPUT("METS")=" "
+97 if INPUT("METSEVAL")=""
SET INPUT("METSEVAL")=" "
+98 if INPUT("NODES")=""
SET INPUT("NODES")=" "
+99 if INPUT("NODESEVAL")=""
SET INPUT("NODESEVAL")=" "
+100 if INPUT("SIZE")=""
SET INPUT("SIZE")=" "
+101 if INPUT("SSF1")=""
SET INPUT("SSF1")=" "
+102 if INPUT("SSF2")=""
SET INPUT("SSF2")=" "
+103 if INPUT("SSF3")=""
SET INPUT("SSF3")=" "
+104 if INPUT("SSF4")=""
SET INPUT("SSF4")=" "
+105 if INPUT("SSF5")=""
SET INPUT("SSF5")=" "
+106 if INPUT("SSF6")=""
SET INPUT("SSF6")=" "
+107 if INPUT("SSF7")=""
SET INPUT("SSF7")=" "
+108 if INPUT("SSF8")=""
SET INPUT("SSF8")=" "
+109 if INPUT("SSF9")=""
SET INPUT("SSF9")=" "
+110 if INPUT("SSF10")=""
SET INPUT("SSF10")=" "
+111 if INPUT("SSF11")=""
SET INPUT("SSF11")=" "
+112 if INPUT("SSF12")=""
SET INPUT("SSF12")=" "
+113 if INPUT("SSF13")=""
SET INPUT("SSF13")=" "
+114 if INPUT("SSF14")=""
SET INPUT("SSF14")=" "
+115 if INPUT("SSF15")=""
SET INPUT("SSF15")=" "
+116 if INPUT("SSF16")=""
SET INPUT("SSF16")=" "
+117 if INPUT("SSF17")=""
SET INPUT("SSF17")=" "
+118 if INPUT("SSF18")=""
SET INPUT("SSF18")=" "
+119 if INPUT("SSF19")=""
SET INPUT("SSF19")=" "
+120 if INPUT("SSF20")=""
SET INPUT("SSF20")=" "
+121 if INPUT("SSF21")=""
SET INPUT("SSF21")=" "
+122 if INPUT("SSF22")=""
SET INPUT("SSF22")=" "
+123 if INPUT("SSF23")=""
SET INPUT("SSF23")=" "
+124 if INPUT("SSF24")=""
SET INPUT("SSF24")=" "
+125 if INPUT("SSF25")=""
SET INPUT("SSF25")=" "
+126 DO XMLREQ
+127 ;
+128 KILL ^TMP("ONCCSRSP",$JOB)
SET ONCEXEC="P"
DO TCS^ONCWEB1
+129 SET ERRFLG=0
DO PARSECS^ONCWEBP2
+130 IF ERRFLG=1
DO DISERR^ONCWEBP2
WRITE !," You have encountered a CS error/warning"
GOTO CSERR
+131 IF ERRFLG=2
WRITE !," You have encountered an XML/server problem"
GOTO CSERR
+132 ; S RC=$$CALC^ONCSAPI3(.ONCSAPI,.INPUT,.STORE,.DISPLAY,.STATUS)
+133 ; I RC D PRTERRS^ONCSAPIE() R "Press return to continue",X:DTIME
+134 ;
+135 IF ONCSTORE("AJCC7-M")=" "
SET ONCSTORE("AJCC7-M")=""
+136 IF ONCSTORE("AJCC7-MDESCR")=" "
SET ONCSTORE("AJCC7-MDESCR")=""
+137 IF ONCSTORE("AJCC7-N")=" "
SET ONCSTORE("AJCC7-N")=""
+138 IF ONCSTORE("AJCC7-NDESCR")=" "
SET ONCSTORE("AJCC7-NDESCR")=""
+139 IF ONCSTORE("AJCC7-STAGE")=" "
SET ONCSTORE("AJCC7-STAGE")=""
+140 IF ONCSTORE("AJCC7-T")=" "
SET ONCSTORE("AJCC7-T")=""
+141 IF ONCSTORE("AJCC7-TDESCR")=" "
SET ONCSTORE("AJCC7-TDESCR")=""
+142 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,1)=ONCSTORE("T")
+143 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,2)=ONCSTORE("TDESCR")
+144 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,3)=ONCSTORE("N")
+145 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,4)=ONCSTORE("NDESCR")
+146 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,5)=ONCSTORE("M")
+147 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,6)=ONCSTORE("MDESCR")
+148 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,7)=ONCSTORE("AJCC")
+149 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,13)=ONCSTORE("AJCC7-T")
+150 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,14)=ONCSTORE("AJCC7-TDESCR")
+151 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,15)=ONCSTORE("AJCC7-N")
+152 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,16)=ONCSTORE("AJCC7-NDESCR")
+153 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,17)=ONCSTORE("AJCC7-M")
+154 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,18)=ONCSTORE("AJCC7-MDESCR")
+155 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,19)=ONCSTORE("AJCC7-STAGE")
+156 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,8)=ONCSTORE("SS1977")
+157 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,9)=ONCSTORE("SS2000")
+158 ;I $D(ONCAPIVR) W !!,"ONCAPIVR=",ONCAPIVR
+159 ;I $D(ONCVERSN) W !!,"ONCVERSN=",ONCVERSN
+160 ;S ONCAPIVR=020550 ;this line would hard set the CS version: cloud migration
+161 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,11)=$GET(ONCAPIVR)
+162 if $PIECE(^ONCO(165.5,IEN,"CS1"),U,12)=""
SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,12)=$GET(ONCAPIVR)
+163 DO ^ONCPCS
+164 IF ERRFLG=0
WRITE !," Collaborative Staging was successful"
QUIT
+165 ;
+166 ;I $P(RC,U,1)=0 W !," Collaborative Staging was successful" Q
+167 ;I $P(RC,U,1)=-10 W !," CS server unavailable. Contact IRM." Q
+168 ;I $P(RC,U,1)=-22 W !," Invalid COLLABORATIVE STAGING URL value in ONCOLOGY SITE PARAMETERS" Q
+169 ;I $P(RC,U,1)<0 W !," You have encountered a CS error" G CSERR
+170 ;I $P(RC,U,1)>0 W !," You have encountered a CS warning" G CSERR
+171 ;
CSERR NEW DIR,X
+1 SET DIR("A")="Do you wish to re-enter the CS input values"
+2 SET DIR(0)="Y"
SET DIR("B")="Yes"
DO ^DIR
+3 IF Y=1
SET Y="@292"
QUIT
+4 IF Y[U
SET Y="@0"
QUIT
+5 SET Y=$SELECT(ONCOANS="A":"@4",1:"@0")
+6 QUIT
+7 ;
XMLREQ ;Build the XML Request for cloud server from INPUT array
+1 KILL ^TMP("ONCINPUT",$JOB)
+2 NEW ONCTAG,ONCN
+3 SET ONCN=1
+4 SET ^TMP("ONCINPUT",$JOB,ONCN)="<?xml version=""1.0"" encoding=""UTF-8""?>"
+5 SET ONCN=ONCN+1
+6 SET ^TMP("ONCINPUT",$JOB,ONCN)="<CS-CALCULATE xmlns=""http://websrv.oncology.domain.ext"">"
+7 SET ONCTAG=""
FOR
SET ONCTAG=$ORDER(INPUT(ONCTAG))
if ONCTAG=""
QUIT
Begin DoDot:1
+8 SET ONCN=ONCN+1
+9 IF ONCTAG="SITE"
IF $LENGTH(INPUT(ONCTAG))=4
SET ^TMP("ONCINPUT",$JOB,ONCN)="<"_ONCTAG_">"_INPUT(ONCTAG)_" </"_ONCTAG_">"
QUIT
+10 SET ^TMP("ONCINPUT",$JOB,ONCN)="<"_ONCTAG_">"_INPUT(ONCTAG)_"</"_ONCTAG_">"
End DoDot:1
+11 SET ONCN=ONCN+1
+12 SET ^TMP("ONCINPUT",$JOB,ONCN)="</CS-CALCULATE>"
+13 QUIT
+14 ;
INIT ;Initialize CS fields when HISTOLOGY (ICD-O-3) (165.5,22.3) changes
+1 NEW FND,HISTNAM,HSTFLD,HSTI,LNS,LSC,MEL,OLDHST,SITEGRP,TEXT,Z,ZZHSTLST
+2 ;
+3 IF ($PIECE($GET(^ONCO(165.5,D0,0)),U,16)>3010000)
IF (X=94211)
Begin DoDot:1
+4 WRITE !!,"94211 is obsolete for primaries starting 2001!!!"
+5 KILL X
End DoDot:1
QUIT
+6 IF ($PIECE($GET(^ONCO(165.5,D0,0)),U,16)>3120000)
IF (X=96703)
Begin DoDot:1
+7 WRITE !!,"96703 is obsolete for primaries starting 2012!!!"
+8 KILL X
End DoDot:1
QUIT
+9 IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)>3100000
Begin DoDot:1
+10 SET FND=0
+11 SET ZZHSTLST="96543^96613^96623^96643^96653^96673^96703^96753^96843^97283^97293^97333^97503^97511^97521^97531^97543^97603^97643^98053^98353^98363^99603^99843^99873"
+12 FOR Z=1:1:27
IF $PIECE(ZZHSTLST,U,Z)=X
SET FND=1
+13 IF FND=1
WRITE !!,X," is obsolete for primaries starting 2010!!!"
KILL X
End DoDot:1
IF FND=1
QUIT
+14 SET LNS=$ORDER(^ONCO(164.2,"B","LUNG NOS",0))
+15 SET LSC=$ORDER(^ONCO(164.2,"B","LUNG SMALL CELL",0))
+16 SET MEL=$ORDER(^ONCO(164.2,"B","MELANOMA",0))
+17 SET SITEGRP=$PIECE($GET(^ONCO(165.5,D0,0)),U,1)
+18 SET OLDHST=$PIECE($GET(^ONCO(165.5,D0,2.2)),U,3)
+19 ;re-initialized if 96703, obsolete histology.
IF (OLDHST=96703)
IF ($PIECE($GET(^ONCO(165.5,D0,0)),U,16)>3120000)
DO CLNCS
+20 IF X=OLDHST
QUIT
+21 IF SITEGRP=LNS
Begin DoDot:1
+22 IF ($EXTRACT(X,1,4)=8041)!($EXTRACT(X,1,4)=8042)!($EXTRACT(X,1,4)=8043)!($EXTRACT(X,1,4)=8044)!($EXTRACT(X,1,4)=8045)!($EXTRACT(X,1,4)=8246)
Begin DoDot:2
+23 SET $PIECE(^ONCO(165.5,D0,0),U,1)=LSC
+24 KILL ^ONCO(165.5,"B",LNS,D0)
+25 SET ^ONCO(165.5,"B",LSC,D0)=""
End DoDot:2
WRITE !!," SITE/GP changed to LUNG SMALL CELL",!
End DoDot:1
+26 IF SITEGRP=LSC
Begin DoDot:1
+27 IF ($EXTRACT(X,1,4)'=8041)&($EXTRACT(X,1,4)'=8042)&($EXTRACT(X,1,4)'=8043)&($EXTRACT(X,1,4)'=8044)&($EXTRACT(X,1,4)'=8045)&($EXTRACT(X,1,4)'=8246)
Begin DoDot:2
+28 SET $PIECE(^ONCO(165.5,D0,0),U,1)=LNS
+29 KILL ^ONCO(165.5,"B",LSC,D0)
+30 SET ^ONCO(165.5,"B",LNS,D0)=""
End DoDot:2
WRITE !!," SITE/GP changed to LUNG NOS",!
End DoDot:1
+31 IF SITEGRP'=MEL
Begin DoDot:1
+32 IF (X'<87200)&(X<87910)
Begin DoDot:2
+33 SET $PIECE(^ONCO(165.5,D0,0),U,1)=MEL
+34 KILL ^ONCO(165.5,"B",SITEGRP,D0)
+35 SET ^ONCO(165.5,"B",MEL,D0)=""
End DoDot:2
WRITE !!," SITE/GP changed to MELANOMA",!
End DoDot:1
+36 IF SITEGRP=MEL
Begin DoDot:1
+37 IF (X<87200)!(X>87900)
Begin DoDot:2
+38 WRITE !
+39 WRITE !," WARNING: SITE/GP and HISTOLOGY discrepancy"
+40 WRITE !," SITE/GP = MELANOMA"
+41 WRITE !," HISTOLOGY = ",$PIECE(Y,U,1)," ",$PIECE(Y,U,2)
+42 WRITE !
End DoDot:2
End DoDot:1
+43 IF OLDHST=""
QUIT
+44 SET HSTI=$$HIST^ONCFUNC(D0,.HSTFLD,.HISTNAM)
+45 SET TEXT=HISTNAM
+46 SET $PIECE(^ONCO(165.5,D0,8),U,2)=$EXTRACT(TEXT,1,40)
+47 IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)<3040000
QUIT
+48 IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)>3171231
DO CL2018
QUIT
+49 WRITE !
+50 WRITE !?3,"You have changed the HISTOLOGY (ICD-O-3). This change may"
+51 WRITE !?3,"affect the validity of the COLLABORATIVE STAGING data."
+52 WRITE !?3,"Therefore, the CS fields have been initialized and need to"
+53 WRITE !?3,"be re-entered."
+54 WRITE !
CLNCS ;re-initialize if Histology 96703
+1 FOR PIECE=1:1:12
SET $PIECE(^ONCO(165.5,D0,"CS"),U,PIECE)=""
+2 FOR PIECE=1:1:19
SET $PIECE(^ONCO(165.5,D0,"CS1"),U,PIECE)=""
+3 FOR PIECE=1:1:19
SET $PIECE(^ONCO(165.5,D0,"CS2"),U,PIECE)=""
+4 SET $PIECE(^ONCO(165.5,D0,"CS3"),U,1)=""
+5 KILL PIECE
+6 QUIT
+7 ;
CL2018 ;
+1 WRITE !
+2 WRITE !?3,"You have changed the HISTOLOGY (ICD-O-3). This change may"
+3 WRITE !?3,"affect the validity of the SITE-SPECIFIC DATA ITEMS."
+4 WRITE !?3,"Therefore, the SSDi fields have been initialized and need to"
+5 WRITE !?3,"be re-entered."
+6 WRITE !
+7 FOR PIECE=12:1:14
SET $PIECE(^ONCO(165.5,D0,2.3),U,PIECE)=""
+8 FOR PIECE=1:1:35
SET $PIECE(^ONCO(165.5,D0,"SSD1"),U,PIECE)=""
+9 FOR PIECE=1:1:36
SET $PIECE(^ONCO(165.5,D0,"SSD2"),U,PIECE)=""
+10 FOR PIECE=1:1:34
SET $PIECE(^ONCO(165.5,D0,"SSD3"),U,PIECE)=""
+11 FOR PIECE=1:1:33
SET $PIECE(^ONCO(165.5,D0,"SSD4"),U,PIECE)=""
+12 KILL PIECE
+13 DO CLNCS
+14 QUIT
CLEANUP ;Cleanup
+1 KILL D0,ONCOANS,Y
+2 QUIT
