EDPQPP ;SLC/KCM,MKB - Display Active Log Entries ;2/28/12 08:33am
;;2.0;EMERGENCY DEPARTMENT;;May 2, 2012;Build 103
;
GET(AREA,BOARD,LAST) ; Get display board contents
;I $G(^EDPB(231.9,AREA,230))=TOKEN D XML^EDPX("<rows status='same' />") Q
;
N EDPTIME S EDPTIME=$$NOW^XLFDT
N EDPNOVAL S EDPNOVAL=+$O(^EDPB(233.1,"B","edp.reserved.novalue",0))
N SEQ,BED,LOG,BEDS,DWHEN,DUP,ACU,LSTUPD,RELOAD,ATT
;
S LSTUPD=$P($G(^EDPB(231.9,AREA,0)),U,3),RELOAD="true",LAST=$G(LAST)
I (LAST="")!(LAST=LSTUPD) S RELOAD="false"
S ATT("status")="new"
S ATT("reloadConfig")=RELOAD
S ATT("configLastUpdated")=LSTUPD
S ATT("version")=$$VERSRV^EDPQAR
D XML^EDPX($$XMLA^EDPX("rows",.ATT,""))
;
; Get a list of all the beds in sequence for this area
S BOARD=$G(BOARD)
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
. Q:$P(^EDPB(231.8,BED,0),U,4) ; inactive bed
. S BEDS(SEQ,BED)="",BEDS("B",BED,SEQ)=""
;
; Insert the active log entries into the correct sequence for the beds
S BED=0 F S BED=$O(^EDP(230,"AL",EDPSITE,AREA,BED)) Q:'BED D
. S LOG=0 F S LOG=$O(^EDP(230,"AL",EDPSITE,AREA,BED,LOG)) Q:'LOG D
. . I '$D(BEDS("B",BED)) S BEDS(99999,BED)="",BEDS("B",BED,99999)=""
. . S SEQ=$O(BEDS("B",BED,0))
. . S ACU=$P($G(^EDP(230,LOG,3)),U,3) S:'ACU ACU=99
. . S BEDS(SEQ,BED,ACU,LOG)=""
;
; Loop thru the sequence of beds to create display board rows
D BLDDUP^EDPQLP(.DUP,AREA)
S SEQ=0 F S SEQ=$O(BEDS(SEQ)) Q:'SEQ D
. S BED=0 F S BED=$O(BEDS(SEQ,BED)) Q:'BED D
. . ; I $L(BOARD),($P(^EDPB(231.8,BED,0),U,11)'=BOARD) Q ; KCM - show all for patient panel
. . S DWHEN=$P(^EDPB(231.8,BED,0),U,7)
. . ; never display DWHEN=2
. . Q:DWHEN=2
. . ; always display DWHEN=1
. . I ($D(BEDS(SEQ,BED))<10)&(DWHEN=1) D EMPTY(BED) Q
. . ; display if occupied DWHEN=0
. . S ACU=0 F S ACU=$O(BEDS(SEQ,BED,ACU)) Q:'ACU D
. . . S LOG=0 F S LOG=$O(BEDS(SEQ,BED,ACU,LOG)) Q:'LOG D OCCUPIED(LOG,.DUP)
;
D XML^EDPX("</rows>")
Q
EMPTY(BED) ; add row if unoccupied be should show
N ROW
S ROW("bed")=BED
S ROW("bedNm")=$P(^EDPB(231.8,BED,0),U,6)
D XML^EDPX($$XMLA^EDPX("row",.ROW))
Q
OCCUPIED(LOG,DUP) ; add log entry row
N X0,X1,X3,X7,DFN,ROW,EDPRF
S X0=^EDP(230,LOG,0),X1=$G(^(1)),X3=$G(^(3)),X7=$G(^(7)),DFN=$P(X0,U,6)
S ROW("loadTS")=$$NOW^XLFDT
S ROW("id")=LOG
S ROW("ptDfn")=DFN
S ROW("site")=$P(X0,U,2)
S ROW("area")=$P(X0,U,3)
S ROW("name")=$P(X0,U,4)
S ROW("ptNm")=$P($P(X0,U,4),",")
S ROW("dob")=$$DOB^EDPQLE(DFN)
S ROW("ssn")=$S(DFN:$P(^DPT(DFN,0),U,9),1:"")
S ROW("closed")=$P(X0,U,7)
S ROW("inTS")=$P(X0,U,8)
S ROW("outTS")=$P(X0,U,9)
S ROW("arrival")=$$CODE^EDPQLE($P(X0,U,10))
S ROW("last4")=$P(X0,U,11)
S ROW("visit")=($P(X0,U,12)!$P(X0,U,13))
S ROW("clinic")=$P(X0,U,14)
S ROW("clinicNm")=$$LOCNM($P(X0,U,14))
S ROW("bed")=BED
S ROW("bedNm")=$$BEDNM^EDPQDB(BED,$P(X3,U,9))
S ROW("complaint")=$P(X1,U,1)
S ROW("compLong")=$G(^EDP(230,LOG,2))
S ROW("comment")=$P(X3,U,8)
S ROW("md")=$P(X3,U,5)
S ROW("mdNm")=$$USRNM($P(X3,U,5))
S ROW("mdInit")=$$INITIAL($P(X3,U,5))
S ROW("rn")=$P(X3,U,6)
S ROW("rnNm")=$$USRNM($P(X3,U,6))
S ROW("rnInit")=$$INITIAL($P(X3,U,6))
S ROW("res")=$P(X3,U,7)
S ROW("resNm")=$$USRNM($P(X3,U,7))
S ROW("resInit")=$$INITIAL($P(X3,U,7))
S ROW("status")=$$CODE^EDPQLE($P(X3,U,2))
S ROW("statusNm")=$$CAB(EDPSTA_".status",$P(X3,U,2))
S ROW("acuity")=$P(X3,U,3)
S ROW("acuityNm")=$$CAB(EDPSTA_".acuity",$P(X3,U,3))
S ROW("delay")=$$CODE^EDPQLE($P(X1,U,5))
S ROW("disposition")=$$CODE^EDPQLE($P(X1,U,2))
S ROW("emins")=$$HHMM($$MIN($P(X0,U,8)))
S ROW("lmins")=$$HHMM($$LMIN(LOG))
S ROW("similar")=$$SIM^EDPQLP(ROW("ptNm"),ROW("last4"),.DUP)
;
N STS D ORDSTS(LOG,.STS)
S ROW("labUrg")=$S(STS("LS"):2,STS("LP"):1,1:0) ; any STAT labs?
S ROW("radUrg")=$S(STS("RS"):2,STS("RP"):1,1:0) ; any STAT imgs?
S ROW("ordNew")=STS("ON") ; number of new orders
S ROW("minLab")=STS("LO") ; oldest pending/active lab
S ROW("minRad")=STS("RO") ; oldest pending/active img
S ROW("minVer")=STS("OO") ; oldest "new" order
D XML^EDPX($$XMLA^EDPX("row",.ROW,"")) K ROW
;
S ROW("num")=STS("LC")_"/"_STS("L") ; lab complete / lab total
D XML^EDPX($$XMLA^EDPX("labs",.ROW,""))
I $O(STS("L",0)) D
. N ORD M ORD=STS("L") D ADDORD(.ORD,"lab")
D XML^EDPX("</labs>") K ROW
;
S ROW("num")=STS("RC")_"/"_STS("R") ; img complete / img total
D XML^EDPX($$XMLA^EDPX("rads",.ROW,""))
I $O(STS("R",0)) D
. N ORD M ORD=STS("R") D ADDORD(.ORD,"rad")
D XML^EDPX("</rads>") K ROW
;
I $O(^EDP(230,LOG,4,0)) D ; diagnoses
. N I,X D XML^EDPX("<diagnoses>")
. S I=0 F S I=$O(^EDP(230,LOG,4,I)) Q:I<1 S X=$G(^(I,0)) D
.. S ROW("name")=$P(X,U) S:$P(X,U,3) ROW("primary")="true"
.. D XML^EDPX($$XMLA^EDPX("dx",.ROW)) K ROW
. D XML^EDPX("</diagnoses>")
;
I $P(X7,U,2) D ; vitals due
. N LAST,DUE D XML^EDPX("<alerts>")
. S LAST=$$LAST^EDPVIT(DFN),DUE=$$FMADD^XLFDT(LAST,,,+X7)
. S ROW("name")="vitals",ROW("isDue")="false"
. I DUE<$$NOW^XLFDT S ROW("isDue")="true",ROW("timeDue")=DUE
. D XML^EDPX($$XMLA^EDPX("alert",.ROW)) K ROW
. D XML^EDPX("</alerts>")
;
I $$GETACT^DGPFAPI(DFN,"EDPRF") D
. N I,X D XML^EDPX("<patientRecordFlags>")
. S I=0 F S I=$O(EDPRF(I)) Q:I<1 D
.. S X=$G(EDPRF(I,"APPRVBY")) I X S ROW("approvedByID")=+X,ROW("approvedByName")=$P(X,U,2)
.. S X=$G(EDPRF(I,"ASSIGNDT")) I X S ROW("assignmentTS")=+X
.. S X=$G(EDPRF(I,"REVIEWDT")) I X S ROW("reviewDT")=+X
.. S X=$G(EDPRF(I,"FLAG")) I $L(X) S ROW("name")=$P(X,U,2)
.. S X=$G(EDPRF(I,"FLAGTYPE")) I $L(X) S ROW("type")=$P(X,U,2)
.. S X=$P($G(EDPRF(I,"CATEGORY")),U)
.. I $L(X) S ROW("categoryID")=$P(X," "),ROW("categoryName")=$P($P(X,"(",2),")")
.. S X=$G(EDPRF(I,"OWNER")) I X S X=$$NS^XUAF4(+X),ROW("ownerSiteID")=$P(X,U,2),ROW("ownerSiteName")=$P(X,U)
.. S X=$G(EDPRF(I,"ORIGSITE")) I X S X=$$NS^XUAF4(+X),ROW("origSiteID")=$P(X,U,2),ROW("origSiteName")=$P(X,U)
.. S X=$NA(EDPRF(I,"NARR")),ROW("text")=$$STRING(X)
.. D XML^EDPX($$XMLA^EDPX("prf",.ROW)) K ROW
. D XML^EDPX("</patientRecordFlags>")
;
D XML^EDPX("</row>")
Q
;
STRING(ARRAY) ; -- Return lines of text in @ARRAY@(N,0) as string
N N,Y S N=$O(@ARRAY@(0)),Y=$G(@ARRAY@(N))
F S N=$O(@ARRAY@(N)) Q:N<1 S Y=Y_$C(13,10)_@ARRAY@(N)
Q Y
;
ADDORD(LIST,TAG) ; add order detail to XML
N ROW,IFN,ORUPCHUK,STS,OI,BEG,END,X,I
S IFN=0 F S IFN=+$O(LIST(IFN)) Q:IFN<1 K ROW D
. S ROW("orderId")=IFN D EN^ORX8(IFN)
. S STS=+$G(ORUPCHUK("ORSTS")),ROW("statusId")=STS
. S ROW("statusName")=$$STATUS^EDPHIST(STS,TAG,IFN) ;result sts
. S OI=$$OI^ORX8(IFN),ROW("name")=$P(OI,U,2),X=""
. S BEG=$G(ORUPCHUK("ORODT")),END=$G(ORUPCHUK("ORSTOP")) S:'END END=$G(EDPTIME)
. S ROW("elapsed")=$$FMDIFF^XLFDT(END,BEG,2)\60 ;#minutes
. I $E(TAG)="l" D ;return X=print name
.. N ORPK,IDX S ORPK=$G(ORUPCHUK("ORPK"))
.. I $L(ORPK,";")<4 S X=$$GET1^DIQ(60,+$P(OI,U,3)_",",51) Q
.. D RR^LR7OR1(DFN,ORPK) S IDX=$NA(^TMP("LRRR",$J,DFN)),IDX=$Q(@IDX)
.. ;first? loop? panel?
.. S ROW("deviation")=$P(@IDX,U,3),X=$P(@IDX,U,15)
. I $E(TAG)="r" S I=+$O(^ORD(101.43,+OI,2,0)),X=$G(^(I,0))
. S:$L(X) ROW("abbre")=X
. D XML^EDPX($$XMLA^EDPX(TAG,.ROW))
Q
;
INITIAL(ID) ; Return initials
Q:'ID ""
Q $P(^VA(200,ID,0),U,2)
;
USRNM(ID) ; Return name
Q:'ID ""
Q $P(^VA(200,ID,0),U)
;
LOCNM(LOC) ; Return clinic name from 44
Q:'LOC ""
N X S X=$G(^SC(LOC,0)) ; IA#10040
Q:'$L(X) ""
I $L($P(X,U,2)) Q $P(X,U,2)
Q $P(X,U)
;
CAB(LST,IEN) ; Return code abbreviation
Q:'IEN ""
N LSTDA,ABB,XSITE,XNATL
S LSTDA=$O(^EDPB(233.2,"AS",LST,IEN,0))
S ABB="",XSITE="",XNATL=""
I LSTDA S XSITE=^EDPB(233.2,"AS",LST,IEN,LSTDA)
S ABB=$P(XSITE,U,1) Q:$L(ABB) ABB ;site abbreviation
S XNATL=^EDPB(233.1,IEN,0)
S ABB=$P(XNATL,U,3) Q:$L(ABB) ABB ;nat'l abbreviation
S ABB=$P(XSITE,U,2) Q:$L(ABB) ABB ;site name
S ABB=$P(XNATL,U,2) Q:$L(ABB) ABB ;nat'l name
Q ""
;
MIN(START) ; Return elapse time
I 'START Q ""
Q $$FMDIFF^XLFDT(EDPTIME,START,2)\60
;
LMIN(LOG) ; Return time at location
N IEN,TS,TM S TM=0
S TS="" F S TS=$O(^EDP(230.1,"ADF",LOG,TS),-1) Q:'TS D Q:TM
. S IEN=0 F S IEN=$O(^EDP(230.1,"ADF",LOG,TS,IEN)) Q:'IEN D Q:TM
. . I +$P($G(^EDP(230.1,IEN,3)),U,4) S TM=$P($G(^EDP(230.1,IEN,0)),U,2)
I TM Q $$FMDIFF^XLFDT(EDPTIME,TM,2)\60
Q 0
;
HHMM(MIN) ; Format as hours:minutes
Q MIN ;(the colon messed up the calculations for elapsed time)
;
N H,M
S H=MIN\60,M=MIN#60
S:$L(M)=1 M="0"_M
Q H_":"_M
;
ORDSTS(LOG,STS) ; compute statuses of orders
N IEN,X0
S STS("OO")=9999999,STS("ON")=0 ; oldest order, new orders
S STS("LP")=0,STS("LO")=9999999,STS("LS")=0,STS("LC")=0,STS("L")=0
S STS("RP")=0,STS("RO")=9999999,STS("RS")=0,STS("RC")=0,STS("R")=0
S IEN=0 F S IEN=$O(^EDP(230,LOG,8,IEN)) Q:'IEN D
. S X0=^EDP(230,LOG,8,IEN,0)
. S:$L($P(X0,U,2)) STS($P(X0,U,2),+X0)="",STS($P(X0,U,2))=$G(STS($P(X0,U,2)))+1
. I ($P(X0,U,3)="N")!($P(X0,U,3)="A") D
. . I $P(X0,U,5)<STS("OO") S STS("OO")=$P(X0,U,5) ; oldest order
. . I $P(X0,U,2)="L" D
. . . S STS("LP")=STS("LP")+1 ; pending labs
. . . I $P(X0,U,5)<STS("LO") S STS("LO")=$P(X0,U,5) ; oldest lab
. . . I $P(X0,U,4) S STS("LS")=1 ; stat lab
. . I $P(X0,U,2)="R" D
. . . S STS("RP")=STS("RP")+1 ; pending radiology
. . . I $P(X0,U,5)<STS("RO") S STS("RO")=$P(X0,U,5) ; oldest radiology
. . . I $P(X0,U,4) S STS("RS")=1 ; stat radiology
. I $P(X0,U,3)="N" S STS("ON")=STS("ON")+1
. I $P(X0,U,3)="C" D
. . I $P(X0,U,2)="L" S STS("LC")=STS("LC")+1 ; completed labs
. . I $P(X0,U,2)="R" S STS("RC")=STS("RC")+1 ; completed radiology
S STS("OO")=$S(STS("OO")=9999999:0,1:$$MIN(STS("OO")))
S STS("LO")=$S(STS("LO")=9999999:0,1:$$MIN(STS("LO")))
S STS("RO")=$S(STS("RO")=9999999:0,1:$$MIN(STS("RO")))
Q
;
LISTS(AREA) ; Get selection lists [from EDPQLE]
N CHTS
S CHTS=$P($G(^EDPB(231.9,AREA,231)),U)
D XML^EDPX("<choices ts='"_CHTS_"' >")
;N CURBED S CURBED="" D BEDS^EDPQLE
D CHOICES^EDPQLE1(AREA)
D CLINLST^EDPQLE1(1)
D XML^EDPX("</choices>")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEDPQPP 10499 printed Dec 13, 2024@01:52:13 Page 2
EDPQPP ;SLC/KCM,MKB - Display Active Log Entries ;2/28/12 08:33am
+1 ;;2.0;EMERGENCY DEPARTMENT;;May 2, 2012;Build 103
+2 ;
GET(AREA,BOARD,LAST) ; Get display board contents
+1 ;I $G(^EDPB(231.9,AREA,230))=TOKEN D XML^EDPX("<rows status='same' />") Q
+2 ;
+3 NEW EDPTIME
SET EDPTIME=$$NOW^XLFDT
+4 NEW EDPNOVAL
SET EDPNOVAL=+$ORDER(^EDPB(233.1,"B","edp.reserved.novalue",0))
+5 NEW SEQ,BED,LOG,BEDS,DWHEN,DUP,ACU,LSTUPD,RELOAD,ATT
+6 ;
+7 SET LSTUPD=$PIECE($GET(^EDPB(231.9,AREA,0)),U,3)
SET RELOAD="true"
SET LAST=$GET(LAST)
+8 IF (LAST="")!(LAST=LSTUPD)
SET RELOAD="false"
+9 SET ATT("status")="new"
+10 SET ATT("reloadConfig")=RELOAD
+11 SET ATT("configLastUpdated")=LSTUPD
+12 SET ATT("version")=$$VERSRV^EDPQAR
+13 DO XML^EDPX($$XMLA^EDPX("rows",.ATT,""))
+14 ;
+15 ; Get a list of all the beds in sequence for this area
+16 SET BOARD=$GET(BOARD)
+17 SET BED=0
FOR
SET BED=$ORDER(^EDPB(231.8,"C",EDPSITE,AREA,BED))
if 'BED
QUIT
Begin DoDot:1
+18 SET SEQ=$PIECE(^EDPB(231.8,BED,0),U,5)
if 'SEQ
SET SEQ=99999
+19 ; inactive bed
if $PIECE(^EDPB(231.8,BED,0),U,4)
QUIT
+20 SET BEDS(SEQ,BED)=""
SET BEDS("B",BED,SEQ)=""
End DoDot:1
+21 ;
+22 ; Insert the active log entries into the correct sequence for the beds
+23 SET BED=0
FOR
SET BED=$ORDER(^EDP(230,"AL",EDPSITE,AREA,BED))
if 'BED
QUIT
Begin DoDot:1
+24 SET LOG=0
FOR
SET LOG=$ORDER(^EDP(230,"AL",EDPSITE,AREA,BED,LOG))
if 'LOG
QUIT
Begin DoDot:2
+25 IF '$DATA(BEDS("B",BED))
SET BEDS(99999,BED)=""
SET BEDS("B",BED,99999)=""
+26 SET SEQ=$ORDER(BEDS("B",BED,0))
+27 SET ACU=$PIECE($GET(^EDP(230,LOG,3)),U,3)
if 'ACU
SET ACU=99
+28 SET BEDS(SEQ,BED,ACU,LOG)=""
End DoDot:2
End DoDot:1
+29 ;
+30 ; Loop thru the sequence of beds to create display board rows
+31 DO BLDDUP^EDPQLP(.DUP,AREA)
+32 SET SEQ=0
FOR
SET SEQ=$ORDER(BEDS(SEQ))
if 'SEQ
QUIT
Begin DoDot:1
+33 SET BED=0
FOR
SET BED=$ORDER(BEDS(SEQ,BED))
if 'BED
QUIT
Begin DoDot:2
+34 ; I $L(BOARD),($P(^EDPB(231.8,BED,0),U,11)'=BOARD) Q ; KCM - show all for patient panel
+35 SET DWHEN=$PIECE(^EDPB(231.8,BED,0),U,7)
+36 ; never display DWHEN=2
+37 if DWHEN=2
QUIT
+38 ; always display DWHEN=1
+39 IF ($DATA(BEDS(SEQ,BED))<10)&(DWHEN=1)
DO EMPTY(BED)
QUIT
+40 ; display if occupied DWHEN=0
+41 SET ACU=0
FOR
SET ACU=$ORDER(BEDS(SEQ,BED,ACU))
if 'ACU
QUIT
Begin DoDot:3
+42 SET LOG=0
FOR
SET LOG=$ORDER(BEDS(SEQ,BED,ACU,LOG))
if 'LOG
QUIT
DO OCCUPIED(LOG,.DUP)
End DoDot:3
End DoDot:2
End DoDot:1
+43 ;
+44 DO XML^EDPX("</rows>")
+45 QUIT
EMPTY(BED) ; add row if unoccupied be should show
+1 NEW ROW
+2 SET ROW("bed")=BED
+3 SET ROW("bedNm")=$PIECE(^EDPB(231.8,BED,0),U,6)
+4 DO XML^EDPX($$XMLA^EDPX("row",.ROW))
+5 QUIT
OCCUPIED(LOG,DUP) ; add log entry row
+1 NEW X0,X1,X3,X7,DFN,ROW,EDPRF
+2 SET X0=^EDP(230,LOG,0)
SET X1=$GET(^(1))
SET X3=$GET(^(3))
SET X7=$GET(^(7))
SET DFN=$PIECE(X0,U,6)
+3 SET ROW("loadTS")=$$NOW^XLFDT
+4 SET ROW("id")=LOG
+5 SET ROW("ptDfn")=DFN
+6 SET ROW("site")=$PIECE(X0,U,2)
+7 SET ROW("area")=$PIECE(X0,U,3)
+8 SET ROW("name")=$PIECE(X0,U,4)
+9 SET ROW("ptNm")=$PIECE($PIECE(X0,U,4),",")
+10 SET ROW("dob")=$$DOB^EDPQLE(DFN)
+11 SET ROW("ssn")=$SELECT(DFN:$PIECE(^DPT(DFN,0),U,9),1:"")
+12 SET ROW("closed")=$PIECE(X0,U,7)
+13 SET ROW("inTS")=$PIECE(X0,U,8)
+14 SET ROW("outTS")=$PIECE(X0,U,9)
+15 SET ROW("arrival")=$$CODE^EDPQLE($PIECE(X0,U,10))
+16 SET ROW("last4")=$PIECE(X0,U,11)
+17 SET ROW("visit")=($PIECE(X0,U,12)!$PIECE(X0,U,13))
+18 SET ROW("clinic")=$PIECE(X0,U,14)
+19 SET ROW("clinicNm")=$$LOCNM($PIECE(X0,U,14))
+20 SET ROW("bed")=BED
+21 SET ROW("bedNm")=$$BEDNM^EDPQDB(BED,$PIECE(X3,U,9))
+22 SET ROW("complaint")=$PIECE(X1,U,1)
+23 SET ROW("compLong")=$GET(^EDP(230,LOG,2))
+24 SET ROW("comment")=$PIECE(X3,U,8)
+25 SET ROW("md")=$PIECE(X3,U,5)
+26 SET ROW("mdNm")=$$USRNM($PIECE(X3,U,5))
+27 SET ROW("mdInit")=$$INITIAL($PIECE(X3,U,5))
+28 SET ROW("rn")=$PIECE(X3,U,6)
+29 SET ROW("rnNm")=$$USRNM($PIECE(X3,U,6))
+30 SET ROW("rnInit")=$$INITIAL($PIECE(X3,U,6))
+31 SET ROW("res")=$PIECE(X3,U,7)
+32 SET ROW("resNm")=$$USRNM($PIECE(X3,U,7))
+33 SET ROW("resInit")=$$INITIAL($PIECE(X3,U,7))
+34 SET ROW("status")=$$CODE^EDPQLE($PIECE(X3,U,2))
+35 SET ROW("statusNm")=$$CAB(EDPSTA_".status",$PIECE(X3,U,2))
+36 SET ROW("acuity")=$PIECE(X3,U,3)
+37 SET ROW("acuityNm")=$$CAB(EDPSTA_".acuity",$PIECE(X3,U,3))
+38 SET ROW("delay")=$$CODE^EDPQLE($PIECE(X1,U,5))
+39 SET ROW("disposition")=$$CODE^EDPQLE($PIECE(X1,U,2))
+40 SET ROW("emins")=$$HHMM($$MIN($PIECE(X0,U,8)))
+41 SET ROW("lmins")=$$HHMM($$LMIN(LOG))
+42 SET ROW("similar")=$$SIM^EDPQLP(ROW("ptNm"),ROW("last4"),.DUP)
+43 ;
+44 NEW STS
DO ORDSTS(LOG,.STS)
+45 ; any STAT labs?
SET ROW("labUrg")=$SELECT(STS("LS"):2,STS("LP"):1,1:0)
+46 ; any STAT imgs?
SET ROW("radUrg")=$SELECT(STS("RS"):2,STS("RP"):1,1:0)
+47 ; number of new orders
SET ROW("ordNew")=STS("ON")
+48 ; oldest pending/active lab
SET ROW("minLab")=STS("LO")
+49 ; oldest pending/active img
SET ROW("minRad")=STS("RO")
+50 ; oldest "new" order
SET ROW("minVer")=STS("OO")
+51 DO XML^EDPX($$XMLA^EDPX("row",.ROW,""))
KILL ROW
+52 ;
+53 ; lab complete / lab total
SET ROW("num")=STS("LC")_"/"_STS("L")
+54 DO XML^EDPX($$XMLA^EDPX("labs",.ROW,""))
+55 IF $ORDER(STS("L",0))
Begin DoDot:1
+56 NEW ORD
MERGE ORD=STS("L")
DO ADDORD(.ORD,"lab")
End DoDot:1
+57 DO XML^EDPX("</labs>")
KILL ROW
+58 ;
+59 ; img complete / img total
SET ROW("num")=STS("RC")_"/"_STS("R")
+60 DO XML^EDPX($$XMLA^EDPX("rads",.ROW,""))
+61 IF $ORDER(STS("R",0))
Begin DoDot:1
+62 NEW ORD
MERGE ORD=STS("R")
DO ADDORD(.ORD,"rad")
End DoDot:1
+63 DO XML^EDPX("</rads>")
KILL ROW
+64 ;
+65 ; diagnoses
IF $ORDER(^EDP(230,LOG,4,0))
Begin DoDot:1
+66 NEW I,X
DO XML^EDPX("<diagnoses>")
+67 SET I=0
FOR
SET I=$ORDER(^EDP(230,LOG,4,I))
if I<1
QUIT
SET X=$GET(^(I,0))
Begin DoDot:2
+68 SET ROW("name")=$PIECE(X,U)
if $PIECE(X,U,3)
SET ROW("primary")="true"
+69 DO XML^EDPX($$XMLA^EDPX("dx",.ROW))
KILL ROW
End DoDot:2
+70 DO XML^EDPX("</diagnoses>")
End DoDot:1
+71 ;
+72 ; vitals due
IF $PIECE(X7,U,2)
Begin DoDot:1
+73 NEW LAST,DUE
DO XML^EDPX("<alerts>")
+74 SET LAST=$$LAST^EDPVIT(DFN)
SET DUE=$$FMADD^XLFDT(LAST,,,+X7)
+75 SET ROW("name")="vitals"
SET ROW("isDue")="false"
+76 IF DUE<$$NOW^XLFDT
SET ROW("isDue")="true"
SET ROW("timeDue")=DUE
+77 DO XML^EDPX($$XMLA^EDPX("alert",.ROW))
KILL ROW
+78 DO XML^EDPX("</alerts>")
End DoDot:1
+79 ;
+80 IF $$GETACT^DGPFAPI(DFN,"EDPRF")
Begin DoDot:1
+81 NEW I,X
DO XML^EDPX("<patientRecordFlags>")
+82 SET I=0
FOR
SET I=$ORDER(EDPRF(I))
if I<1
QUIT
Begin DoDot:2
+83 SET X=$GET(EDPRF(I,"APPRVBY"))
IF X
SET ROW("approvedByID")=+X
SET ROW("approvedByName")=$PIECE(X,U,2)
+84 SET X=$GET(EDPRF(I,"ASSIGNDT"))
IF X
SET ROW("assignmentTS")=+X
+85 SET X=$GET(EDPRF(I,"REVIEWDT"))
IF X
SET ROW("reviewDT")=+X
+86 SET X=$GET(EDPRF(I,"FLAG"))
IF $LENGTH(X)
SET ROW("name")=$PIECE(X,U,2)
+87 SET X=$GET(EDPRF(I,"FLAGTYPE"))
IF $LENGTH(X)
SET ROW("type")=$PIECE(X,U,2)
+88 SET X=$PIECE($GET(EDPRF(I,"CATEGORY")),U)
+89 IF $LENGTH(X)
SET ROW("categoryID")=$PIECE(X," ")
SET ROW("categoryName")=$PIECE($PIECE(X,"(",2),")")
+90 SET X=$GET(EDPRF(I,"OWNER"))
IF X
SET X=$$NS^XUAF4(+X)
SET ROW("ownerSiteID")=$PIECE(X,U,2)
SET ROW("ownerSiteName")=$PIECE(X,U)
+91 SET X=$GET(EDPRF(I,"ORIGSITE"))
IF X
SET X=$$NS^XUAF4(+X)
SET ROW("origSiteID")=$PIECE(X,U,2)
SET ROW("origSiteName")=$PIECE(X,U)
+92 SET X=$NAME(EDPRF(I,"NARR"))
SET ROW("text")=$$STRING(X)
+93 DO XML^EDPX($$XMLA^EDPX("prf",.ROW))
KILL ROW
End DoDot:2
+94 DO XML^EDPX("</patientRecordFlags>")
End DoDot:1
+95 ;
+96 DO XML^EDPX("</row>")
+97 QUIT
+98 ;
STRING(ARRAY) ; -- Return lines of text in @ARRAY@(N,0) as string
+1 NEW N,Y
SET N=$ORDER(@ARRAY@(0))
SET Y=$GET(@ARRAY@(N))
+2 FOR
SET N=$ORDER(@ARRAY@(N))
if N<1
QUIT
SET Y=Y_$CHAR(13,10)_@ARRAY@(N)
+3 QUIT Y
+4 ;
ADDORD(LIST,TAG) ; add order detail to XML
+1 NEW ROW,IFN,ORUPCHUK,STS,OI,BEG,END,X,I
+2 SET IFN=0
FOR
SET IFN=+$ORDER(LIST(IFN))
if IFN<1
QUIT
KILL ROW
Begin DoDot:1
+3 SET ROW("orderId")=IFN
DO EN^ORX8(IFN)
+4 SET STS=+$GET(ORUPCHUK("ORSTS"))
SET ROW("statusId")=STS
+5 ;result sts
SET ROW("statusName")=$$STATUS^EDPHIST(STS,TAG,IFN)
+6 SET OI=$$OI^ORX8(IFN)
SET ROW("name")=$PIECE(OI,U,2)
SET X=""
+7 SET BEG=$GET(ORUPCHUK("ORODT"))
SET END=$GET(ORUPCHUK("ORSTOP"))
if 'END
SET END=$GET(EDPTIME)
+8 ;#minutes
SET ROW("elapsed")=$$FMDIFF^XLFDT(END,BEG,2)\60
+9 ;return X=print name
IF $EXTRACT(TAG)="l"
Begin DoDot:2
+10 NEW ORPK,IDX
SET ORPK=$GET(ORUPCHUK("ORPK"))
+11 IF $LENGTH(ORPK,";")<4
SET X=$$GET1^DIQ(60,+$PIECE(OI,U,3)_",",51)
QUIT
+12 DO RR^LR7OR1(DFN,ORPK)
SET IDX=$NAME(^TMP("LRRR",$JOB,DFN))
SET IDX=$QUERY(@IDX)
+13 ;first? loop? panel?
+14 SET ROW("deviation")=$PIECE(@IDX,U,3)
SET X=$PIECE(@IDX,U,15)
End DoDot:2
+15 IF $EXTRACT(TAG)="r"
SET I=+$ORDER(^ORD(101.43,+OI,2,0))
SET X=$GET(^(I,0))
+16 if $LENGTH(X)
SET ROW("abbre")=X
+17 DO XML^EDPX($$XMLA^EDPX(TAG,.ROW))
End DoDot:1
+18 QUIT
+19 ;
INITIAL(ID) ; Return initials
+1 if 'ID
QUIT ""
+2 QUIT $PIECE(^VA(200,ID,0),U,2)
+3 ;
USRNM(ID) ; Return name
+1 if 'ID
QUIT ""
+2 QUIT $PIECE(^VA(200,ID,0),U)
+3 ;
LOCNM(LOC) ; Return clinic name from 44
+1 if 'LOC
QUIT ""
+2 ; IA#10040
NEW X
SET X=$GET(^SC(LOC,0))
+3 if '$LENGTH(X)
QUIT ""
+4 IF $LENGTH($PIECE(X,U,2))
QUIT $PIECE(X,U,2)
+5 QUIT $PIECE(X,U)
+6 ;
CAB(LST,IEN) ; Return code abbreviation
+1 if 'IEN
QUIT ""
+2 NEW LSTDA,ABB,XSITE,XNATL
+3 SET LSTDA=$ORDER(^EDPB(233.2,"AS",LST,IEN,0))
+4 SET ABB=""
SET XSITE=""
SET XNATL=""
+5 IF LSTDA
SET XSITE=^EDPB(233.2,"AS",LST,IEN,LSTDA)
+6 ;site abbreviation
SET ABB=$PIECE(XSITE,U,1)
if $LENGTH(ABB)
QUIT ABB
+7 SET XNATL=^EDPB(233.1,IEN,0)
+8 ;nat'l abbreviation
SET ABB=$PIECE(XNATL,U,3)
if $LENGTH(ABB)
QUIT ABB
+9 ;site name
SET ABB=$PIECE(XSITE,U,2)
if $LENGTH(ABB)
QUIT ABB
+10 ;nat'l name
SET ABB=$PIECE(XNATL,U,2)
if $LENGTH(ABB)
QUIT ABB
+11 QUIT ""
+12 ;
MIN(START) ; Return elapse time
+1 IF 'START
QUIT ""
+2 QUIT $$FMDIFF^XLFDT(EDPTIME,START,2)\60
+3 ;
LMIN(LOG) ; Return time at location
+1 NEW IEN,TS,TM
SET TM=0
+2 SET TS=""
FOR
SET TS=$ORDER(^EDP(230.1,"ADF",LOG,TS),-1)
if 'TS
QUIT
Begin DoDot:1
+3 SET IEN=0
FOR
SET IEN=$ORDER(^EDP(230.1,"ADF",LOG,TS,IEN))
if 'IEN
QUIT
Begin DoDot:2
+4 IF +$PIECE($GET(^EDP(230.1,IEN,3)),U,4)
SET TM=$PIECE($GET(^EDP(230.1,IEN,0)),U,2)
End DoDot:2
if TM
QUIT
End DoDot:1
if TM
QUIT
+5 IF TM
QUIT $$FMDIFF^XLFDT(EDPTIME,TM,2)\60
+6 QUIT 0
+7 ;
HHMM(MIN) ; Format as hours:minutes
+1 ;(the colon messed up the calculations for elapsed time)
QUIT MIN
+2 ;
+3 NEW H,M
+4 SET H=MIN\60
SET M=MIN#60
+5 if $LENGTH(M)=1
SET M="0"_M
+6 QUIT H_":"_M
+7 ;
ORDSTS(LOG,STS) ; compute statuses of orders
+1 NEW IEN,X0
+2 ; oldest order, new orders
SET STS("OO")=9999999
SET STS("ON")=0
+3 SET STS("LP")=0
SET STS("LO")=9999999
SET STS("LS")=0
SET STS("LC")=0
SET STS("L")=0
+4 SET STS("RP")=0
SET STS("RO")=9999999
SET STS("RS")=0
SET STS("RC")=0
SET STS("R")=0
+5 SET IEN=0
FOR
SET IEN=$ORDER(^EDP(230,LOG,8,IEN))
if 'IEN
QUIT
Begin DoDot:1
+6 SET X0=^EDP(230,LOG,8,IEN,0)
+7 if $LENGTH($PIECE(X0,U,2))
SET STS($PIECE(X0,U,2),+X0)=""
SET STS($PIECE(X0,U,2))=$GET(STS($PIECE(X0,U,2)))+1
+8 IF ($PIECE(X0,U,3)="N")!($PIECE(X0,U,3)="A")
Begin DoDot:2
+9 ; oldest order
IF $PIECE(X0,U,5)<STS("OO")
SET STS("OO")=$PIECE(X0,U,5)
+10 IF $PIECE(X0,U,2)="L"
Begin DoDot:3
+11 ; pending labs
SET STS("LP")=STS("LP")+1
+12 ; oldest lab
IF $PIECE(X0,U,5)<STS("LO")
SET STS("LO")=$PIECE(X0,U,5)
+13 ; stat lab
IF $PIECE(X0,U,4)
SET STS("LS")=1
End DoDot:3
+14 IF $PIECE(X0,U,2)="R"
Begin DoDot:3
+15 ; pending radiology
SET STS("RP")=STS("RP")+1
+16 ; oldest radiology
IF $PIECE(X0,U,5)<STS("RO")
SET STS("RO")=$PIECE(X0,U,5)
+17 ; stat radiology
IF $PIECE(X0,U,4)
SET STS("RS")=1
End DoDot:3
End DoDot:2
+18 IF $PIECE(X0,U,3)="N"
SET STS("ON")=STS("ON")+1
+19 IF $PIECE(X0,U,3)="C"
Begin DoDot:2
+20 ; completed labs
IF $PIECE(X0,U,2)="L"
SET STS("LC")=STS("LC")+1
+21 ; completed radiology
IF $PIECE(X0,U,2)="R"
SET STS("RC")=STS("RC")+1
End DoDot:2
End DoDot:1
+22 SET STS("OO")=$SELECT(STS("OO")=9999999:0,1:$$MIN(STS("OO")))
+23 SET STS("LO")=$SELECT(STS("LO")=9999999:0,1:$$MIN(STS("LO")))
+24 SET STS("RO")=$SELECT(STS("RO")=9999999:0,1:$$MIN(STS("RO")))
+25 QUIT
+26 ;
LISTS(AREA) ; Get selection lists [from EDPQLE]
+1 NEW CHTS
+2 SET CHTS=$PIECE($GET(^EDPB(231.9,AREA,231)),U)
+3 DO XML^EDPX("<choices ts='"_CHTS_"' >")
+4 ;N CURBED S CURBED="" D BEDS^EDPQLE
+5 DO CHOICES^EDPQLE1(AREA)
+6 DO CLINLST^EDPQLE1(1)
+7 DO XML^EDPX("</choices>")
+8 QUIT
