EDPHIST ;SLC/MKB - Return results history as XML ; 9/1/22 9:27am
;;2.0;EMERGENCY DEPARTMENT;**20**;May 2, 2012;Build 7
;External reference ^ORX8 supported by DBIA 871
;
LAB(XML,PARAM) ; -- Return results history for lab orders
K XML D ADD("<results>")
;
; validate input parameters
N DFN,LOG,IN,MAX
S DFN=+$$VAL("patient") I DFN<1 D ERR(1) G LQ
S LOG=+$O(^EDP(230,"APA",DFN,0)),IN=$P($G(^EDP(230,LOG,0)),U,8)
S MAX=$$VAL("total")
;
K ^TMP("LRRR",$J) D RR^LR7OR1(DFN)
;
; get results for tests in each order
N EDPI,ORIFN,NAME,STS,START,EDPY,EDPTST,ORPK,SUB,IDT,SEQ,EDPX,X,ORUPCHUK
S EDPI=0 F S EDPI=$O(PARAM("order",EDPI)) Q:EDPI<1 D
. S ORIFN=+$G(PARAM("order",EDPI)) Q:ORIFN<1
. S NAME=$P($$OI^ORX8(ORIFN),U,2) ;get order text if null?
. S STS=$$GET1^DIQ(100,ORIFN_",",5,"I")
. D EN^ORX8(ORIFN)
. S START=ORUPCHUK("ORSTRT")
. I 'START S START=ORUPCHUK("ORODT")
. S EDPY="<order id="""_ORIFN_""" name="""_$$ESC(NAME)_""" ack="""_$$ACK(ORIFN)_""" statusId="""_STS_""" statusName="""_$$STATUS(STS,"L",ORIFN)_""" collectedTS="""_START_""">"
. D ADD(EDPY) K EDPY,EDPTST
. ; add order results from visit
. S ORPK=$$PKGID^ORX8(ORIFN) I $L(ORPK,";")'>3 G L1 ;no results
. S SUB=$P(ORPK,";",4),IDT=$P(ORPK,";",5)
. D ADD("<visit>")
. S SEQ=0 F S SEQ=$O(^TMP("LRRR",$J,DFN,SUB,IDT,SEQ)) Q:SEQ<1 D
.. K EDPX S EDPX("id")=SUB_";"_IDT_";"_SEQ
.. D TMP^EDPLAB(.EDPX,DFN,SUB,IDT,SEQ) ;parse into EDPX("att")=value
.. D ADDA("item",.EDPX)
.. S X=$G(EDPX("testID")) S:X EDPTST(X)=""
. D ADD("</visit>")
. ;
. ; add prior results of all included tests [up to MAX# collections]
. N CNT,DONE,MORE
. D ADD("<history>") S (CNT,DONE)=0
. F S IDT=$O(^TMP("LRRR",$J,DFN,SUB,IDT)) Q:IDT<1 D Q:DONE
.. S SEQ=0,MORE=0
.. F S SEQ=$O(^TMP("LRRR",$J,DFN,SUB,IDT,SEQ)) Q:SEQ<1 S X=$G(^(SEQ)) D
... Q:'$D(EDPTST(+X)) ;not a matching test
... K EDPX S EDPX("id")="CH;"_IDT_";"_SEQ,MORE=1
... D TMP^EDPLAB(.EDPX,DFN,"CH",IDT,SEQ) ;parse into EDPX("att")=value
... D ADDA("item",.EDPX)
.. S:MORE CNT=CNT+1 I $G(MAX),CNT'<MAX S DONE=1
. D ADD("</history>")
L1 . D ADD("</order>")
;
LQ ; end
D ADD("</results>")
Q
;
ACK(ORDER,RETDATE) ; -- Return [first] user that ack'd order
; INPUT
; ORDER - Order IEN
; RETDATE - (optional) 1 if ack date is to be returned, otherwise do not return ack date
N IFN,X,Y,Y1 S Y="false",Y1=""
S RETDATE=$G(RETDATE,"")
S IFN=0 F S IFN=+$O(^ORA(102.4,"B",+$G(ORDER),IFN)) Q:IFN<1 D Q:Y'="false"
. S X=$G(^ORA(102.4,IFN,0))
. I $P(X,U,3) S X=+$P(X,U,2),Y=$$GET1^DIQ(200,X_",",1),Y1=$P(X,U,3) ;Y=initials, Y1=date/time
I RETDATE Q Y_U_Y1
Q Y
;
MED(XML,PARAM) ; -- Return dose & lab history for med
K XML D ADD("<results>")
;
; validate input parameters
N DFN,ORD,ORIT,ORVP,ORIDT,ORIFN,EDPLST,EDPX
S DFN=+$$VAL("patient") I DFN<1 D ERR(1) G MQ
S ORD=+$$VAL("order") I ORD<1 D ERR(4) G MQ
S ORIT=+$$OI^ORX8(ORD) I ORIT<1 D ERR(5) G MQ
S ORVP=DFN_";DPT("
;
; search Pharmacy for history of medication
S ORIDT=0 F S ORIDT=$O(^OR(100,"AOI",ORIT,ORVP,ORIDT)) Q:ORIDT<1 D
. S ORIFN=0 F S ORIFN=$O(^OR(100,"AOI",ORIT,ORVP,ORIDT,ORIFN)) Q:ORIFN<1 I ORIFN'=ORD S EDPLST(ORIFN)=""
K ^TMP("PS",$J) I $O(EDPLST(0)) D
. D ADD("<meds>")
. S ORIFN=0 F S ORIFN=$O(EDPLST(ORIFN)) Q:ORIFN<1 D
.. K EDPX D OEL^EDPMED(.EDPX,DFN,ORIFN,ORIDT)
.. D ADDA("med",.EDPX)
. D ADD("</meds>") K ^TMP("PS",$J)
;
; search Lab for result history of TEST
N DRUG,TEST K ^TMP("LRRR",$J)
S DRUG=+$$VALUE^ORCSAVE2(ORIFN,"DRUG")
S TEST=$$GET1^DIQ(50,DRUG_",",17.2,"I") I TEST<1 G MQ
D RR^LR7OR1(DFN,,,,,TEST) I $D(^TMP("LRRR",$J)) D
. N SUB,IDT,SEQ
. D ADD("<labs>")
. S SUB=$O(^TMP("LRRR",$J,DFN,"")) Q:SUB=""
. S IDT=0 F S IDT=$O(^TMP("LRRR",$J,DFN,SUB,IDT)) Q:IDT<1 D
.. S SEQ=0 F S SEQ=$O(^TMP("LRRR",$J,DFN,SUB,IDT,SEQ)) Q:SEQ<1 D
... K EDPX ;S EDPX("id")=SUB_";"_IDT_";"_SEQ ??
... D TMP^EDPLAB(.EDPX,DFN,SUB,IDT,SEQ) ;parse into EDPX("att")=value
... D ADDA("lab",.EDPX)
. D ADD("</labs>") K ^TMP("LRRR",$J)
;
; search for Clinical Events on ORIT/TEST
I $D(^EDP(234,"AL",DFN,ORIT,TEST)) D
. D ADD("<events>")
. N EDPDT,DA,X0,X1,X2,EDPV S EDPDT=0
. F S EDPDT=$O(^EDP(234,"AL",DFN,ORIT,TEST,EDPDT)) Q:EDPDT<1 S DA=+$O(^(EDPDT,0)) D
.. S X0=$G(^EDP(234,DA,0)),X1=$G(^(1)),X2=$G(^(2)) K EDPV
.. S EDPV("eventTS")=+X0,EDPV("title")=X1,EDPV("text")=X2
.. S X=+$P(X0,U,3),EDPV("userID")=X,EDPV("id")=DA
.. S EDPV("userName")=$P($G(^VA(200,X,0)),U)
.. D ADDA("event",.EDPV)
. D ADD("</events>")
;
MQ ;end
D ADD("</results>")
Q
;
VAL(X) Q $G(PARAM(X,1))
;
STATUS(STS,TYPE,ORDER) ; -- Return result status for ORDER status
N Y,X
S Y=""
S STS=+$G(STS),TYPE=$E($$UP^XLFSTR($G(TYPE))),ORDER=+$G(ORDER)
I STS=1 S Y="Order discontinued" D:ORDER ;look for reason
. S X=$$GET1^DIQ(100,ORDER_",",65) S:'$L(X) X=$$GET1^DIQ(100,ORDER_",",64)
. I $L(X) S Y=Y_" ("_X_")"
I STS=2 S Y=$S(TYPE="R":"Report",1:"Results")_$S($$ACKD(ORDER):" acknowledged",1:" available")
I STS=3 S Y="On hold"
I STS=5 S Y="Order pending"
I STS=6 S Y=$S(TYPE="L":"Specimen in lab",TYPE="R":"In Process",1:"Active")
I STS=7 S Y="Order expired"
I STS=8 S Y=$S(TYPE="R":"Exam scheduled",1:"Scheduled")
I STS=9 S Y="Partial results available"
I STS=10!(STS=11) S Y="Order not released"
I STS=12 S Y="Order discontinued (changed)"
I STS=13 S Y="Order cancelled"
I STS=14 S Y="Order discontinued (lapsed)"
I STS=15 S Y="Order renewed"
Q Y
;
ACKD(ORDER) ; -- Returns 1 or 0, if ORDER has been acknowledged
N Y,X,IFN S Y=0
S IFN=0 F S IFN=$O(^ORA(102.4,"B",+$G(ORDER),IFN)) Q:IFN<1 D Q:Y
. S X=$G(^ORA(102.4,IFN,0)) I $P(X,U,3) S Y=1 Q
Q Y
;
RANGE(VAL,BEG,END,MAX) ; -- Return BEG,END,MAX
S BEG=$G(VAL("start",1)),END=$G(VAL("stop",1)),MAX=$G(VAL("total",1))
S:BEG BEG=$$HL7TFM^XLFDT(BEG)
S:END END=$$HL7TFM^XLFDT(END)
I BEG,END,END<BEG N X S X=BEG,BEG=END,END=X ;switch
I END,$L(END,".")<2 S END=END_".24"
Q
;
ERR(X) ; -- return error message
N MSG
I X=1 S MSG="Missing or invalid patient identifier"
I X=2 S MSG="Missing or invalid data type"
I X=3 S MSG="Missing or invalid observation identifier"
I X=4 S MSG="Missing or invalid order number"
I X=5 S MSG="Missing or invalid orderable item"
; X=? S MSG="others"
I X=99 S MSG="Unknown request"
D XML^EDPX("<error msg='"_MSG_"' />")
Q
;
UES(X) ; -- unescape incoming XML
; bwf: 12/19/2011 commented following line due to SAC. Need to figure out why this is here.
;Q $ZCONVERT(X,"I","HTML")
;
ESC(X) ; -- escape outgoing XML
; 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
;
ADD(X) ; Add a line to XML(n)
S XML=$G(XML)+1
S XML(XML)=X
Q
;
ADDA(TAG,ATT) ; Add ATTribute list to XML(n)
; as <TAG att1="a" att2="b"... />
N NODE,X,MULT,N,I
S NODE="<"_TAG_" ",N=0
S X="" F S X=$O(ATT(X)) Q:X="" D
. I X="text",$L($G(ATT(X))) S N=N+1,MULT(N)="<"_X_" xml:space=""preserve"">"_$$ESC(ATT(X))_"</"_X_">" Q
. I $L($G(ATT(X))) S NODE=NODE_X_"="""_$$ESC(ATT(X))_""" " Q
. S N=N+1,MULT(N)="<"_X_"s>"
. S I=0 F S I=$O(ATT(X,I)) Q:I<1 D
.. I $L($G(ATT(X,I))) S N=N+1,MULT(N)="<"_X_$S(X="text":" xml:space=""preserve"">",1:">")_$$ESC(ATT(X,I))_"</"_X_">" Q
.. N SUB,TXT,Y S Y="<"_X_" ",(TXT,SUB)=""
.. F S SUB=$O(ATT(X,I,SUB)) Q:SUB="" D
... I SUB="text",$L($G(ATT(X,I,SUB))) S TXT="<text xml:space=""preserve"">"_$$ESC(ATT(X,I,SUB))_"</text>" Q
... I $L($G(ATT(X,I,SUB))) S Y=Y_SUB_"="""_$$ESC(ATT(X,I,SUB))_""" "
.. S N=N+1,MULT(N)=Y_$S($L(TXT):">",1:"/>")
.. S:$L(TXT) N=N+1,MULT(N)=TXT,N=N+1,MULT(N)="</"_X_">"
. S N=N+1,MULT(N)="</"_X_"s>"
S NODE=NODE_$S(N:"",1:"/")_">" D ADD(NODE)
I N D
. S I=0 F S I=$O(MULT(I)) Q:I<1 S X=MULT(I) D ADD(X)
. S X="</"_TAG_">" D ADD(X)
Q
;
ADDE(ELMT) ; Add ELeMenT list to XML(n)
N X,NODE
S X="" F S X=$O(ELMT(X)) Q:X="" D
. S NODE="<"_X_">"_$$ESC(ELMT(X))_"</"_X_">"
. D ADD(NODE)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEDPHIST 8401 printed Apr 09, 2024@20:57:20 Page 2
EDPHIST ;SLC/MKB - Return results history as XML ; 9/1/22 9:27am
+1 ;;2.0;EMERGENCY DEPARTMENT;**20**;May 2, 2012;Build 7
+2 ;External reference ^ORX8 supported by DBIA 871
+3 ;
LAB(XML,PARAM) ; -- Return results history for lab orders
+1 KILL XML
DO ADD("<results>")
+2 ;
+3 ; validate input parameters
+4 NEW DFN,LOG,IN,MAX
+5 SET DFN=+$$VAL("patient")
IF DFN<1
DO ERR(1)
GOTO LQ
+6 SET LOG=+$ORDER(^EDP(230,"APA",DFN,0))
SET IN=$PIECE($GET(^EDP(230,LOG,0)),U,8)
+7 SET MAX=$$VAL("total")
+8 ;
+9 KILL ^TMP("LRRR",$JOB)
DO RR^LR7OR1(DFN)
+10 ;
+11 ; get results for tests in each order
+12 NEW EDPI,ORIFN,NAME,STS,START,EDPY,EDPTST,ORPK,SUB,IDT,SEQ,EDPX,X,ORUPCHUK
+13 SET EDPI=0
FOR
SET EDPI=$ORDER(PARAM("order",EDPI))
if EDPI<1
QUIT
Begin DoDot:1
+14 SET ORIFN=+$GET(PARAM("order",EDPI))
if ORIFN<1
QUIT
+15 ;get order text if null?
SET NAME=$PIECE($$OI^ORX8(ORIFN),U,2)
+16 SET STS=$$GET1^DIQ(100,ORIFN_",",5,"I")
+17 DO EN^ORX8(ORIFN)
+18 SET START=ORUPCHUK("ORSTRT")
+19 IF 'START
SET START=ORUPCHUK("ORODT")
+20 SET EDPY="<order id="""_ORIFN_""" name="""_$$ESC(NAME)_""" ack="""_$$ACK(ORIFN)_""" statusId="""_STS_""" statusName="""_$$STATUS(STS,"L",ORIFN)_""" collectedTS="""_START_""">"
+21 DO ADD(EDPY)
KILL EDPY,EDPTST
+22 ; add order results from visit
+23 ;no results
SET ORPK=$$PKGID^ORX8(ORIFN)
IF $LENGTH(ORPK,";")'>3
GOTO L1
+24 SET SUB=$PIECE(ORPK,";",4)
SET IDT=$PIECE(ORPK,";",5)
+25 DO ADD("<visit>")
+26 SET SEQ=0
FOR
SET SEQ=$ORDER(^TMP("LRRR",$JOB,DFN,SUB,IDT,SEQ))
if SEQ<1
QUIT
Begin DoDot:2
+27 KILL EDPX
SET EDPX("id")=SUB_";"_IDT_";"_SEQ
+28 ;parse into EDPX("att")=value
DO TMP^EDPLAB(.EDPX,DFN,SUB,IDT,SEQ)
+29 DO ADDA("item",.EDPX)
+30 SET X=$GET(EDPX("testID"))
if X
SET EDPTST(X)=""
End DoDot:2
+31 DO ADD("</visit>")
+32 ;
+33 ; add prior results of all included tests [up to MAX# collections]
+34 NEW CNT,DONE,MORE
+35 DO ADD("<history>")
SET (CNT,DONE)=0
+36 FOR
SET IDT=$ORDER(^TMP("LRRR",$JOB,DFN,SUB,IDT))
if IDT<1
QUIT
Begin DoDot:2
+37 SET SEQ=0
SET MORE=0
+38 FOR
SET SEQ=$ORDER(^TMP("LRRR",$JOB,DFN,SUB,IDT,SEQ))
if SEQ<1
QUIT
SET X=$GET(^(SEQ))
Begin DoDot:3
+39 ;not a matching test
if '$DATA(EDPTST(+X))
QUIT
+40 KILL EDPX
SET EDPX("id")="CH;"_IDT_";"_SEQ
SET MORE=1
+41 ;parse into EDPX("att")=value
DO TMP^EDPLAB(.EDPX,DFN,"CH",IDT,SEQ)
+42 DO ADDA("item",.EDPX)
End DoDot:3
+43 if MORE
SET CNT=CNT+1
IF $GET(MAX)
IF CNT'<MAX
SET DONE=1
End DoDot:2
if DONE
QUIT
+44 DO ADD("</history>")
L1 DO ADD("</order>")
End DoDot:1
+1 ;
LQ ; end
+1 DO ADD("</results>")
+2 QUIT
+3 ;
ACK(ORDER,RETDATE) ; -- Return [first] user that ack'd order
+1 ; INPUT
+2 ; ORDER - Order IEN
+3 ; RETDATE - (optional) 1 if ack date is to be returned, otherwise do not return ack date
+4 NEW IFN,X,Y,Y1
SET Y="false"
SET Y1=""
+5 SET RETDATE=$GET(RETDATE,"")
+6 SET IFN=0
FOR
SET IFN=+$ORDER(^ORA(102.4,"B",+$GET(ORDER),IFN))
if IFN<1
QUIT
Begin DoDot:1
+7 SET X=$GET(^ORA(102.4,IFN,0))
+8 ;Y=initials, Y1=date/time
IF $PIECE(X,U,3)
SET X=+$PIECE(X,U,2)
SET Y=$$GET1^DIQ(200,X_",",1)
SET Y1=$PIECE(X,U,3)
End DoDot:1
if Y'="false"
QUIT
+9 IF RETDATE
QUIT Y_U_Y1
+10 QUIT Y
+11 ;
MED(XML,PARAM) ; -- Return dose & lab history for med
+1 KILL XML
DO ADD("<results>")
+2 ;
+3 ; validate input parameters
+4 NEW DFN,ORD,ORIT,ORVP,ORIDT,ORIFN,EDPLST,EDPX
+5 SET DFN=+$$VAL("patient")
IF DFN<1
DO ERR(1)
GOTO MQ
+6 SET ORD=+$$VAL("order")
IF ORD<1
DO ERR(4)
GOTO MQ
+7 SET ORIT=+$$OI^ORX8(ORD)
IF ORIT<1
DO ERR(5)
GOTO MQ
+8 SET ORVP=DFN_";DPT("
+9 ;
+10 ; search Pharmacy for history of medication
+11 SET ORIDT=0
FOR
SET ORIDT=$ORDER(^OR(100,"AOI",ORIT,ORVP,ORIDT))
if ORIDT<1
QUIT
Begin DoDot:1
+12 SET ORIFN=0
FOR
SET ORIFN=$ORDER(^OR(100,"AOI",ORIT,ORVP,ORIDT,ORIFN))
if ORIFN<1
QUIT
IF ORIFN'=ORD
SET EDPLST(ORIFN)=""
End DoDot:1
+13 KILL ^TMP("PS",$JOB)
IF $ORDER(EDPLST(0))
Begin DoDot:1
+14 DO ADD("<meds>")
+15 SET ORIFN=0
FOR
SET ORIFN=$ORDER(EDPLST(ORIFN))
if ORIFN<1
QUIT
Begin DoDot:2
+16 KILL EDPX
DO OEL^EDPMED(.EDPX,DFN,ORIFN,ORIDT)
+17 DO ADDA("med",.EDPX)
End DoDot:2
+18 DO ADD("</meds>")
KILL ^TMP("PS",$JOB)
End DoDot:1
+19 ;
+20 ; search Lab for result history of TEST
+21 NEW DRUG,TEST
KILL ^TMP("LRRR",$JOB)
+22 SET DRUG=+$$VALUE^ORCSAVE2(ORIFN,"DRUG")
+23 SET TEST=$$GET1^DIQ(50,DRUG_",",17.2,"I")
IF TEST<1
GOTO MQ
+24 DO RR^LR7OR1(DFN,,,,,TEST)
IF $DATA(^TMP("LRRR",$JOB))
Begin DoDot:1
+25 NEW SUB,IDT,SEQ
+26 DO ADD("<labs>")
+27 SET SUB=$ORDER(^TMP("LRRR",$JOB,DFN,""))
if SUB=""
QUIT
+28 SET IDT=0
FOR
SET IDT=$ORDER(^TMP("LRRR",$JOB,DFN,SUB,IDT))
if IDT<1
QUIT
Begin DoDot:2
+29 SET SEQ=0
FOR
SET SEQ=$ORDER(^TMP("LRRR",$JOB,DFN,SUB,IDT,SEQ))
if SEQ<1
QUIT
Begin DoDot:3
+30 ;S EDPX("id")=SUB_";"_IDT_";"_SEQ ??
KILL EDPX
+31 ;parse into EDPX("att")=value
DO TMP^EDPLAB(.EDPX,DFN,SUB,IDT,SEQ)
+32 DO ADDA("lab",.EDPX)
End DoDot:3
End DoDot:2
+33 DO ADD("</labs>")
KILL ^TMP("LRRR",$JOB)
End DoDot:1
+34 ;
+35 ; search for Clinical Events on ORIT/TEST
+36 IF $DATA(^EDP(234,"AL",DFN,ORIT,TEST))
Begin DoDot:1
+37 DO ADD("<events>")
+38 NEW EDPDT,DA,X0,X1,X2,EDPV
SET EDPDT=0
+39 FOR
SET EDPDT=$ORDER(^EDP(234,"AL",DFN,ORIT,TEST,EDPDT))
if EDPDT<1
QUIT
SET DA=+$ORDER(^(EDPDT,0))
Begin DoDot:2
+40 SET X0=$GET(^EDP(234,DA,0))
SET X1=$GET(^(1))
SET X2=$GET(^(2))
KILL EDPV
+41 SET EDPV("eventTS")=+X0
SET EDPV("title")=X1
SET EDPV("text")=X2
+42 SET X=+$PIECE(X0,U,3)
SET EDPV("userID")=X
SET EDPV("id")=DA
+43 SET EDPV("userName")=$PIECE($GET(^VA(200,X,0)),U)
+44 DO ADDA("event",.EDPV)
End DoDot:2
+45 DO ADD("</events>")
End DoDot:1
+46 ;
MQ ;end
+1 DO ADD("</results>")
+2 QUIT
+3 ;
VAL(X) QUIT $GET(PARAM(X,1))
+1 ;
STATUS(STS,TYPE,ORDER) ; -- Return result status for ORDER status
+1 NEW Y,X
+2 SET Y=""
+3 SET STS=+$GET(STS)
SET TYPE=$EXTRACT($$UP^XLFSTR($GET(TYPE)))
SET ORDER=+$GET(ORDER)
+4 ;look for reason
IF STS=1
SET Y="Order discontinued"
if ORDER
Begin DoDot:1
+5 SET X=$$GET1^DIQ(100,ORDER_",",65)
if '$LENGTH(X)
SET X=$$GET1^DIQ(100,ORDER_",",64)
+6 IF $LENGTH(X)
SET Y=Y_" ("_X_")"
End DoDot:1
+7 IF STS=2
SET Y=$SELECT(TYPE="R":"Report",1:"Results")_$SELECT($$ACKD(ORDER):" acknowledged",1:" available")
+8 IF STS=3
SET Y="On hold"
+9 IF STS=5
SET Y="Order pending"
+10 IF STS=6
SET Y=$SELECT(TYPE="L":"Specimen in lab",TYPE="R":"In Process",1:"Active")
+11 IF STS=7
SET Y="Order expired"
+12 IF STS=8
SET Y=$SELECT(TYPE="R":"Exam scheduled",1:"Scheduled")
+13 IF STS=9
SET Y="Partial results available"
+14 IF STS=10!(STS=11)
SET Y="Order not released"
+15 IF STS=12
SET Y="Order discontinued (changed)"
+16 IF STS=13
SET Y="Order cancelled"
+17 IF STS=14
SET Y="Order discontinued (lapsed)"
+18 IF STS=15
SET Y="Order renewed"
+19 QUIT Y
+20 ;
ACKD(ORDER) ; -- Returns 1 or 0, if ORDER has been acknowledged
+1 NEW Y,X,IFN
SET Y=0
+2 SET IFN=0
FOR
SET IFN=$ORDER(^ORA(102.4,"B",+$GET(ORDER),IFN))
if IFN<1
QUIT
Begin DoDot:1
+3 SET X=$GET(^ORA(102.4,IFN,0))
IF $PIECE(X,U,3)
SET Y=1
QUIT
End DoDot:1
if Y
QUIT
+4 QUIT Y
+5 ;
RANGE(VAL,BEG,END,MAX) ; -- Return BEG,END,MAX
+1 SET BEG=$GET(VAL("start",1))
SET END=$GET(VAL("stop",1))
SET MAX=$GET(VAL("total",1))
+2 if BEG
SET BEG=$$HL7TFM^XLFDT(BEG)
+3 if END
SET END=$$HL7TFM^XLFDT(END)
+4 ;switch
IF BEG
IF END
IF END<BEG
NEW X
SET X=BEG
SET BEG=END
SET END=X
+5 IF END
IF $LENGTH(END,".")<2
SET END=END_".24"
+6 QUIT
+7 ;
ERR(X) ; -- return error message
+1 NEW MSG
+2 IF X=1
SET MSG="Missing or invalid patient identifier"
+3 IF X=2
SET MSG="Missing or invalid data type"
+4 IF X=3
SET MSG="Missing or invalid observation identifier"
+5 IF X=4
SET MSG="Missing or invalid order number"
+6 IF X=5
SET MSG="Missing or invalid orderable item"
+7 ; X=? S MSG="others"
+8 IF X=99
SET MSG="Unknown request"
+9 DO XML^EDPX("<error msg='"_MSG_"' />")
+10 QUIT
+11 ;
UES(X) ; -- unescape incoming XML
+1 ; bwf: 12/19/2011 commented following line due to SAC. Need to figure out why this is here.
+2 ;Q $ZCONVERT(X,"I","HTML")
+3 ;
ESC(X) ; -- escape outgoing XML
+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 ;
ADD(X) ; Add a line to XML(n)
+1 SET XML=$GET(XML)+1
+2 SET XML(XML)=X
+3 QUIT
+4 ;
ADDA(TAG,ATT) ; Add ATTribute list to XML(n)
+1 ; as <TAG att1="a" att2="b"... />
+2 NEW NODE,X,MULT,N,I
+3 SET NODE="<"_TAG_" "
SET N=0
+4 SET X=""
FOR
SET X=$ORDER(ATT(X))
if X=""
QUIT
Begin DoDot:1
+5 IF X="text"
IF $LENGTH($GET(ATT(X)))
SET N=N+1
SET MULT(N)="<"_X_" xml:space=""preserve"">"_$$ESC(ATT(X))_"</"_X_">"
QUIT
+6 IF $LENGTH($GET(ATT(X)))
SET NODE=NODE_X_"="""_$$ESC(ATT(X))_""" "
QUIT
+7 SET N=N+1
SET MULT(N)="<"_X_"s>"
+8 SET I=0
FOR
SET I=$ORDER(ATT(X,I))
if I<1
QUIT
Begin DoDot:2
+9 IF $LENGTH($GET(ATT(X,I)))
SET N=N+1
SET MULT(N)="<"_X_$SELECT(X="text":" xml:space=""preserve"">",1:">")_$$ESC(ATT(X,I))_"</"_X_">"
QUIT
+10 NEW SUB,TXT,Y
SET Y="<"_X_" "
SET (TXT,SUB)=""
+11 FOR
SET SUB=$ORDER(ATT(X,I,SUB))
if SUB=""
QUIT
Begin DoDot:3
+12 IF SUB="text"
IF $LENGTH($GET(ATT(X,I,SUB)))
SET TXT="<text xml:space=""preserve"">"_$$ESC(ATT(X,I,SUB))_"</text>"
QUIT
+13 IF $LENGTH($GET(ATT(X,I,SUB)))
SET Y=Y_SUB_"="""_$$ESC(ATT(X,I,SUB))_""" "
End DoDot:3
+14 SET N=N+1
SET MULT(N)=Y_$SELECT($LENGTH(TXT):">",1:"/>")
+15 if $LENGTH(TXT)
SET N=N+1
SET MULT(N)=TXT
SET N=N+1
SET MULT(N)="</"_X_">"
End DoDot:2
+16 SET N=N+1
SET MULT(N)="</"_X_"s>"
End DoDot:1
+17 SET NODE=NODE_$SELECT(N:"",1:"/")_">"
DO ADD(NODE)
+18 IF N
Begin DoDot:1
+19 SET I=0
FOR
SET I=$ORDER(MULT(I))
if I<1
QUIT
SET X=MULT(I)
DO ADD(X)
+20 SET X="</"_TAG_">"
DO ADD(X)
End DoDot:1
+21 QUIT
+22 ;
ADDE(ELMT) ; Add ELeMenT list to XML(n)
+1 NEW X,NODE
+2 SET X=""
FOR
SET X=$ORDER(ELMT(X))
if X=""
QUIT
Begin DoDot:1
+3 SET NODE="<"_X_">"_$$ESC(ELMT(X))_"</"_X_">"
+4 DO ADD(NODE)
End DoDot:1
+5 QUIT
