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

EDPHIST.m

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