- 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 Feb 18, 2025@23:49:01 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