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

ONCCS.m

Go to the documentation of this file. 
  1. ONCCS ;HINES OIFO/GWB - Collaborative Staging ;06/23/10
  1.  ;;2.2;ONCOLOGY;**1,4,5,10,19**;Jul 31, 2013;Build 4
  1.  ;
  1.  N DIR,IEN,LV,PS,RC,X
  1.  W !
  1.  S DIR("A")=" Compute Collaborative Staging"
  1.  S DIR(0)="Y",DIR("B")="Yes" D ^DIR
  1.  I (Y=0)!(Y="")!(Y[U) S Y=$S(ONCOANS="A":"@4",1:"@0") Q
  1.  ;
  1.  ;re-initialize if 96703
  1.  I ($P($G(^ONCO(165.5,D0,2.2)),U,3)=96703),($P($G(^ONCO(165.5,D0,0)),U,16)>3120000) D  Q
  1.  .D CLNCS
  1.  .W !!,"96703 is obsolete for primaries starting 2012!!!"
  1.  ;
  1.  S IEN=D0
  1.  S $P(^ONCO(165.5,IEN,"CS1"),U,1,9)=U_U_U_U_U_U_U_U
  1.  S $P(^ONCO(165.5,IEN,"CS1"),U,11)=""
  1.  ;
  1.  K INPUT,STORE,DISPLAY,STATUS,ONCSAPI
  1.  D CLEAR^ONCSAPIE(1)
  1.  ;
  1.  S PS=$$GET1^DIQ(165.5,IEN,20,"I")
  1.  S:PS'="" PS=$TR($$GET1^DIQ(164,PS,1,"I"),".","")
  1.  S INPUT("SITE")=PS
  1.  ;
  1.  S INPUT("HIST")=$E($$GET1^DIQ(165.5,IEN,22.3,"I"),1,4)
  1.  ;
  1.  S INPUT("DIAGNOSIS_YEAR")=$E($$DATE^ONCACDU1($$GET1^DIQ(165.5,IEN,3,"I")),1,4)
  1.  ;
  1.  ;S INPUT("CSVER_ORIGINAL")=$P($$VERSION^ONCSAPIV,U,2)
  1.  ;S:INPUT("CSVER_ORIGINAL")="" INPUT("CSVER_ORIGINAL")=$P($$VERSION^ONCSAPIV,U,2)
  1.  S INPUT("CSVER_ORIGINAL")=$$GET1^DIQ(165.5,IEN,169.1,"I")
  1.  S:INPUT("CSVER_ORIGINAL")="" INPUT("CSVER_ORIGINAL")="020550"
  1.  ;
  1.  S INPUT("BEHAV")=$E($$GET1^DIQ(165.5,IEN,22.3,"I"),5)
  1.  ;
  1.  S INPUT("GRADE")=$$GET1^DIQ(165.5,IEN,24,"I")
  1.  ;
  1.  S INPUT("AGE")=$$AGEDX^ONCACDU1(IEN)
  1.  S:$L(INPUT("AGE"))=1 INPUT("AGE")="00"_INPUT("AGE")
  1.  S:$L(INPUT("AGE"))=2 INPUT("AGE")=0_INPUT("AGE")
  1.  ;
  1.  S LV=$$GET1^DIQ(165.5,IEN,149,"I")_$$GET1^DIQ(165.5,IEN,151,"I")
  1.  S INPUT("LVI")=$S(LV[1:1,LV[2:1,LV[0:0,LV["X":9,1:8)
  1.  ;
  1.  S INPUT("SIZE")=$$GET1^DIQ(165.5,IEN,29.2,"I")
  1.  ;
  1.  S INPUT("EXT")=$$GET1^DIQ(165.5,IEN,30.2,"I")
  1.  ;
  1.  S INPUT("EXTEVAL")=$$GET1^DIQ(165.5,IEN,29.1,"I")
  1.  ;
  1.  S INPUT("NODES")=$$GET1^DIQ(165.5,IEN,31.1,"I")
  1.  ;
  1.  S INPUT("LNPOS")=$$GET1^DIQ(165.5,IEN,32,"I")
  1.  S:$L(INPUT("LNPOS"))=1 INPUT("LNPOS")=0_INPUT("LNPOS")
  1.  ;
  1.  S INPUT("LNEXAM")=$$GET1^DIQ(165.5,IEN,33,"I")
  1.  S:$L(INPUT("LNEXAM"))=1 INPUT("LNEXAM")=0_INPUT("LNEXAM")
  1.  ;
  1.  S INPUT("NODESEVAL")=$$GET1^DIQ(165.5,IEN,32.1,"I")
  1.  ;
  1.  S INPUT("METS")=$$GET1^DIQ(165.5,IEN,34.3,"I")
  1.  ;
  1.  S INPUT("METSEVAL")=$$GET1^DIQ(165.5,IEN,34.4,"I")
  1.  ;
  1.  S INPUT("SSF1")=$$GET1^DIQ(165.5,IEN,44.1,"I")
  1.  S INPUT("SSF2")=$$GET1^DIQ(165.5,IEN,44.2,"I")
  1.  S INPUT("SSF3")=$$GET1^DIQ(165.5,IEN,44.3,"I")
  1.  S INPUT("SSF4")=$$GET1^DIQ(165.5,IEN,44.4,"I")
  1.  S INPUT("SSF5")=$$GET1^DIQ(165.5,IEN,44.5,"I")
  1.  S INPUT("SSF6")=$$GET1^DIQ(165.5,IEN,44.6,"I")
  1.  S INPUT("SSF7")=$$GET1^DIQ(165.5,IEN,44.7,"I")
  1.  S INPUT("SSF8")=$$GET1^DIQ(165.5,IEN,44.8,"I")
  1.  S INPUT("SSF9")=$$GET1^DIQ(165.5,IEN,44.9,"I")
  1.  S INPUT("SSF10")=$$GET1^DIQ(165.5,IEN,44.101,"I")
  1.  S INPUT("SSF11")=$$GET1^DIQ(165.5,IEN,44.11,"I")
  1.  S INPUT("SSF12")=$$GET1^DIQ(165.5,IEN,44.12,"I")
  1.  S INPUT("SSF13")=$$GET1^DIQ(165.5,IEN,44.13,"I")
  1.  S INPUT("SSF14")=$$GET1^DIQ(165.5,IEN,44.14,"I")
  1.  S INPUT("SSF15")=$$GET1^DIQ(165.5,IEN,44.15,"I")
  1.  S INPUT("SSF16")=$$GET1^DIQ(165.5,IEN,44.16,"I")
  1.  S INPUT("SSF17")=$$GET1^DIQ(165.5,IEN,44.17,"I")
  1.  S INPUT("SSF18")=$$GET1^DIQ(165.5,IEN,44.18,"I")
  1.  S INPUT("SSF19")=$$GET1^DIQ(165.5,IEN,44.19,"I")
  1.  S INPUT("SSF20")=$$GET1^DIQ(165.5,IEN,44.201,"I")
  1.  S INPUT("SSF21")=$$GET1^DIQ(165.5,IEN,44.21,"I")
  1.  S INPUT("SSF22")=$$GET1^DIQ(165.5,IEN,44.22,"I")
  1.  S INPUT("SSF23")=$$GET1^DIQ(165.5,IEN,44.23,"I")
  1.  S INPUT("SSF24")=$$GET1^DIQ(165.5,IEN,44.24,"I")
  1.  I $P($G(^ONCO(165.5,IEN,"CS3")),U,1)'="" D
  1.  .S $P(^ONCO(165.5,IEN,"CS2"),U,19)=$P($G(^ONCO(165.5,IEN,"CS3")),U,1)
  1.  S INPUT("SSF25")=$$GET1^DIQ(165.5,IEN,44.25,"I")
  1.  ;patch 19 - stuff with BLANKS for NULL: cloud server migration
  1.  S:INPUT("EXT")="" INPUT("EXT")="   "
  1.  S:INPUT("EXTEVAL")="" INPUT("EXTEVAL")=" "
  1.  S:INPUT("GRADE")="" INPUT("GRADE")=" "
  1.  S:INPUT("METS")="" INPUT("METS")="  "
  1.  S:INPUT("METSEVAL")="" INPUT("METSEVAL")=" "
  1.  S:INPUT("NODES")="" INPUT("NODES")="   "
  1.  S:INPUT("NODESEVAL")="" INPUT("NODESEVAL")=" "
  1.  S:INPUT("SIZE")="" INPUT("SIZE")="   "
  1.  S:INPUT("SSF1")="" INPUT("SSF1")="   "
  1.  S:INPUT("SSF2")="" INPUT("SSF2")="   "
  1.  S:INPUT("SSF3")="" INPUT("SSF3")="   "
  1.  S:INPUT("SSF4")="" INPUT("SSF4")="   "
  1.  S:INPUT("SSF5")="" INPUT("SSF5")="   "
  1.  S:INPUT("SSF6")="" INPUT("SSF6")="   "
  1.  S:INPUT("SSF7")="" INPUT("SSF7")="   "
  1.  S:INPUT("SSF8")="" INPUT("SSF8")="   "
  1.  S:INPUT("SSF9")="" INPUT("SSF9")="   "
  1.  S:INPUT("SSF10")="" INPUT("SSF10")="   "
  1.  S:INPUT("SSF11")="" INPUT("SSF11")="   "
  1.  S:INPUT("SSF12")="" INPUT("SSF12")="   "
  1.  S:INPUT("SSF13")="" INPUT("SSF13")="   "
  1.  S:INPUT("SSF14")="" INPUT("SSF14")="   "
  1.  S:INPUT("SSF15")="" INPUT("SSF15")="   "
  1.  S:INPUT("SSF16")="" INPUT("SSF16")="   "
  1.  S:INPUT("SSF17")="" INPUT("SSF17")="   "
  1.  S:INPUT("SSF18")="" INPUT("SSF18")="   "
  1.  S:INPUT("SSF19")="" INPUT("SSF19")="   "
  1.  S:INPUT("SSF20")="" INPUT("SSF20")="   "
  1.  S:INPUT("SSF21")="" INPUT("SSF21")="   "
  1.  S:INPUT("SSF22")="" INPUT("SSF22")="   "
  1.  S:INPUT("SSF23")="" INPUT("SSF23")="   "
  1.  S:INPUT("SSF24")="" INPUT("SSF24")="   "
  1.  S:INPUT("SSF25")="" INPUT("SSF25")="   "
  1.  D XMLREQ
  1.  ;
  1.  K ^TMP("ONCCSRSP",$J) S ONCEXEC="P" D TCS^ONCWEB1
  1.  S ERRFLG=0 D PARSECS^ONCWEBP2
  1.  I ERRFLG=1 D DISERR^ONCWEBP2 W !," You have encountered a CS error/warning" G CSERR
  1.  I ERRFLG=2 W !," You have encountered an XML/server problem" G CSERR
  1.  ; S RC=$$CALC^ONCSAPI3(.ONCSAPI,.INPUT,.STORE,.DISPLAY,.STATUS)
  1.  ; I RC D PRTERRS^ONCSAPIE() R "Press return to continue",X:DTIME
  1.  ;
  1.  I ONCSTORE("AJCC7-M")="   " S ONCSTORE("AJCC7-M")=""
  1.  I ONCSTORE("AJCC7-MDESCR")=" " S ONCSTORE("AJCC7-MDESCR")=""
  1.  I ONCSTORE("AJCC7-N")="   " S ONCSTORE("AJCC7-N")=""
  1.  I ONCSTORE("AJCC7-NDESCR")=" " S ONCSTORE("AJCC7-NDESCR")=""
  1.  I ONCSTORE("AJCC7-STAGE")="   " S ONCSTORE("AJCC7-STAGE")=""
  1.  I ONCSTORE("AJCC7-T")="   " S ONCSTORE("AJCC7-T")=""
  1.  I ONCSTORE("AJCC7-TDESCR")=" " S ONCSTORE("AJCC7-TDESCR")=""
  1.  S $P(^ONCO(165.5,IEN,"CS1"),U,1)=ONCSTORE("T")
  1.  S $P(^ONCO(165.5,IEN,"CS1"),U,2)=ONCSTORE("TDESCR")
  1.  S $P(^ONCO(165.5,IEN,"CS1"),U,3)=ONCSTORE("N")
  1.  S $P(^ONCO(165.5,IEN,"CS1"),U,4)=ONCSTORE("NDESCR")
  1.  S $P(^ONCO(165.5,IEN,"CS1"),U,5)=ONCSTORE("M")
  1.  S $P(^ONCO(165.5,IEN,"CS1"),U,6)=ONCSTORE("MDESCR")
  1.  S $P(^ONCO(165.5,IEN,"CS1"),U,7)=ONCSTORE("AJCC")
  1.  S $P(^ONCO(165.5,IEN,"CS1"),U,13)=ONCSTORE("AJCC7-T")
  1.  S $P(^ONCO(165.5,IEN,"CS1"),U,14)=ONCSTORE("AJCC7-TDESCR")
  1.  S $P(^ONCO(165.5,IEN,"CS1"),U,15)=ONCSTORE("AJCC7-N")
  1.  S $P(^ONCO(165.5,IEN,"CS1"),U,16)=ONCSTORE("AJCC7-NDESCR")
  1.  S $P(^ONCO(165.5,IEN,"CS1"),U,17)=ONCSTORE("AJCC7-M")
  1.  S $P(^ONCO(165.5,IEN,"CS1"),U,18)=ONCSTORE("AJCC7-MDESCR")
  1.  S $P(^ONCO(165.5,IEN,"CS1"),U,19)=ONCSTORE("AJCC7-STAGE")
  1.  S $P(^ONCO(165.5,IEN,"CS1"),U,8)=ONCSTORE("SS1977")
  1.  S $P(^ONCO(165.5,IEN,"CS1"),U,9)=ONCSTORE("SS2000")
  1.  ;I $D(ONCAPIVR) W !!,"ONCAPIVR=",ONCAPIVR
  1.  ;I $D(ONCVERSN) W !!,"ONCVERSN=",ONCVERSN
  1.  ;S ONCAPIVR=020550 ;this line would hard set the CS version: cloud migration
  1.  S $P(^ONCO(165.5,IEN,"CS1"),U,11)=$G(ONCAPIVR)
  1.  S:$P(^ONCO(165.5,IEN,"CS1"),U,12)="" $P(^ONCO(165.5,IEN,"CS1"),U,12)=$G(ONCAPIVR)
  1.  D ^ONCPCS
  1.  I ERRFLG=0 W !," Collaborative Staging was successful" Q
  1.  ;
  1.  ;I $P(RC,U,1)=0 W !," Collaborative Staging was successful" Q
  1.  ;I $P(RC,U,1)=-10 W !," CS server unavailable.  Contact IRM." Q
  1.  ;I $P(RC,U,1)=-22 W !," Invalid COLLABORATIVE STAGING URL value in ONCOLOGY SITE PARAMETERS" Q
  1.  ;I $P(RC,U,1)<0 W !," You have encountered a CS error" G CSERR
  1.  ;I $P(RC,U,1)>0 W !," You have encountered a CS warning" G CSERR
  1.  ;
  1. CSERR N DIR,X
  1.  S DIR("A")="Do you wish to re-enter the CS input values"
  1.  S DIR(0)="Y",DIR("B")="Yes" D ^DIR
  1.  I Y=1 S Y="@292" Q
  1.  I Y[U S Y="@0" Q
  1.  S Y=$S(ONCOANS="A":"@4",1:"@0")
  1.  Q
  1.  ;
  1. XMLREQ ;Build the XML Request for cloud server from INPUT array
  1.  K ^TMP("ONCINPUT",$J)
  1.  N ONCTAG,ONCN
  1.  S ONCN=1
  1.  S ^TMP("ONCINPUT",$J,ONCN)="<?xml version=""1.0"" encoding=""UTF-8""?>"
  1.  S ONCN=ONCN+1
  1.  S ^TMP("ONCINPUT",$J,ONCN)="<CS-CALCULATE xmlns=""http://websrv.oncology.domain.ext"">"
  1.  S ONCTAG="" F  S ONCTAG=$O(INPUT(ONCTAG)) Q:ONCTAG=""  D
  1.  .S ONCN=ONCN+1
  1.  .I ONCTAG="SITE",$L(INPUT(ONCTAG))=4 S ^TMP("ONCINPUT",$J,ONCN)="<"_ONCTAG_">"_INPUT(ONCTAG)_" </"_ONCTAG_">" Q
  1.  .S ^TMP("ONCINPUT",$J,ONCN)="<"_ONCTAG_">"_INPUT(ONCTAG)_"</"_ONCTAG_">"
  1.  S ONCN=ONCN+1
  1.  S ^TMP("ONCINPUT",$J,ONCN)="</CS-CALCULATE>"
  1.  Q
  1.  ;
  1. INIT ;Initialize CS fields when HISTOLOGY (ICD-O-3) (165.5,22.3) changes
  1.  N FND,HISTNAM,HSTFLD,HSTI,LNS,LSC,MEL,OLDHST,SITEGRP,TEXT,Z,ZZHSTLST
  1.  ;
  1.  I ($P($G(^ONCO(165.5,D0,0)),U,16)>3010000),(X=94211) D  Q
  1.  .W !!,"94211 is obsolete for primaries starting 2001!!!"
  1.  .K X
  1.  I ($P($G(^ONCO(165.5,D0,0)),U,16)>3120000),(X=96703) D  Q
  1.  .W !!,"96703 is obsolete for primaries starting 2012!!!"
  1.  .K X
  1.  I $P($G(^ONCO(165.5,D0,0)),U,16)>3100000 D  I FND=1 Q
  1.  .S FND=0
  1.  .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"
  1.  .F Z=1:1:27 I $P(ZZHSTLST,U,Z)=X S FND=1
  1.  .I FND=1 W !!,X," is obsolete for primaries starting 2010!!!" K X
  1.  S LNS=$O(^ONCO(164.2,"B","LUNG NOS",0))
  1.  S LSC=$O(^ONCO(164.2,"B","LUNG SMALL CELL",0))
  1.  S MEL=$O(^ONCO(164.2,"B","MELANOMA",0))
  1.  S SITEGRP=$P($G(^ONCO(165.5,D0,0)),U,1)
  1.  S OLDHST=$P($G(^ONCO(165.5,D0,2.2)),U,3)
  1.  I (OLDHST=96703),($P($G(^ONCO(165.5,D0,0)),U,16)>3120000) D CLNCS  ;re-initialized if 96703, obsolete histology.
  1.  I X=OLDHST Q
  1.  I SITEGRP=LNS D
  1.  .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",!
  1.  ..S $P(^ONCO(165.5,D0,0),U,1)=LSC
  1.  ..K ^ONCO(165.5,"B",LNS,D0)
  1.  ..S ^ONCO(165.5,"B",LSC,D0)=""
  1.  I SITEGRP=LSC D
  1.  .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",!
  1.  ..S $P(^ONCO(165.5,D0,0),U,1)=LNS
  1.  ..K ^ONCO(165.5,"B",LSC,D0)
  1.  ..S ^ONCO(165.5,"B",LNS,D0)=""
  1.  I SITEGRP'=MEL D
  1.  .I (X'<87200)&(X<87910) D  W !!," SITE/GP changed to MELANOMA",!
  1.  ..S $P(^ONCO(165.5,D0,0),U,1)=MEL
  1.  ..K ^ONCO(165.5,"B",SITEGRP,D0)
  1.  ..S ^ONCO(165.5,"B",MEL,D0)=""
  1.  I SITEGRP=MEL D
  1.  .I (X<87200)!(X>87900) D
  1.  ..W !
  1.  ..W !," WARNING: SITE/GP and HISTOLOGY discrepancy"
  1.  ..W !,"          SITE/GP   = MELANOMA"
  1.  ..W !,"          HISTOLOGY = ",$P(Y,U,1),"  ",$P(Y,U,2)
  1.  ..W !
  1.  I OLDHST="" Q
  1.  S HSTI=$$HIST^ONCFUNC(D0,.HSTFLD,.HISTNAM)
  1.  S TEXT=HISTNAM
  1.  S $P(^ONCO(165.5,D0,8),U,2)=$E(TEXT,1,40)
  1.  I $P($G(^ONCO(165.5,D0,0)),U,16)<3040000 Q
  1.  I $P($G(^ONCO(165.5,D0,0)),U,16)>3171231 D CL2018 Q
  1.  W !
  1.  W !?3,"You have changed the HISTOLOGY (ICD-O-3).  This change may"
  1.  W !?3,"affect the validity of the COLLABORATIVE STAGING data."
  1.  W !?3,"Therefore, the CS fields have been initialized and need to"
  1.  W !?3,"be re-entered."
  1.  W !
  1. CLNCS ;re-initialize if Histology 96703
  1.  F PIECE=1:1:12 S $P(^ONCO(165.5,D0,"CS"),U,PIECE)=""
  1.  F PIECE=1:1:19 S $P(^ONCO(165.5,D0,"CS1"),U,PIECE)=""
  1.  F PIECE=1:1:19 S $P(^ONCO(165.5,D0,"CS2"),U,PIECE)=""
  1.  S $P(^ONCO(165.5,D0,"CS3"),U,1)=""
  1.  K PIECE
  1.  Q
  1.  ;
  1. CL2018 ;
  1.  W !
  1.  W !?3,"You have changed the HISTOLOGY (ICD-O-3).  This change may"
  1.  W !?3,"affect the validity of the SITE-SPECIFIC DATA ITEMS."
  1.  W !?3,"Therefore, the SSDi fields have been initialized and need to"
  1.  W !?3,"be re-entered."
  1.  W !
  1.  F PIECE=12:1:14 S $P(^ONCO(165.5,D0,2.3),U,PIECE)=""
  1.  F PIECE=1:1:35 S $P(^ONCO(165.5,D0,"SSD1"),U,PIECE)=""
  1.  F PIECE=1:1:36 S $P(^ONCO(165.5,D0,"SSD2"),U,PIECE)=""
  1.  F PIECE=1:1:34 S $P(^ONCO(165.5,D0,"SSD3"),U,PIECE)=""
  1.  F PIECE=1:1:33 S $P(^ONCO(165.5,D0,"SSD4"),U,PIECE)=""
  1.  K PIECE
  1.  D CLNCS
  1.  Q
  1. CLEANUP ;Cleanup
  1.  K D0,ONCOANS,Y
  1.  Q