ONCSAPIR ;Hines OIFO/SG - COLLABORATIVE STAGING (REQUEST) ; 2/8/07 8:28am
;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
;
; ONC8DST ------------- DESCRIPTOR OF THE DESTINATION BUFFER
; (a parameter of HEADER, PUT, and TRAILER)
;
; ONC8DST( Closed root of the destination buffer
; "PTR") Pointer in the destination buffer
; "PTRC") Continuation pointer (optional)
; "REQ") Name of the root tag of the request
;
Q
;
;***** APPENDS THE STRING TO THE LAST LINE OF THE DESTINATION BUFFER
;
; .ONC8DST Reference to a descriptor of the destination buffer.
;
; STR String
;
; [NOENC] Disable XML encoding (enabled by default)
;
; This procedure appends the string as the continuation node
; to the last line added by the PUT^ONCSAPIR.
;
APPEND(ONC8DST,STR,NOENC) ;
Q:$G(ONC8DST("PTR"))'>0
N ENCSTR,I1,I2,S1
S ENCSTR=$S('$G(NOENC):$$SYMENC^MXMLUTL(STR),1:STR)
S I2=0
F S I1=I2+1,I2=I1+249,S1=$E(ENCSTR,I1,I2) Q:S1="" D
. S ONC8DST("PTRC")=$G(ONC8DST("PTRC"))+1
. S @ONC8DST@(ONC8DST("PTR"),ONC8DST("PTRC"))=S1
Q
;
;***** CHECKS FOR PARSING AND WEB SERVICE ERRORS
;
; .ONCXML Reference to the XML parsing descriptor
;
; [ONC8INFO] Closed root of the variable that contains
; additional information related to the error
;
; Return values:
;
; <0 Error Descriptor
; 0 Ok
; 1 Warning(s)
;
CHKERR(ONCXML,ONC8INFO) ;
N RC,TMP
I $G(ONCXML("ERR"))>0 Q $$ERROR^ONCSAPIE(-5)
I $G(ONCXML("FAULTCODE"))'="" D Q RC
. S TMP=$TR($G(ONCXML("FAULTSTRING")),"^","~")
. S:TMP="" TMP="Unknown error"
. S RC="-2"_U_ONCXML("FAULTCODE")_": "_TMP
. D STORE^ONCSAPIE(RC,$G(ONC8INFO))
. ;--- Error code -11 is returned by the web-service if the
. ; CStage_calculate function calculated only some staging
. ;--- values and returned warning(s).
. S:+$G(ONCXML("RC"))=-11 RC=1
Q 0
;
;***** STORES THE REQUEST HEADER INTO THE DESTINATION BUFFER
;
; .ONC8DST Reference to a descriptor of the destination buffer.
;
; REQUEST Name of the root tag of the request.
;
; [.ATTS] Reference to a local variable that stores a list
; of attribute values (ATTS(name)=value).
;
;;<soap:Envelope xmlns:soap="http://www.w3.org/2001/12/soap-envelope"
;; soap:encodingStyle="http://www.w3.org/2001/12/soap-encoding">
;;<soap:Body>
;
N I,TAG,TMP
S ONC8DST("PTR")=0 K @ONC8DST
D PUT(.ONC8DST,,$$XMLHDR^MXMLUTL())
F I=1:1 S TMP=$P($T(HEADER+I),";;",2) Q:TMP="" D
. D PUT(.ONC8DST,,TMP)
S TAG=REQUEST,I=""
F S I=$O(ATTS(I)) Q:I="" D
. S TAG=TAG_" "_I_"="""_$$SYMENC^MXMLUTL(ATTS(I))_""""
S TAG=TAG_" ver=""2.0"" xmlns=""http://websrv.oncology.domain.ext"""
D PUT(.ONC8DST,TAG,,1)
S ONC8DST("REQ")=REQUEST
Q
;
;***** CONVERTS INPUT PARAMETERS INTO XML FORMAT
;
; ONC8DST Closed root of the destination buffer
;
; REQUEST Name of the root tag of the request.
;
; [.INPUT] Reference to a local variable containg
; input parameters.
;
; Return values:
;
; <0 Error Descriptor
; 0 Ok
;
PARAMS(ONC8DST,REQUEST,INPUT) ;
N I,NAME,VAL
D HEADER(.ONC8DST,REQUEST)
;---
S NAME=""
F S NAME=$O(INPUT(NAME)) Q:NAME="" D
. S VAL=$G(INPUT(NAME)) D:VAL'="" PUT(.ONC8DST,NAME,VAL)
;---
D TRAILER(.ONC8DST)
Q 0
;
;***** ADDS THE ELEMENT/TEXT TO THE DESTINATION BUFFER
;
; .ONC8DST Reference to a descriptor of the destination buffer.
;
; [NAME] Name of the element. If omitted or empty then the
; text line defined by the second parameter is added
; to the buffer.
;
; [VAL] Value of the element.
;
; [TAGONLY] Ignore the value and output only the tag defined
; by the NAME parameter
;
PUT(ONC8DST,NAME,VAL,TAGONLY) ;
S (ONC8DST("PTR"),PTR)=ONC8DST("PTR")+1 K ONC8DST("PTRC")
I $G(NAME)="" S @ONC8DST@(PTR)=$G(VAL) Q
I $G(TAGONLY) S @ONC8DST@(PTR)="<"_NAME_">" Q
I $G(VAL)="" S @ONC8DST@(PTR)="<"_NAME_"/>" Q
S @ONC8DST@(PTR)="<"_NAME_">"_$$SYMENC^MXMLUTL(VAL)_"</"_NAME_">"
Q
;
;***** SENDS THE REQUEST AND GETS THE RESPONSE
;
; URL URL (http://host:port/path)
;
; ONC8RSP Closed root of the variable where the
; response text will be returned.
;
; [ONC8REQ] Closed root of the variable containing
; the text of the request.
;
; Return Values:
; 0 Ok
; <0 Error code
;
REQUEST(URL,ONC8RSP,ONC8REQ) ;
N HS,ONCINFO,ONCRHDR,ONCSHDR,RC,REPCNT,REPEAT,TMP
;--- Prepare the request header
S ONCSHDR("Content-Type")="text/xml"
;---
S (RC,REPCNT)=0 D
. F S REPEAT=0 D Q:'REPEAT
. . ;--- Call the web service
. . S RC=$$GETURL^ONCX10(URL,60,ONC8RSP,.ONCRHDR,$G(ONC8REQ),.ONCSHDR)
. . S HS=+RC Q:HS=200
. . ;--- Temporary redirection
. . I HS=302 D Q
. . . S REPCNT=REPCNT+1
. . . I REPCNT>5 S RC=$$ERROR^ONCSAPIE(-12,,REPCNT) Q
. . . S URL=$G(ONCRHDR("LOCATION"))
. . . I URL?." " S RC=$$ERROR^ONCSAPIE(-18) Q
. . . D ERROR^ONCSAPIE(-7,,URL) S REPEAT=1,RC=0
. . ;--- Permanent redirection
. . I HS=301 D Q
. . . S REPCNT=REPCNT+1
. . . I REPCNT>5 S RC=$$ERROR^ONCSAPIE(-12,,REPCNT) Q
. . . S URL=$G(ONCRHDR("LOCATION"))
. . . I URL?." " S RC=$$ERROR^ONCSAPIE(-18) Q
. . . S RC=$$UPDCSURL^ONCSAPIU(URL) Q:RC<0
. . . D ERROR^ONCSAPIE(-8,,URL) S REPEAT=1,RC=0
. . ;--- Record the HTTP client error
. . K ONCINFO S ONCINFO(1)=$P(RC,U,2)_" ("_$P(RC,U)_")"
. . S RC=$$ERROR^ONCSAPIE(-10,.ONCINFO)
. Q:RC<0
;---
Q $S(RC<0:RC,1:0)
;
;***** APPENDS THE REQUEST TRAILER TO THE DESTINATION BUFFER
;
; .ONC8DST Reference to a descriptor of the destination buffer.
;
TRAILER(ONC8DST) ;
S ONC8DST("PTR")=+$O(@ONC8DST@(""),-1)
D PUT(.ONC8DST,"/"_ONC8DST("REQ"),,1)
D PUT(.ONC8DST,"/soap:Body",,1)
D PUT(.ONC8DST,"/soap:Envelope",,1)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCSAPIR 6177 printed Apr 09, 2024@21:25:27 Page 2
ONCSAPIR ;Hines OIFO/SG - COLLABORATIVE STAGING (REQUEST) ; 2/8/07 8:28am
+1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
+2 ;
+3 ; ONC8DST ------------- DESCRIPTOR OF THE DESTINATION BUFFER
+4 ; (a parameter of HEADER, PUT, and TRAILER)
+5 ;
+6 ; ONC8DST( Closed root of the destination buffer
+7 ; "PTR") Pointer in the destination buffer
+8 ; "PTRC") Continuation pointer (optional)
+9 ; "REQ") Name of the root tag of the request
+10 ;
+11 QUIT
+12 ;
+13 ;***** APPENDS THE STRING TO THE LAST LINE OF THE DESTINATION BUFFER
+14 ;
+15 ; .ONC8DST Reference to a descriptor of the destination buffer.
+16 ;
+17 ; STR String
+18 ;
+19 ; [NOENC] Disable XML encoding (enabled by default)
+20 ;
+21 ; This procedure appends the string as the continuation node
+22 ; to the last line added by the PUT^ONCSAPIR.
+23 ;
APPEND(ONC8DST,STR,NOENC) ;
+1 if $GET(ONC8DST("PTR"))'>0
QUIT
+2 NEW ENCSTR,I1,I2,S1
+3 SET ENCSTR=$SELECT('$GET(NOENC):$$SYMENC^MXMLUTL(STR),1:STR)
+4 SET I2=0
+5 FOR
SET I1=I2+1
SET I2=I1+249
SET S1=$EXTRACT(ENCSTR,I1,I2)
if S1=""
QUIT
Begin DoDot:1
+6 SET ONC8DST("PTRC")=$GET(ONC8DST("PTRC"))+1
+7 SET @ONC8DST@(ONC8DST("PTR"),ONC8DST("PTRC"))=S1
End DoDot:1
+8 QUIT
+9 ;
+10 ;***** CHECKS FOR PARSING AND WEB SERVICE ERRORS
+11 ;
+12 ; .ONCXML Reference to the XML parsing descriptor
+13 ;
+14 ; [ONC8INFO] Closed root of the variable that contains
+15 ; additional information related to the error
+16 ;
+17 ; Return values:
+18 ;
+19 ; <0 Error Descriptor
+20 ; 0 Ok
+21 ; 1 Warning(s)
+22 ;
CHKERR(ONCXML,ONC8INFO) ;
+1 NEW RC,TMP
+2 IF $GET(ONCXML("ERR"))>0
QUIT $$ERROR^ONCSAPIE(-5)
+3 IF $GET(ONCXML("FAULTCODE"))'=""
Begin DoDot:1
+4 SET TMP=$TRANSLATE($GET(ONCXML("FAULTSTRING")),"^","~")
+5 if TMP=""
SET TMP="Unknown error"
+6 SET RC="-2"_U_ONCXML("FAULTCODE")_": "_TMP
+7 DO STORE^ONCSAPIE(RC,$GET(ONC8INFO))
+8 ;--- Error code -11 is returned by the web-service if the
+9 ; CStage_calculate function calculated only some staging
+10 ;--- values and returned warning(s).
+11 if +$GET(ONCXML("RC"))=-11
SET RC=1
End DoDot:1
QUIT RC
+12 QUIT 0
+13 ;
+14 ;***** STORES THE REQUEST HEADER INTO THE DESTINATION BUFFER
+15 ;
+16 ; .ONC8DST Reference to a descriptor of the destination buffer.
+17 ;
+18 ; REQUEST Name of the root tag of the request.
+19 ;
+20 ; [.ATTS] Reference to a local variable that stores a list
+21 ; of attribute values (ATTS(name)=value).
+22 ;
+1 ;;<soap:Envelope xmlns:soap="http://www.w3.org/2001/12/soap-envelope"
+2 ;; soap:encodingStyle="http://www.w3.org/2001/12/soap-encoding">
+3 ;;<soap:Body>
+4 ;
+5 NEW I,TAG,TMP
+6 SET ONC8DST("PTR")=0
KILL @ONC8DST
+7 DO PUT(.ONC8DST,,$$XMLHDR^MXMLUTL())
+8 FOR I=1:1
SET TMP=$PIECE($TEXT(HEADER+I),";;",2)
if TMP=""
QUIT
Begin DoDot:1
+9 DO PUT(.ONC8DST,,TMP)
End DoDot:1
+10 SET TAG=REQUEST
SET I=""
+11 FOR
SET I=$ORDER(ATTS(I))
if I=""
QUIT
Begin DoDot:1
+12 SET TAG=TAG_" "_I_"="""_$$SYMENC^MXMLUTL(ATTS(I))_""""
End DoDot:1
+13 SET TAG=TAG_" ver=""2.0"" xmlns=""http://websrv.oncology.domain.ext"""
+14 DO PUT(.ONC8DST,TAG,,1)
+15 SET ONC8DST("REQ")=REQUEST
+16 QUIT
+17 ;
+18 ;***** CONVERTS INPUT PARAMETERS INTO XML FORMAT
+19 ;
+20 ; ONC8DST Closed root of the destination buffer
+21 ;
+22 ; REQUEST Name of the root tag of the request.
+23 ;
+24 ; [.INPUT] Reference to a local variable containg
+25 ; input parameters.
+26 ;
+27 ; Return values:
+28 ;
+29 ; <0 Error Descriptor
+30 ; 0 Ok
+31 ;
PARAMS(ONC8DST,REQUEST,INPUT) ;
+1 NEW I,NAME,VAL
+2 DO HEADER(.ONC8DST,REQUEST)
+3 ;---
+4 SET NAME=""
+5 FOR
SET NAME=$ORDER(INPUT(NAME))
if NAME=""
QUIT
Begin DoDot:1
+6 SET VAL=$GET(INPUT(NAME))
if VAL'=""
DO PUT(.ONC8DST,NAME,VAL)
End DoDot:1
+7 ;---
+8 DO TRAILER(.ONC8DST)
+9 QUIT 0
+10 ;
+11 ;***** ADDS THE ELEMENT/TEXT TO THE DESTINATION BUFFER
+12 ;
+13 ; .ONC8DST Reference to a descriptor of the destination buffer.
+14 ;
+15 ; [NAME] Name of the element. If omitted or empty then the
+16 ; text line defined by the second parameter is added
+17 ; to the buffer.
+18 ;
+19 ; [VAL] Value of the element.
+20 ;
+21 ; [TAGONLY] Ignore the value and output only the tag defined
+22 ; by the NAME parameter
+23 ;
PUT(ONC8DST,NAME,VAL,TAGONLY) ;
+1 SET (ONC8DST("PTR"),PTR)=ONC8DST("PTR")+1
KILL ONC8DST("PTRC")
+2 IF $GET(NAME)=""
SET @ONC8DST@(PTR)=$GET(VAL)
QUIT
+3 IF $GET(TAGONLY)
SET @ONC8DST@(PTR)="<"_NAME_">"
QUIT
+4 IF $GET(VAL)=""
SET @ONC8DST@(PTR)="<"_NAME_"/>"
QUIT
+5 SET @ONC8DST@(PTR)="<"_NAME_">"_$$SYMENC^MXMLUTL(VAL)_"</"_NAME_">"
+6 QUIT
+7 ;
+8 ;***** SENDS THE REQUEST AND GETS THE RESPONSE
+9 ;
+10 ; URL URL (http://host:port/path)
+11 ;
+12 ; ONC8RSP Closed root of the variable where the
+13 ; response text will be returned.
+14 ;
+15 ; [ONC8REQ] Closed root of the variable containing
+16 ; the text of the request.
+17 ;
+18 ; Return Values:
+19 ; 0 Ok
+20 ; <0 Error code
+21 ;
REQUEST(URL,ONC8RSP,ONC8REQ) ;
+1 NEW HS,ONCINFO,ONCRHDR,ONCSHDR,RC,REPCNT,REPEAT,TMP
+2 ;--- Prepare the request header
+3 SET ONCSHDR("Content-Type")="text/xml"
+4 ;---
+5 SET (RC,REPCNT)=0
Begin DoDot:1
+6 FOR
SET REPEAT=0
Begin DoDot:2
+7 ;--- Call the web service
+8 SET RC=$$GETURL^ONCX10(URL,60,ONC8RSP,.ONCRHDR,$GET(ONC8REQ),.ONCSHDR)
+9 SET HS=+RC
if HS=200
QUIT
+10 ;--- Temporary redirection
+11 IF HS=302
Begin DoDot:3
+12 SET REPCNT=REPCNT+1
+13 IF REPCNT>5
SET RC=$$ERROR^ONCSAPIE(-12,,REPCNT)
QUIT
+14 SET URL=$GET(ONCRHDR("LOCATION"))
+15 IF URL?." "
SET RC=$$ERROR^ONCSAPIE(-18)
QUIT
+16 DO ERROR^ONCSAPIE(-7,,URL)
SET REPEAT=1
SET RC=0
End DoDot:3
QUIT
+17 ;--- Permanent redirection
+18 IF HS=301
Begin DoDot:3
+19 SET REPCNT=REPCNT+1
+20 IF REPCNT>5
SET RC=$$ERROR^ONCSAPIE(-12,,REPCNT)
QUIT
+21 SET URL=$GET(ONCRHDR("LOCATION"))
+22 IF URL?." "
SET RC=$$ERROR^ONCSAPIE(-18)
QUIT
+23 SET RC=$$UPDCSURL^ONCSAPIU(URL)
if RC<0
QUIT
+24 DO ERROR^ONCSAPIE(-8,,URL)
SET REPEAT=1
SET RC=0
End DoDot:3
QUIT
+25 ;--- Record the HTTP client error
+26 KILL ONCINFO
SET ONCINFO(1)=$PIECE(RC,U,2)_" ("_$PIECE(RC,U)_")"
+27 SET RC=$$ERROR^ONCSAPIE(-10,.ONCINFO)
End DoDot:2
if 'REPEAT
QUIT
+28 if RC<0
QUIT
End DoDot:1
+29 ;---
+30 QUIT $SELECT(RC<0:RC,1:0)
+31 ;
+32 ;***** APPENDS THE REQUEST TRAILER TO THE DESTINATION BUFFER
+33 ;
+34 ; .ONC8DST Reference to a descriptor of the destination buffer.
+35 ;
TRAILER(ONC8DST) ;
+1 SET ONC8DST("PTR")=+$ORDER(@ONC8DST@(""),-1)
+2 DO PUT(.ONC8DST,"/"_ONC8DST("REQ"),,1)
+3 DO PUT(.ONC8DST,"/soap:Body",,1)
+4 DO PUT(.ONC8DST,"/soap:Envelope",,1)
+5 QUIT
