- 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 Feb 18, 2025@23:18:11 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