Released XT*7.3*123 SEQ #97 Extracted from mail message **KIDS**:XT*7.3*123^ **INSTALL NAME** XT*7.3*123 "BLD",1267,0) XT*7.3*123^TOOLKIT^0^3100729^y "BLD",1267,1,0) ^^2^2^3091110^ "BLD",1267,1,1,0) Please refer to the Description in the FORUM Patch Module for details. "BLD",1267,1,2,0) XT*7.3*123 HTTP Client. "BLD",1267,4,0) ^9.64PA^^ "BLD",1267,6.3) 4 "BLD",1267,"KRN",0) ^9.67PA^9002226^21 "BLD",1267,"KRN",.4,0) .4 "BLD",1267,"KRN",.401,0) .401 "BLD",1267,"KRN",.402,0) .402 "BLD",1267,"KRN",.403,0) .403 "BLD",1267,"KRN",.5,0) .5 "BLD",1267,"KRN",.84,0) .84 "BLD",1267,"KRN",3.6,0) 3.6 "BLD",1267,"KRN",3.8,0) 3.8 "BLD",1267,"KRN",9.2,0) 9.2 "BLD",1267,"KRN",9.8,0) 9.8 "BLD",1267,"KRN",9.8,"NM",0) ^9.68A^6^6 "BLD",1267,"KRN",9.8,"NM",1,0) XTHC^^0^B3844 "BLD",1267,"KRN",9.8,"NM",2,0) XTHC10^^0^B19523775 "BLD",1267,"KRN",9.8,"NM",3,0) XTHC10A^^0^B34274348 "BLD",1267,"KRN",9.8,"NM",4,0) XTHCDEM^^0^B2836502 "BLD",1267,"KRN",9.8,"NM",5,0) XTHCURL^^0^B3579375 "BLD",1267,"KRN",9.8,"NM",6,0) XTHCUTL^^0^B3432229 "BLD",1267,"KRN",9.8,"NM","B","XTHC",1) "BLD",1267,"KRN",9.8,"NM","B","XTHC10",2) "BLD",1267,"KRN",9.8,"NM","B","XTHC10A",3) "BLD",1267,"KRN",9.8,"NM","B","XTHCDEM",4) "BLD",1267,"KRN",9.8,"NM","B","XTHCURL",5) "BLD",1267,"KRN",9.8,"NM","B","XTHCUTL",6) "BLD",1267,"KRN",19,0) 19 "BLD",1267,"KRN",19.1,0) 19.1 "BLD",1267,"KRN",101,0) 101 "BLD",1267,"KRN",409.61,0) 409.61 "BLD",1267,"KRN",771,0) 771 "BLD",1267,"KRN",779.2,0) 779.2 "BLD",1267,"KRN",870,0) 870 "BLD",1267,"KRN",8989.51,0) 8989.51 "BLD",1267,"KRN",8989.52,0) 8989.52 "BLD",1267,"KRN",8994,0) 8994 "BLD",1267,"KRN",9002226,0) 9002226 "BLD",1267,"KRN","B",.4,.4) "BLD",1267,"KRN","B",.401,.401) "BLD",1267,"KRN","B",.402,.402) "BLD",1267,"KRN","B",.403,.403) "BLD",1267,"KRN","B",.5,.5) "BLD",1267,"KRN","B",.84,.84) "BLD",1267,"KRN","B",3.6,3.6) "BLD",1267,"KRN","B",3.8,3.8) "BLD",1267,"KRN","B",9.2,9.2) "BLD",1267,"KRN","B",9.8,9.8) "BLD",1267,"KRN","B",19,19) "BLD",1267,"KRN","B",19.1,19.1) "BLD",1267,"KRN","B",101,101) "BLD",1267,"KRN","B",409.61,409.61) "BLD",1267,"KRN","B",771,771) "BLD",1267,"KRN","B",779.2,779.2) "BLD",1267,"KRN","B",870,870) "BLD",1267,"KRN","B",8989.51,8989.51) "BLD",1267,"KRN","B",8989.52,8989.52) "BLD",1267,"KRN","B",8994,8994) "BLD",1267,"KRN","B",9002226,9002226) "BLD",1267,"QUES",0) ^9.62^^ "MBREQ") 0 "PKG",6,-1) 1^1 "PKG",6,0) TOOLKIT^XT^PROGRAMMERS OPTIONS, MULTI. TERM LOOKUP^ "PKG",6,20,0) ^9.402P^^0 "PKG",6,22,0) ^9.49I^1^1 "PKG",6,22,1,0) 7.3^3040428^2970513^2 "PKG",6,22,1,"PAH",1,0) 123^3100729 "PKG",6,22,1,"PAH",1,1,0) ^^2^2^3100729 "PKG",6,22,1,"PAH",1,1,1,0) Please refer to the Description in the FORUM Patch Module for details. "PKG",6,22,1,"PAH",1,1,2,0) XT*7.3*123 HTTP Client. "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") NO "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 6 "RTN","XTHC") 0^1^B3844^n/a "RTN","XTHC",1,0) XTHC ;HCIOFO/SG - HTTP 1.0 CLIENT ;11/10/2009 "RTN","XTHC",2,0) ;;7.3;TOOLKIT;**123**;Apr 25, 1995;Build 4 "RTN","XTHC",3,0) ; "RTN","XTHC",4,0) ; API ENTRY POINTS ---- DESCRIPTIONS "RTN","XTHC",5,0) ; "RTN","XTHC",6,0) ; $$GETURL^XTHC10 Gets the data from the provided URL "RTN","XTHC",7,0) ; "RTN","XTHC",8,0) ; DEMO^XTHCDEM Demonstartion entry point "RTN","XTHC",9,0) ; "RTN","XTHC",10,0) ; $$ENCODE^XTHCURL Encodes the string "RTN","XTHC",11,0) ; $$MAKEURL^XTHCURL Creates a URL from components "RTN","XTHC",12,0) ; $$PARSEURL^XTHCURL Parses the URL into components "RTN","XTHC",13,0) ; $$NORMPATH^XTHCURL Returns "normalized" path "RTN","XTHC",14,0) ; "RTN","XTHC",15,0) ; $$DECODE^XTHCUTL Decodes one string replacing "RTN","XTHC",16,0) ; < <, > >, & &,   " ". "RTN","XTHC",17,0) ; "RTN","XTHC",18,0) ; INTERNAL TOOLS ------ DESCRIPTIONS "RTN","XTHC",19,0) ; "RTN","XTHC",20,0) ; $$RECEIVE^XTHC10A Reads the HTTP response "RTN","XTHC",21,0) ; $$REQUEST^XTHC10A Sends the HTTP request "RTN","XTHC",22,0) ; "RTN","XTHC",23,0) Q "RTN","XTHC10") 0^2^B19523775^n/a "RTN","XTHC10",1,0) XTHC10 ;HCIOFO/SG - HTTP 1.0 CLIENT ;11/03/09 16:00 "RTN","XTHC10",2,0) ;;7.3;TOOLKIT;**123**;Apr 25, 1995;Build 4 "RTN","XTHC10",3,0) ; "RTN","XTHC10",4,0) Q "RTN","XTHC10",5,0) ; "RTN","XTHC10",6,0) ;##### GETS THE DATA FROM THE PROVIDED URL USING HTTP 1.0 "RTN","XTHC10",7,0) ; "RTN","XTHC10",8,0) ; URL URL (http://host:port/path) "RTN","XTHC10",9,0) ; "RTN","XTHC10",10,0) ; [XT8FLG] Timeout and flags to control processing. "RTN","XTHC10",11,0) ; If a value of this parameter starts from a number "RTN","XTHC10",12,0) ; then this number is used as a value of the timeout "RTN","XTHC10",13,0) ; (in seconds). Otherwise, the default value of 5 "RTN","XTHC10",14,0) ; seconds is used. "RTN","XTHC10",15,0) ; "RTN","XTHC10",16,0) ; [XT8RDAT] Closed root of the variable where the message "RTN","XTHC10",17,0) ; body is returned. Data is stored in consecutive "RTN","XTHC10",18,0) ; nodes (numbers starting from 1). If a line is "RTN","XTHC10",19,0) ; longer than 245 characters, only 245 characters "RTN","XTHC10",20,0) ; are stored in the corresponding node. After that, "RTN","XTHC10",21,0) ; overflow sub-nodes are created. For example: "RTN","XTHC10",22,0) ; "RTN","XTHC10",23,0) ; @XT8DATA@(1)="" "RTN","XTHC10",24,0) ; @XT8DATA@(2)="VistA" "RTN","XTHC10",25,0) ; @XT8DATA@(3)="" "RTN","XTHC10",26,0) ; @XT8DATA@(4)="

