- 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 Feb 18, 2025@23:58:34 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