PXVWSOAP ;ISP/LMT - ICE Web Service utilities ;Jun 06, 2019@20:26:09
;;1.0;PCE PATIENT CARE ENCOUNTER;**217**;Aug 12, 1996;Build 134
;
;
EN(PXURL) ;
;
; Make SOAP call and parse data from ICE.
; Use data in ^TMP("PXVWMSG",$J) to build SOAP message to ICE.
; Return parsed data in ^TMP("PXICEWEB",$J).
;
N PXCNT,PXGBL,PXHDRIN,PXHDROUT,PXHTTPSTAT
;
D CLEAN
;
; Build outbound message to ICE
D BLDOUT
;
S PXHDROUT("Content-Type")="application/soap+xml;charset=UTF-8"
S PXHTTPSTAT=$$GETURL^XTHC10(PXURL,"",$NA(^TMP("PXVWIN",$J)),.PXHDRIN,$NA(^TMP("PXVWOUT",$J)),.PXHDROUT,"POST")
;
;If call was unsuccessful, quit and return error from server.
I +PXHTTPSTAT'=200 D Q
. ;M ^TMP("PXICEWEB",$J)=^TMP("PXVWIN",$J)
. S PXCNT=0
. S PXGBL=$NA(^TMP("PXVWIN",$J))
. F S PXGBL=$Q(@PXGBL) Q:PXGBL="" Q:($QS(PXGBL,1)'="PXVWIN")!($QS(PXGBL,2)'=$J) D
. . S PXCNT=PXCNT+1
. . S ^TMP("PXICEWEB",$J,PXCNT)=$G(@PXGBL)
. S ^TMP("PXICEWEB",$J,0)="-3^"_PXHTTPSTAT
. D CLEAN
;
; Process Incoming Message from ICE
D PROCIN
;
I '$D(^TMP("PXICEWEB",$J)) D Q
. S ^TMP("PXICEWEB",$J,0)="-4^Unable to process incoming message from ICE"
. D CLEAN
;
; Success
S ^TMP("PXICEWEB",$J,0)=1
;
D CLEAN
;
Q
;
CLEAN ;
K ^TMP("PXVWOUT",$J)
K ^TMP("PXVWIN",$J)
Q
;
BLDOUT ; Build outbound message to ICE
;
; Build SOAP envelope and add b64 encoded VMR message to envelope.
; Input:
; VMR Message in ^TMP("PXVWMSG",$J)
; Output:
; ICE Input in ^TMP("PXVWOUT",$J)
;
N PXCNT,PXELIEN,PXI,PXJ,PXLEN,PXLINE,PXMAXLINE,PXNODE,PXSUB,PXTIME,PXTEXT,PXTZ,PXVARS,PXX
;
S PXMAXLINE=245
S PXSUB=1
S PXCNT=0
;
K ^TMP("PXPAYLOAD",$J)
;
S PXELIEN=$O(^PXV(920.77,"B","ENVELOPE",0))
I 'PXELIEN Q
;
; Base-64 encode message
D B64ENCD($NA(^TMP("PXPAYLOAD",$J)),$NA(^TMP("PXVWMSG",$J)))
;
; Format date/time as YYYY-MM-DD"T"HH:MM:SS+-time_zone_offset (e.g., 2012-01-14T00:00:00-05:00)
S PXTIME=17000000+$$NOW^XLFDT
S PXTIME=$TR(PXTIME,".","")
S PXTIME=PXTIME_$E("00000000000000",$L(PXTIME)+1,14)
S PXTZ=$$TZ^XLFDT
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)
S PXVARS("|TIME|")=PXTIME
;
S PXLINE=""
F PXNODE=2:1:4 D
. S PXI=0
. F S PXI=$O(^PXV(920.77,PXELIEN,PXNODE,PXI)) Q:'PXI D
. . S PXTEXT=$G(^PXV(920.77,PXELIEN,PXNODE,PXI,0))
. . ;
. . I PXTEXT["|PAYLOAD|" D Q
. . . S PXLINE=PXLINE_$P(PXTEXT,"|PAYLOAD|",1)
. . . S PXJ=0
. . . F S PXJ=$O(^TMP("PXPAYLOAD",$J,PXJ)) Q:'PXJ D
. . . . S PXLINE=PXLINE_$G(^TMP("PXPAYLOAD",$J,PXJ))
. . . . D ADDOUTLN(.PXLINE)
. . . S PXLINE=PXLINE_$P(PXTEXT,"|PAYLOAD|",2)
. . ;
. . I PXTEXT["|" S PXTEXT=$$REPLACE^XLFSTR(PXTEXT,.PXVARS)
. . S PXLINE=PXLINE_PXTEXT
. . ;
. . D ADDOUTLN(.PXLINE)
;
I PXLINE'="" D
. D ADDOUTLN(.PXLINE,1)
;
K ^TMP("PXPAYLOAD",$J)
;
Q
;
ADDOUTLN(PXLINE,PXLAST) ;
;
; ZEXCEPT: PXCNT,PXMAXLINE,PXSUB
;
N PXLEN
;
S PXLEN=$L(PXLINE)
I PXLEN<PXMAXLINE,'$G(PXLAST) Q
I PXCNT=0 S ^TMP("PXVWOUT",$J,PXSUB)=$E(PXLINE,1,PXMAXLINE)
I PXCNT>0 S ^TMP("PXVWOUT",$J,PXSUB,PXCNT)=$E(PXLINE,1,PXMAXLINE)
S PXCNT=PXCNT+1
S PXLINE=$E(PXLINE,(PXMAXLINE+1),PXLEN)
;
I $L(PXLINE)>PXMAXLINE D ADDOUTLN(.PXLINE,$G(PXLAST))
I $G(PXLAST),$L(PXLINE)>0 D ADDOUTLN(.PXLINE,1)
Q
;
PROCIN ; Process message from ICE
;
; Extract and decode B64 message from ICE and parse XML.
; Input:
; ICE Output Message in ^TMP("PXVWIN",$J)
; Output:
; Parsed data in ^TMP("PXICEWEB",$J)
;
N PXCALLBACK,PXCNT,PXGBL,PXSTART,PXTAG
;
K ^TMP("PXPAYLOAD",$J)
K ^TMP("PXICEXML",$J)
K ^TMP("PXVWIN2",$J)
;
; Flatten global, to put it in correct format for EN^MXMLPRSE
S PXCNT=0
S PXGBL=$NA(^TMP("PXVWIN",$J))
F S PXGBL=$Q(@PXGBL) Q:PXGBL="" Q:($QS(PXGBL,1)'="PXVWIN")!($QS(PXGBL,2)'=$J) D
. S PXCNT=PXCNT+1
. S ^TMP("PXVWIN2",$J,PXCNT)=$G(@PXGBL)
;
; Extract Base64 Payload from the base64EncodedPayload element
S PXCNT=0
S PXSTART=0
S PXTAG="base64EncodedPayload"
S PXCALLBACK("STARTELEMENT")="PROCINSE^PXVWSOAP"
S PXCALLBACK("ENDELEMENT")="PROCINEE^PXVWSOAP"
S PXCALLBACK("CHARACTERS")="PROCINC^PXVWSOAP"
D EN^MXMLPRSE($NA(^TMP("PXVWIN2",$J)),.PXCALLBACK,"W")
;
I '$D(^TMP("PXPAYLOAD",$J)) Q
D B64DECD($NA(^TMP("PXICEXML",$J)),$NA(^TMP("PXPAYLOAD",$J)))
I '$D(^TMP("PXICEXML",$J)) K ^TMP("PXPAYLOAD",$J) Q
;
; Parse XML Message from ICE
D EN^PXVWPXML
;
K ^TMP("PXPAYLOAD",$J)
K ^TMP("PXICEXML",$J)
K ^TMP("PXVWIN2",$J)
;
Q
;
PROCINSE(PXELEMENT,PXATTLIST) ; start element
;
; ZEXCEPT: PXTAG,PXSTART
;
I PXELEMENT=PXTAG S PXSTART=1
Q
;
PROCINEE(PXELEMENT) ; end element
;
; ZEXCEPT: PXTAG,PXSTART
;
I PXELEMENT=PXTAG S PXSTART=0
Q
;
PROCINC(PXTEXT) ; Characters
;
; ZEXCEPT: PXCNT,PXSTART
;
I 'PXSTART Q
S PXCNT=PXCNT+1
S ^TMP("PXPAYLOAD",$J,PXCNT)=PXTEXT
Q
;
B64ENCD(PXOUT,PXIN) ; Base64 Encode data in PXIN
;
N PXB64,PXCNT,PXENCDLEN,PXI,PXLEN,PXLINE,PXMAXLINE,PXSTOP
;
; Encode length should be a multiple of 3, so that partial text encodes ok.
S PXENCDLEN=183
;S PXENCDLEN=915
S PXLINE=""
S PXCNT=0
;
S PXSTOP=0
S PXI=0
F D Q:PXSTOP
. I $L(PXLINE)<PXENCDLEN D Q:PXSTOP
. . S PXI=$O(@PXIN@(PXI))
. . I 'PXI S PXSTOP=1 Q
. . S PXLINE=PXLINE_$G(@PXIN@(PXI))
. S PXLEN=$L(PXLINE)
. I PXLEN<PXENCDLEN Q
. S PXB64=$$B64ENCD^XUSHSH($E(PXLINE,1,PXENCDLEN))
. D ADDENCLN(.PXB64)
. S PXLINE=$E(PXLINE,(PXENCDLEN+1),PXLEN)
;
I PXLINE'="" D
. S PXB64=$$B64ENCD^XUSHSH(PXLINE)
. D ADDENCLN(.PXB64)
;
Q
;
ADDENCLN(PXLINE) ;
;
; ZEXCEPT: PXCNT,PXOUT
;
; Base64 encoding adds CRLF after every 76 characters.
; Remove them from payload.
S PXLINE=$TR(PXLINE,$C(13,10),"")
S PXCNT=PXCNT+1
S @PXOUT@(PXCNT)=PXLINE
Q
;
B64DECD(PXOUT,PXIN) ; Base64 decode data in PXIN
;
N PXCNT,PXDECDLEN,PXI,PXLEN,PXLINE,PXSTOP,PXTEXT
;
; Decode length should be a multiple of 4 (so that it decodes partial text ok).
;S PXDECDLEN=3752
S PXDECDLEN=244
S PXLINE=""
S PXCNT=0
;
S PXSTOP=0
S PXI=0
F D Q:PXSTOP
. I $L(PXLINE)<PXDECDLEN D Q:PXSTOP
. . S PXI=$O(@PXIN@(PXI))
. . I 'PXI S PXSTOP=1 Q
. . S PXLINE=PXLINE_$G(@PXIN@(PXI))
. S PXLEN=$L(PXLINE)
. I PXLEN<PXDECDLEN Q
. S PXTEXT=$$B64DECD^XUSHSH($E(PXLINE,1,PXDECDLEN))
. D ADDDECLN(.PXTEXT)
. S PXLINE=$E(PXLINE,(PXDECDLEN+1),PXLEN)
;
I PXLINE'="" D
. S PXTEXT=$$B64DECD^XUSHSH(PXLINE)
. D ADDDECLN(.PXTEXT)
;
Q
;
ADDDECLN(PXLINE) ;
;
; ZEXCEPT: PXCNT,PXOUT
;
S PXCNT=PXCNT+1
S @PXOUT@(PXCNT)=PXLINE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXVWSOAP 6724 printed Oct 16, 2024@18:32:54 Page 2
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
+2 ;
+3 ;
EN(PXURL) ;
+1 ;
+2 ; Make SOAP call and parse data from ICE.
+3 ; Use data in ^TMP("PXVWMSG",$J) to build SOAP message to ICE.
+4 ; Return parsed data in ^TMP("PXICEWEB",$J).
+5 ;
+6 NEW PXCNT,PXGBL,PXHDRIN,PXHDROUT,PXHTTPSTAT
+7 ;
+8 DO CLEAN
+9 ;
+10 ; Build outbound message to ICE
+11 DO BLDOUT
+12 ;
+13 SET PXHDROUT("Content-Type")="application/soap+xml;charset=UTF-8"
+14 SET PXHTTPSTAT=$$GETURL^XTHC10(PXURL,"",$NAME(^TMP("PXVWIN",$JOB)),.PXHDRIN,$NAME(^TMP("PXVWOUT",$JOB)),.PXHDROUT,"POST")
+15 ;
+16 ;If call was unsuccessful, quit and return error from server.
+17 IF +PXHTTPSTAT'=200
Begin DoDot:1
+18 ;M ^TMP("PXICEWEB",$J)=^TMP("PXVWIN",$J)
+19 SET PXCNT=0
+20 SET PXGBL=$NAME(^TMP("PXVWIN",$JOB))
+21 FOR
SET PXGBL=$QUERY(@PXGBL)
if PXGBL=""
QUIT
if ($QSUBSCRIPT(PXGBL,1)'="PXVWIN")!($QSUBSCRIPT(PXGBL,2)'=$JOB)
QUIT
Begin DoDot:2
+22 SET PXCNT=PXCNT+1
+23 SET ^TMP("PXICEWEB",$JOB,PXCNT)=$GET(@PXGBL)
End DoDot:2
+24 SET ^TMP("PXICEWEB",$JOB,0)="-3^"_PXHTTPSTAT
+25 DO CLEAN
End DoDot:1
QUIT
+26 ;
+27 ; Process Incoming Message from ICE
+28 DO PROCIN
+29 ;
+30 IF '$DATA(^TMP("PXICEWEB",$JOB))
Begin DoDot:1
+31 SET ^TMP("PXICEWEB",$JOB,0)="-4^Unable to process incoming message from ICE"
+32 DO CLEAN
End DoDot:1
QUIT
+33 ;
+34 ; Success
+35 SET ^TMP("PXICEWEB",$JOB,0)=1
+36 ;
+37 DO CLEAN
+38 ;
+39 QUIT
+40 ;
CLEAN ;
+1 KILL ^TMP("PXVWOUT",$JOB)
+2 KILL ^TMP("PXVWIN",$JOB)
+3 QUIT
+4 ;
BLDOUT ; Build outbound message to ICE
+1 ;
+2 ; Build SOAP envelope and add b64 encoded VMR message to envelope.
+3 ; Input:
+4 ; VMR Message in ^TMP("PXVWMSG",$J)
+5 ; Output:
+6 ; ICE Input in ^TMP("PXVWOUT",$J)
+7 ;
+8 NEW PXCNT,PXELIEN,PXI,PXJ,PXLEN,PXLINE,PXMAXLINE,PXNODE,PXSUB,PXTIME,PXTEXT,PXTZ,PXVARS,PXX
+9 ;
+10 SET PXMAXLINE=245
+11 SET PXSUB=1
+12 SET PXCNT=0
+13 ;
+14 KILL ^TMP("PXPAYLOAD",$JOB)
+15 ;
+16 SET PXELIEN=$ORDER(^PXV(920.77,"B","ENVELOPE",0))
+17 IF 'PXELIEN
QUIT
+18 ;
+19 ; Base-64 encode message
+20 DO B64ENCD($NAME(^TMP("PXPAYLOAD",$JOB)),$NAME(^TMP("PXVWMSG",$JOB)))
+21 ;
+22 ; Format date/time as YYYY-MM-DD"T"HH:MM:SS+-time_zone_offset (e.g., 2012-01-14T00:00:00-05:00)
+23 SET PXTIME=17000000+$$NOW^XLFDT
+24 SET PXTIME=$TRANSLATE(PXTIME,".","")
+25 SET PXTIME=PXTIME_$EXTRACT("00000000000000",$LENGTH(PXTIME)+1,14)
+26 SET PXTZ=$$TZ^XLFDT
+27 SET PXTIME=$EXTRACT(PXTIME,1,4)_"-"_$EXTRACT(PXTIME,5,6)_"-"_$EXTRACT(PXTIME,7,8)_"T"_$EXTRACT(PXTIME,9,10)_":"_$EXTRACT(PXTIME,11,12)_":"_$EXTRACT(PXTIME,13,14)_$EXTRACT(PXTZ,1,3)_":"_$EXTRACT(PXTZ,4,5)
+28 SET PXVARS("|TIME|")=PXTIME
+29 ;
+30 SET PXLINE=""
+31 FOR PXNODE=2:1:4
Begin DoDot:1
+32 SET PXI=0
+33 FOR
SET PXI=$ORDER(^PXV(920.77,PXELIEN,PXNODE,PXI))
if 'PXI
QUIT
Begin DoDot:2
+34 SET PXTEXT=$GET(^PXV(920.77,PXELIEN,PXNODE,PXI,0))
+35 ;
+36 IF PXTEXT["|PAYLOAD|"
Begin DoDot:3
+37 SET PXLINE=PXLINE_$PIECE(PXTEXT,"|PAYLOAD|",1)
+38 SET PXJ=0
+39 FOR
SET PXJ=$ORDER(^TMP("PXPAYLOAD",$JOB,PXJ))
if 'PXJ
QUIT
Begin DoDot:4
+40 SET PXLINE=PXLINE_$GET(^TMP("PXPAYLOAD",$JOB,PXJ))
+41 DO ADDOUTLN(.PXLINE)
End DoDot:4
+42 SET PXLINE=PXLINE_$PIECE(PXTEXT,"|PAYLOAD|",2)
End DoDot:3
QUIT
+43 ;
+44 IF PXTEXT["|"
SET PXTEXT=$$REPLACE^XLFSTR(PXTEXT,.PXVARS)
+45 SET PXLINE=PXLINE_PXTEXT
+46 ;
+47 DO ADDOUTLN(.PXLINE)
End DoDot:2
End DoDot:1
+48 ;
+49 IF PXLINE'=""
Begin DoDot:1
+50 DO ADDOUTLN(.PXLINE,1)
End DoDot:1
+51 ;
+52 KILL ^TMP("PXPAYLOAD",$JOB)
+53 ;
+54 QUIT
+55 ;
ADDOUTLN(PXLINE,PXLAST) ;
+1 ;
+2 ; ZEXCEPT: PXCNT,PXMAXLINE,PXSUB
+3 ;
+4 NEW PXLEN
+5 ;
+6 SET PXLEN=$LENGTH(PXLINE)
+7 IF PXLEN<PXMAXLINE
IF '$GET(PXLAST)
QUIT
+8 IF PXCNT=0
SET ^TMP("PXVWOUT",$JOB,PXSUB)=$EXTRACT(PXLINE,1,PXMAXLINE)
+9 IF PXCNT>0
SET ^TMP("PXVWOUT",$JOB,PXSUB,PXCNT)=$EXTRACT(PXLINE,1,PXMAXLINE)
+10 SET PXCNT=PXCNT+1
+11 SET PXLINE=$EXTRACT(PXLINE,(PXMAXLINE+1),PXLEN)
+12 ;
+13 IF $LENGTH(PXLINE)>PXMAXLINE
DO ADDOUTLN(.PXLINE,$GET(PXLAST))
+14 IF $GET(PXLAST)
IF $LENGTH(PXLINE)>0
DO ADDOUTLN(.PXLINE,1)
+15 QUIT
+16 ;
PROCIN ; Process message from ICE
+1 ;
+2 ; Extract and decode B64 message from ICE and parse XML.
+3 ; Input:
+4 ; ICE Output Message in ^TMP("PXVWIN",$J)
+5 ; Output:
+6 ; Parsed data in ^TMP("PXICEWEB",$J)
+7 ;
+8 NEW PXCALLBACK,PXCNT,PXGBL,PXSTART,PXTAG
+9 ;
+10 KILL ^TMP("PXPAYLOAD",$JOB)
+11 KILL ^TMP("PXICEXML",$JOB)
+12 KILL ^TMP("PXVWIN2",$JOB)
+13 ;
+14 ; Flatten global, to put it in correct format for EN^MXMLPRSE
+15 SET PXCNT=0
+16 SET PXGBL=$NAME(^TMP("PXVWIN",$JOB))
+17 FOR
SET PXGBL=$QUERY(@PXGBL)
if PXGBL=""
QUIT
if ($QSUBSCRIPT(PXGBL,1)'="PXVWIN")!($QSUBSCRIPT(PXGBL,2)'=$JOB)
QUIT
Begin DoDot:1
+18 SET PXCNT=PXCNT+1
+19 SET ^TMP("PXVWIN2",$JOB,PXCNT)=$GET(@PXGBL)
End DoDot:1
+20 ;
+21 ; Extract Base64 Payload from the base64EncodedPayload element
+22 SET PXCNT=0
+23 SET PXSTART=0
+24 SET PXTAG="base64EncodedPayload"
+25 SET PXCALLBACK("STARTELEMENT")="PROCINSE^PXVWSOAP"
+26 SET PXCALLBACK("ENDELEMENT")="PROCINEE^PXVWSOAP"
+27 SET PXCALLBACK("CHARACTERS")="PROCINC^PXVWSOAP"
+28 DO EN^MXMLPRSE($NAME(^TMP("PXVWIN2",$JOB)),.PXCALLBACK,"W")
+29 ;
+30 IF '$DATA(^TMP("PXPAYLOAD",$JOB))
QUIT
+31 DO B64DECD($NAME(^TMP("PXICEXML",$JOB)),$NAME(^TMP("PXPAYLOAD",$JOB)))
+32 IF '$DATA(^TMP("PXICEXML",$JOB))
KILL ^TMP("PXPAYLOAD",$JOB)
QUIT
+33 ;
+34 ; Parse XML Message from ICE
+35 DO EN^PXVWPXML
+36 ;
+37 KILL ^TMP("PXPAYLOAD",$JOB)
+38 KILL ^TMP("PXICEXML",$JOB)
+39 KILL ^TMP("PXVWIN2",$JOB)
+40 ;
+41 QUIT
+42 ;
PROCINSE(PXELEMENT,PXATTLIST) ; start element
+1 ;
+2 ; ZEXCEPT: PXTAG,PXSTART
+3 ;
+4 IF PXELEMENT=PXTAG
SET PXSTART=1
+5 QUIT
+6 ;
PROCINEE(PXELEMENT) ; end element
+1 ;
+2 ; ZEXCEPT: PXTAG,PXSTART
+3 ;
+4 IF PXELEMENT=PXTAG
SET PXSTART=0
+5 QUIT
+6 ;
PROCINC(PXTEXT) ; Characters
+1 ;
+2 ; ZEXCEPT: PXCNT,PXSTART
+3 ;
+4 IF 'PXSTART
QUIT
+5 SET PXCNT=PXCNT+1
+6 SET ^TMP("PXPAYLOAD",$JOB,PXCNT)=PXTEXT
+7 QUIT
+8 ;
B64ENCD(PXOUT,PXIN) ; Base64 Encode data in PXIN
+1 ;
+2 NEW PXB64,PXCNT,PXENCDLEN,PXI,PXLEN,PXLINE,PXMAXLINE,PXSTOP
+3 ;
+4 ; Encode length should be a multiple of 3, so that partial text encodes ok.
+5 SET PXENCDLEN=183
+6 ;S PXENCDLEN=915
+7 SET PXLINE=""
+8 SET PXCNT=0
+9 ;
+10 SET PXSTOP=0
+11 SET PXI=0
+12 FOR
Begin DoDot:1
+13 IF $LENGTH(PXLINE)<PXENCDLEN
Begin DoDot:2
+14 SET PXI=$ORDER(@PXIN@(PXI))
+15 IF 'PXI
SET PXSTOP=1
QUIT
+16 SET PXLINE=PXLINE_$GET(@PXIN@(PXI))
End DoDot:2
if PXSTOP
QUIT
+17 SET PXLEN=$LENGTH(PXLINE)
+18 IF PXLEN<PXENCDLEN
QUIT
+19 SET PXB64=$$B64ENCD^XUSHSH($EXTRACT(PXLINE,1,PXENCDLEN))
+20 DO ADDENCLN(.PXB64)
+21 SET PXLINE=$EXTRACT(PXLINE,(PXENCDLEN+1),PXLEN)
End DoDot:1
if PXSTOP
QUIT
+22 ;
+23 IF PXLINE'=""
Begin DoDot:1
+24 SET PXB64=$$B64ENCD^XUSHSH(PXLINE)
+25 DO ADDENCLN(.PXB64)
End DoDot:1
+26 ;
+27 QUIT
+28 ;
ADDENCLN(PXLINE) ;
+1 ;
+2 ; ZEXCEPT: PXCNT,PXOUT
+3 ;
+4 ; Base64 encoding adds CRLF after every 76 characters.
+5 ; Remove them from payload.
+6 SET PXLINE=$TRANSLATE(PXLINE,$CHAR(13,10),"")
+7 SET PXCNT=PXCNT+1
+8 SET @PXOUT@(PXCNT)=PXLINE
+9 QUIT
+10 ;
B64DECD(PXOUT,PXIN) ; Base64 decode data in PXIN
+1 ;
+2 NEW PXCNT,PXDECDLEN,PXI,PXLEN,PXLINE,PXSTOP,PXTEXT
+3 ;
+4 ; Decode length should be a multiple of 4 (so that it decodes partial text ok).
+5 ;S PXDECDLEN=3752
+6 SET PXDECDLEN=244
+7 SET PXLINE=""
+8 SET PXCNT=0
+9 ;
+10 SET PXSTOP=0
+11 SET PXI=0
+12 FOR
Begin DoDot:1
+13 IF $LENGTH(PXLINE)<PXDECDLEN
Begin DoDot:2
+14 SET PXI=$ORDER(@PXIN@(PXI))
+15 IF 'PXI
SET PXSTOP=1
QUIT
+16 SET PXLINE=PXLINE_$GET(@PXIN@(PXI))
End DoDot:2
if PXSTOP
QUIT
+17 SET PXLEN=$LENGTH(PXLINE)
+18 IF PXLEN<PXDECDLEN
QUIT
+19 SET PXTEXT=$$B64DECD^XUSHSH($EXTRACT(PXLINE,1,PXDECDLEN))
+20 DO ADDDECLN(.PXTEXT)
+21 SET PXLINE=$EXTRACT(PXLINE,(PXDECDLEN+1),PXLEN)
End DoDot:1
if PXSTOP
QUIT
+22 ;
+23 IF PXLINE'=""
Begin DoDot:1
+24 SET PXTEXT=$$B64DECD^XUSHSH(PXLINE)
+25 DO ADDDECLN(.PXTEXT)
End DoDot:1
+26 ;
+27 QUIT
+28 ;
ADDDECLN(PXLINE) ;
+1 ;
+2 ; ZEXCEPT: PXCNT,PXOUT
+3 ;
+4 SET PXCNT=PXCNT+1
+5 SET @PXOUT@(PXCNT)=PXLINE
+6 QUIT
