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

EDPDTL.m

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