EDPQLE ;SLC/KCM - Retrieve Log Entry ;2/28/12 08:33am
;;2.0;EMERGENCY DEPARTMENT;**6,2,12**;Feb 24, 2012;Build 2
;
; DBIA# SUPPORTED
; ----- --------- ------------------------------------
; 1894 Cont Sub ENCEVENT^PXAPI
; 10103 Sup $$NOW^XLFDT,$$FMDIFF^XLFDT
; 2056 Sup $$GET1^DIQ
; 10061 Sup DEM^VADPT
; 2815 Sup ^ICPT("B"
; 1593 Cont Sub ^AUTNPOV(
; 10035 Sup ^DPT(
; 10040 Sup ^SC(
; 10060 Sup ^VA(200
; 10076 Sup ^XUSEC("PROVIDER"
;
GET(LOG,CHOICES) ; Get a log entry by request
N CURBED,CURVAL,PERSON,CODED,CHTS,CHLOAD,CLINIC
S AREA=$P(^EDP(230,LOG,0),U,3)
S CHTS=$P($G(^EDPB(231.9,AREA,231)),U),CHLOAD=(CHTS'=CHOICES)
N EDPTIME S EDPTIME=$$NOW^XLFDT
N EDPNOVAL S EDPNOVAL=+$O(^EDPB(233.1,"B","edp.reserved.novalue",0))
D LOG(LOG)
D XML^EDPX("<choices ts='"_CHTS_"' >")
D BEDS,PERSONS,CODED,CLINICS
D:CHLOAD CHOICES^EDPQLE1(AREA)
D CLINLST^EDPQLE1($P(^EDP(230,LOG,0),U,14)) ; time-sensitive, get every time
D XML^EDPX("</choices>")
Q
LOG(LOG) ; return the log entry as XML
N X,X0,X1,X3
;
L +^EDP(230,LOG):3
S X0=^EDP(230,LOG,0),X1=$G(^(1)),X3=$G(^(3))
S X("loadTS")=$$NOW^XLFDT
L -^EDP(230,LOG)
;
; Set up encounter info into ^TMP if necessary so we can use it later
; see if visit present, if diagnosis coded or missing provider
I $P(X0,U,12),($P($G(^EDPB(231.9,AREA,1)),U,2)!('$P(X3,U,5))) D
. K ^TMP("PXKENC",$J)
. D ENCEVENT^PXAPI($P(X0,U,12))
;
; Get Provider from PCE if we don't have one
; this is commented out for now since we don't have a way to
; let the user know the provider was pulled in and needed to be saved
; I '$P(X3,U,5),$P(X0,U,12) S X("md")=$$PRIMPCE($P(X0,U,12)),PERSON("provider")=X("md")
;
S X("id")=LOG
S X("site")=$P(X0,U,2)
S X("area")=$P(X0,U,3)
S X("name")=$P(X0,U,4)
S X("dfn")=$P(X0,U,6)
S X("ssn")=$S(X("dfn"):$P(^DPT(X("dfn"),0),U,9),1:"")
S X("dob")=$$DOB(X("dfn"))
S X("closed")=$P(X0,U,7)
S X("inTS")=$P(X0,U,8)
S X("outTS")=$P(X0,U,9)
S X("arrival")=$$CODE($P(X0,U,10)),CODED("arrival")=X("arrival")
S X("visit")=$P(X0,U,12)
S X("clinic")=$P(X0,U,14),CLINIC=X("clinic")
S X("complaint")=$P(X1,U,1)
S X("compLong")=$G(^EDP(230,LOG,2))
S X("status")=$$CODE($P(X3,U,2)),CODED("status")=X("status")
S X("acuity")=$$CODE($P(X3,U,3))
S X("bed")=+$P(X3,U,4)
S X("md")=+$P(X3,U,5),PERSON("provider")=X("md")
S X("nurse")=+$P(X3,U,6),PERSON("nurse")=X("nurse")
S X("res")=+$P(X3,U,7),PERSON("resident")=X("res")
S X("comment")=$P(X3,U,8)
S X("delay")=$$CODE($P(X1,U,5)),CODED("delay")=X("delay")
S X("disposition")=$$CODE($P(X1,U,2)),CODED("disposition")=X("disposition")
S X("required")=$$REQ(.X)
S CURBED=X("bed")_U_$P(X3,U,9) ; for later use by BEDS
;
D XML^EDPX("<logEntry>")
D XMLE^EDPX(.X)
;
; Get diagnosis from PCE if it is coded entry required AND patient has a VISIT
I $P($G(^EDPB(231.9,AREA,1)),U,2),$P(X0,U,12) D
. D DIAGPCE($P(X0,U,12))
E D
. D DIAGFREE(LOG)
;
I X("dfn") D PRF^EDPFPTC(X("dfn")) ; patient record flags
;
D XML^EDPX("</logEntry>")
Q
PRIMPCE(EDPVISIT) ; return primary provider from PCE
;for provider
; LST(n)="PRV"^ien^^^name^primary/secondary flag
N I,X,PRIM
S PRIM=""
S I=0 F S I=$O(^TMP("PXKENC",$J,EDPVISIT,"PRV",I)) Q:'I D Q:PRIM
. S X=^TMP("PXKENC",$J,EDPVISIT,"PRV",I,0)
. Q:$P(X,U,4)'="P"
. S PRIM=$P(X,U)
Q:'PRIM ""
Q:'$D(^XUSEC("PROVIDER",PRIM)) ""
Q:'$$ALLOW^EDPFPER(PRIM,"P") ""
Q PRIM
;
DIAGPCE(EDPVISIT) ; add PCE diagnoses
Q:'EDPVISIT
;BEGIN EDP*2.0*2 CHANGES replace line below with one that follows
N I,X,CODE,EDPLVDT,EDPLCIEN,EDPLCTYPE
S I=0 F S I=$O(^TMP("PXKENC",$J,EDPVISIT,"POV",I)) Q:'I D
. K X S X=^TMP("PXKENC",$J,EDPVISIT,"POV",I,0)
. S X("type")="POV",EDPLVDT=$P($G(^TMP("PXKENC",$J,EDPVISIT,"VST",EDPVISIT,0)),U)
. S EDPLCIEN=$P(X,U),EDPLCTYPE=$$VER^EDPLEX($$CSYS^EDPLEX(EDPLVDT)) ;DRP Added this line
. S:EDPLCIEN (X("code"),CODE)=$P($$ICDDATA^EDPLEX("DIAG",EDPLCIEN,EDPLVDT),U,2)
. S X("label")=^AUTNPOV($P(X,U,4),0),X("icdType")=EDPLCTYPE,X("ien")=EDPLCIEN
. S:X("label")'[EDPLCTYPE X("label")=X("label")_" ("_$G(EDPLCTYPE)_" "_$G(CODE)_")" ; drp added this line
. ;END EDP*2.0*2 CHANGES
. S X("primary")=($P(X,U,12)="P")
. D XML^EDPX($$XMLA^EDPX("diagnosis",.X))
S I=0 F S I=$O(^TMP("PXKENC",$J,EDPVISIT,"CPT",I)) Q:'I D
. K X S X=^TMP("PXKENC",$J,EDPVISIT,"CPT",I,0)
. S X("type")="CPT"
. S CODE=$O(^ICPT("B",$P(X,U),0)) S:CODE CODE=$P(^ICPT(CODE,0),U)
. S X("code")=CODE
. ; ** EDP *2* 12 ** NULL narrative = XML error -- "faultCode:Client.CouldNotDecode faultString:'Error #1085' faultDetail:'null'"
. S X("label")=$G(^AUTNPOV(+$P(X,U,4),0))
. S X("quantity")=$P(X,U,16)
. D XML^EDPX($$XMLA^EDPX("proc",.X))
Q
DIAGFREE(LOG) ; add free text diagnoses
N DIAG,CODE,LABEL,X4
S DIAG=0 F S DIAG=$O(^EDP(230,LOG,4,DIAG)) Q:'DIAG D
. S EDPLVDT=$P(^EDP(230,LOG,0),U,8) ;drp EDP*2.0*2 added to retrieve Date of Interest
. S X4=^EDP(230,LOG,4,DIAG,0)
. ;BEGIN EDP*2.0*2 CHANGES
. S X4("type")="POV"
. S EDPLCIEN=$P(X4,U,2) S:EDPLCIEN CODE=$P($$ICDDATA^EDPLEX("DIAG",EDPLCIEN,EDPLVDT),U,2) ;drp
. S:$G(CODE)'="" X4("code")=CODE,EDPLCTYPE=$$VER^EDPLEX($$CSYS^EDPLEX(EDPLVDT)),X4("ien")=EDPLCIEN
. S:$G(EDPLCTYPE)'="" X4("icdType")=EDPLCTYPE ; added this line drp
. S X4("label")=$P(X4,U,1)
. S:X4("label")'[$G(EDPLCTYPE) X4("label")=X4("label")_" ("_$G(EDPLCTYPE)_" "_$G(CODE)_")" ; drp added this line
. ;drp END EDP*2.0*2 CHANGES
. S X4("primary")=+$P(X4,U,3)
. D XML^EDPX($$XMLA^EDPX("diagnosis",.X4))
Q
DOB(DFN) ; Return date of birth (external)
I 'DFN Q ""
N VA,VADM,X,Y
D DEM^VADPT
Q $P(VADM(3),U,2)_" Age "_VADM(4)
;
CODE(IEN) ; set NOVAL code to 0 when returning code
Q:IEN=EDPNOVAL 0
Q +IEN
;
BEDS ; add a list of available room/beds for this area
D XML^EDPX("<bedList>")
D XML^EDPX($$XMLS^EDPX("bed",0,"None")) ;non-selected
N BED,X0,MULTI,SEQ,OCCUPIED,MYBED
S BED=0 F S BED=$O(^EDPB(231.8,"C",EDPSITE,AREA,BED)) Q:'BED D
. S SEQ=$P(^EDPB(231.8,BED,0),U,5) S:'SEQ SEQ=99999
. ; PATCH 6 (BWF - 4/24/2013) - Additional filter for EDIS_DEFAULT
. I $$GET1^DIQ(231.8,BED,.01,"E")="EDIS_DEFAULT" Q
. S SEQ(SEQ,BED)=""
S SEQ=0 F S SEQ=$O(SEQ(SEQ)) Q:'SEQ D
. S BED=0 F S BED=$O(SEQ(SEQ,BED)) Q:'BED D
.. S X0=^EDPB(231.8,BED,0)
.. ; QUIT if inactive bed
.. I $P(X0,U,4) Q
.. ; QUIT if occupied, unless own bed or multi-assign
.. S MULTI=+$P(X0,U,9) S:MULTI=3 MULTI=0 ; single non-ed
.. S OCCUPIED=$D(^EDP(230,"AL",EDPSITE,AREA,BED))!$D(^EDP(230,"AH",EDPSITE,AREA,BED))
.. S MYBED=(BED=+CURBED)!(BED=$P(CURBED,U,2))
.. I OCCUPIED,'MYBED,'MULTI Q
.. ;
.. S X("data")=BED
.. S X("label")=$P(X0,U,6)_" ("_$P(X0,U)_")"
.. S X("ref")=$P(X0,U,8)
.. D XML^EDPX($$XMLA^EDPX("bed",.X))
D XML^EDPX("</bedList>")
Q
PERSONS ; add the internal/external values for persons
N ROLE,NAME,LOCID,IEN,X
D XML^EDPX("<persons>")
F ROLE="provider","nurse","resident" S LOCID=$G(PERSON(ROLE)) D
. Q:'LOCID
. S NAME=$P(^VA(200,LOCID,0),U)
. S X("data")=LOCID,X("label")=NAME
. D XML^EDPX($$XMLA^EDPX(ROLE,.X))
D XML^EDPX("</persons>")
Q
CODED ; add internal/external values for codes
N NAME,X
D XML^EDPX("<selected>")
S X="" F S X=$O(CODED(X)) Q:X="" I CODED(X) D
. S NAME=$P($G(^EDPB(233.1,CODED(X),0)),U,2) Q:NAME=""
. D XML^EDPX($$XMLS^EDPX(X,CODED(X),NAME))
D XML^EDPX("</selected>")
Q
CLINICS ; add internal/external values for clinic
Q:'CLINIC
N NAME,X
D XML^EDPX("<clinics>")
S NAME=$P($G(^SC(CLINIC,0)),U)
S X("data")=CLINIC,X("label")=NAME
D XML^EDPX($$XMLA^EDPX("clinic",.X))
D XML^EDPX("</clinics>")
Q
REQ(VAL) ; return the fields required to close this entry
; called from LOG, AREA is assumed to be defined
N NEED,PARAM
S PARAM=$G(^EDPB(231.9,AREA,1)),NEED=""
I $P(PARAM,U,1) S $P(NEED,",",1)="diag"
I $P(PARAM,U,3) S $P(NEED,",",2)="disp"
; bwf - 4/26/13 - per Dr. Gelman, want delay reason no matter whether patient is in observation or not.
; - replaced line below with one that follows
;I $$DLYREQ,$$NOTOBS,$$EXCEED S $P(NEED,",",3)="delay"
I $$DLYREQ,$$EXCEED S $P(NEED,",",3)="delay"
Q NEED
;
DLYREQ() ; return true if delay params set to required
; called from REQ, PARAM is assumed to be defined
Q $P(PARAM,U,4)&$P(PARAM,U,5)
;
NOTOBS() ; return true if not in observation status
; called from REQ, VAL is assumed to be defined
N STS S STS=+$G(VAL("status"))
Q:'STS 1
Q:$P(^EDPB(233.1,STS,0),U,5)["O" 0
Q 1
;
EXCEED() ; return true if delay time exceeded
; called from REQ, VAL and PARAM are assumed to be defined
N IN S IN=$G(VAL("inTS"))
N OUT S OUT=$G(VAL("outTS")) S:'OUT OUT=EDPTIME
N MAX S MAX=$P(PARAM,U,5)
Q ($$FMDIFF^XLFDT(OUT,IN,2)\60)>MAX
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEDPQLE 8915 printed Apr 09, 2024@20:57:38 Page 2
EDPQLE ;SLC/KCM - Retrieve Log Entry ;2/28/12 08:33am
+1 ;;2.0;EMERGENCY DEPARTMENT;**6,2,12**;Feb 24, 2012;Build 2
+2 ;
+3 ; DBIA# SUPPORTED
+4 ; ----- --------- ------------------------------------
+5 ; 1894 Cont Sub ENCEVENT^PXAPI
+6 ; 10103 Sup $$NOW^XLFDT,$$FMDIFF^XLFDT
+7 ; 2056 Sup $$GET1^DIQ
+8 ; 10061 Sup DEM^VADPT
+9 ; 2815 Sup ^ICPT("B"
+10 ; 1593 Cont Sub ^AUTNPOV(
+11 ; 10035 Sup ^DPT(
+12 ; 10040 Sup ^SC(
+13 ; 10060 Sup ^VA(200
+14 ; 10076 Sup ^XUSEC("PROVIDER"
+15 ;
GET(LOG,CHOICES) ; Get a log entry by request
+1 NEW CURBED,CURVAL,PERSON,CODED,CHTS,CHLOAD,CLINIC
+2 SET AREA=$PIECE(^EDP(230,LOG,0),U,3)
+3 SET CHTS=$PIECE($GET(^EDPB(231.9,AREA,231)),U)
SET CHLOAD=(CHTS'=CHOICES)
+4 NEW EDPTIME
SET EDPTIME=$$NOW^XLFDT
+5 NEW EDPNOVAL
SET EDPNOVAL=+$ORDER(^EDPB(233.1,"B","edp.reserved.novalue",0))
+6 DO LOG(LOG)
+7 DO XML^EDPX("<choices ts='"_CHTS_"' >")
+8 DO BEDS
DO PERSONS
DO CODED
DO CLINICS
+9 if CHLOAD
DO CHOICES^EDPQLE1(AREA)
+10 ; time-sensitive, get every time
DO CLINLST^EDPQLE1($PIECE(^EDP(230,LOG,0),U,14))
+11 DO XML^EDPX("</choices>")
+12 QUIT
LOG(LOG) ; return the log entry as XML
+1 NEW X,X0,X1,X3
+2 ;
+3 LOCK +^EDP(230,LOG):3
+4 SET X0=^EDP(230,LOG,0)
SET X1=$GET(^(1))
SET X3=$GET(^(3))
+5 SET X("loadTS")=$$NOW^XLFDT
+6 LOCK -^EDP(230,LOG)
+7 ;
+8 ; Set up encounter info into ^TMP if necessary so we can use it later
+9 ; see if visit present, if diagnosis coded or missing provider
+10 IF $PIECE(X0,U,12)
IF ($PIECE($GET(^EDPB(231.9,AREA,1)),U,2)!('$PIECE(X3,U,5)))
Begin DoDot:1
+11 KILL ^TMP("PXKENC",$JOB)
+12 DO ENCEVENT^PXAPI($PIECE(X0,U,12))
End DoDot:1
+13 ;
+14 ; Get Provider from PCE if we don't have one
+15 ; this is commented out for now since we don't have a way to
+16 ; let the user know the provider was pulled in and needed to be saved
+17 ; I '$P(X3,U,5),$P(X0,U,12) S X("md")=$$PRIMPCE($P(X0,U,12)),PERSON("provider")=X("md")
+18 ;
+19 SET X("id")=LOG
+20 SET X("site")=$PIECE(X0,U,2)
+21 SET X("area")=$PIECE(X0,U,3)
+22 SET X("name")=$PIECE(X0,U,4)
+23 SET X("dfn")=$PIECE(X0,U,6)
+24 SET X("ssn")=$SELECT(X("dfn"):$PIECE(^DPT(X("dfn"),0),U,9),1:"")
+25 SET X("dob")=$$DOB(X("dfn"))
+26 SET X("closed")=$PIECE(X0,U,7)
+27 SET X("inTS")=$PIECE(X0,U,8)
+28 SET X("outTS")=$PIECE(X0,U,9)
+29 SET X("arrival")=$$CODE($PIECE(X0,U,10))
SET CODED("arrival")=X("arrival")
+30 SET X("visit")=$PIECE(X0,U,12)
+31 SET X("clinic")=$PIECE(X0,U,14)
SET CLINIC=X("clinic")
+32 SET X("complaint")=$PIECE(X1,U,1)
+33 SET X("compLong")=$GET(^EDP(230,LOG,2))
+34 SET X("status")=$$CODE($PIECE(X3,U,2))
SET CODED("status")=X("status")
+35 SET X("acuity")=$$CODE($PIECE(X3,U,3))
+36 SET X("bed")=+$PIECE(X3,U,4)
+37 SET X("md")=+$PIECE(X3,U,5)
SET PERSON("provider")=X("md")
+38 SET X("nurse")=+$PIECE(X3,U,6)
SET PERSON("nurse")=X("nurse")
+39 SET X("res")=+$PIECE(X3,U,7)
SET PERSON("resident")=X("res")
+40 SET X("comment")=$PIECE(X3,U,8)
+41 SET X("delay")=$$CODE($PIECE(X1,U,5))
SET CODED("delay")=X("delay")
+42 SET X("disposition")=$$CODE($PIECE(X1,U,2))
SET CODED("disposition")=X("disposition")
+43 SET X("required")=$$REQ(.X)
+44 ; for later use by BEDS
SET CURBED=X("bed")_U_$PIECE(X3,U,9)
+45 ;
+46 DO XML^EDPX("<logEntry>")
+47 DO XMLE^EDPX(.X)
+48 ;
+49 ; Get diagnosis from PCE if it is coded entry required AND patient has a VISIT
+50 IF $PIECE($GET(^EDPB(231.9,AREA,1)),U,2)
IF $PIECE(X0,U,12)
Begin DoDot:1
+51 DO DIAGPCE($PIECE(X0,U,12))
End DoDot:1
+52 IF '$TEST
Begin DoDot:1
+53 DO DIAGFREE(LOG)
End DoDot:1
+54 ;
+55 ; patient record flags
IF X("dfn")
DO PRF^EDPFPTC(X("dfn"))
+56 ;
+57 DO XML^EDPX("</logEntry>")
+58 QUIT
PRIMPCE(EDPVISIT) ; return primary provider from PCE
+1 ;for provider
+2 ; LST(n)="PRV"^ien^^^name^primary/secondary flag
+3 NEW I,X,PRIM
+4 SET PRIM=""
+5 SET I=0
FOR
SET I=$ORDER(^TMP("PXKENC",$JOB,EDPVISIT,"PRV",I))
if 'I
QUIT
Begin DoDot:1
+6 SET X=^TMP("PXKENC",$JOB,EDPVISIT,"PRV",I,0)
+7 if $PIECE(X,U,4)'="P"
QUIT
+8 SET PRIM=$PIECE(X,U)
End DoDot:1
if PRIM
QUIT
+9 if 'PRIM
QUIT ""
+10 if '$DATA(^XUSEC("PROVIDER",PRIM))
QUIT ""
+11 if '$$ALLOW^EDPFPER(PRIM,"P")
QUIT ""
+12 QUIT PRIM
+13 ;
DIAGPCE(EDPVISIT) ; add PCE diagnoses
+1 if 'EDPVISIT
QUIT
+2 ;BEGIN EDP*2.0*2 CHANGES replace line below with one that follows
+3 NEW I,X,CODE,EDPLVDT,EDPLCIEN,EDPLCTYPE
+4 SET I=0
FOR
SET I=$ORDER(^TMP("PXKENC",$JOB,EDPVISIT,"POV",I))
if 'I
QUIT
Begin DoDot:1
+5 KILL X
SET X=^TMP("PXKENC",$JOB,EDPVISIT,"POV",I,0)
+6 SET X("type")="POV"
SET EDPLVDT=$PIECE($GET(^TMP("PXKENC",$JOB,EDPVISIT,"VST",EDPVISIT,0)),U)
+7 ;DRP Added this line
SET EDPLCIEN=$PIECE(X,U)
SET EDPLCTYPE=$$VER^EDPLEX($$CSYS^EDPLEX(EDPLVDT))
+8 if EDPLCIEN
SET (X("code"),CODE)=$PIECE($$ICDDATA^EDPLEX("DIAG",EDPLCIEN,EDPLVDT),U,2)
+9 SET X("label")=^AUTNPOV($PIECE(X,U,4),0)
SET X("icdType")=EDPLCTYPE
SET X("ien")=EDPLCIEN
+10 ; drp added this line
if X("label")'[EDPLCTYPE
SET X("label")=X("label")_" ("_$GET(EDPLCTYPE)_" "_$GET(CODE)_")"
+11 ;END EDP*2.0*2 CHANGES
+12 SET X("primary")=($PIECE(X,U,12)="P")
+13 DO XML^EDPX($$XMLA^EDPX("diagnosis",.X))
End DoDot:1
+14 SET I=0
FOR
SET I=$ORDER(^TMP("PXKENC",$JOB,EDPVISIT,"CPT",I))
if 'I
QUIT
Begin DoDot:1
+15 KILL X
SET X=^TMP("PXKENC",$JOB,EDPVISIT,"CPT",I,0)
+16 SET X("type")="CPT"
+17 SET CODE=$ORDER(^ICPT("B",$PIECE(X,U),0))
if CODE
SET CODE=$PIECE(^ICPT(CODE,0),U)
+18 SET X("code")=CODE
+19 ; ** EDP *2* 12 ** NULL narrative = XML error -- "faultCode:Client.CouldNotDecode faultString:'Error #1085' faultDetail:'null'"
+20 SET X("label")=$GET(^AUTNPOV(+$PIECE(X,U,4),0))
+21 SET X("quantity")=$PIECE(X,U,16)
+22 DO XML^EDPX($$XMLA^EDPX("proc",.X))
End DoDot:1
+23 QUIT
DIAGFREE(LOG) ; add free text diagnoses
+1 NEW DIAG,CODE,LABEL,X4
+2 SET DIAG=0
FOR
SET DIAG=$ORDER(^EDP(230,LOG,4,DIAG))
if 'DIAG
QUIT
Begin DoDot:1
+3 ;drp EDP*2.0*2 added to retrieve Date of Interest
SET EDPLVDT=$PIECE(^EDP(230,LOG,0),U,8)
+4 SET X4=^EDP(230,LOG,4,DIAG,0)
+5 ;BEGIN EDP*2.0*2 CHANGES
+6 SET X4("type")="POV"
+7 ;drp
SET EDPLCIEN=$PIECE(X4,U,2)
if EDPLCIEN
SET CODE=$PIECE($$ICDDATA^EDPLEX("DIAG",EDPLCIEN,EDPLVDT),U,2)
+8 if $GET(CODE)'=""
SET X4("code")=CODE
SET EDPLCTYPE=$$VER^EDPLEX($$CSYS^EDPLEX(EDPLVDT))
SET X4("ien")=EDPLCIEN
+9 ; added this line drp
if $GET(EDPLCTYPE)'=""
SET X4("icdType")=EDPLCTYPE
+10 SET X4("label")=$PIECE(X4,U,1)
+11 ; drp added this line
if X4("label")'[$GET(EDPLCTYPE)
SET X4("label")=X4("label")_" ("_$GET(EDPLCTYPE)_" "_$GET(CODE)_")"
+12 ;drp END EDP*2.0*2 CHANGES
+13 SET X4("primary")=+$PIECE(X4,U,3)
+14 DO XML^EDPX($$XMLA^EDPX("diagnosis",.X4))
End DoDot:1
+15 QUIT
DOB(DFN) ; Return date of birth (external)
+1 IF 'DFN
QUIT ""
+2 NEW VA,VADM,X,Y
+3 DO DEM^VADPT
+4 QUIT $PIECE(VADM(3),U,2)_" Age "_VADM(4)
+5 ;
CODE(IEN) ; set NOVAL code to 0 when returning code
+1 if IEN=EDPNOVAL
QUIT 0
+2 QUIT +IEN
+3 ;
BEDS ; add a list of available room/beds for this area
+1 DO XML^EDPX("<bedList>")
+2 ;non-selected
DO XML^EDPX($$XMLS^EDPX("bed",0,"None"))
+3 NEW BED,X0,MULTI,SEQ,OCCUPIED,MYBED
+4 SET BED=0
FOR
SET BED=$ORDER(^EDPB(231.8,"C",EDPSITE,AREA,BED))
if 'BED
QUIT
Begin DoDot:1
+5 SET SEQ=$PIECE(^EDPB(231.8,BED,0),U,5)
if 'SEQ
SET SEQ=99999
+6 ; PATCH 6 (BWF - 4/24/2013) - Additional filter for EDIS_DEFAULT
+7 IF $$GET1^DIQ(231.8,BED,.01,"E")="EDIS_DEFAULT"
QUIT
+8 SET SEQ(SEQ,BED)=""
End DoDot:1
+9 SET SEQ=0
FOR
SET SEQ=$ORDER(SEQ(SEQ))
if 'SEQ
QUIT
Begin DoDot:1
+10 SET BED=0
FOR
SET BED=$ORDER(SEQ(SEQ,BED))
if 'BED
QUIT
Begin DoDot:2
+11 SET X0=^EDPB(231.8,BED,0)
+12 ; QUIT if inactive bed
+13 IF $PIECE(X0,U,4)
QUIT
+14 ; QUIT if occupied, unless own bed or multi-assign
+15 ; single non-ed
SET MULTI=+$PIECE(X0,U,9)
if MULTI=3
SET MULTI=0
+16 SET OCCUPIED=$DATA(^EDP(230,"AL",EDPSITE,AREA,BED))!$DATA(^EDP(230,"AH",EDPSITE,AREA,BED))
+17 SET MYBED=(BED=+CURBED)!(BED=$PIECE(CURBED,U,2))
+18 IF OCCUPIED
IF 'MYBED
IF 'MULTI
QUIT
+19 ;
+20 SET X("data")=BED
+21 SET X("label")=$PIECE(X0,U,6)_" ("_$PIECE(X0,U)_")"
+22 SET X("ref")=$PIECE(X0,U,8)
+23 DO XML^EDPX($$XMLA^EDPX("bed",.X))
End DoDot:2
End DoDot:1
+24 DO XML^EDPX("</bedList>")
+25 QUIT
PERSONS ; add the internal/external values for persons
+1 NEW ROLE,NAME,LOCID,IEN,X
+2 DO XML^EDPX("<persons>")
+3 FOR ROLE="provider","nurse","resident"
SET LOCID=$GET(PERSON(ROLE))
Begin DoDot:1
+4 if 'LOCID
QUIT
+5 SET NAME=$PIECE(^VA(200,LOCID,0),U)
+6 SET X("data")=LOCID
SET X("label")=NAME
+7 DO XML^EDPX($$XMLA^EDPX(ROLE,.X))
End DoDot:1
+8 DO XML^EDPX("</persons>")
+9 QUIT
CODED ; add internal/external values for codes
+1 NEW NAME,X
+2 DO XML^EDPX("<selected>")
+3 SET X=""
FOR
SET X=$ORDER(CODED(X))
if X=""
QUIT
IF CODED(X)
Begin DoDot:1
+4 SET NAME=$PIECE($GET(^EDPB(233.1,CODED(X),0)),U,2)
if NAME=""
QUIT
+5 DO XML^EDPX($$XMLS^EDPX(X,CODED(X),NAME))
End DoDot:1
+6 DO XML^EDPX("</selected>")
+7 QUIT
CLINICS ; add internal/external values for clinic
+1 if 'CLINIC
QUIT
+2 NEW NAME,X
+3 DO XML^EDPX("<clinics>")
+4 SET NAME=$PIECE($GET(^SC(CLINIC,0)),U)
+5 SET X("data")=CLINIC
SET X("label")=NAME
+6 DO XML^EDPX($$XMLA^EDPX("clinic",.X))
+7 DO XML^EDPX("</clinics>")
+8 QUIT
REQ(VAL) ; return the fields required to close this entry
+1 ; called from LOG, AREA is assumed to be defined
+2 NEW NEED,PARAM
+3 SET PARAM=$GET(^EDPB(231.9,AREA,1))
SET NEED=""
+4 IF $PIECE(PARAM,U,1)
SET $PIECE(NEED,",",1)="diag"
+5 IF $PIECE(PARAM,U,3)
SET $PIECE(NEED,",",2)="disp"
+6 ; bwf - 4/26/13 - per Dr. Gelman, want delay reason no matter whether patient is in observation or not.
+7 ; - replaced line below with one that follows
+8 ;I $$DLYREQ,$$NOTOBS,$$EXCEED S $P(NEED,",",3)="delay"
+9 IF $$DLYREQ
IF $$EXCEED
SET $PIECE(NEED,",",3)="delay"
+10 QUIT NEED
+11 ;
DLYREQ() ; return true if delay params set to required
+1 ; called from REQ, PARAM is assumed to be defined
+2 QUIT $PIECE(PARAM,U,4)&$PIECE(PARAM,U,5)
+3 ;
NOTOBS() ; return true if not in observation status
+1 ; called from REQ, VAL is assumed to be defined
+2 NEW STS
SET STS=+$GET(VAL("status"))
+3 if 'STS
QUIT 1
+4 if $PIECE(^EDPB(233.1,STS,0),U,5)["O"
QUIT 0
+5 QUIT 1
+6 ;
EXCEED() ; return true if delay time exceeded
+1 ; called from REQ, VAL and PARAM are assumed to be defined
+2 NEW IN
SET IN=$GET(VAL("inTS"))
+3 NEW OUT
SET OUT=$GET(VAL("outTS"))
if 'OUT
SET OUT=EDPTIME
+4 NEW MAX
SET MAX=$PIECE(PARAM,U,5)
+5 QUIT ($$FMDIFF^XLFDT(OUT,IN,2)\60)>MAX
