Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXVWSOAP

PXVWSOAP.m

Go to the documentation of this file.
  1. PXVWSOAP ;ISP/LMT - ICE Web Service utilities ;Jun 06, 2019@20:26:09
  1. ;;1.0;PCE PATIENT CARE ENCOUNTER;**217**;Aug 12, 1996;Build 134
  1. ;
  1. ;
  1. EN(PXURL) ;
  1. ;
  1. ; Make SOAP call and parse data from ICE.
  1. ; Use data in ^TMP("PXVWMSG",$J) to build SOAP message to ICE.
  1. ; Return parsed data in ^TMP("PXICEWEB",$J).
  1. ;
  1. N PXCNT,PXGBL,PXHDRIN,PXHDROUT,PXHTTPSTAT
  1. ;
  1. D CLEAN
  1. ;
  1. ; Build outbound message to ICE
  1. D BLDOUT
  1. ;
  1. S PXHDROUT("Content-Type")="application/soap+xml;charset=UTF-8"
  1. S PXHTTPSTAT=$$GETURL^XTHC10(PXURL,"",$NA(^TMP("PXVWIN",$J)),.PXHDRIN,$NA(^TMP("PXVWOUT",$J)),.PXHDROUT,"POST")
  1. ;
  1. ;If call was unsuccessful, quit and return error from server.
  1. I +PXHTTPSTAT'=200 D Q
  1. . ;M ^TMP("PXICEWEB",$J)=^TMP("PXVWIN",$J)
  1. . S PXCNT=0
  1. . S PXGBL=$NA(^TMP("PXVWIN",$J))
  1. . F S PXGBL=$Q(@PXGBL) Q:PXGBL="" Q:($QS(PXGBL,1)'="PXVWIN")!($QS(PXGBL,2)'=$J) D
  1. . . S PXCNT=PXCNT+1
  1. . . S ^TMP("PXICEWEB",$J,PXCNT)=$G(@PXGBL)
  1. . S ^TMP("PXICEWEB",$J,0)="-3^"_PXHTTPSTAT
  1. . D CLEAN
  1. ;
  1. ; Process Incoming Message from ICE
  1. D PROCIN
  1. ;
  1. I '$D(^TMP("PXICEWEB",$J)) D Q
  1. . S ^TMP("PXICEWEB",$J,0)="-4^Unable to process incoming message from ICE"
  1. . D CLEAN
  1. ;
  1. ; Success
  1. S ^TMP("PXICEWEB",$J,0)=1
  1. ;
  1. D CLEAN
  1. ;
  1. Q
  1. ;
  1. CLEAN ;
  1. K ^TMP("PXVWOUT",$J)
  1. K ^TMP("PXVWIN",$J)
  1. Q
  1. ;
  1. BLDOUT ; Build outbound message to ICE
  1. ;
  1. ; Build SOAP envelope and add b64 encoded VMR message to envelope.
  1. ; Input:
  1. ; VMR Message in ^TMP("PXVWMSG",$J)
  1. ; Output:
  1. ; ICE Input in ^TMP("PXVWOUT",$J)
  1. ;
  1. N PXCNT,PXELIEN,PXI,PXJ,PXLEN,PXLINE,PXMAXLINE,PXNODE,PXSUB,PXTIME,PXTEXT,PXTZ,PXVARS,PXX
  1. ;
  1. S PXMAXLINE=245
  1. S PXSUB=1
  1. S PXCNT=0
  1. ;
  1. K ^TMP("PXPAYLOAD",$J)
  1. ;
  1. S PXELIEN=$O(^PXV(920.77,"B","ENVELOPE",0))
  1. I 'PXELIEN Q
  1. ;
  1. ; Base-64 encode message
  1. D B64ENCD($NA(^TMP("PXPAYLOAD",$J)),$NA(^TMP("PXVWMSG",$J)))
  1. ;
  1. ; Format date/time as YYYY-MM-DD"T"HH:MM:SS+-time_zone_offset (e.g., 2012-01-14T00:00:00-05:00)
  1. S PXTIME=17000000+$$NOW^XLFDT
  1. S PXTIME=$TR(PXTIME,".","")
  1. S PXTIME=PXTIME_$E("00000000000000",$L(PXTIME)+1,14)
  1. S PXTZ=$$TZ^XLFDT
  1. S PXTIME=$E(PXTIME,1,4)_"-"_$E(PXTIME,5,6)_"-"_$E(PXTIME,7,8)_"T"_$E(PXTIME,9,10)_":"_$E(PXTIME,11,12)_":"_$E(PXTIME,13,14)_$E(PXTZ,1,3)_":"_$E(PXTZ,4,5)
  1. S PXVARS("|TIME|")=PXTIME
  1. ;
  1. S PXLINE=""
  1. F PXNODE=2:1:4 D
  1. . S PXI=0
  1. . F S PXI=$O(^PXV(920.77,PXELIEN,PXNODE,PXI)) Q:'PXI D
  1. . . S PXTEXT=$G(^PXV(920.77,PXELIEN,PXNODE,PXI,0))
  1. . . ;
  1. . . I PXTEXT["|PAYLOAD|" D Q
  1. . . . S PXLINE=PXLINE_$P(PXTEXT,"|PAYLOAD|",1)
  1. . . . S PXJ=0
  1. . . . F S PXJ=$O(^TMP("PXPAYLOAD",$J,PXJ)) Q:'PXJ D
  1. . . . . S PXLINE=PXLINE_$G(^TMP("PXPAYLOAD",$J,PXJ))
  1. . . . . D ADDOUTLN(.PXLINE)
  1. . . . S PXLINE=PXLINE_$P(PXTEXT,"|PAYLOAD|",2)
  1. . . ;
  1. . . I PXTEXT["|" S PXTEXT=$$REPLACE^XLFSTR(PXTEXT,.PXVARS)
  1. . . S PXLINE=PXLINE_PXTEXT
  1. . . ;
  1. . . D ADDOUTLN(.PXLINE)
  1. ;
  1. I PXLINE'="" D
  1. . D ADDOUTLN(.PXLINE,1)
  1. ;
  1. K ^TMP("PXPAYLOAD",$J)
  1. ;
  1. Q
  1. ;
  1. ADDOUTLN(PXLINE,PXLAST) ;
  1. ;
  1. ; ZEXCEPT: PXCNT,PXMAXLINE,PXSUB
  1. ;
  1. N PXLEN
  1. ;
  1. S PXLEN=$L(PXLINE)
  1. I PXLEN<PXMAXLINE,'$G(PXLAST) Q
  1. I PXCNT=0 S ^TMP("PXVWOUT",$J,PXSUB)=$E(PXLINE,1,PXMAXLINE)
  1. I PXCNT>0 S ^TMP("PXVWOUT",$J,PXSUB,PXCNT)=$E(PXLINE,1,PXMAXLINE)
  1. S PXCNT=PXCNT+1
  1. S PXLINE=$E(PXLINE,(PXMAXLINE+1),PXLEN)
  1. ;
  1. I $L(PXLINE)>PXMAXLINE D ADDOUTLN(.PXLINE,$G(PXLAST))
  1. I $G(PXLAST),$L(PXLINE)>0 D ADDOUTLN(.PXLINE,1)
  1. Q
  1. ;
  1. PROCIN ; Process message from ICE
  1. ;
  1. ; Extract and decode B64 message from ICE and parse XML.
  1. ; Input:
  1. ; ICE Output Message in ^TMP("PXVWIN",$J)
  1. ; Output:
  1. ; Parsed data in ^TMP("PXICEWEB",$J)
  1. ;
  1. N PXCALLBACK,PXCNT,PXGBL,PXSTART,PXTAG
  1. ;
  1. K ^TMP("PXPAYLOAD",$J)
  1. K ^TMP("PXICEXML",$J)
  1. K ^TMP("PXVWIN2",$J)
  1. ;
  1. ; Flatten global, to put it in correct format for EN^MXMLPRSE
  1. S PXCNT=0
  1. S PXGBL=$NA(^TMP("PXVWIN",$J))
  1. F S PXGBL=$Q(@PXGBL) Q:PXGBL="" Q:($QS(PXGBL,1)'="PXVWIN")!($QS(PXGBL,2)'=$J) D
  1. . S PXCNT=PXCNT+1
  1. . S ^TMP("PXVWIN2",$J,PXCNT)=$G(@PXGBL)
  1. ;
  1. ; Extract Base64 Payload from the base64EncodedPayload element
  1. S PXCNT=0
  1. S PXSTART=0
  1. S PXTAG="base64EncodedPayload"
  1. S PXCALLBACK("STARTELEMENT")="PROCINSE^PXVWSOAP"
  1. S PXCALLBACK("ENDELEMENT")="PROCINEE^PXVWSOAP"
  1. S PXCALLBACK("CHARACTERS")="PROCINC^PXVWSOAP"
  1. D EN^MXMLPRSE($NA(^TMP("PXVWIN2",$J)),.PXCALLBACK,"W")
  1. ;
  1. I '$D(^TMP("PXPAYLOAD",$J)) Q
  1. D B64DECD($NA(^TMP("PXICEXML",$J)),$NA(^TMP("PXPAYLOAD",$J)))
  1. I '$D(^TMP("PXICEXML",$J)) K ^TMP("PXPAYLOAD",$J) Q
  1. ;
  1. ; Parse XML Message from ICE
  1. D EN^PXVWPXML
  1. ;
  1. K ^TMP("PXPAYLOAD",$J)
  1. K ^TMP("PXICEXML",$J)
  1. K ^TMP("PXVWIN2",$J)
  1. ;
  1. Q
  1. ;
  1. PROCINSE(PXELEMENT,PXATTLIST) ; start element
  1. ;
  1. ; ZEXCEPT: PXTAG,PXSTART
  1. ;
  1. I PXELEMENT=PXTAG S PXSTART=1
  1. Q
  1. ;
  1. PROCINEE(PXELEMENT) ; end element
  1. ;
  1. ; ZEXCEPT: PXTAG,PXSTART
  1. ;
  1. I PXELEMENT=PXTAG S PXSTART=0
  1. Q
  1. ;
  1. PROCINC(PXTEXT) ; Characters
  1. ;
  1. ; ZEXCEPT: PXCNT,PXSTART
  1. ;
  1. I 'PXSTART Q
  1. S PXCNT=PXCNT+1
  1. S ^TMP("PXPAYLOAD",$J,PXCNT)=PXTEXT
  1. Q
  1. ;
  1. B64ENCD(PXOUT,PXIN) ; Base64 Encode data in PXIN
  1. ;
  1. N PXB64,PXCNT,PXENCDLEN,PXI,PXLEN,PXLINE,PXMAXLINE,PXSTOP
  1. ;
  1. ; Encode length should be a multiple of 3, so that partial text encodes ok.
  1. S PXENCDLEN=183
  1. ;S PXENCDLEN=915
  1. S PXLINE=""
  1. S PXCNT=0
  1. ;
  1. S PXSTOP=0
  1. S PXI=0
  1. F D Q:PXSTOP
  1. . I $L(PXLINE)<PXENCDLEN D Q:PXSTOP
  1. . . S PXI=$O(@PXIN@(PXI))
  1. . . I 'PXI S PXSTOP=1 Q
  1. . . S PXLINE=PXLINE_$G(@PXIN@(PXI))
  1. . S PXLEN=$L(PXLINE)
  1. . I PXLEN<PXENCDLEN Q
  1. . S PXB64=$$B64ENCD^XUSHSH($E(PXLINE,1,PXENCDLEN))
  1. . D ADDENCLN(.PXB64)
  1. . S PXLINE=$E(PXLINE,(PXENCDLEN+1),PXLEN)
  1. ;
  1. I PXLINE'="" D
  1. . S PXB64=$$B64ENCD^XUSHSH(PXLINE)
  1. . D ADDENCLN(.PXB64)
  1. ;
  1. Q
  1. ;
  1. ADDENCLN(PXLINE) ;
  1. ;
  1. ; ZEXCEPT: PXCNT,PXOUT
  1. ;
  1. ; Base64 encoding adds CRLF after every 76 characters.
  1. ; Remove them from payload.
  1. S PXLINE=$TR(PXLINE,$C(13,10),"")
  1. S PXCNT=PXCNT+1
  1. S @PXOUT@(PXCNT)=PXLINE
  1. Q
  1. ;
  1. B64DECD(PXOUT,PXIN) ; Base64 decode data in PXIN
  1. ;
  1. N PXCNT,PXDECDLEN,PXI,PXLEN,PXLINE,PXSTOP,PXTEXT
  1. ;
  1. ; Decode length should be a multiple of 4 (so that it decodes partial text ok).
  1. ;S PXDECDLEN=3752
  1. S PXDECDLEN=244
  1. S PXLINE=""
  1. S PXCNT=0
  1. ;
  1. S PXSTOP=0
  1. S PXI=0
  1. F D Q:PXSTOP
  1. . I $L(PXLINE)<PXDECDLEN D Q:PXSTOP
  1. . . S PXI=$O(@PXIN@(PXI))
  1. . . I 'PXI S PXSTOP=1 Q
  1. . . S PXLINE=PXLINE_$G(@PXIN@(PXI))
  1. . S PXLEN=$L(PXLINE)
  1. . I PXLEN<PXDECDLEN Q
  1. . S PXTEXT=$$B64DECD^XUSHSH($E(PXLINE,1,PXDECDLEN))
  1. . D ADDDECLN(.PXTEXT)
  1. . S PXLINE=$E(PXLINE,(PXDECDLEN+1),PXLEN)
  1. ;
  1. I PXLINE'="" D
  1. . S PXTEXT=$$B64DECD^XUSHSH(PXLINE)
  1. . D ADDDECLN(.PXTEXT)
  1. ;
  1. Q
  1. ;
  1. ADDDECLN(PXLINE) ;
  1. ;
  1. ; ZEXCEPT: PXCNT,PXOUT
  1. ;
  1. S PXCNT=PXCNT+1
  1. S @PXOUT@(PXCNT)=PXLINE
  1. Q