EDPX ;SLC/KCM - Common Utilities ;6/8/12 12:09pm
;;2.0;EMERGENCY DEPARTMENT;**6,2**;Feb 24, 2012;Build 23
;
ESC(X) ; Escape for XML transmission
; Q $ZCONVERT(X,"O","HTML") ; uncomment for fastest performance on Cache
;
N I,Y,QOT S QOT=""""
S Y=$P(X,"&") F I=2:1:$L(X,"&") S Y=Y_"&"_$P(X,"&",I)
S X=Y,Y=$P(X,"<") F I=2:1:$L(X,"<") S Y=Y_"<"_$P(X,"<",I)
S X=Y,Y=$P(X,">") F I=2:1:$L(X,">") S Y=Y_">"_$P(X,">",I)
S X=Y,Y=$P(X,"'") F I=2:1:$L(X,"'") S Y=Y_"'"_$P(X,"'",I)
S X=Y,Y=$P(X,QOT) F I=2:1:$L(X,QOT) S Y=Y_"""_$P(X,QOT,I)
Q Y
;
UES(X) ; Unescape XML
Q X ; java side is unescaping this already
; Q $ZCONVERT(X,"I","HTML")
;
UESREQ(REQ) ; Unescape HTTP post
N I,X
S X="" F S X=$O(REQ(X)) Q:X="" D
. S I=0 F S I=$O(REQ(X,I)) Q:'I D
. . S REQ(X,I)=$$UES(REQ(X,I))
Q
VAL(X,R) ; Returns parameter value or null
; HTTP passes HTML-escaped values in an array as REC(param,1)
Q $G(R(X,1))
;
NVPARSE(LST,IN) ; Parses tab delimited name-value pairs into array
N I,X,TAB,NM,VAL
S TAB=$C(9)
F I=1:1:$L(IN,TAB) S X=$P(IN,TAB,I),NM=$P(X,"="),VAL=$P(X,"=",2,999) S:$L(NM) LST(NM)=VAL
Q
XMLS(TAG,DATA,LBL) ; Return XML node as <TAG data="9" label="XXX" />
Q "<"_TAG_" data="""_$$ESC(DATA)_""" label="""_$$ESC(LBL)_""" />"
;
XMLA(TAG,ATT,END) ; Return XML node as <TAG att1="a" att2="b"... />
N NODE S NODE="<"_TAG_" "
N X
;S X="" F S X=$O(ATT(X)) Q:X="" I $L(ATT(X)) S NODE=NODE_X_"="""_$$ESC(ATT(X))_""" "
S X="" F S X=$O(ATT(X)) Q:X="" S NODE=NODE_X_"="""_$$ESC(ATT(X))_""" "
S NODE=NODE_$G(END,"/")_">"
Q NODE
;
XMLQA(EDPTAG,EDPATT,EDPEND) ; Return XML node as <TAG att1="a" att2="b"... />
; tag is built this way to work with most any output array.drp 04122012 patch2
; tag added with EDP*2.0*2
N EDPLNODE,EDPLSUB,EDPLX
S EDPLNODE="<"_EDPTAG_" "
S EDPLX="EDPATT" F S EDPLX=$Q(@EDPLX) Q:EDPLX="" D
. I $L($G(@EDPLX)) D
. . S EDPLSUB=$QL(EDPLX) ;returns number of subscripts
. . S EDPLNODE=EDPLNODE_$QS(EDPLX,EDPLSUB)_"="""_$$ESC(@EDPLX)_""" " ;makes an attribute out of the subscript
. .Q
.Q
S EDPLNODE=EDPLNODE_$G(EDPEND,"/")_">"
Q EDPLNODE
; end EDP*2.0*2 changes - drp
XMLE(SRC) ; Append list to XML array as elements
N X,NODE
S X="" F S X=$O(SRC(X)) Q:X="" D
. S NODE="<"_X_">"_$$ESC(SRC(X))_"</"_X_">"
. D XML(NODE)
Q
XML(X) ; Add a line of XML to be returned
S EDPXML=$G(EDPXML)+1
S EDPXML(EDPXML)=X
Q
XMLG(X,EDPCNT,EDPXML) ; Add line of XML to global array
S EDPCNT=$G(EDPCNT)+1
S @EDPXML@(EDPCNT)=X
Q
CODE(X) ; Return internal value for a code
Q $O(^EDPB(233.1,"B",X,0))
;
SAVERR(TYP,ERR) ; Output a save error
D XML^EDPX("<save status='"_TYP_"' >"_ERR_"</save>")
Q
SAVERRG(EDPXML,TYP,ERR) ;
D XMLG^EDPX("<save status='"_TYP_"' >"_ERR_"</save>",EDPCNT,EDPXML)
Q
MSG(MSG) ; Write out error message
I MSG=1 S X="some error"
I MSG=2300001 S X="Station Number is missing"
I MSG=2300002 S X="Patient is already active in log"
I MSG=2300003 S X="Unable to create lock for new record"
I MSG=2300004 S X="Error creating new record"
I MSG=2300005 S X="Error creating sub-record"
I MSG=2300006 S X="Missing log record"
I MSG=2300007 S X="Missing log IEN"
I MSG=2300008 S X="Error updating record"
I MSG=2300009 S X="Error updating sub-record"
I MSG=2300010 S X="Command missing or not recognized: "
I MSG=2300011 S X="Unknown report type"
I MSG=2300012 S X="Missing or invalid date range"
I MSG=2300013 S X="Shift times not defined for this site"
I MSG=2300014 S X="Name missing"
I MSG=2300015 S X="Unable to lock record"
I MSG=2300016 S X="The selected room/area is now occupied."
I MSG=2300017 S X="Report too big, unable to task."
I MSG=2300018 S X="Required parameters missing or invalid."
I MSG=2300019 S X="Default bed missing or invalid."
Q $$ESC^EDPX(X)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEDPX 3882 printed Apr 09, 2024@20:57:35 Page 2
EDPX ;SLC/KCM - Common Utilities ;6/8/12 12:09pm
+1 ;;2.0;EMERGENCY DEPARTMENT;**6,2**;Feb 24, 2012;Build 23
+2 ;
ESC(X) ; Escape for XML transmission
+1 ; Q $ZCONVERT(X,"O","HTML") ; uncomment for fastest performance on Cache
+2 ;
+3 NEW I,Y,QOT
SET QOT=""""
+4 SET Y=$PIECE(X,"&")
FOR I=2:1:$LENGTH(X,"&")
SET Y=Y_"&"_$PIECE(X,"&",I)
+5 SET X=Y
SET Y=$PIECE(X,"<")
FOR I=2:1:$LENGTH(X,"<")
SET Y=Y_"<"_$PIECE(X,"<",I)
+6 SET X=Y
SET Y=$PIECE(X,">")
FOR I=2:1:$LENGTH(X,">")
SET Y=Y_">"_$PIECE(X,">",I)
+7 SET X=Y
SET Y=$PIECE(X,"'")
FOR I=2:1:$LENGTH(X,"'")
SET Y=Y_"'"_$PIECE(X,"'",I)
+8 SET X=Y
SET Y=$PIECE(X,QOT)
FOR I=2:1:$LENGTH(X,QOT)
SET Y=Y_"""_$PIECE(X,QOT,I)
+9 QUIT Y
+10 ;
UES(X) ; Unescape XML
+1 ; java side is unescaping this already
QUIT X
+2 ; Q $ZCONVERT(X,"I","HTML")
+3 ;
UESREQ(REQ) ; Unescape HTTP post
+1 NEW I,X
+2 SET X=""
FOR
SET X=$ORDER(REQ(X))
if X=""
QUIT
Begin DoDot:1
+3 SET I=0
FOR
SET I=$ORDER(REQ(X,I))
if 'I
QUIT
Begin DoDot:2
+4 SET REQ(X,I)=$$UES(REQ(X,I))
End DoDot:2
End DoDot:1
+5 QUIT
VAL(X,R) ; Returns parameter value or null
+1 ; HTTP passes HTML-escaped values in an array as REC(param,1)
+2 QUIT $GET(R(X,1))
+3 ;
NVPARSE(LST,IN) ; Parses tab delimited name-value pairs into array
+1 NEW I,X,TAB,NM,VAL
+2 SET TAB=$CHAR(9)
+3 FOR I=1:1:$LENGTH(IN,TAB)
SET X=$PIECE(IN,TAB,I)
SET NM=$PIECE(X,"=")
SET VAL=$PIECE(X,"=",2,999)
if $LENGTH(NM)
SET LST(NM)=VAL
+4 QUIT
XMLS(TAG,DATA,LBL) ; Return XML node as <TAG data="9" label="XXX" />
+1 QUIT "<"_TAG_" data="""_$$ESC(DATA)_""" label="""_$$ESC(LBL)_""" />"
+2 ;
XMLA(TAG,ATT,END) ; Return XML node as <TAG att1="a" att2="b"... />
+1 NEW NODE
SET NODE="<"_TAG_" "
+2 NEW X
+3 ;S X="" F S X=$O(ATT(X)) Q:X="" I $L(ATT(X)) S NODE=NODE_X_"="""_$$ESC(ATT(X))_""" "
+4 SET X=""
FOR
SET X=$ORDER(ATT(X))
if X=""
QUIT
SET NODE=NODE_X_"="""_$$ESC(ATT(X))_""" "
+5 SET NODE=NODE_$GET(END,"/")_">"
+6 QUIT NODE
+7 ;
XMLQA(EDPTAG,EDPATT,EDPEND) ; Return XML node as <TAG att1="a" att2="b"... />
+1 ; tag is built this way to work with most any output array.drp 04122012 patch2
+2 ; tag added with EDP*2.0*2
+3 NEW EDPLNODE,EDPLSUB,EDPLX
+4 SET EDPLNODE="<"_EDPTAG_" "
+5 SET EDPLX="EDPATT"
FOR
SET EDPLX=$QUERY(@EDPLX)
if EDPLX=""
QUIT
Begin DoDot:1
+6 IF $LENGTH($GET(@EDPLX))
Begin DoDot:2
+7 ;returns number of subscripts
SET EDPLSUB=$QLENGTH(EDPLX)
+8 ;makes an attribute out of the subscript
SET EDPLNODE=EDPLNODE_$QSUBSCRIPT(EDPLX,EDPLSUB)_"="""_$$ESC(@EDPLX)_""" "
+9 QUIT
End DoDot:2
+10 QUIT
End DoDot:1
+11 SET EDPLNODE=EDPLNODE_$GET(EDPEND,"/")_">"
+12 QUIT EDPLNODE
+13 ; end EDP*2.0*2 changes - drp
XMLE(SRC) ; Append list to XML array as elements
+1 NEW X,NODE
+2 SET X=""
FOR
SET X=$ORDER(SRC(X))
if X=""
QUIT
Begin DoDot:1
+3 SET NODE="<"_X_">"_$$ESC(SRC(X))_"</"_X_">"
+4 DO XML(NODE)
End DoDot:1
+5 QUIT
XML(X) ; Add a line of XML to be returned
+1 SET EDPXML=$GET(EDPXML)+1
+2 SET EDPXML(EDPXML)=X
+3 QUIT
XMLG(X,EDPCNT,EDPXML) ; Add line of XML to global array
+1 SET EDPCNT=$GET(EDPCNT)+1
+2 SET @EDPXML@(EDPCNT)=X
+3 QUIT
CODE(X) ; Return internal value for a code
+1 QUIT $ORDER(^EDPB(233.1,"B",X,0))
+2 ;
SAVERR(TYP,ERR) ; Output a save error
+1 DO XML^EDPX("<save status='"_TYP_"' >"_ERR_"</save>")
+2 QUIT
SAVERRG(EDPXML,TYP,ERR) ;
+1 DO XMLG^EDPX("<save status='"_TYP_"' >"_ERR_"</save>",EDPCNT,EDPXML)
+2 QUIT
MSG(MSG) ; Write out error message
+1 IF MSG=1
SET X="some error"
+2 IF MSG=2300001
SET X="Station Number is missing"
+3 IF MSG=2300002
SET X="Patient is already active in log"
+4 IF MSG=2300003
SET X="Unable to create lock for new record"
+5 IF MSG=2300004
SET X="Error creating new record"
+6 IF MSG=2300005
SET X="Error creating sub-record"
+7 IF MSG=2300006
SET X="Missing log record"
+8 IF MSG=2300007
SET X="Missing log IEN"
+9 IF MSG=2300008
SET X="Error updating record"
+10 IF MSG=2300009
SET X="Error updating sub-record"
+11 IF MSG=2300010
SET X="Command missing or not recognized: "
+12 IF MSG=2300011
SET X="Unknown report type"
+13 IF MSG=2300012
SET X="Missing or invalid date range"
+14 IF MSG=2300013
SET X="Shift times not defined for this site"
+15 IF MSG=2300014
SET X="Name missing"
+16 IF MSG=2300015
SET X="Unable to lock record"
+17 IF MSG=2300016
SET X="The selected room/area is now occupied."
+18 IF MSG=2300017
SET X="Report too big, unable to task."
+19 IF MSG=2300018
SET X="Required parameters missing or invalid."
+20 IF MSG=2300019
SET X="Default bed missing or invalid."
+21 QUIT $$ESC^EDPX(X)
