- ONCSAPIR ;HINES OIFO/SG - COLLABORATIVE STAGING (REQUEST) ; 2/8/07 8:28am
- ;;2.2;ONCOLOGY;**1,19**;Jul 31, 2013;Build 4
- ; ...P19 testing CS Encryption
- ; 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
- . . M ^TMP("ONC",$J)=ONCREQ
- ..S ONCEXEC="G" D T3^ONCWEB1
- ..;S ONCEXEC="P" D T3^ONCWEB1
- ..M ^TMP("ONCSAPIV",$J)=^TMP("ONCSED01R",$J)
- ..M ^TMP("ONCSAPIT",$J)=^TMP("ONCSED01R",$J)
- ..;S RC=$$GETURL^ONCX10(URL,60,ONC8RSP,.ONCRHDR,$G(ONC8REQ),.ONCSHDR)
- ..S RC="200^OK" ;check the HWSC return code
- . . 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 6443 printed Feb 18, 2025@23:54:16 Page 2
- ONCSAPIR ;HINES OIFO/SG - COLLABORATIVE STAGING (REQUEST) ; 2/8/07 8:28am
- +1 ;;2.2;ONCOLOGY;**1,19**;Jul 31, 2013;Build 4
- +2 ; ...P19 testing CS Encryption
- +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 MERGE ^TMP("ONC",$JOB)=ONCREQ
- +9 SET ONCEXEC="G"
- DO T3^ONCWEB1
- +10 ;S ONCEXEC="P" D T3^ONCWEB1
- +11 MERGE ^TMP("ONCSAPIV",$JOB)=^TMP("ONCSED01R",$JOB)
- +12 MERGE ^TMP("ONCSAPIT",$JOB)=^TMP("ONCSED01R",$JOB)
- +13 ;S RC=$$GETURL^ONCX10(URL,60,ONC8RSP,.ONCRHDR,$G(ONC8REQ),.ONCSHDR)
- +14 ;check the HWSC return code
- SET RC="200^OK"
- +15 SET HS=+RC
- if HS=200
- QUIT
- +16 ;--- Temporary redirection
- +17 IF HS=302
- Begin DoDot:3
- +18 SET REPCNT=REPCNT+1
- +19 IF REPCNT>5
- SET RC=$$ERROR^ONCSAPIE(-12,,REPCNT)
- QUIT
- +20 SET URL=$GET(ONCRHDR("LOCATION"))
- +21 IF URL?." "
- SET RC=$$ERROR^ONCSAPIE(-18)
- QUIT
- +22 DO ERROR^ONCSAPIE(-7,,URL)
- SET REPEAT=1
- SET RC=0
- End DoDot:3
- QUIT
- +23 ;--- Permanent redirection
- +24 IF HS=301
- Begin DoDot:3
- +25 SET REPCNT=REPCNT+1
- +26 IF REPCNT>5
- SET RC=$$ERROR^ONCSAPIE(-12,,REPCNT)
- QUIT
- +27 SET URL=$GET(ONCRHDR("LOCATION"))
- +28 IF URL?." "
- SET RC=$$ERROR^ONCSAPIE(-18)
- QUIT
- +29 SET RC=$$UPDCSURL^ONCSAPIU(URL)
- if RC<0
- QUIT
- +30 DO ERROR^ONCSAPIE(-8,,URL)
- SET REPEAT=1
- SET RC=0
- End DoDot:3
- QUIT
- +31 ;--- Record the HTTP client error
- +32 KILL ONCINFO
- SET ONCINFO(1)=$PIECE(RC,U,2)_" ("_$PIECE(RC,U)_")"
- +33 SET RC=$$ERROR^ONCSAPIE(-10,.ONCINFO)
- End DoDot:2
- if 'REPEAT
- QUIT
- +34 if RC<0
- QUIT
- End DoDot:1
- +35 ;---
- +36 QUIT $SELECT(RC<0:RC,1:0)
- +37 ;
- +38 ;***** APPENDS THE REQUEST TRAILER TO THE DESTINATION BUFFER
- +39 ;
- +40 ; .ONC8DST Reference to a descriptor of the destination buffer.
- +41 ;
- 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