program http1,1.0(101)  ! test XCALL HTTP POST of HIPAA doc
!------------------------------------------------------------
!EDIT HISTORY
![101] November 03, 2008 09:34 AM       Edited by jack
!   Add ATHTTP option
!------------------------------------------------------------
significance 11
++include ashinc:ashell.def
++include ashinc:http.def

MAP1 FLAGS,B,4
MAP1 URL$,S,200
MAP1 RESPONSE$,S,20,"http.rsp"
MAP1 STATUS,F
MAP1 UPLOAD$,S,120
MAP1 DBG$,S,1
MAP1 GUIFLAGS,B,4
MAP1 ATHTTP$,S,1

    ? tab(-1,0);"Test HTTP.SBR / ATHTTP.SBX POST"

    FLAGS = XHTTPF_SSL or XHTTPF_REQPOST                ! SSL, POST
    FLAGS = FLAGS or XHTTPF_FILERESP OR XHTTPF_FILEREQ  ! use files for request and response

    input "Use ATHTTP.SBX? (for UNIX/ATE) ? ",ATHTTP$

    input "Debug? (Creates DEBUG.REQ file and adds status line to response file) ",DBG$
    if ucs(DBG$)="Y" and ucs(ATHTTP$)="Y" then
        FLAGS = FLAGS or XHTTPF_DEBUG
        FLAGS = FLAGS or &h80000001     ! for ATHTTP.SBX   
    endif  
    ? "Flags = ";FLAGS

    URL$ = "https://secure.enshealth.com/stomp/servlet/com.ens.stomp.transport.adapters.inbound.http.HttpAdapter"
    UPLOAD$ = "095151.QRY"

    if ucs(ATHTTP$)="Y" then
        xcall ATHTTP,1,STATUS,FLAGS,URL$,UPLOAD$,RESPONSE$
    else
        xcall HTTP,1,STATUS,FLAGS,URL$,UPLOAD$,RESPONSE$
    endif

    ? "Status : ";STATUS;
    if STATUS = 0 then
        ? " [OK]"
    else
        if STATUS > 0 then
            ? " [HTTP response code]"
            ? "See response in file HTTP.RSP"
        else
            ? "[";Fn'Print'Http'Error'Msg$(STATUS);"]"
        endif
    endif
    if FLAGS and XHTTPF_DEBUG then
        ? "Also see DEBUG.REQ (copy of formulated request sent to server)"
    endif
    end

Function Fn'Print'Http'Error'Msg$(status as f6) as s100

    switch status
    case HTTPERR_TOOFEW
        Fn'Print'Http'Error'Msg$ = "Too few params"
        exit
    case HTTPERR_NOMEM
        Fn'Print'Http'Error'Msg$ = "Can't alloc needed memory"
        exit
    case HTTPERR_BADOPCODE
        Fn'Print'Http'Error'Msg$ = "Bad opcode"
        exit
    case HTTPERR_PERR
        Fn'Print'Http'Error'Msg$ = "General parameter error (or unsupported options)"
        exit
    case HTTPERR_LIBLINK
        Fn'Print'Http'Error'Msg$ = "Error loading/linking ASHNET.DLL functions"
        exit
    case HTTPERR_LICENSE
        Fn'Print'Http'Error'Msg$ = "License failure"
        exit
    case HTTPERR_ADDFILE
        Fn'Print'Http'Error'Msg$ = "Error adding file to upload list"
        exit
    case HTTPERR_SYNCREQ
        Fn'Print'Http'Error'Msg$ = "Error during synchronous request"
        exit
    case HTTPERR_POSTFILE
        Fn'Print'Http'Error'Msg$ = "Error processing file for POST"
        exit
    case HTTPERR_STRALC
        Fn'Print'Http'Error'Msg$ = "Error allocating string buffer"
        exit
    case HTTPERR_PUTREQ
        Fn'Print'Http'Error'Msg$ = "Error during PUT"
        exit
    case HTTPERR_DOWNLOAD
        Fn'Print'Http'Error'Msg$ = "Error during download"
        exit
    default
        Fn'Print'Http'Error'Msg$ = "Unknown error"
        exit
    endswitch
End Function