EDPDTL ;SLC/MKB - Return various details for ED LOG ;2/28/12 08:33am
;;2.0;EMERGENCY DEPARTMENT;;May 2, 2012;Build 103
;
EN(LOG,TYPE) ; -- Return details for item in EDPXML(n)
D XML^EDPX("<details>")
S LOG=+$G(LOG) I 'LOG D ERR(2300007) G ENQ
I '$D(^EDP(230,LOG)) D ERR(2300006) G ENQ
S TYPE=$$UP^XLFSTR($G(TYPE)) S:$E(TYPE)="@" TYPE=$E(TYPE,2,99)
; switch on TYPE
I TYPE="PTNM" D DFN G ENQ
I TYPE="LAST4" D DFN G ENQ
I TYPE="BEDNM" D LOC G ENQ
I TYPE="COMPLAINT" D COMP G ENQ
I TYPE="LAB" D ORD("L") G ENQ
I TYPE="RAD" D ORD("R") G ENQ
I TYPE="ORDNEW" D ORD G ENQ
I TYPE="MDNM" D USR(5) G ENQ
I TYPE="RNNM" D USR(6) G ENQ
I TYPE="RESNM" D USR(7) G ENQ
I TYPE="ALLERGY" D ALLG G ENQ
I TYPE="PLIST" D PROB G ENQ
I TYPE="MEDS" D MEDS G ENQ
I TYPE="VITALS" D VIT G ENQ
; else
D ERR(2300011)
ENQ ; end
D XML^EDPX("</details>")
Q
;
ERR(MSG) ; -- return error MSG
N X S X=$$MSG^EDPX(MSG)
D XML^EDPX("<error msg='"_X_"' />")
Q
;
BOOL(X) ; -- Return external form of boolean value X
Q $S(+$G(X):"true",1:"false")
;
DFN ; -- Return patient information in EDPXML(n)
N DFN,VA,VADM,VAEL,VAPA,VAPD,VAOA,VAERR,EDPX,X
S DFN=+$P($G(^EDP(230,LOG,0)),U,6) Q:DFN<1
D 6^VADPT,OPD^VADPT,OAD^VADPT
;DEM
S EDPX("name")=VADM(1) ;LNAME,FNAME
S EDPX("ssn")=$P(VADM(2),U,2) ;000-00-0000
S EDPX("dob")=+VADM(3) ;YYYMMDD
S EDPX("age")=VADM(4) ;00
S EDPX("sex")=$P(VADM(5),U) ;M
; EDPX("bid")=VA("BID") ;0000
S EDPX("maritalSts")=$P(VADM(10),U,2) ;MARRIED
S:VADM(6) EDPX("died")=+VADM(6) ;YYYMMDD
; ELIG
S EDPX("veteran")=$$BOOL(+VAEL(4)) ;true
S EDPX("sc")=$$BOOL(+VAEL(3)) ;true
S:VAEL(3) EDPX("scPct")=$P(VAEL(3),U,2) ;50
; ADD
S EDPX("address1")=VAPA(1) ;123 Main St
S:$L($G(VAPA(2))) EDPX("address2")=VAPA(2) ;Apt A
S:$L($G(VAPA(3))) EDPX("address3")=VAPA(3) ;P.O.Box 999
S EDPX("city")=VAPA(4) ;LOGAN
S EDPX("state")=$P(VAPA(5),U,2) ;UTAH
S EDPX("zip")=VAPA(6),X=VAPA(8) ;12345-6789
S EDPX("phone")=$$FORMAT^EDPUPD(X) ;(555)555-5555
S X=$$GET1^DIQ(2,DFN_",",.134)
S EDPX("cell")=$$FORMAT^EDPUPD(X) ;(555)666-6666
; OPD
S EDPX("employmentSts")=$P(VAPD(7),U,2) ;SELF EMPLOYED
S EDPX("employmentName")=VAPD(6) ;CARPENTER
; OAD
S EDPX("nok")=VAOA(9) ;LNAME,FNAME
S EDPX("nokPhone")=VAOA(8) ;(555)555-5555
;
; Advance Directive?
N MSG K ^TMP("TIUPPCV",$J)
D ENCOVER^TIUPP3(DFN) I +MSG=0 D
. N I S I=0 F S I=$O(^TMP("TIUPPCV",$J,I)) Q:I<1 I $P($G(^(I)),U,2)="D" S EDPX("advDirective")="Yes" Q
. K ^TMP("TIUPPCV",$J)
; Tobacco health factors?
N HF,X S HF=0
F S HF=$O(^AUPNVHF("AA",DFN,HF)) Q:HF<1 D Q:$D(EDPX("tobaccoUse"))
. S X=$$GET1^DIQ(9999999.64,HF_",",.01)
. I X["TOBACCO" S EDPX("tobaccoUse")=X
; done
D XMLE^EDPX(.EDPX)
Q
;
LOC ; -- Return location information
N LOC,NODE,EDPX
S LOC=+$P($G(^EDP(230,LOG,3)),U,4) Q:LOC<1
S NODE=$G(^EDPB(231.8,LOC,0))
; parse values
S EDPX("name")=$P(NODE,U)
S EDPX("stnNum")=$P(NODE,U,2)
S EDPX("area")=$P($G(^EDPB(231.9,+$P(NODE,U,3),0)),U)
S EDPX("inactive")=$$BOOL($P(NODE,U,4))
S EDPX("sequence")=$P(NODE,U,5)
S EDPX("displayName")=$P(NODE,U,6)
S X=$P(NODE,U,7)
S EDPX("displayWhen")=$S(X=0:"OCCUPIED",X=1:"ALWAYS",X=2:"NEVER",1:"")
S EDPX("defaultSts")=$P($G(^EDPB(233.1,+$P(NODE,U,8),0)),U,2)
S X=$P(NODE,U,9)
S EDPX("multipleAssign")=$S(X=0:"SINGLE",X=1:"MULTIPLE",X=2:"WAITING",X=3:"SINGLE NON-ED",X=4:"MULTIPLE NON-ED",1:"")
S:$L($P(NODE,U,10)) EDPX("sharedName")=$P(NODE,U,10)
S:$L($P(NODE,U,11)) EDPX("board")=$P(NODE,U,11)
S:$L($P(NODE,U,12)) EDPX("color")=$P(NODE,U,12)
; done
D XMLE^EDPX(.EDPX)
Q
;
COMP ; -- Return long complaint
N X,EDPX
S X=$G(^EDP(230,LOG,2))
I $L(X) S EDPX("longComplaint")=X D XMLE^EDPX(.EDPX)
Q
;
USR(P) ; -- Return contact info for provider/resident/rn
N NP,NODE,EDPX
S NP=+$P($G(^EDP(230,LOG,3)),U,P) Q:NP<1
; name/title
S NODE=$G(^VA(200,NP,0))
S EDPX("name")=$P(NODE,U)
S:$P(NODE,U,9) EDPX("title")=$$GET1^DIQ(3.1,+$P(NODE,U,9)_",",.01)
; phone numbers
S NODE=$G(^VA(200,NP,.13))
S:$L($P(NODE,U,1)) EDPX("homePhone")=$P(NODE,U)
S:$L($P(NODE,U,2)) EDPX("officePhone")=$P(NODE,U,2)
S:$L($P(NODE,U,3)) EDPX("phone3")=$P(NODE,U,3)
S:$L($P(NODE,U,4)) EDPX("phone4")=$P(NODE,U,4)
S:$L($P(NODE,U,5)) EDPX("commercialPhone")=$P(NODE,U,5)
S:$L($P(NODE,U,6)) EDPX("fax")=$P(NODE,U,6)
S:$L($P(NODE,U,7)) EDPX("voicePager")=$P(NODE,U,7)
S:$L($P(NODE,U,8)) EDPX("digitalPager")=$P(NODE,U,8)
; done
D XMLE^EDPX(.EDPX)
Q
;
ORD(TYPE) ; -- Return status info for orders
N I,ORIFN,EDPX,X,OI,STS,X0
S TYPE=$G(TYPE,"MLRCA"),I=0 ;get all, if not specified?
F S I=$O(^EDP(230,LOG,8,I)) Q:I<1 S X0=$G(^(I,0)) I TYPE[$P(X0,U,2) D
. K EDPX,EDPTXT
. S ORIFN=+X0,EDPX("orderId")=ORIFN
. S STS=$$GET1^DIQ(100,ORIFN_",",5,"I"),EDPX("statusId")=STS
. S EDPX("statusName")=$$STATUS^EDPHIST(STS,TYPE,ORIFN)
. ; EDPX("start")=$$GET1^DIQ(100,ORIFN_",",21,"I")
. ; ORIGVIEW=2 D TEXT^ORQ12(.EDPTXT,ORIFN)
. S EDPX("abbre")=$$ITEM(ORIFN,$P(X0,U,2)) ;$G(EDPTXT(1))
. S EDPX("name")=$P($$OI^ORX8(ORIFN),U,2)
. I $P(X0,U,2)="L",$P(X0,U,3)="C" D Q ;Lab results
.. N DFN,LABID,SUB,IDT,I,EDPL K ^TMP("LRRR",$J)
.. S DFN=+$P($G(^EDP(230,LOG,0)),U,6) Q:DFN<1
.. S LABID=$$GET1^DIQ(100,ORIFN_",",33) Q:'$L(LABID)
.. S SUB=$P(LABID,";",4),IDT=$P(LABID,";",5)
.. S X=$$XMLA^EDPX("lab",.EDPX,"") D XML^EDPX(X)
.. D RR^LR7OR1(DFN,LABID)
.. S I=0 F S I=$O(^TMP("LRRR",$J,DFN,SUB,IDT,I)) Q:I<1 S X=$G(^(I)) D
... K EDPL S EDPL("value")=$P(X,U,2),EDPL("units")=$P(X,U,4)
... S EDPL("range")=$P(X,U,5) S:$L($P(X,U,3)) EDPL("deviation")=$P(X,U,3)
... S X=+X,EDPL("test")=$$GET1^DIQ(60,X_",",51)
... S X=$$XMLA^EDPX("result",.EDPL) D XML^EDPX(X)
.. D XML^EDPX("</lab>")
. I $P(X0,U,2)="R",$P(X0,U,3)="C" D Q ;Radiology report
.. S X=$$XMLA^EDPX("rad",.EDPX,"") D XML^EDPX(X)
.. N EDPR S EDPR("report")=$$RADRPT(ORIFN)
.. D XMLE^EDPX(.EDPR)
.. D XML^EDPX("</rad>")
. S X=$$XMLA^EDPX("order",.EDPX) D XML^EDPX(X) ;all other orders
Q
;
ITEM(ORDER,PKG) ; -- Return [short] name of ORDER's orderable item
N OI,I,X,Y
S OI=$$OI^ORX8(ORDER),Y=$P(OI,U,2)
I PKG="L" D ;Print Name
. S X=$$GET1^DIQ(60,+$P(OI,U,3)_",",51) S:$L(X) Y=X
I PKG="R" D ;[first] synonym
. S I=+$O(^ORD(101.43,+OI,2,0)),X=$G(^(I,0))
. S:$L(X) Y=X
Q Y
;
RADRPT(ORIFN) ; -- Return Radiology report as text string
N ID,DFN,PSET,CASE,PROC,N,TEXT,Y,I
S ID=+$$PKGID^ORX8(+ORIFN) D EN30^RAO7PC3(ID)
S DFN=+$P($G(^EDP(230,LOG,0)),U,6)
S PSET=$D(^TMP($J,"RAE3",DFN,"PRINT_SET")),N=0
S CASE=0 F S CASE=$O(^TMP($J,"RAE3",DFN,CASE)) Q:CASE'>0 D
. I PSET S PROC=$O(^TMP($J,"RAE3",DFN,CASE,"")) S N=N+1,TEXT(N)=PROC Q
. S PROC="" F S PROC=$O(^TMP($J,"RAE3",DFN,CASE,PROC)) Q:PROC="" D
.. S:N N=N+1,TEXT(N)=" "
.. S N=N+1,TEXT(N)=PROC
.. S N=N+1,TEXT(N)=" " D XRPT
I PSET D ;printset = list all procs, then one report
. S CASE=$O(^TMP($J,"RAE3",DFN,0)),PROC=$O(^(CASE,""))
. S N=N+1,TEXT(N)=" " D XRPT
K ^TMP($J,"RAE3",DFN)
; return in single string Y
S Y=$G(TEXT(1)),N=1
F S N=$O(TEXT(N)) Q:N<1 S Y=Y_$C(13,10)_TEXT(N)
Q Y
;
XRPT ; -- Body of Report for CASE, PROC
N ORD,X,I
S ORD=$S($L($G(^TMP($J,"RAE3",DFN,"ORD"))):^("ORD"),$L($G(^("ORD",CASE))):^(CASE),1:"")
I $L(ORD),ORD'=PROC S N=N+1,TEXT(N)="Proc Ord: "_ORD
S I=1 F S I=$O(^TMP($J,"RAE3",DFN,CASE,PROC,I)) Q:I'>0 S X=^(I),N=N+1,TEXT(N)=X ;Skip pt ID on line 1
Q
;
ALLG ; -- Return list of allergies
N DFN,GMRAL,I,EDPX
S DFN=+$P($G(^EDP(230,LOG,0)),U,6) Q:DFN<1
D EN1^GMRADPT Q:'GMRAL
S I=0 F S I=$O(GMRAL(I)) Q:I<1 D
. S EDPX("name")=$P(GMRAL(I),U,2)
. D XMLE^EDPX(.EDPX)
Q
;
PROB ; -- Return active problems
N DFN,IEN,EDPX
S DFN=+$P($G(^EDP(230,LOG,0)),U,6) Q:DFN<1
S IEN=0 F S IEN=$O(^AUPNPROB("ACTIVE",DFN,"A",IEN)) Q:IEN<1 D
. S EDPX("name")=$$GET1^DIQ(9000011,IEN_",",.05,"E")
. S EDPX("icd")=$$GET1^DIQ(9000011,IEN_",",.01,"E")
. D XML^EDPX($$XMLA^EDPX("problem",.EDPX))
Q
;
MEDS ; -- Return active Rx's
N DFN,I,RX,EDPX
S DFN=+$P($G(^EDP(230,LOG,0)),U,6) Q:DFN<1
D OCL^PSOORRL(DFN,1,9999999)
S I=0 F S I=$O(^TMP("PS",$J,I)) Q:I<1 M RX=^(I) D
. Q:'$$ACTIVE($P(RX(0),U,9)) ;want only what pt is taking
. S EDPX("name")=$P(RX(0),U,2)
. S EDPX("sig")=$G(RX("SIG",1,0))
. S EDPX("status")=$P(RX(0),U,9)
. D XML^EDPX($$XMLA^EDPX("med",.EDPX))
Q
;
ACTIVE(X) ; -- return 1 or 0, if X is an active status
N Y S Y=1
I X="PURGE" S Y=0
I X="DELETED" S Y=0
I X="EXPIRED" S Y=0 ;keep for a time, to renew?
I $P(X," ")="DISCONTINUED" S Y=0
Q Y
;
VIT ; -- Return vitals taken during current ED visit
N DFN,IN,GMRVSTR,IDT,TYPE,IEN,REC,EDPX,X
S DFN=+$P($G(^EDP(230,LOG,0)),U,6),IN=$P($G(^(0)),U,8) Q:DFN<1
S GMRVSTR="BP;T;R;P;HT;WT;PN",GMRVSTR(0)=IN_"^9999999^9999999^1"
K ^UTILITY($J,"GMRVD") D EN1^GMRVUT0
S IDT="A" F S IDT=$O(^UTILITY($J,"GMRVD",IDT),-1) Q:IDT<1 D
. K EDPX S X=9999999-IDT,EDPX("time")=$$FMTE^XLFDT(X,"1P")
. S TYPE="" F S TYPE=$O(^UTILITY($J,"GMRVD",IDT,TYPE)) Q:TYPE="" D
.. S IEN=$O(^UTILITY($J,"GMRVD",IDT,TYPE,0)),REC=$G(^(IEN))
.. S EDPX(TYPE)=$P(REC,U,8)
. S EDPX("error")="false" ;for now
. D XML^EDPX($$XMLA^EDPX("vital",.EDPX))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEDPDTL 9664 printed Sep 23, 2025@19:27:52 Page 2
EDPDTL ;SLC/MKB - Return various details for ED LOG ;2/28/12 08:33am
+1 ;;2.0;EMERGENCY DEPARTMENT;;May 2, 2012;Build 103
+2 ;
EN(LOG,TYPE) ; -- Return details for item in EDPXML(n)
+1 DO XML^EDPX("<details>")
+2 SET LOG=+$GET(LOG)
IF 'LOG
DO ERR(2300007)
GOTO ENQ
+3 IF '$DATA(^EDP(230,LOG))
DO ERR(2300006)
GOTO ENQ
+4 SET TYPE=$$UP^XLFSTR($GET(TYPE))
if $EXTRACT(TYPE)="@"
SET TYPE=$EXTRACT(TYPE,2,99)
+5 ; switch on TYPE
+6 IF TYPE="PTNM"
DO DFN
GOTO ENQ
+7 IF TYPE="LAST4"
DO DFN
GOTO ENQ
+8 IF TYPE="BEDNM"
DO LOC
GOTO ENQ
+9 IF TYPE="COMPLAINT"
DO COMP
GOTO ENQ
+10 IF TYPE="LAB"
DO ORD("L")
GOTO ENQ
+11 IF TYPE="RAD"
DO ORD("R")
GOTO ENQ
+12 IF TYPE="ORDNEW"
DO ORD
GOTO ENQ
+13 IF TYPE="MDNM"
DO USR(5)
GOTO ENQ
+14 IF TYPE="RNNM"
DO USR(6)
GOTO ENQ
+15 IF TYPE="RESNM"
DO USR(7)
GOTO ENQ
+16 IF TYPE="ALLERGY"
DO ALLG
GOTO ENQ
+17 IF TYPE="PLIST"
DO PROB
GOTO ENQ
+18 IF TYPE="MEDS"
DO MEDS
GOTO ENQ
+19 IF TYPE="VITALS"
DO VIT
GOTO ENQ
+20 ; else
+21 DO ERR(2300011)
ENQ ; end
+1 DO XML^EDPX("</details>")
+2 QUIT
+3 ;
ERR(MSG) ; -- return error MSG
+1 NEW X
SET X=$$MSG^EDPX(MSG)
+2 DO XML^EDPX("<error msg='"_X_"' />")
+3 QUIT
+4 ;
BOOL(X) ; -- Return external form of boolean value X
+1 QUIT $SELECT(+$GET(X):"true",1:"false")
+2 ;
DFN ; -- Return patient information in EDPXML(n)
+1 NEW DFN,VA,VADM,VAEL,VAPA,VAPD,VAOA,VAERR,EDPX,X
+2 SET DFN=+$PIECE($GET(^EDP(230,LOG,0)),U,6)
if DFN<1
QUIT
+3 DO 6^VADPT
DO OPD^VADPT
DO OAD^VADPT
+4 ;DEM
+5 ;LNAME,FNAME
SET EDPX("name")=VADM(1)
+6 ;000-00-0000
SET EDPX("ssn")=$PIECE(VADM(2),U,2)
+7 ;YYYMMDD
SET EDPX("dob")=+VADM(3)
+8 ;00
SET EDPX("age")=VADM(4)
+9 ;M
SET EDPX("sex")=$PIECE(VADM(5),U)
+10 ; EDPX("bid")=VA("BID") ;0000
+11 ;MARRIED
SET EDPX("maritalSts")=$PIECE(VADM(10),U,2)
+12 ;YYYMMDD
if VADM(6)
SET EDPX("died")=+VADM(6)
+13 ; ELIG
+14 ;true
SET EDPX("veteran")=$$BOOL(+VAEL(4))
+15 ;true
SET EDPX("sc")=$$BOOL(+VAEL(3))
+16 ;50
if VAEL(3)
SET EDPX("scPct")=$PIECE(VAEL(3),U,2)
+17 ; ADD
+18 ;123 Main St
SET EDPX("address1")=VAPA(1)
+19 ;Apt A
if $LENGTH($GET(VAPA(2)))
SET EDPX("address2")=VAPA(2)
+20 ;P.O.Box 999
if $LENGTH($GET(VAPA(3)))
SET EDPX("address3")=VAPA(3)
+21 ;LOGAN
SET EDPX("city")=VAPA(4)
+22 ;UTAH
SET EDPX("state")=$PIECE(VAPA(5),U,2)
+23 ;12345-6789
SET EDPX("zip")=VAPA(6)
SET X=VAPA(8)
+24 ;(555)555-5555
SET EDPX("phone")=$$FORMAT^EDPUPD(X)
+25 SET X=$$GET1^DIQ(2,DFN_",",.134)
+26 ;(555)666-6666
SET EDPX("cell")=$$FORMAT^EDPUPD(X)
+27 ; OPD
+28 ;SELF EMPLOYED
SET EDPX("employmentSts")=$PIECE(VAPD(7),U,2)
+29 ;CARPENTER
SET EDPX("employmentName")=VAPD(6)
+30 ; OAD
+31 ;LNAME,FNAME
SET EDPX("nok")=VAOA(9)
+32 ;(555)555-5555
SET EDPX("nokPhone")=VAOA(8)
+33 ;
+34 ; Advance Directive?
+35 NEW MSG
KILL ^TMP("TIUPPCV",$JOB)
+36 DO ENCOVER^TIUPP3(DFN)
IF +MSG=0
Begin DoDot:1
+37 NEW I
SET I=0
FOR
SET I=$ORDER(^TMP("TIUPPCV",$JOB,I))
if I<1
QUIT
IF $PIECE($GET(^(I)),U,2)="D"
SET EDPX("advDirective")="Yes"
QUIT
+38 KILL ^TMP("TIUPPCV",$JOB)
End DoDot:1
+39 ; Tobacco health factors?
+40 NEW HF,X
SET HF=0
+41 FOR
SET HF=$ORDER(^AUPNVHF("AA",DFN,HF))
if HF<1
QUIT
Begin DoDot:1
+42 SET X=$$GET1^DIQ(9999999.64,HF_",",.01)
+43 IF X["TOBACCO"
SET EDPX("tobaccoUse")=X
End DoDot:1
if $DATA(EDPX("tobaccoUse"))
QUIT
+44 ; done
+45 DO XMLE^EDPX(.EDPX)
+46 QUIT
+47 ;
LOC ; -- Return location information
+1 NEW LOC,NODE,EDPX
+2 SET LOC=+$PIECE($GET(^EDP(230,LOG,3)),U,4)
if LOC<1
QUIT
+3 SET NODE=$GET(^EDPB(231.8,LOC,0))
+4 ; parse values
+5 SET EDPX("name")=$PIECE(NODE,U)
+6 SET EDPX("stnNum")=$PIECE(NODE,U,2)
+7 SET EDPX("area")=$PIECE($GET(^EDPB(231.9,+$PIECE(NODE,U,3),0)),U)
+8 SET EDPX("inactive")=$$BOOL($PIECE(NODE,U,4))
+9 SET EDPX("sequence")=$PIECE(NODE,U,5)
+10 SET EDPX("displayName")=$PIECE(NODE,U,6)
+11 SET X=$PIECE(NODE,U,7)
+12 SET EDPX("displayWhen")=$SELECT(X=0:"OCCUPIED",X=1:"ALWAYS",X=2:"NEVER",1:"")
+13 SET EDPX("defaultSts")=$PIECE($GET(^EDPB(233.1,+$PIECE(NODE,U,8),0)),U,2)
+14 SET X=$PIECE(NODE,U,9)
+15 SET EDPX("multipleAssign")=$SELECT(X=0:"SINGLE",X=1:"MULTIPLE",X=2:"WAITING",X=3:"SINGLE NON-ED",X=4:"MULTIPLE NON-ED",1:"")
+16 if $LENGTH($PIECE(NODE,U,10))
SET EDPX("sharedName")=$PIECE(NODE,U,10)
+17 if $LENGTH($PIECE(NODE,U,11))
SET EDPX("board")=$PIECE(NODE,U,11)
+18 if $LENGTH($PIECE(NODE,U,12))
SET EDPX("color")=$PIECE(NODE,U,12)
+19 ; done
+20 DO XMLE^EDPX(.EDPX)
+21 QUIT
+22 ;
COMP ; -- Return long complaint
+1 NEW X,EDPX
+2 SET X=$GET(^EDP(230,LOG,2))
+3 IF $LENGTH(X)
SET EDPX("longComplaint")=X
DO XMLE^EDPX(.EDPX)
+4 QUIT
+5 ;
USR(P) ; -- Return contact info for provider/resident/rn
+1 NEW NP,NODE,EDPX
+2 SET NP=+$PIECE($GET(^EDP(230,LOG,3)),U,P)
if NP<1
QUIT
+3 ; name/title
+4 SET NODE=$GET(^VA(200,NP,0))
+5 SET EDPX("name")=$PIECE(NODE,U)
+6 if $PIECE(NODE,U,9)
SET EDPX("title")=$$GET1^DIQ(3.1,+$PIECE(NODE,U,9)_",",.01)
+7 ; phone numbers
+8 SET NODE=$GET(^VA(200,NP,.13))
+9 if $LENGTH($PIECE(NODE,U,1))
SET EDPX("homePhone")=$PIECE(NODE,U)
+10 if $LENGTH($PIECE(NODE,U,2))
SET EDPX("officePhone")=$PIECE(NODE,U,2)
+11 if $LENGTH($PIECE(NODE,U,3))
SET EDPX("phone3")=$PIECE(NODE,U,3)
+12 if $LENGTH($PIECE(NODE,U,4))
SET EDPX("phone4")=$PIECE(NODE,U,4)
+13 if $LENGTH($PIECE(NODE,U,5))
SET EDPX("commercialPhone")=$PIECE(NODE,U,5)
+14 if $LENGTH($PIECE(NODE,U,6))
SET EDPX("fax")=$PIECE(NODE,U,6)
+15 if $LENGTH($PIECE(NODE,U,7))
SET EDPX("voicePager")=$PIECE(NODE,U,7)
+16 if $LENGTH($PIECE(NODE,U,8))
SET EDPX("digitalPager")=$PIECE(NODE,U,8)
+17 ; done
+18 DO XMLE^EDPX(.EDPX)
+19 QUIT
+20 ;
ORD(TYPE) ; -- Return status info for orders
+1 NEW I,ORIFN,EDPX,X,OI,STS,X0
+2 ;get all, if not specified?
SET TYPE=$GET(TYPE,"MLRCA")
SET I=0
+3 FOR
SET I=$ORDER(^EDP(230,LOG,8,I))
if I<1
QUIT
SET X0=$GET(^(I,0))
IF TYPE[$PIECE(X0,U,2)
Begin DoDot:1
+4 KILL EDPX,EDPTXT
+5 SET ORIFN=+X0
SET EDPX("orderId")=ORIFN
+6 SET STS=$$GET1^DIQ(100,ORIFN_",",5,"I")
SET EDPX("statusId")=STS
+7 SET EDPX("statusName")=$$STATUS^EDPHIST(STS,TYPE,ORIFN)
+8 ; EDPX("start")=$$GET1^DIQ(100,ORIFN_",",21,"I")
+9 ; ORIGVIEW=2 D TEXT^ORQ12(.EDPTXT,ORIFN)
+10 ;$G(EDPTXT(1))
SET EDPX("abbre")=$$ITEM(ORIFN,$PIECE(X0,U,2))
+11 SET EDPX("name")=$PIECE($$OI^ORX8(ORIFN),U,2)
+12 ;Lab results
IF $PIECE(X0,U,2)="L"
IF $PIECE(X0,U,3)="C"
Begin DoDot:2
+13 NEW DFN,LABID,SUB,IDT,I,EDPL
KILL ^TMP("LRRR",$JOB)
+14 SET DFN=+$PIECE($GET(^EDP(230,LOG,0)),U,6)
if DFN<1
QUIT
+15 SET LABID=$$GET1^DIQ(100,ORIFN_",",33)
if '$LENGTH(LABID)
QUIT
+16 SET SUB=$PIECE(LABID,";",4)
SET IDT=$PIECE(LABID,";",5)
+17 SET X=$$XMLA^EDPX("lab",.EDPX,"")
DO XML^EDPX(X)
+18 DO RR^LR7OR1(DFN,LABID)
+19 SET I=0
FOR
SET I=$ORDER(^TMP("LRRR",$JOB,DFN,SUB,IDT,I))
if I<1
QUIT
SET X=$GET(^(I))
Begin DoDot:3
+20 KILL EDPL
SET EDPL("value")=$PIECE(X,U,2)
SET EDPL("units")=$PIECE(X,U,4)
+21 SET EDPL("range")=$PIECE(X,U,5)
if $LENGTH($PIECE(X,U,3))
SET EDPL("deviation")=$PIECE(X,U,3)
+22 SET X=+X
SET EDPL("test")=$$GET1^DIQ(60,X_",",51)
+23 SET X=$$XMLA^EDPX("result",.EDPL)
DO XML^EDPX(X)
End DoDot:3
+24 DO XML^EDPX("</lab>")
End DoDot:2
QUIT
+25 ;Radiology report
IF $PIECE(X0,U,2)="R"
IF $PIECE(X0,U,3)="C"
Begin DoDot:2
+26 SET X=$$XMLA^EDPX("rad",.EDPX,"")
DO XML^EDPX(X)
+27 NEW EDPR
SET EDPR("report")=$$RADRPT(ORIFN)
+28 DO XMLE^EDPX(.EDPR)
+29 DO XML^EDPX("</rad>")
End DoDot:2
QUIT
+30 ;all other orders
SET X=$$XMLA^EDPX("order",.EDPX)
DO XML^EDPX(X)
End DoDot:1
+31 QUIT
+32 ;
ITEM(ORDER,PKG) ; -- Return [short] name of ORDER's orderable item
+1 NEW OI,I,X,Y
+2 SET OI=$$OI^ORX8(ORDER)
SET Y=$PIECE(OI,U,2)
+3 ;Print Name
IF PKG="L"
Begin DoDot:1
+4 SET X=$$GET1^DIQ(60,+$PIECE(OI,U,3)_",",51)
if $LENGTH(X)
SET Y=X
End DoDot:1
+5 ;[first] synonym
IF PKG="R"
Begin DoDot:1
+6 SET I=+$ORDER(^ORD(101.43,+OI,2,0))
SET X=$GET(^(I,0))
+7 if $LENGTH(X)
SET Y=X
End DoDot:1
+8 QUIT Y
+9 ;
RADRPT(ORIFN) ; -- Return Radiology report as text string
+1 NEW ID,DFN,PSET,CASE,PROC,N,TEXT,Y,I
+2 SET ID=+$$PKGID^ORX8(+ORIFN)
DO EN30^RAO7PC3(ID)
+3 SET DFN=+$PIECE($GET(^EDP(230,LOG,0)),U,6)
+4 SET PSET=$DATA(^TMP($JOB,"RAE3",DFN,"PRINT_SET"))
SET N=0
+5 SET CASE=0
FOR
SET CASE=$ORDER(^TMP($JOB,"RAE3",DFN,CASE))
if CASE'>0
QUIT
Begin DoDot:1
+6 IF PSET
SET PROC=$ORDER(^TMP($JOB,"RAE3",DFN,CASE,""))
SET N=N+1
SET TEXT(N)=PROC
QUIT
+7 SET PROC=""
FOR
SET PROC=$ORDER(^TMP($JOB,"RAE3",DFN,CASE,PROC))
if PROC=""
QUIT
Begin DoDot:2
+8 if N
SET N=N+1
SET TEXT(N)=" "
+9 SET N=N+1
SET TEXT(N)=PROC
+10 SET N=N+1
SET TEXT(N)=" "
DO XRPT
End DoDot:2
End DoDot:1
+11 ;printset = list all procs, then one report
IF PSET
Begin DoDot:1
+12 SET CASE=$ORDER(^TMP($JOB,"RAE3",DFN,0))
SET PROC=$ORDER(^(CASE,""))
+13 SET N=N+1
SET TEXT(N)=" "
DO XRPT
End DoDot:1
+14 KILL ^TMP($JOB,"RAE3",DFN)
+15 ; return in single string Y
+16 SET Y=$GET(TEXT(1))
SET N=1
+17 FOR
SET N=$ORDER(TEXT(N))
if N<1
QUIT
SET Y=Y_$CHAR(13,10)_TEXT(N)
+18 QUIT Y
+19 ;
XRPT ; -- Body of Report for CASE, PROC
+1 NEW ORD,X,I
+2 SET ORD=$SELECT($LENGTH($GET(^TMP($JOB,"RAE3",DFN,"ORD"))):^("ORD"),$LENGTH($GET(^("ORD",CASE))):^(CASE),1:"")
+3 IF $LENGTH(ORD)
IF ORD'=PROC
SET N=N+1
SET TEXT(N)="Proc Ord: "_ORD
+4 ;Skip pt ID on line 1
SET I=1
FOR
SET I=$ORDER(^TMP($JOB,"RAE3",DFN,CASE,PROC,I))
if I'>0
QUIT
SET X=^(I)
SET N=N+1
SET TEXT(N)=X
+5 QUIT
+6 ;
ALLG ; -- Return list of allergies
+1 NEW DFN,GMRAL,I,EDPX
+2 SET DFN=+$PIECE($GET(^EDP(230,LOG,0)),U,6)
if DFN<1
QUIT
+3 DO EN1^GMRADPT
if 'GMRAL
QUIT
+4 SET I=0
FOR
SET I=$ORDER(GMRAL(I))
if I<1
QUIT
Begin DoDot:1
+5 SET EDPX("name")=$PIECE(GMRAL(I),U,2)
+6 DO XMLE^EDPX(.EDPX)
End DoDot:1
+7 QUIT
+8 ;
PROB ; -- Return active problems
+1 NEW DFN,IEN,EDPX
+2 SET DFN=+$PIECE($GET(^EDP(230,LOG,0)),U,6)
if DFN<1
QUIT
+3 SET IEN=0
FOR
SET IEN=$ORDER(^AUPNPROB("ACTIVE",DFN,"A",IEN))
if IEN<1
QUIT
Begin DoDot:1
+4 SET EDPX("name")=$$GET1^DIQ(9000011,IEN_",",.05,"E")
+5 SET EDPX("icd")=$$GET1^DIQ(9000011,IEN_",",.01,"E")
+6 DO XML^EDPX($$XMLA^EDPX("problem",.EDPX))
End DoDot:1
+7 QUIT
+8 ;
MEDS ; -- Return active Rx's
+1 NEW DFN,I,RX,EDPX
+2 SET DFN=+$PIECE($GET(^EDP(230,LOG,0)),U,6)
if DFN<1
QUIT
+3 DO OCL^PSOORRL(DFN,1,9999999)
+4 SET I=0
FOR
SET I=$ORDER(^TMP("PS",$JOB,I))
if I<1
QUIT
MERGE RX=^(I)
Begin DoDot:1
+5 ;want only what pt is taking
if '$$ACTIVE($PIECE(RX(0),U,9))
QUIT
+6 SET EDPX("name")=$PIECE(RX(0),U,2)
+7 SET EDPX("sig")=$GET(RX("SIG",1,0))
+8 SET EDPX("status")=$PIECE(RX(0),U,9)
+9 DO XML^EDPX($$XMLA^EDPX("med",.EDPX))
End DoDot:1
+10 QUIT
+11 ;
ACTIVE(X) ; -- return 1 or 0, if X is an active status
+1 NEW Y
SET Y=1
+2 IF X="PURGE"
SET Y=0
+3 IF X="DELETED"
SET Y=0
+4 ;keep for a time, to renew?
IF X="EXPIRED"
SET Y=0
+5 IF $PIECE(X," ")="DISCONTINUED"
SET Y=0
+6 QUIT Y
+7 ;
VIT ; -- Return vitals taken during current ED visit
+1 NEW DFN,IN,GMRVSTR,IDT,TYPE,IEN,REC,EDPX,X
+2 SET DFN=+$PIECE($GET(^EDP(230,LOG,0)),U,6)
SET IN=$PIECE($GET(^(0)),U,8)
if DFN<1
QUIT
+3 SET GMRVSTR="BP;T;R;P;HT;WT;PN"
SET GMRVSTR(0)=IN_"^9999999^9999999^1"
+4 KILL ^UTILITY($JOB,"GMRVD")
DO EN1^GMRVUT0
+5 SET IDT="A"
FOR
SET IDT=$ORDER(^UTILITY($JOB,"GMRVD",IDT),-1)
if IDT<1
QUIT
Begin DoDot:1
+6 KILL EDPX
SET X=9999999-IDT
SET EDPX("time")=$$FMTE^XLFDT(X,"1P")
+7 SET TYPE=""
FOR
SET TYPE=$ORDER(^UTILITY($JOB,"GMRVD",IDT,TYPE))
if TYPE=""
QUIT
Begin DoDot:2
+8 SET IEN=$ORDER(^UTILITY($JOB,"GMRVD",IDT,TYPE,0))
SET REC=$GET(^(IEN))
+9 SET EDPX(TYPE)=$PIECE(REC,U,8)
End DoDot:2
+10 ;for now
SET EDPX("error")="false"
+11 DO XML^EDPX($$XMLA^EDPX("vital",.EDPX))
End DoDot:1
+12 QUIT
