ONCSAPIT ;Hines OIFO/SG - COLLABORATIVE STAGING (TABLES) ;06/23/10
;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
;
;--- STRUCTURE OF THE RESPONSE
;
; <?xml version="1.0" encoding="utf-8"?>
; <soap:Envelope
; xmlns:soap="http://www.w3.org/2001/12/soap-envelope"
; soap:encodingStyle="http://www.w3.org/2001/12/soap-encoding">
; <soap:Body>
; <CS-RESPONSE xmlns="http://vista.domain.ext/oncology">
; <SCHEMA>...</SCHEMA>
; <TABLE>
; <NUMBER>...</NUMBER>
; <PATTERN>...</PATTERN>
; <ROLE>...</ROLE>
; <SUBTITLE>...</SUBTITLE>
; <TITLE>...</TITLE>
; <ROWS>
; <ROW>
; <CODE>...</CODE>
; <DESCR>
; <P>...</P>
; ...
; </DESCR>
; <AC>...</AC>
; ...
; </ROW>
; ...
; </ROWS>
; <NOTES>
; <TN>
; <P>...</P>
; ...
; </TN>
; ...
; <FN>
; <P>...</P>
; ...
; </FN>
; ...
; </NOTES>
; </TABLE>
; ...
; </CS-RESPONSE>
; <soap:Fault>
; <faultcode> ... </faultcode>
; <faultstring> ... </faultstring>
; <detail>
; <RC> ... </RC>
; </detail>
; </soap:Fault>
; </soap:Body >
; </soap:Envelope>
;
Q
;
;***** LOADS THE CS CODE DESCRIPTION
;
; [.ONCSAPI] Reference to the API descriptor (see the ^ONCSAPI)
;
; SITE Primary site
; HIST Histology
;
; TABLE Table number (see the ^ONCSAPI routine)
; CODE Primary code of a table row
;
; ONC8DST Closed reference of the destination buffer
;
; Return Values:
; 0 Ok
; <0 Error code
;
CODEDESC(ONCSAPI,SITE,HIST,TABLE,CODE,ONC8DST) ;
N I,NODE,RC,ROW,TBLIEN,TMP
D CLEAR^ONCSAPIE() K @ONC8DST
Q:$G(CODE)?." " $$ERROR^ONCSAPIE(-6,,"CODE",$G(CODE))
;---
L +^XTMP("ONCSAPI","TABLES","JOB",$J):5 E D Q RC
. S RC=$$ERROR^ONCSAPIE(-15,,"access control node")
;
S RC=0 D
. ;--- Get the table IEN
. S TBLIEN=$$GETCSTBL(.ONCSAPI,SITE,HIST,TABLE)
. I TBLIEN<0 S RC=TBLIEN Q
. S NODE=$NA(^XTMP("ONCSAPI","TABLES",TBLIEN))
. S CODE=+$G(CODE)
. ;--- Check the single code
. S ROW=$G(@NODE@("C",CODE))
. ;--- Check the interval
. I ROW'>0 D I ROW'>0 S RC=$$ERROR^ONCSAPIE(-6,,"CODE",CODE) Q
. . S TMP=$O(@NODE@("C",CODE),-1) Q:TMP=""
. . S ROW=$G(@NODE@("C",TMP))
. . S:CODE>$P(ROW,U,2) ROW=0
. ;--- Load the description
. M @ONC8DST=@NODE@(+ROW,3)
;
L -^XTMP("ONCSAPI","TABLES","JOB",$J)
Q $S(RC<0:RC,1:0)
;
;***** END ELEMENT CALLBACK FOR THE SAX PARSER
;
; ELMT Name of the element
;
ENDEL(ELMT) ;
N I,J,L,L2E,L3E,SUBS,TMP
S L=$L(ONCXML("PATH"),","),L2E=$P(ONCXML("PATH"),",",L-1,L)
S L3E=$P(ONCXML("PATH"),",",L-2,L)
D ENDEL^ONCSAPIX(ELMT)
;---
I L2E="CS-RESPONSE,TABLE" D Q
. N NAME,SCHEMA,TABLE
. S SCHEMA=+$G(ONCXML("SCHEMA")),TABLE=+$P(ONCTBDSC,U,3)
. S NAME=$P(ONCTBDSC,U,5)
. I (SCHEMA'>0)!(TABLE'>0)!(NAME="") K @ONCXML@(ONCTBIEN) Q
. S $P(ONCTBDSC,U,2)=SCHEMA
. ;---
. S @ONCXML@(ONCTBIEN,0)=$E(ONCTBDSC,1,254)
. S @ONCXML@("ST",SCHEMA,TABLE)=ONCTBIEN
;---
I L2E="ROW,CODE" D Q
. S $P(@ONCXML@(ONCTBIEN,ONCTBROW,1),U)=ONCXML("ROWCODE")
. Q:ONCXML("ROWCODE")?."-"
. S TMP=ONCTBROW
. S:ONCXML("ROWCODE")["-" $P(TMP,U,2)=+$P(ONCXML("ROWCODE"),"-",2)
. S @ONCXML@(ONCTBIEN,"C",+ONCXML("ROWCODE"))=TMP
I L3E="ROW,DESCR,P" D Q
. S J=+$O(@ONCXML@(ONCTBIEN,ONCTBROW,3,""),-1)
. S I=""
. F S I=$O(^UTILITY($J,"W",1,I)) Q:I="" D
. . S TMP=$G(^UTILITY($J,"W",1,I,0)),J=J+1
. . S @ONCXML@(ONCTBIEN,ONCTBROW,3,J)=$$TRIM^XLFSTR(TMP,"R")
;---
I (L3E="NOTES,FN,P")!(L3E="NOTES,TN,P") D Q
. S SUBS=$P(L3E,",",2)
. S J=+$O(@ONCXML@(ONCTBIEN,SUBS,ONCXML(SUBS),""),-1)
. S I=""
. F S I=$O(^UTILITY($J,"W",1,I)) Q:I="" D
. . S TMP=$G(^UTILITY($J,"W",1,I,0)),J=J+1
. . S @ONCXML@(ONCTBIEN,SUBS,ONCXML(SUBS),J)=$$TRIM^XLFSTR(TMP,"R")
Q
;
;***** RETURNS THE TABLE IEN (LOADS THE TABLES IF NECESSARY)
;
; [.ONCSAPI] Reference to the API descriptor (see the ^ONCSAPI)
;
; SITE Primary site
; HIST Histology
; TABLE Table number (see the ^ONCSAPI)
;
; The ^TMP("ONCSAPIT",$J) global node is used by this function.
;
; Return Values:
; >0 IEN of the table
; <0 Error code
;
GETCSTBL(ONCSAPI,SITE,HIST,TABLE) ;
N ONCTBDSC ; Descriptor of the table
N ONCTBIEN ; IEN of the table
N ONCTBROW ; Row number
;
N DST,ONCREQ,ONCRSP,ONCXML,SCHEMA,URL,XHIST,XSITE
D CLEAR^ONCSAPIE()
Q:TABLE'>0 $$ERROR^ONCSAPIE(-6,,"TABLE",TABLE)
;--- Initialize constants and variables
S ONCXML=$NA(^XTMP("ONCSAPI","TABLES"))
S ONCXML("XSITE")=$S(SITE'="":SITE,1:" ")
S ONCXML("XHIST")=$S(HIST'="":HIST,1:" ")
S ONCXML("XDISC")=$S(DISCRIM'="":DISCRIM,1:" ")
;
;--- Check if the schema number is available
S SCHEMA=+$G(@ONCXML@("SH",ONCXML("XSITE"),ONCXML("XHIST"),ONCXML("XDISC")))
I SCHEMA'>0 D Q:SCHEMA<0 SCHEMA
. S SCHEMA=+$$SCHEMA^ONCSAPIS(.ONCSAPI,SITE,HIST,DISCRIM)
;
;--- Check if the table is available
S ONCTBIEN=+$G(@ONCXML@("ST",SCHEMA,TABLE))
Q:ONCTBIEN>0 ONCTBIEN
S ONCRSP=$NA(^TMP("ONCSAPIT",$J)) K @ONCRSP
;
;--- Get the server URL
S URL=$$GETCSURL^ONCSAPIU()
;
L +@ONCXML@("ST",SCHEMA,TABLE):5
E Q $$ERROR^ONCSAPIE(-15,,"local CS table")
S RC=0 D
. ;--- Check if the table has become available
. S ONCTBIEN=+$G(@ONCXML@("ST",SCHEMA,TABLE)) Q:ONCTBIEN>0
. ;--- Prepare the request data
. S DST="ONCREQ"
. D HEADER^ONCSAPIR(.DST,"CS-GET-TABLES")
. D PUT^ONCSAPIR(.DST,"SCHEMA",SCHEMA)
. D PUT^ONCSAPIR(.DST,"TABLE",TABLE)
. D TRAILER^ONCSAPIR(.DST)
. K DST
. ;--- Send the request and get the response
. D:$G(ONCSAPI("DEBUG"))
. . D ZW^ONCSAPIU("ONCREQ","*** 'TABLE' REQUEST ***")
. S RC=$$REQUEST^ONCSAPIR(URL,ONCRSP,"ONCREQ") Q:RC<0
. D:$G(ONCSAPI("DEBUG"))
. . D ZW^ONCSAPIU(ONCRSP,"*** 'TABLE' RESPONSE ***")
. ;--- Load the table into the XTMP global
. D SETCBK(.CBK),EN^MXMLPRSE(ONCRSP,.CBK,"W")
. ;--- Check for parsing and web service errors
. S RC=$$CHKERR^ONCSAPIR(.ONCXML) Q:RC<0
L -@ONCXML@("ST",SCHEMA,TABLE)
;
;--- Cleanup
K @ONCRSP
Q $S(RC<0:RC,1:+$G(ONCTBIEN))
;
;***** SETS THE EVENT INTERFACE ENTRY POINTS
;
; .CBK Reference to the destination list
;
SETCBK(CBK) ;
;;CHARACTERS ^ TEXT^ONCSAPIT
;;ENDELEMENT ^ ENDEL^ONCSAPIT
;;STARTELEMENT^STARTEL^ONCSAPIT
;
D SETCBK^ONCSAPIX(.CBK,"SETCBK^ONCSAPIT")
Q
;
;***** START ELEMENT CALLBACK FOR THE SAX PARSER
;
; ELMT Name of the element
;
; .ATTR List of attributes and their values
;
STARTEL(ELMT,ATTR) ;
N L,L2E,L3E,SUBS,TBLIEN
D STARTEL^ONCSAPIX(ELMT,.ATTR)
S L=$L(ONCXML("PATH"),","),L2E=$P(ONCXML("PATH"),",",L-1,L)
S L3E=$P(ONCXML("PATH"),",",L-2,L)
;---
I L2E="CS-RESPONSE,TABLE" D Q
. S ONCTBIEN=+$O(@ONCXML@(" "),-1)+1
. S ONCTBDSC="",ONCTBROW=0
. S (ONCXML("FN"),ONCXML("TN"))=0
;---
I L2E="ROWS,ROW" D Q
. S ONCXML("ROWCODE")="",ONCXML("AC")=1
. S ONCTBROW=ONCTBROW+1
;---
I L2E="ROW,AC" S ONCXML("AC")=ONCXML("AC")+1 Q
I L3E="ROW,DESCR,P" K ^UTILITY($J,"W") Q
;---
I (L2E="NOTES,FN")!(L2E="NOTES,TN") D Q
. S SUBS=$P(L2E,",",2),ONCXML(SUBS)=$G(ONCXML(SUBS))+1 ; Note number
I L3E="NOTES,FN,P" K ^UTILITY($J,"W") Q
I L3E="NOTES,TN,P" K ^UTILITY($J,"W") Q
Q
;
;***** RETURNS THE TABLE TITLE AND SUBTITLE
;
; [.ONCSAPI] Reference to the API descriptor (see the ^ONCSAPI)
;
; SITE Primary site
; HIST Histology
; TABLE Table number (see the ^ONCSAPI)
;
; Tables other than site specific factors (10-15) usually do not
; have subtitles.
;
; Return Values:
; <0 Error code
; 0 0^Title^Subtitle
;
TBLTTL(ONCSAPI,SITE,HIST,TABLE) ;
N TBLIEN
;--- Make sure that table info is loaded
S TBLIEN=$$GETCSTBL(.ONCSAPI,SITE,HIST,TABLE) Q:TBLIEN<0 TBLIEN
;--- Return the table subtitle
Q 0_U_$P($G(^XTMP("ONCSAPI","TABLES",TBLIEN,0)),U,5,6)
;
;***** TEXT CALLBACK FOR THE SAX PARSER
;
; TXT Line of unmarked text
;
TEXT(TXT) ;
N I,L,L2E,L3E,TMP
S L=$L(ONCXML("PATH"),","),L2E=$P(ONCXML("PATH"),",",L-1,L)
S L3E=$P(ONCXML("PATH"),",",L-2,L)
;---
I L2E="CS-RESPONSE,SCHEMA" S ONCXML("SCHEMA")=TXT Q
;--- Table descriptor
I L2E="TABLE,NUMBER" S $P(ONCTBDSC,U,3)=$P(ONCTBDSC,U,3)_TXT Q
I L2E="TABLE,PATTERN" S $P(ONCTBDSC,U,4)=$P(ONCTBDSC,U,4)_TXT Q
I L2E="TABLE,SUBTITLE" S $P(ONCTBDSC,U,6)=$P(ONCTBDSC,U,6)_TXT Q
I L2E="TABLE,TITLE" S $P(ONCTBDSC,U,5)=$P(ONCTBDSC,U,5)_TXT Q
;--- Codes
I L2E="ROW,AC" D Q
. S $P(@ONCXML@(ONCTBIEN,ONCTBROW,1),U,ONCXML("AC"))=TXT
I L2E="ROW,CODE" D Q
. S ONCXML("ROWCODE")=ONCXML("ROWCODE")_TXT
;--- Row description
I L3E="ROW,DESCR,P" D WW(.TXT,70) Q
;--- Notes
I L3E="NOTES,FN,P" D WW(.TXT,75) Q
I L3E="NOTES,TN,P" D WW(.TXT,75) Q
;--- Default processing
D TEXT^ONCSAPIX(TXT)
Q
;
;***** REFORMATS THE TEXT AND WRAPS THE LINES
WW(TXT,DIWR) ;
N CR,DIWF,DIWL,I,ONCI1,ONCI2,LF,X
S DIWF="|",DIWL=1
S ONCI1=1,(ONCI2,L)=$L(TXT)
F D Q:ONCI2>L S ONCI1=ONCI2
. S ONCI2=$F(TXT,$C(13),ONCI1),(CR,LF)=0
. I ONCI2>0 S CR=1 S:$A(TXT,ONCI2)=10 LF=1,ONCI2=ONCI2+1
. E D
. . S ONCI2=$F(TXT,$C(10),ONCI1)
. . I ONCI2>0 S LF=1
. . E S ONCI2=L+1
. F I=ONCI1:1:ONCI2 Q:$E(TXT,I)'=" "
. S X=$E(TXT,(I+ONCI1)\2,ONCI2-1-CR-LF)
. D ^DIWP
Q
;
CLEANUP ;Cleanup
K DISCRIM
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCSAPIT 9853 printed Sep 23, 2025@20:03:55 Page 2
ONCSAPIT ;Hines OIFO/SG - COLLABORATIVE STAGING (TABLES) ;06/23/10
+1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
+2 ;
+3 ;--- STRUCTURE OF THE RESPONSE
+4 ;
+5 ; <?xml version="1.0" encoding="utf-8"?>
+6 ; <soap:Envelope
+7 ; xmlns:soap="http://www.w3.org/2001/12/soap-envelope"
+8 ; soap:encodingStyle="http://www.w3.org/2001/12/soap-encoding">
+9 ; <soap:Body>
+10 ; <CS-RESPONSE xmlns="http://vista.domain.ext/oncology">
+11 ; <SCHEMA>...</SCHEMA>
+12 ; <TABLE>
+13 ; <NUMBER>...</NUMBER>
+14 ; <PATTERN>...</PATTERN>
+15 ; <ROLE>...</ROLE>
+16 ; <SUBTITLE>...</SUBTITLE>
+17 ; <TITLE>...</TITLE>
+18 ; <ROWS>
+19 ; <ROW>
+20 ; <CODE>...</CODE>
+21 ; <DESCR>
+22 ; <P>...</P>
+23 ; ...
+24 ; </DESCR>
+25 ; <AC>...</AC>
+26 ; ...
+27 ; </ROW>
+28 ; ...
+29 ; </ROWS>
+30 ; <NOTES>
+31 ; <TN>
+32 ; <P>...</P>
+33 ; ...
+34 ; </TN>
+35 ; ...
+36 ; <FN>
+37 ; <P>...</P>
+38 ; ...
+39 ; </FN>
+40 ; ...
+41 ; </NOTES>
+42 ; </TABLE>
+43 ; ...
+44 ; </CS-RESPONSE>
+45 ; <soap:Fault>
+46 ; <faultcode> ... </faultcode>
+47 ; <faultstring> ... </faultstring>
+48 ; <detail>
+49 ; <RC> ... </RC>
+50 ; </detail>
+51 ; </soap:Fault>
+52 ; </soap:Body >
+53 ; </soap:Envelope>
+54 ;
+55 QUIT
+56 ;
+57 ;***** LOADS THE CS CODE DESCRIPTION
+58 ;
+59 ; [.ONCSAPI] Reference to the API descriptor (see the ^ONCSAPI)
+60 ;
+61 ; SITE Primary site
+62 ; HIST Histology
+63 ;
+64 ; TABLE Table number (see the ^ONCSAPI routine)
+65 ; CODE Primary code of a table row
+66 ;
+67 ; ONC8DST Closed reference of the destination buffer
+68 ;
+69 ; Return Values:
+70 ; 0 Ok
+71 ; <0 Error code
+72 ;
CODEDESC(ONCSAPI,SITE,HIST,TABLE,CODE,ONC8DST) ;
+1 NEW I,NODE,RC,ROW,TBLIEN,TMP
+2 DO CLEAR^ONCSAPIE()
KILL @ONC8DST
+3 if $GET(CODE)?." "
QUIT $$ERROR^ONCSAPIE(-6,,"CODE",$GET(CODE))
+4 ;---
+5 LOCK +^XTMP("ONCSAPI","TABLES","JOB",$JOB):5
IF '$TEST
Begin DoDot:1
+6 SET RC=$$ERROR^ONCSAPIE(-15,,"access control node")
End DoDot:1
QUIT RC
+7 ;
+8 SET RC=0
Begin DoDot:1
+9 ;--- Get the table IEN
+10 SET TBLIEN=$$GETCSTBL(.ONCSAPI,SITE,HIST,TABLE)
+11 IF TBLIEN<0
SET RC=TBLIEN
QUIT
+12 SET NODE=$NAME(^XTMP("ONCSAPI","TABLES",TBLIEN))
+13 SET CODE=+$GET(CODE)
+14 ;--- Check the single code
+15 SET ROW=$GET(@NODE@("C",CODE))
+16 ;--- Check the interval
+17 IF ROW'>0
Begin DoDot:2
+18 SET TMP=$ORDER(@NODE@("C",CODE),-1)
if TMP=""
QUIT
+19 SET ROW=$GET(@NODE@("C",TMP))
+20 if CODE>$PIECE(ROW,U,2)
SET ROW=0
End DoDot:2
IF ROW'>0
SET RC=$$ERROR^ONCSAPIE(-6,,"CODE",CODE)
QUIT
+21 ;--- Load the description
+22 MERGE @ONC8DST=@NODE@(+ROW,3)
End DoDot:1
+23 ;
+24 LOCK -^XTMP("ONCSAPI","TABLES","JOB",$JOB)
+25 QUIT $SELECT(RC<0:RC,1:0)
+26 ;
+27 ;***** END ELEMENT CALLBACK FOR THE SAX PARSER
+28 ;
+29 ; ELMT Name of the element
+30 ;
ENDEL(ELMT) ;
+1 NEW I,J,L,L2E,L3E,SUBS,TMP
+2 SET L=$LENGTH(ONCXML("PATH"),",")
SET L2E=$PIECE(ONCXML("PATH"),",",L-1,L)
+3 SET L3E=$PIECE(ONCXML("PATH"),",",L-2,L)
+4 DO ENDEL^ONCSAPIX(ELMT)
+5 ;---
+6 IF L2E="CS-RESPONSE,TABLE"
Begin DoDot:1
+7 NEW NAME,SCHEMA,TABLE
+8 SET SCHEMA=+$GET(ONCXML("SCHEMA"))
SET TABLE=+$PIECE(ONCTBDSC,U,3)
+9 SET NAME=$PIECE(ONCTBDSC,U,5)
+10 IF (SCHEMA'>0)!(TABLE'>0)!(NAME="")
KILL @ONCXML@(ONCTBIEN)
QUIT
+11 SET $PIECE(ONCTBDSC,U,2)=SCHEMA
+12 ;---
+13 SET @ONCXML@(ONCTBIEN,0)=$EXTRACT(ONCTBDSC,1,254)
+14 SET @ONCXML@("ST",SCHEMA,TABLE)=ONCTBIEN
End DoDot:1
QUIT
+15 ;---
+16 IF L2E="ROW,CODE"
Begin DoDot:1
+17 SET $PIECE(@ONCXML@(ONCTBIEN,ONCTBROW,1),U)=ONCXML("ROWCODE")
+18 if ONCXML("ROWCODE")?."-"
QUIT
+19 SET TMP=ONCTBROW
+20 if ONCXML("ROWCODE")["-"
SET $PIECE(TMP,U,2)=+$PIECE(ONCXML("ROWCODE"),"-",2)
+21 SET @ONCXML@(ONCTBIEN,"C",+ONCXML("ROWCODE"))=TMP
End DoDot:1
QUIT
+22 IF L3E="ROW,DESCR,P"
Begin DoDot:1
+23 SET J=+$ORDER(@ONCXML@(ONCTBIEN,ONCTBROW,3,""),-1)
+24 SET I=""
+25 FOR
SET I=$ORDER(^UTILITY($JOB,"W",1,I))
if I=""
QUIT
Begin DoDot:2
+26 SET TMP=$GET(^UTILITY($JOB,"W",1,I,0))
SET J=J+1
+27 SET @ONCXML@(ONCTBIEN,ONCTBROW,3,J)=$$TRIM^XLFSTR(TMP,"R")
End DoDot:2
End DoDot:1
QUIT
+28 ;---
+29 IF (L3E="NOTES,FN,P")!(L3E="NOTES,TN,P")
Begin DoDot:1
+30 SET SUBS=$PIECE(L3E,",",2)
+31 SET J=+$ORDER(@ONCXML@(ONCTBIEN,SUBS,ONCXML(SUBS),""),-1)
+32 SET I=""
+33 FOR
SET I=$ORDER(^UTILITY($JOB,"W",1,I))
if I=""
QUIT
Begin DoDot:2
+34 SET TMP=$GET(^UTILITY($JOB,"W",1,I,0))
SET J=J+1
+35 SET @ONCXML@(ONCTBIEN,SUBS,ONCXML(SUBS),J)=$$TRIM^XLFSTR(TMP,"R")
End DoDot:2
End DoDot:1
QUIT
+36 QUIT
+37 ;
+38 ;***** RETURNS THE TABLE IEN (LOADS THE TABLES IF NECESSARY)
+39 ;
+40 ; [.ONCSAPI] Reference to the API descriptor (see the ^ONCSAPI)
+41 ;
+42 ; SITE Primary site
+43 ; HIST Histology
+44 ; TABLE Table number (see the ^ONCSAPI)
+45 ;
+46 ; The ^TMP("ONCSAPIT",$J) global node is used by this function.
+47 ;
+48 ; Return Values:
+49 ; >0 IEN of the table
+50 ; <0 Error code
+51 ;
GETCSTBL(ONCSAPI,SITE,HIST,TABLE) ;
+1 ; Descriptor of the table
NEW ONCTBDSC
+2 ; IEN of the table
NEW ONCTBIEN
+3 ; Row number
NEW ONCTBROW
+4 ;
+5 NEW DST,ONCREQ,ONCRSP,ONCXML,SCHEMA,URL,XHIST,XSITE
+6 DO CLEAR^ONCSAPIE()
+7 if TABLE'>0
QUIT $$ERROR^ONCSAPIE(-6,,"TABLE",TABLE)
+8 ;--- Initialize constants and variables
+9 SET ONCXML=$NAME(^XTMP("ONCSAPI","TABLES"))
+10 SET ONCXML("XSITE")=$SELECT(SITE'="":SITE,1:" ")
+11 SET ONCXML("XHIST")=$SELECT(HIST'="":HIST,1:" ")
+12 SET ONCXML("XDISC")=$SELECT(DISCRIM'="":DISCRIM,1:" ")
+13 ;
+14 ;--- Check if the schema number is available
+15 SET SCHEMA=+$GET(@ONCXML@("SH",ONCXML("XSITE"),ONCXML("XHIST"),ONCXML("XDISC")))
+16 IF SCHEMA'>0
Begin DoDot:1
+17 SET SCHEMA=+$$SCHEMA^ONCSAPIS(.ONCSAPI,SITE,HIST,DISCRIM)
End DoDot:1
if SCHEMA<0
QUIT SCHEMA
+18 ;
+19 ;--- Check if the table is available
+20 SET ONCTBIEN=+$GET(@ONCXML@("ST",SCHEMA,TABLE))
+21 if ONCTBIEN>0
QUIT ONCTBIEN
+22 SET ONCRSP=$NAME(^TMP("ONCSAPIT",$JOB))
KILL @ONCRSP
+23 ;
+24 ;--- Get the server URL
+25 SET URL=$$GETCSURL^ONCSAPIU()
+26 ;
+27 LOCK +@ONCXML@("ST",SCHEMA,TABLE):5
+28 IF '$TEST
QUIT $$ERROR^ONCSAPIE(-15,,"local CS table")
+29 SET RC=0
Begin DoDot:1
+30 ;--- Check if the table has become available
+31 SET ONCTBIEN=+$GET(@ONCXML@("ST",SCHEMA,TABLE))
if ONCTBIEN>0
QUIT
+32 ;--- Prepare the request data
+33 SET DST="ONCREQ"
+34 DO HEADER^ONCSAPIR(.DST,"CS-GET-TABLES")
+35 DO PUT^ONCSAPIR(.DST,"SCHEMA",SCHEMA)
+36 DO PUT^ONCSAPIR(.DST,"TABLE",TABLE)
+37 DO TRAILER^ONCSAPIR(.DST)
+38 KILL DST
+39 ;--- Send the request and get the response
+40 if $GET(ONCSAPI("DEBUG"))
Begin DoDot:2
+41 DO ZW^ONCSAPIU("ONCREQ","*** 'TABLE' REQUEST ***")
End DoDot:2
+42 SET RC=$$REQUEST^ONCSAPIR(URL,ONCRSP,"ONCREQ")
if RC<0
QUIT
+43 if $GET(ONCSAPI("DEBUG"))
Begin DoDot:2
+44 DO ZW^ONCSAPIU(ONCRSP,"*** 'TABLE' RESPONSE ***")
End DoDot:2
+45 ;--- Load the table into the XTMP global
+46 DO SETCBK(.CBK)
DO EN^MXMLPRSE(ONCRSP,.CBK,"W")
+47 ;--- Check for parsing and web service errors
+48 SET RC=$$CHKERR^ONCSAPIR(.ONCXML)
if RC<0
QUIT
End DoDot:1
+49 LOCK -@ONCXML@("ST",SCHEMA,TABLE)
+50 ;
+51 ;--- Cleanup
+52 KILL @ONCRSP
+53 QUIT $SELECT(RC<0:RC,1:+$GET(ONCTBIEN))
+54 ;
+55 ;***** SETS THE EVENT INTERFACE ENTRY POINTS
+56 ;
+57 ; .CBK Reference to the destination list
+58 ;
SETCBK(CBK) ;
+1 ;;CHARACTERS ^ TEXT^ONCSAPIT
+2 ;;ENDELEMENT ^ ENDEL^ONCSAPIT
+3 ;;STARTELEMENT^STARTEL^ONCSAPIT
+4 ;
+5 DO SETCBK^ONCSAPIX(.CBK,"SETCBK^ONCSAPIT")
+6 QUIT
+7 ;
+8 ;***** START ELEMENT CALLBACK FOR THE SAX PARSER
+9 ;
+10 ; ELMT Name of the element
+11 ;
+12 ; .ATTR List of attributes and their values
+13 ;
STARTEL(ELMT,ATTR) ;
+1 NEW L,L2E,L3E,SUBS,TBLIEN
+2 DO STARTEL^ONCSAPIX(ELMT,.ATTR)
+3 SET L=$LENGTH(ONCXML("PATH"),",")
SET L2E=$PIECE(ONCXML("PATH"),",",L-1,L)
+4 SET L3E=$PIECE(ONCXML("PATH"),",",L-2,L)
+5 ;---
+6 IF L2E="CS-RESPONSE,TABLE"
Begin DoDot:1
+7 SET ONCTBIEN=+$ORDER(@ONCXML@(" "),-1)+1
+8 SET ONCTBDSC=""
SET ONCTBROW=0
+9 SET (ONCXML("FN"),ONCXML("TN"))=0
End DoDot:1
QUIT
+10 ;---
+11 IF L2E="ROWS,ROW"
Begin DoDot:1
+12 SET ONCXML("ROWCODE")=""
SET ONCXML("AC")=1
+13 SET ONCTBROW=ONCTBROW+1
End DoDot:1
QUIT
+14 ;---
+15 IF L2E="ROW,AC"
SET ONCXML("AC")=ONCXML("AC")+1
QUIT
+16 IF L3E="ROW,DESCR,P"
KILL ^UTILITY($JOB,"W")
QUIT
+17 ;---
+18 IF (L2E="NOTES,FN")!(L2E="NOTES,TN")
Begin DoDot:1
+19 ; Note number
SET SUBS=$PIECE(L2E,",",2)
SET ONCXML(SUBS)=$GET(ONCXML(SUBS))+1
End DoDot:1
QUIT
+20 IF L3E="NOTES,FN,P"
KILL ^UTILITY($JOB,"W")
QUIT
+21 IF L3E="NOTES,TN,P"
KILL ^UTILITY($JOB,"W")
QUIT
+22 QUIT
+23 ;
+24 ;***** RETURNS THE TABLE TITLE AND SUBTITLE
+25 ;
+26 ; [.ONCSAPI] Reference to the API descriptor (see the ^ONCSAPI)
+27 ;
+28 ; SITE Primary site
+29 ; HIST Histology
+30 ; TABLE Table number (see the ^ONCSAPI)
+31 ;
+32 ; Tables other than site specific factors (10-15) usually do not
+33 ; have subtitles.
+34 ;
+35 ; Return Values:
+36 ; <0 Error code
+37 ; 0 0^Title^Subtitle
+38 ;
TBLTTL(ONCSAPI,SITE,HIST,TABLE) ;
+1 NEW TBLIEN
+2 ;--- Make sure that table info is loaded
+3 SET TBLIEN=$$GETCSTBL(.ONCSAPI,SITE,HIST,TABLE)
if TBLIEN<0
QUIT TBLIEN
+4 ;--- Return the table subtitle
+5 QUIT 0_U_$PIECE($GET(^XTMP("ONCSAPI","TABLES",TBLIEN,0)),U,5,6)
+6 ;
+7 ;***** TEXT CALLBACK FOR THE SAX PARSER
+8 ;
+9 ; TXT Line of unmarked text
+10 ;
TEXT(TXT) ;
+1 NEW I,L,L2E,L3E,TMP
+2 SET L=$LENGTH(ONCXML("PATH"),",")
SET L2E=$PIECE(ONCXML("PATH"),",",L-1,L)
+3 SET L3E=$PIECE(ONCXML("PATH"),",",L-2,L)
+4 ;---
+5 IF L2E="CS-RESPONSE,SCHEMA"
SET ONCXML("SCHEMA")=TXT
QUIT
+6 ;--- Table descriptor
+7 IF L2E="TABLE,NUMBER"
SET $PIECE(ONCTBDSC,U,3)=$PIECE(ONCTBDSC,U,3)_TXT
QUIT
+8 IF L2E="TABLE,PATTERN"
SET $PIECE(ONCTBDSC,U,4)=$PIECE(ONCTBDSC,U,4)_TXT
QUIT
+9 IF L2E="TABLE,SUBTITLE"
SET $PIECE(ONCTBDSC,U,6)=$PIECE(ONCTBDSC,U,6)_TXT
QUIT
+10 IF L2E="TABLE,TITLE"
SET $PIECE(ONCTBDSC,U,5)=$PIECE(ONCTBDSC,U,5)_TXT
QUIT
+11 ;--- Codes
+12 IF L2E="ROW,AC"
Begin DoDot:1
+13 SET $PIECE(@ONCXML@(ONCTBIEN,ONCTBROW,1),U,ONCXML("AC"))=TXT
End DoDot:1
QUIT
+14 IF L2E="ROW,CODE"
Begin DoDot:1
+15 SET ONCXML("ROWCODE")=ONCXML("ROWCODE")_TXT
End DoDot:1
QUIT
+16 ;--- Row description
+17 IF L3E="ROW,DESCR,P"
DO WW(.TXT,70)
QUIT
+18 ;--- Notes
+19 IF L3E="NOTES,FN,P"
DO WW(.TXT,75)
QUIT
+20 IF L3E="NOTES,TN,P"
DO WW(.TXT,75)
QUIT
+21 ;--- Default processing
+22 DO TEXT^ONCSAPIX(TXT)
+23 QUIT
+24 ;
+25 ;***** REFORMATS THE TEXT AND WRAPS THE LINES
WW(TXT,DIWR) ;
+1 NEW CR,DIWF,DIWL,I,ONCI1,ONCI2,LF,X
+2 SET DIWF="|"
SET DIWL=1
+3 SET ONCI1=1
SET (ONCI2,L)=$LENGTH(TXT)
+4 FOR
Begin DoDot:1
+5 SET ONCI2=$FIND(TXT,$CHAR(13),ONCI1)
SET (CR,LF)=0
+6 IF ONCI2>0
SET CR=1
if $ASCII(TXT,ONCI2)=10
SET LF=1
SET ONCI2=ONCI2+1
+7 IF '$TEST
Begin DoDot:2
+8 SET ONCI2=$FIND(TXT,$CHAR(10),ONCI1)
+9 IF ONCI2>0
SET LF=1
+10 IF '$TEST
SET ONCI2=L+1
End DoDot:2
+11 FOR I=ONCI1:1:ONCI2
if $EXTRACT(TXT,I)'=" "
QUIT
+12 SET X=$EXTRACT(TXT,(I+ONCI1)\2,ONCI2-1-CR-LF)
+13 DO ^DIWP
End DoDot:1
if ONCI2>L
QUIT
SET ONCI1=ONCI2
+14 QUIT
+15 ;
CLEANUP ;Cleanup
+1 KILL DISCRIM