" "RTN","XTHC10",27,0) ; @XT8DATA@(5)="Beginning of a very long line" "RTN","XTHC10",28,0) ; @XT8DATA@(5,1)="Continuation #1 of the long line" "RTN","XTHC10",29,0) ; @XT8DATA@(5,2)="Continuation #2 of the long line" "RTN","XTHC10",30,0) ; @XT8DATA@(5,...)=... "RTN","XTHC10",31,0) ; @XT8DATA@(6)="

" "RTN","XTHC10",32,0) ; ... "RTN","XTHC10",33,0) ; "RTN","XTHC10",34,0) ; [.XT8RHDR] Reference to a local variable where the parsed "RTN","XTHC10",35,0) ; headers are returned. Header names are converted to "RTN","XTHC10",36,0) ; upper case; the values are left "as is". The root "RTN","XTHC10",37,0) ; node contains the status line. For example: "RTN","XTHC10",38,0) ; "RTN","XTHC10",39,0) ; XT8HDR="HTTP/1.0 200 OK" "RTN","XTHC10",40,0) ; XT8HDR("CACHE-CONTROL")="private" "RTN","XTHC10",41,0) ; XT8HDR("CONNECTION")="Keep-Alive" "RTN","XTHC10",42,0) ; XT8HDR("CONTENT-LENGTH")="2690" "RTN","XTHC10",43,0) ; XT8HDR("CONTENT-TYPE")="text/html" "RTN","XTHC10",44,0) ; XT8HDR("DATE")="Fri, 26 Sep 2003 16:04:10 GMT" "RTN","XTHC10",45,0) ; XT8HDR("SERVER")="GWS/2.1" "RTN","XTHC10",46,0) ; "RTN","XTHC10",47,0) ; [XT8SDAT] Closed root of a variable containing body of the "RTN","XTHC10",48,0) ; request message. Data should be formatted as "RTN","XTHC10",49,0) ; described earlier (see the XT8RDAT parameter). "RTN","XTHC10",50,0) ; "RTN","XTHC10",51,0) ; NOTE: If this parameter is defined, not empty, and "RTN","XTHC10",52,0) ; the referenced array contains data then the "RTN","XTHC10",53,0) ; POST request is generated. Otherwise, the GET "RTN","XTHC10",54,0) ; request is sent. "RTN","XTHC10",55,0) ; "RTN","XTHC10",56,0) ; [.XT8SHDR] Reference to a local variable containing header "RTN","XTHC10",57,0) ; values, which will be added to the request. "RTN","XTHC10",58,0) ; "RTN","XTHC10",59,0) ; [REDIR] This IS NOT a published parameter. It is used "RTN","XTHC10",60,0) ; internally to limit number of redirections. "RTN","XTHC10",61,0) ; "RTN","XTHC10",62,0) ; Return values: "RTN","XTHC10",63,0) ; "RTN","XTHC10",64,0) ; <0 Error Descriptor (see the $$ERROR^XTERROR) "RTN","XTHC10",65,0) ; >0 HTTP Status Code^Description "RTN","XTHC10",66,0) ; "RTN","XTHC10",67,0) ; Most common HTTP status codes: "RTN","XTHC10",68,0) ; "RTN","XTHC10",69,0) ; 200 Ok "RTN","XTHC10",70,0) ; "RTN","XTHC10",71,0) ; 301 Moved Permanently (The application should either "RTN","XTHC10",72,0) ; automatically update the URL with the new one from "RTN","XTHC10",73,0) ; the Location response header or instruct the user "RTN","XTHC10",74,0) ; how to do this). "RTN","XTHC10",75,0) ; "RTN","XTHC10",76,0) ; 302 Moved Temporarily (The application should continue "RTN","XTHC10",77,0) ; using the original URL). "RTN","XTHC10",78,0) ; "RTN","XTHC10",79,0) ; NOTE: You will not see this code for GET requests. "RTN","XTHC10",80,0) ; They are redirected automatically. "RTN","XTHC10",81,0) ; "RTN","XTHC10",82,0) ; 303 See Other (The resource has moved to another URL "RTN","XTHC10",83,0) ; given by the Location response header, and should "RTN","XTHC10",84,0) ; be automatically retrieved by the client using the "RTN","XTHC10",85,0) ; GET method. This is often used by a CGI script to "RTN","XTHC10",86,0) ; redirect the client to an existing file). "RTN","XTHC10",87,0) ; "RTN","XTHC10",88,0) ; NOTE: You will not see this status code because it "RTN","XTHC10",89,0) ; is handled automatically inside the function. "RTN","XTHC10",90,0) ; "RTN","XTHC10",91,0) ; 400 Bad Request "RTN","XTHC10",92,0) ; "RTN","XTHC10",93,0) ; 404 Not Found "RTN","XTHC10",94,0) ; "RTN","XTHC10",95,0) ; 500 Server Error (An unexpected server error. The most "RTN","XTHC10",96,0) ; common cause is a server-side script that has bad "RTN","XTHC10",97,0) ; syntax, fails, or otherwise can't run correctly). "RTN","XTHC10",98,0) ; "RTN","XTHC10",99,0) ; See the http://www.faqs.org/rfcs/rfc1945.html for more details. "RTN","XTHC10",100,0) ; "RTN","XTHC10",101,0) GETURL(URL,XT8FLG,XT8RDAT,XT8RHDR,XT8SDAT,XT8SHDR,REDIR) ; "RTN","XTHC10",102,0) N HOST,I,IP,IPADDR,PATH,PORT,RQS,STATUS,X "RTN","XTHC10",103,0) S XT8FLG=$G(XT8FLG) S:XT8FLG'?1.N.E XT8FLG="5"_XT8FLG "RTN","XTHC10",104,0) ; "RTN","XTHC10",105,0) ;Check IO "RTN","XTHC10",106,0) I '$D(IO(0)) D HOME^%ZIS "RTN","XTHC10",107,0) ;=== Parse the URL "RTN","XTHC10",108,0) S I=$$PARSEURL^XTHCURL(URL,.HOST,.PORT,.PATH) Q:I<0 I "RTN","XTHC10",109,0) ; "RTN","XTHC10",110,0) ;=== Check the host name/address "RTN","XTHC10",111,0) I HOST'?1.3N3(1"."1.3N) D Q:IPADDR="" $$ERROR(2,HOST) "RTN","XTHC10",112,0) . ;--- Resolve the host name into the IP address(es) "RTN","XTHC10",113,0) . S IPADDR=$$ADDRESS^XLFNSLK(HOST) Q:IPADDR="" "RTN","XTHC10",114,0) . ;--- Check for the Host header value "RTN","XTHC10",115,0) . S I="" "RTN","XTHC10",116,0) . F S I=$O(XT8SHDR(I)) Q:(I="")!($$UP^XLFSTR(I)="HOST") "RTN","XTHC10",117,0) . S:I="" XT8SHDR("Host")=HOST "RTN","XTHC10",118,0) E S IPADDR=HOST "RTN","XTHC10",119,0) ; "RTN","XTHC10",120,0) ;=== Connect to the host "RTN","XTHC10",121,0) F I=1:1 S IP=$P(IPADDR,",",I) Q:IP="" D Q:'$G(POP) "RTN","XTHC10",122,0) . D CALL^%ZISTCP(IP,PORT,+XT8FLG) "RTN","XTHC10",123,0) Q:$G(POP) $$ERROR(3,IPADDR) "RTN","XTHC10",124,0) ; "RTN","XTHC10",125,0) ;=== Perform the transaction "RTN","XTHC10",126,0) D "RTN","XTHC10",127,0) . N $ESTACK,$ETRAP "RTN","XTHC10",128,0) . ;--- Setup the error processing "RTN","XTHC10",129,0) . ;D SETDEFEH^XTERROR("STATUS") "RTN","XTHC10",130,0) . S $ET="D ETRAP^XTHC10" "RTN","XTHC10",131,0) . ;--- Send the request and get the response "RTN","XTHC10",132,0) . S RQS=$$REQUEST^XTHC10A(PATH,$G(XT8SDAT),.XT8SHDR) "RTN","XTHC10",133,0) . I RQS<0 S STATUS=RQS Q "RTN","XTHC10",134,0) . S STATUS=$$RECEIVE^XTHC10A(+XT8FLG,$G(XT8RDAT),.XT8RHDR) "RTN","XTHC10",135,0) ; "RTN","XTHC10",136,0) ;=== Close the socket "RTN","XTHC10",137,0) D CLOSE^%ZISTCP "RTN","XTHC10",138,0) ; "RTN","XTHC10",139,0) ;=== Redirect if requested by the server "RTN","XTHC10",140,0) S I=+STATUS "RTN","XTHC10",141,0) I (I\100)=3 D:$S(I=303:1,I=301:0,1:RQS="GET") "RTN","XTHC10",142,0) . I $G(REDIR)>5 S STATUS=$$ERROR(5) Q "RTN","XTHC10",143,0) . S URL=$G(XT8RHDR("LOCATION")) "RTN","XTHC10",144,0) . ;I URL="" S STATUS=$$ERROR^XTERROR(-150000.024) Q "RTN","XTHC10",145,0) . I URL="" S STATUS=$$ERROR(4) Q "RTN","XTHC10",146,0) . I RQS="POST" N XT8SDAT ; Force the GET request "RTN","XTHC10",147,0) . S STATUS=$$GETURL(URL,XT8FLG,$G(XT8RDAT),.XT8RHDR,$G(XT8SDAT),.XT8SHDR,$G(REDIR)+1) "RTN","XTHC10",148,0) ; "RTN","XTHC10",149,0) ;=== Return the status "RTN","XTHC10",150,0) ;I +STATUS=-150000.004 S X=$$LASTERR^XTERROR1() S:X STATUS=X "RTN","XTHC10",151,0) I +STATUS=-6 S STATUS=STATUS("ERROR") "RTN","XTHC10",152,0) Q STATUS "RTN","XTHC10",153,0) ; "RTN","XTHC10",154,0) ETRAP ;Catch a runtime error "RTN","XTHC10",155,0) N EC "RTN","XTHC10",156,0) S STATUS("ERROR")=$$EC^%ZOSV D ^%ZTER "RTN","XTHC10",157,0) S STATUS=-6 "RTN","XTHC10",158,0) I $L($EC) S $ECODE="" S $ETRAP="D UNW^%ZTER Q:$QUIT STATUS Q " S $ECODE=",U1," "RTN","XTHC10",159,0) Q "RTN","XTHC10",160,0) ; "RTN","XTHC10",161,0) ERROR(ENUM,PARAM) ;Expand error "RTN","XTHC10",162,0) N MSG "RTN","XTHC10",163,0) S MSG=$P($T(@ENUM),";;",2) S:MSG["|" MSG=$P(MSG,"|")_$G(PARAM)_$P(MSG,"|",2) "RTN","XTHC10",164,0) Q MSG "RTN","XTHC10",165,0) ; "RTN","XTHC10",166,0) 1 ;;-1^Missing host name. "RTN","XTHC10",167,0) 2 ;;-1^Cannot resolve the host name: |. "RTN","XTHC10",168,0) 3 ;;-1^Cannot connect to host. "RTN","XTHC10",169,0) 4 ;;-1^Missing redirection URL. "RTN","XTHC10",170,0) 5 ;;-1^Too many redirections. "RTN","XTHC10",171,0) 6 ;;-6^Run Time Error. "RTN","XTHC10",172,0) 7 ;;-1^Time Out. "RTN","XTHC10A") 0^3^B34274348^n/a "RTN","XTHC10A",1,0) XTHC10A ;HCIOFO/SG - HTTP 1.0 CLIENT (TOOLS) ;12/07/09 16:05 "RTN","XTHC10A",2,0) ;;7.3;TOOLKIT;**123**;Apr 25, 1995;Build 4 "RTN","XTHC10A",3,0) ; "RTN","XTHC10A",4,0) Q "RTN","XTHC10A",5,0) ; "RTN","XTHC10A",6,0) ;+++++ APPENDS RECEIVED PIECE OF DATA TO THE DESTINATION BUFFER "RTN","XTHC10A",7,0) ; "RTN","XTHC10A",8,0) ; BUF Received data "RTN","XTHC10A",9,0) ; "RTN","XTHC10A",10,0) ; [NEWLINE] Start a new line after appending the data "RTN","XTHC10A",11,0) ; "RTN","XTHC10A",12,0) ; The XT8BUF, XT8DST, XT8IS, XT8MBL, XT8PTR, and XT8SL "RTN","XTHC10A",13,0) ; variables must be properly initialized before calling this "RTN","XTHC10A",14,0) ; procedure (see the $$RECEIVE^XTHC10A for details). "RTN","XTHC10A",15,0) ; "RTN","XTHC10A",16,0) APPEND(BUF,NEWLINE) ; "RTN","XTHC10A",17,0) N BASE,L "RTN","XTHC10A",18,0) S L=$L(BUF) S:$A(BUF,L)=13 L=L-1 "RTN","XTHC10A",19,0) ;--- Append the data "RTN","XTHC10A",20,0) I L'0 "RTN","XTHC10A",24,0) . . I 'XT8IS S @XT8DST@(XT8PTR)=XT8BUF "RTN","XTHC10A",25,0) . . E S @XT8DST@(XT8PTR,XT8IS)=XT8BUF "RTN","XTHC10A",26,0) . . S BASE=BASE+XT8SL,XT8IS=XT8IS+1,XT8SL=XT8MBL "RTN","XTHC10A",27,0) . . S XT8BUF=$E(BUF,BASE,BASE+XT8SL-1),L=L-XT8SL "RTN","XTHC10A",28,0) . S XT8SL=-L "RTN","XTHC10A",29,0) E S XT8BUF=XT8BUF_$E(BUF,1,L),XT8SL=XT8SL-L "RTN","XTHC10A",30,0) ;--- Flush the buffer and start a new line "RTN","XTHC10A",31,0) I $G(NEWLINE) D S XT8BUF="",XT8IS=0,XT8PTR=XT8PTR+1,XT8SL=XT8MBL "RTN","XTHC10A",32,0) . I 'XT8IS S @XT8DST@(XT8PTR)=XT8BUF Q "RTN","XTHC10A",33,0) . S @XT8DST@(XT8PTR,XT8IS)=XT8BUF "RTN","XTHC10A",34,0) Q "RTN","XTHC10A",35,0) ; "RTN","XTHC10A",36,0) ;+++++ CALCULATES NUMBER OF BYTES IN THE MESSAGE BODY "RTN","XTHC10A",37,0) ; "RTN","XTHC10A",38,0) ; XT8DATA Closed root of a variable containing body "RTN","XTHC10A",39,0) ; of the message "RTN","XTHC10A",40,0) ; "RTN","XTHC10A",41,0) ; NLS Length of the line terminator(s) "RTN","XTHC10A",42,0) ; "RTN","XTHC10A",43,0) DATASIZE(XT8DATA,NLS) ; "RTN","XTHC10A",44,0) N I,J,SIZE "RTN","XTHC10A",45,0) S SIZE=0,I="" "RTN","XTHC10A",46,0) F S I=$O(@XT8DATA@(I)) Q:I="" D S SIZE=SIZE+NLS "RTN","XTHC10A",47,0) . S SIZE=SIZE+$L($G(@XT8DATA@(I))) "RTN","XTHC10A",48,0) . S J="" "RTN","XTHC10A",49,0) . F S J=$O(@XT8DATA@(I,J)) Q:J="" D "RTN","XTHC10A",50,0) . . S SIZE=SIZE+$L($G(@XT8DATA@(I,J))) "RTN","XTHC10A",51,0) Q $S(SIZE>0:SIZE-NLS,1:0) "RTN","XTHC10A",52,0) ; "RTN","XTHC10A",53,0) ;+++++ PROCESSES THE HTTP HEADER "RTN","XTHC10A",54,0) ; "RTN","XTHC10A",55,0) ; .XT8H Reference to a local array containing "RTN","XTHC10A",56,0) ; the raw header data "RTN","XTHC10A",57,0) ; "RTN","XTHC10A",58,0) ; .XT8HDR Reference to a local variable where the parsed "RTN","XTHC10A",59,0) ; header will be returned "RTN","XTHC10A",60,0) ; "RTN","XTHC10A",61,0) ; Return values: "RTN","XTHC10A",62,0) ; <0 Error Descriptor (see the $$ERROR^XTERROR) "RTN","XTHC10A",63,0) ; >0 HTTP Status Code^Description "RTN","XTHC10A",64,0) ; "RTN","XTHC10A",65,0) HEADER(XT8H,XT8HDR) ; "RTN","XTHC10A",66,0) N BUF,I,NAME,TAB,TMP "RTN","XTHC10A",67,0) S XT8HDR=$$NORMSTAT($G(XT8H(1))),TAB=$C(9) "RTN","XTHC10A",68,0) F I=2:1 S BUF=$TR($G(XT8H(I)),TAB," ") Q:BUF="" D "RTN","XTHC10A",69,0) . ;--- Continuation of the previous header line "RTN","XTHC10A",70,0) . I $E(BUF,1)=" " D:$G(NAME)'="" Q "RTN","XTHC10A",71,0) . . S TMP=$$TRIM^XLFSTR(BUF) "RTN","XTHC10A",72,0) . . S:TMP'="" XT8HDR(NAME)=XT8HDR(NAME)_" "_TMP "RTN","XTHC10A",73,0) . ;--- New header line "RTN","XTHC10A",74,0) . S NAME=$$UP^XLFSTR($$TRIM^XLFSTR($P(BUF,":"))) "RTN","XTHC10A",75,0) . S:NAME'="" XT8HDR(NAME)=$$TRIM^XLFSTR($P(BUF,":",2,999)) "RTN","XTHC10A",76,0) Q $P(XT8HDR," ",2)_U_$P(XT8HDR," ",3,999) "RTN","XTHC10A",77,0) ; "RTN","XTHC10A",78,0) ;+++++ NORMALIZES THE HTTP STATUS LINE "RTN","XTHC10A",79,0) NORMSTAT(STATUS) ; "RTN","XTHC10A",80,0) N I,J1,J2,TMP "RTN","XTHC10A",81,0) ;--- Remove leading and trailing spaces "RTN","XTHC10A",82,0) S STATUS=$$TRIM^XLFSTR(STATUS) "RTN","XTHC10A",83,0) ;--- Replace groups of consecutive spaces with single spaces "RTN","XTHC10A",84,0) S J2=1 "RTN","XTHC10A",85,0) F I=1,2 D Q:'J1 "RTN","XTHC10A",86,0) . S J1=$F(STATUS," ",J2) Q:'J1 "RTN","XTHC10A",87,0) . F J2=J1:1 Q:$E(STATUS,J2)'=" " "RTN","XTHC10A",88,0) . S $E(STATUS,J1,J2-1)="" "RTN","XTHC10A",89,0) ;--- Return normalized status line "RTN","XTHC10A",90,0) Q STATUS "RTN","XTHC10A",91,0) ; "RTN","XTHC10A",92,0) ;+++++ RECEIVES AN HTTP RESPONSE "RTN","XTHC10A",93,0) ; "RTN","XTHC10A",94,0) ; TIMEOUT Timeout value (in seconds) for TCP/IP input. "RTN","XTHC10A",95,0) ; "RTN","XTHC10A",96,0) ; [XT8DATA] Closed root of the variable where the message "RTN","XTHC10A",97,0) ; body is returned. See the $$GETURL^XTHC10 "RTN","XTHC10A",98,0) ; for details. "RTN","XTHC10A",99,0) ; "RTN","XTHC10A",100,0) ; [.XT8HDR] Reference to a local variable where the parsed "RTN","XTHC10A",101,0) ; headers will be returned. See the $$GETURL^XTHC10 "RTN","XTHC10A",102,0) ; for details. "RTN","XTHC10A",103,0) ; "RTN","XTHC10A",104,0) RECEIVE(TIMEOUT,XT8DATA,XT8HDR) ; "RTN","XTHC10A",105,0) ; "RTN","XTHC10A",106,0) ; XT8BUF Work buffer where the current line is being built "RTN","XTHC10A",107,0) ; "RTN","XTHC10A",108,0) ; XT8DST Closed root of the current destination buffer used "RTN","XTHC10A",109,0) ; by the APPEND^XTHC10A "RTN","XTHC10A",110,0) ; "RTN","XTHC10A",111,0) ; XT8H Temporary buffer for the raw HTTP header "RTN","XTHC10A",112,0) ; "RTN","XTHC10A",113,0) ; XT8IS Subscript of the current continuation sub-node in "RTN","XTHC10A",114,0) ; the destination buffer (if 0 then the current main "RTN","XTHC10A",115,0) ; node is used) "RTN","XTHC10A",116,0) ; "RTN","XTHC10A",117,0) ; XT8MBL Maximum buffer length "RTN","XTHC10A",118,0) ; "RTN","XTHC10A",119,0) ; XT8PTR Subscript of the current node in the dest. buffer "RTN","XTHC10A",120,0) ; "RTN","XTHC10A",121,0) ; XT8SL Number of available bytes in the current (sub)node "RTN","XTHC10A",122,0) ; "RTN","XTHC10A",123,0) N $ESTACK,$ETRAP,BLCHS,BUF,EXIT,I1,I2,MBL,RTO,STATUS,TMP,X,XT8BUF,XT8DST,XT8H,XT8IS,XT8MBL,XT8PTR,XT8SL "RTN","XTHC10A",124,0) S BLCHS=$C(9,10,12,13)_" ",XT8MBL=245 "RTN","XTHC10A",125,0) K:$G(XT8DATA)'="" @XT8DATA K XT8HDR "RTN","XTHC10A",126,0) S XT8BUF="",XT8IS=0,XT8PTR=1,XT8SL=XT8MBL "RTN","XTHC10A",127,0) ; "RTN","XTHC10A",128,0) ;=== Setup the error processing "RTN","XTHC10A",129,0) ;S X="RCVERR^XTHC10A",@^%ZOSF("TRAP"),$ETRAP="" "RTN","XTHC10A",130,0) S $ET="D RCVERR^XTHC10A" "RTN","XTHC10A",131,0) ; "RTN","XTHC10A",132,0) ;=== Receive the header (until the first empty line) "RTN","XTHC10A",133,0) U IO "RTN","XTHC10A",134,0) S XT8DST="XT8H",(EXIT,RTO)=0 "RTN","XTHC10A",135,0) ;F R BUF#XT8MBL:TIMEOUT S RTO='$T D Q:EXIT!RTO "RTN","XTHC10A",136,0) F R BUF#XT8MBL:TIMEOUT S RTO='$T D Q:EXIT!RTO "RTN","XTHC10A",137,0) . S I1=1 "RTN","XTHC10A",138,0) . F S I2=$F(BUF,$C(10),I1) Q:'I2 D Q:EXIT "RTN","XTHC10A",139,0) . . S TMP=$E(BUF,I1,I2-2) D APPEND(TMP,1) S I1=I2 "RTN","XTHC10A",140,0) . . S:$TR(TMP,BLCHS)="" EXIT=1 "RTN","XTHC10A",141,0) . D:'EXIT APPEND($E(BUF,I1,XT8MBL)) "RTN","XTHC10A",142,0) ;--- A header must end with an empty line. "RTN","XTHC10A",143,0) ;--- Otherwise, there was a timeout. "RTN","XTHC10A",144,0) Q:'EXIT $$ERROR^XTHC10(-7) "RTN","XTHC10A",145,0) ;--- Remove ending of the header from the buffer. The buffer "RTN","XTHC10A",146,0) ;--- can contain beginning of the message body. "RTN","XTHC10A",147,0) S:I1>1 $E(BUF,1,I1-1)="" "RTN","XTHC10A",148,0) ;--- Process the header "RTN","XTHC10A",149,0) S STATUS=$$HEADER(.XT8H,.XT8HDR) "RTN","XTHC10A",150,0) ; "RTN","XTHC10A",151,0) ;=== Receive the message body "RTN","XTHC10A",152,0) D:$G(XT8DATA)'="" "RTN","XTHC10A",153,0) . N CNTLEN,RDLEN "RTN","XTHC10A",154,0) . S RDLEN=XT8MBL "RTN","XTHC10A",155,0) . ;--- Check for Content-Length header "RTN","XTHC10A",156,0) . I $D(XT8HDR("CONTENT-LENGTH")) D Q:CNTLEN'>0 "RTN","XTHC10A",157,0) . . S CNTLEN=+XT8HDR("CONTENT-LENGTH") "RTN","XTHC10A",158,0) . . S:CNTLEN1 S STATUS="POST" D "RTN","XTHC10A",212,0) . S:$D(DFLTHDR("CONTENT-TYPE")) XT8HDR("Content-Type")="text/html" "RTN","XTHC10A",213,0) . D:$D(DFLTHDR("CONTENT-LENGTH")) "RTN","XTHC10A",214,0) . . S XT8HDR("Content-Length")=$$DATASIZE(XT8DATA,$L(CRLF)) "RTN","XTHC10A",215,0) . W "POST "_URI_" HTTP/1.0",CRLF,! "RTN","XTHC10A",216,0) . ;--- Header "RTN","XTHC10A",217,0) . S I="" "RTN","XTHC10A",218,0) . F S I=$O(XT8HDR(I)) Q:I="" W I_": "_XT8HDR(I),CRLF,! "RTN","XTHC10A",219,0) . ;--- Body "RTN","XTHC10A",220,0) . S I="" "RTN","XTHC10A",221,0) . F S I=$O(@XT8DATA@(I)) Q:I="" D "RTN","XTHC10A",222,0) . . W CRLF,$G(@XT8DATA@(I)),! "RTN","XTHC10A",223,0) . . S J="" "RTN","XTHC10A",224,0) . . F S J=$O(@XT8DATA@(I,J)) Q:J="" W $G(@XT8DATA@(I,J)),! "RTN","XTHC10A",225,0) E S STATUS="GET" D "RTN","XTHC10A",226,0) . W "GET "_URI_" HTTP/1.0",CRLF,! "RTN","XTHC10A",227,0) . S I="" "RTN","XTHC10A",228,0) . F S I=$O(XT8HDR(I)) Q:I="" W I_": "_XT8HDR(I),CRLF,! "RTN","XTHC10A",229,0) . W CRLF,! "RTN","XTHC10A",230,0) ;U $P "RTN","XTHC10A",231,0) Q STATUS "RTN","XTHCDEM") 0^4^B2836502^n/a "RTN","XTHCDEM",1,0) XTHCDEM ;HCIOFO/SG - HTTP 1.0 CLIENT (DEMO) ;11/05/09 17:19 "RTN","XTHCDEM",2,0) ;;7.3;TOOLKIT;**123**;Apr 25, 1995;Build 4 "RTN","XTHCDEM",3,0) ; "RTN","XTHCDEM",4,0) ;##### DEMO ENTRY POINT "RTN","XTHCDEM",5,0) ; "RTN","XTHCDEM",6,0) ; The ^TMP($J,"XTHC") global node is used by the entry point. "RTN","XTHCDEM",7,0) ; "RTN","XTHCDEM",8,0) DEMO ; "RTN","XTHCDEM",9,0) N BODY,DIR,DIRUT,DTOUT,DUOUT,HEADER,RC,URL,X,Y "RTN","XTHCDEM",10,0) S BODY=$NA(^TMP($J,"XTHC")) "RTN","XTHCDEM",11,0) S URL="http://www.hardhats.org" "RTN","XTHCDEM",12,0) ; "RTN","XTHCDEM",13,0) S RC=0 "RTN","XTHCDEM",14,0) F D Q:RC "RTN","XTHCDEM",15,0) . K @BODY,HEADER W ! "RTN","XTHCDEM",16,0) . ;--- Request a URL from the user "RTN","XTHCDEM",17,0) . K DIR S DIR(0)="F" "RTN","XTHCDEM",18,0) . S DIR("A")="URL",DIR("B")=URL "RTN","XTHCDEM",19,0) . D ^DIR I $D(DIRUT) S RC=1 Q "RTN","XTHCDEM",20,0) . S URL=$$TRIM^XLFSTR(Y) "RTN","XTHCDEM",21,0) . ;--- Request the resource "RTN","XTHCDEM",22,0) . S RC=$$GETURL^XTHC10(URL,,BODY,.HEADER) "RTN","XTHCDEM",23,0) . I RC<0 W !,RC S RC=0 Q ; D PRTERRS^XTERROR1(RC) S RC=0 Q "RTN","XTHCDEM",24,0) . ;--- Print the data "RTN","XTHCDEM",25,0) . D PRINT(BODY,.HEADER) "RTN","XTHCDEM",26,0) . S RC=0 "RTN","XTHCDEM",27,0) ; "RTN","XTHCDEM",28,0) ;--- Cleanup "RTN","XTHCDEM",29,0) K @BODY "RTN","XTHCDEM",30,0) Q "RTN","XTHCDEM",31,0) ; "RTN","XTHCDEM",32,0) ;+++++ PRINTS THE RESPONSE "RTN","XTHCDEM",33,0) PRINT(XTHC8DAT,HEADER) ; "RTN","XTHCDEM",34,0) N I,J "RTN","XTHCDEM",35,0) ;--- "RTN","XTHCDEM",36,0) I $D(HEADER)>0 D Q:$$PAGE "RTN","XTHCDEM",37,0) . W @IOF,"----- HTTP HEADER -----",!! "RTN","XTHCDEM",38,0) . W $G(HEADER),! "RTN","XTHCDEM",39,0) . S I="" "RTN","XTHCDEM",40,0) . F S I=$O(HEADER(I)) Q:I="" W I_"="_HEADER(I),! "RTN","XTHCDEM",41,0) ;--- "RTN","XTHCDEM",42,0) D:$D(@XTHC8DAT)>1 "RTN","XTHCDEM",43,0) . W @IOF,"----- MESSAGE XTHC8DAT -----",!! "RTN","XTHCDEM",44,0) . S I="" "RTN","XTHCDEM",45,0) . F S I=$O(@XTHC8DAT@(I)) Q:I="" W @XTHC8DAT@(I) D W ! "RTN","XTHCDEM",46,0) . . S J="" F S J=$O(@XTHC8DAT@(I,J)) Q:J="" W @XTHC8DAT@(I,J) "RTN","XTHCDEM",47,0) Q "RTN","XTHCDEM",48,0) ; "RTN","XTHCDEM",49,0) PAGE() ;Page break "RTN","XTHCDEM",50,0) N DIR,DIROUT,DTOUT,DUOUT "RTN","XTHCDEM",51,0) S DIR(0)="E" "RTN","XTHCDEM",52,0) D ^DIR "RTN","XTHCDEM",53,0) Q $S($D(DUOUT):1,$D(DTOUT):1,1:0) "RTN","XTHCDEM",54,0) ; "RTN","XTHCURL") 0^5^B3579375^n/a "RTN","XTHCURL",1,0) XTHCURL ;HCIOFO/SG - HTTP 1.0 CLIENT (URL TOOLS) ;07/29/10 14:01 "RTN","XTHCURL",2,0) ;;7.3;TOOLKIT;**123**;Apr 25, 1995;Build 4 "RTN","XTHCURL",3,0) ;Per VHA Directive 2004-038, this routine should not be modified "RTN","XTHCURL",4,0) Q "RTN","XTHCURL",5,0) ; "RTN","XTHCURL",6,0) ;***** ENCODES THE STRING "RTN","XTHCURL",7,0) ; "RTN","XTHCURL",8,0) ; STR String to be encoded "RTN","XTHCURL",9,0) ; "RTN","XTHCURL",10,0) ENCODE(STR) ; "RTN","XTHCURL",11,0) N CH,I "RTN","XTHCURL",12,0) F I=1:1 S CH=$E(STR,I) Q:CH="" I CH?1CP D "RTN","XTHCURL",13,0) . I CH="." Q "RTN","XTHCURL",14,0) . I CH=" " S $E(STR,I)="+" Q "RTN","XTHCURL",15,0) . S $E(STR,I)="%"_$$RJ^XLFSTR($$CNV^XLFUTL($A(CH),16),2,"0"),I=I+2 "RTN","XTHCURL",16,0) Q STR "RTN","XTHCURL",17,0) ; "RTN","XTHCURL",18,0) ;##### CREATES URL FROM COMPONENTS "RTN","XTHCURL",19,0) ; "RTN","XTHCURL",20,0) ; HOST Host name "RTN","XTHCURL",21,0) ; [PORT] Port number (80, by default) "RTN","XTHCURL",22,0) ; [PATH] Resource path ("/", by default) "RTN","XTHCURL",23,0) ; "RTN","XTHCURL",24,0) ; [.QUERY] Reference to a local variable containing values of "RTN","XTHCURL",25,0) ; the query parameters: QUERY(Name)=Value. "RTN","XTHCURL",26,0) ; "RTN","XTHCURL",27,0) ; Return values: "RTN","XTHCURL",28,0) ; <0 Error Descriptor "RTN","XTHCURL",29,0) ; ... Resulting URL "RTN","XTHCURL",30,0) ; "RTN","XTHCURL",31,0) MAKEURL(HOST,PORT,PATH,QUERY) ; "RTN","XTHCURL",32,0) N NAME,QSTR,VAL "RTN","XTHCURL",33,0) S:HOST'["://" HOST="http://"_HOST "RTN","XTHCURL",34,0) S PORT=$S($G(PORT)>0:":"_(+PORT),1:"") "RTN","XTHCURL",35,0) ;--- "RTN","XTHCURL",36,0) S (NAME,QSTR)="" "RTN","XTHCURL",37,0) F S NAME=$O(QUERY(NAME)) Q:NAME="" D "RTN","XTHCURL",38,0) . S VAL=$G(QUERY(NAME)) "RTN","XTHCURL",39,0) . S QSTR=QSTR_"&"_$$ENCODE(NAME)_"="_$$ENCODE(VAL) "RTN","XTHCURL",40,0) S:QSTR'="" $E(QSTR,1)="?" "RTN","XTHCURL",41,0) ;--- "RTN","XTHCURL",42,0) S:$G(PATH)="" PATH="/" "RTN","XTHCURL",43,0) Q HOST_PORT_$$NORMPATH($G(PATH)_QSTR) "RTN","XTHCURL",44,0) ; "RTN","XTHCURL",45,0) ;##### RETURNS "NORMALIZED" PATH "RTN","XTHCURL",46,0) ; "RTN","XTHCURL",47,0) ; PATH Source path "RTN","XTHCURL",48,0) ; "RTN","XTHCURL",49,0) NORMPATH(PATH) ; "RTN","XTHCURL",50,0) N LAST "RTN","XTHCURL",51,0) ;--- Make sure the path has a leading slash if it "RTN","XTHCURL",52,0) ;--- is not empty and has no query string "RTN","XTHCURL",53,0) I $E(PATH,1)'="/" S:$E(PATH,1)'="?" PATH="/"_PATH "RTN","XTHCURL",54,0) ;--- Append a trailing slash to the path if it has "RTN","XTHCURL",55,0) ;--- neither a file name nor a query string "RTN","XTHCURL",56,0) S LAST=$L(PATH,"/"),LAST=$P(PATH,"/",LAST) "RTN","XTHCURL",57,0) I LAST'="",LAST'["?",LAST'["." S PATH=PATH_"/" "RTN","XTHCURL",58,0) Q PATH "RTN","XTHCURL",59,0) ; "RTN","XTHCURL",60,0) ;##### PARSES THE URL INTO COMPONENTS "RTN","XTHCURL",61,0) ; "RTN","XTHCURL",62,0) ; URL Source URL "RTN","XTHCURL",63,0) ; "RTN","XTHCURL",64,0) ; .HOST Reference to a local variable for the host name "RTN","XTHCURL",65,0) ; .PORT Reference to a local variable for the port number "RTN","XTHCURL",66,0) ; .PATH Reference to a local variable for the path "RTN","XTHCURL",67,0) ; "RTN","XTHCURL",68,0) ; Return values: "RTN","XTHCURL",69,0) ; <0 Error Descriptor "RTN","XTHCURL",70,0) ; 0 Ok "RTN","XTHCURL",71,0) ; "RTN","XTHCURL",72,0) PARSEURL(URL,HOST,PORT,PATH) ; "RTN","XTHCURL",73,0) S:$F(URL,"://") URL=$P(URL,"://",2,999) "RTN","XTHCURL",74,0) S HOST=$TR($P(URL,"/")," ") "RTN","XTHCURL",75,0) S PATH=$$NORMPATH($P(URL,"/",2,999)) "RTN","XTHCURL",76,0) S PORT=$P(HOST,":",2),HOST=$P(HOST,":") "RTN","XTHCURL",77,0) Q:HOST?." " $$ERROR^XTHC10(1,URL) "RTN","XTHCURL",78,0) S:PORT'>0 PORT=80 "RTN","XTHCURL",79,0) Q 0 "RTN","XTHCUTL") 0^6^B3432229^n/a "RTN","XTHCUTL",1,0) XTHCUTL ;ISF/RWF - HTTP 1.0 CLIENT Utilities ;11/10/09 15:12 "RTN","XTHCUTL",2,0) ;;7.3;TOOLKIT;**123**;;Build 4 "RTN","XTHCUTL",3,0) Q "RTN","XTHCUTL",4,0) ;
  • Payroll & Personnel
  • "RTN","XTHCUTL",5,0) ; "RTN","XTHCUTL",6,0) DECODE(STR) ;DeCode a string =" ", <=<, >=>,  =" " "RTN","XTHCUTL",7,0) N I,J "RTN","XTHCUTL",8,0) S I=0 "RTN","XTHCUTL",9,0) F S I=$F(STR,"&",I) Q:'I S J=$P($E(STR,I,I+5),";"),J=$$LOW^XLFSTR(J),K=$S(J="nbsp":" ",J="lt":"<",J="gt":">",J="amp":"&",J="apos":"'",J="quot":"""",$E(J)="#":$E(J,2,4),1:"") D:$L(K) "RTN","XTHCUTL",10,0) . I +K S K=$C(+K) ;A The decimal value in ISO-latin-1 for A "RTN","XTHCUTL",11,0) . S STR=$E(STR,1,I-2)_K_$E(STR,I+$L(J)+1,$L(STR)) "RTN","XTHCUTL",12,0) Q STR "RTN","XTHCUTL",13,0) ; "RTN","XTHCUTL",14,0) UNHEX(HH) ;function - decode one pair of hex digits to ASCII char "RTN","XTHCUTL",15,0) S HH=$TR(HH,"abcdef","ABCDEF") "RTN","XTHCUTL",16,0) I $TR(HH,"0123456789ABCDEF")'="" Q "???" ;-- error - bad hex code --; "RTN","XTHCUTL",17,0) S HH=$TR(HH,"ABCDEF",":;<=>?") "RTN","XTHCUTL",18,0) Q $C($$UNHEXD($E(HH,1))*16+$$UNHEXD($E(HH,2))) "RTN","XTHCUTL",19,0) ; "RTN","XTHCUTL",20,0) UNHEXD(X) ;function - convert hex digit back to decimal "RTN","XTHCUTL",21,0) Q $A(X)-48 "RTN","XTHCUTL",22,0) ; "RTN","XTHCUTL",23,0) QUOTE ; "RTN","XTHCUTL",24,0) F I=I+1:1 S CH=$E(STR,I) Q:CH=""!(CH=Q) "RTN","XTHCUTL",25,0) I $E(STR,I+1)=Q S I=I+1 G QUOTE "RTN","XTHCUTL",26,0) Q "RTN","XTHCUTL",27,0) ; "RTN","XTHCUTL",28,0) TEST ;Unit Tests "RTN","XTHCUTL",29,0) S STR="[ <&"'> ]m" I $$DECODE(STR)'="[ <&""'> ]m" W !,"Fail: ",STR "RTN","XTHCUTL",30,0) S STR="0123456789ABCDEF" I $$DECODE(STR)'="0123456789ABCDEF" W !,"Fail: ",STR "RTN","XTHCUTL",31,0) Q "VER") 8.0^22.0 "BLD",1267,6) ^97 **END** **END**