EDPQDB ;SLC/KCM - Display Active Log Entries ; 4/18/23 7:58am
;;2.0;EMERGENCY DEPARTMENT;**6,15,23**;Feb 24, 2012;Build 4
;
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 SEQ,BED,LOG,BEDS,BED2,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="" 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
. . S BED2=BED
. . 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
. . I BED=0 S BED2=$P(^EDPB(231.9,AREA,1),U,12),SEQ=$P(^EDPB(231.8,BED2,0),U,5) ; Patch 15
. . S BEDS(SEQ,BED2,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
. . 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,ROW,ADMT,NOADMT,CTIME,EDPDISP
S X0=^EDP(230,LOG,0),X1=$G(^(1)),X3=$G(^(3)),X7=$G(^(7))
S ROW("id")=LOG
;S ROW("bed")=$$BEDNM(BED,$P(X3,U,9))
S ROW("bed")=BED
S ROW("bedNm")=$P(^EDPB(231.8,BED,0),U,6)
S ROW("ptNm")=$P($P(X0,U,4),",")
S ROW("ptDfn")=$P(X0,U,6)
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("complaint")=$P(X1,U,1)
S ROW("comment")=$P(X3,U,8)
S ROW("md")=$P(X3,U,5)
S ROW("mdNm")=$$INITIAL($P(X3,U,5))
S ROW("rn")=$P(X3,U,6)
S ROW("rnNm")=$$INITIAL($P(X3,U,6))
S ROW("res")=$P(X3,U,7)
S ROW("resNm")=$$INITIAL($P(X3,U,7))
S ROW("status")=$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("emins")=$$HHMM($$MIN($P(X0,U,8)))
S ROW("lmins")=$$HHMM($$LMIN(LOG))
S ROW("similar")=$$SIM^EDPQLP(ROW("ptNm"),ROW("last4"),.DUP)
;8/14/11 - Adding disposition to display board
;4/23/13 - bwf - replacing line below with the one that follows
;S ROW("disposition")=$$GET1^DIQ(233.1,$P(X1,U,2),.02,"E")
S ROW("disposition")=$$CAB(EDPSTA_".disposition",$P(X1,U,2))
;*23 Admission Time & Door to Doc Time
S ADMT=$$ADMIT^EDPRPT(LOG),CTIME=$$NOW^XLFDT,EDPDISP=$G(^EDP(230,LOG,1))
I $P(EDPDISP,U,2),$P($G(^EDPB(233.1,+$P(EDPDISP,U,2),0)),U,5)'["A" S NOADMT=1
I ADMT="" S ROW("amins")="",NOADMT=1
I '$G(NOADMT) S ROW("amins")=$$HHMM($$FMDIFF^XLFDT(CTIME,ADMT,2)\60)
S ROW("d2d")=$$HHMM($$FMDIFF^XLFDT($$MD^EDPRPT(LOG),$P(X0,U,8),2)\60)
I ROW("d2d")<0 S ROW("d2d")=""
;
N STS D ORDSTS(LOG,.STS)
; ROW("lab")=STS("LP")_"/"_STS("LC") ; lab pending / lab complete
S ROW("lab")=STS("LP")_"/"_STS("LC") ; lab pending / lab complete
S ROW("labUrg")=$S(STS("LS"):2,STS("LP"):1,1:0) ; any STAT labs?
; ROW("rad")=STS("RP")_"/"_STS("RC") ; img pending / img complete
S ROW("rad")=STS("RP")_"/"_STS("RC")
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("LP")_"/"_STS("LC") ; lab pending / lab complete
D XML^EDPX($$XMLA^EDPX("labs",.ROW,""))
;4/26/13 - BWF removed following two lines
;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("RP")_"/"_STS("RC") ; img pending / img complete
D XML^EDPX($$XMLA^EDPX("rads",.ROW,""))
;4/26/13 - BWF removed following two lines
;I $O(STS("R",0)) D
;. N ORD M ORD=STS("R") D ADDORD(.ORD,"rad")
D XML^EDPX("</rads>")
;
I $P(X7,U,2) D ; vitals due
. N LAST,DUE D XML^EDPX("<alerts>")
. S LAST=$$LAST^EDPVIT($P(X0,U,6)),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>")
;
D XML^EDPX("</row>")
Q
;
ADDORD(LIST,TAG) ; add order detail to XML
N ROW,IFN,OI,X,I
S IFN=0 F S IFN=+$O(LIST(IFN)) Q:IFN<1 K ROW D
. S ROW("orderId")=IFN
. S ROW("status")=$$GET1^DIQ(100,IFN_",",5)
. S OI=$$OI^ORX8(IFN),ROW("name")=$P(OI,U,2),X=""
. I $E(TAG)="l" S X=$$GET1^DIQ(60,+$P(OI,U,3)_",",51)
. 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(LOCID) ; Return initials
Q:'LOCID ""
Q $P(^VA(200,LOCID,0),U,2)
;
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)
;
BEDNM(CURBED,HELDBED) ; Return string for bed
N X S X=$P(^EDPB(231.8,CURBED,0),U,6)
I +HELDBED S X=X_" ("_$P(^EDPB(231.8,HELDBED,0),U,6)_")"
Q X
;
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
S STS("RP")=0,STS("RO")=9999999,STS("RS")=0,STS("RC")=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)=""
. 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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEDPQDB 8847 printed Apr 09, 2024@20:57:33 Page 2
EDPQDB ;SLC/KCM - Display Active Log Entries ; 4/18/23 7:58am
+1 ;;2.0;EMERGENCY DEPARTMENT;**6,15,23**;Feb 24, 2012;Build 4
+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 SEQ,BED,LOG,BEDS,BED2,DWHEN,DUP,ACU,LSTUPD,RELOAD,ATT
+5 ;
+6 SET LSTUPD=$PIECE($GET(^EDPB(231.9,AREA,0)),U,3)
SET RELOAD="true"
SET LAST=$GET(LAST)
+7 IF (LAST="")!(LAST=LSTUPD)
SET RELOAD="false"
+8 SET ATT("status")="new"
+9 SET ATT("reloadConfig")=RELOAD
+10 SET ATT("configLastUpdated")=LSTUPD
+11 SET ATT("version")=$$VERSRV^EDPQAR
+12 DO XML^EDPX($$XMLA^EDPX("rows",.ATT,""))
+13 ;
+14 ; Get a list of all the beds in sequence for this area
+15 SET BOARD=$GET(BOARD)
+16 SET BED=0
FOR
SET BED=$ORDER(^EDPB(231.8,"C",EDPSITE,AREA,BED))
if 'BED
QUIT
Begin DoDot:1
+17 SET SEQ=$PIECE(^EDPB(231.8,BED,0),U,5)
if 'SEQ
SET SEQ=99999
+18 ; inactive bed
if $PIECE(^EDPB(231.8,BED,0),U,4)
QUIT
+19 SET BEDS(SEQ,BED)=""
SET BEDS("B",BED,SEQ)=""
End DoDot:1
+20 ;
+21 ; Insert the active log entries into the correct sequence for the beds
+22 SET BED=""
FOR
SET BED=$ORDER(^EDP(230,"AL",EDPSITE,AREA,BED))
if BED=""
QUIT
Begin DoDot:1
+23 SET LOG=0
FOR
SET LOG=$ORDER(^EDP(230,"AL",EDPSITE,AREA,BED,LOG))
if 'LOG
QUIT
Begin DoDot:2
+24 SET BED2=BED
+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 ; Patch 15
IF BED=0
SET BED2=$PIECE(^EDPB(231.9,AREA,1),U,12)
SET SEQ=$PIECE(^EDPB(231.8,BED2,0),U,5)
+29 SET BEDS(SEQ,BED2,ACU,LOG)=""
End DoDot:2
End DoDot:1
+30 ;
+31 ; Loop thru the sequence of beds to create display board rows
+32 DO BLDDUP^EDPQLP(.DUP,AREA)
+33 SET SEQ=0
FOR
SET SEQ=$ORDER(BEDS(SEQ))
if 'SEQ
QUIT
Begin DoDot:1
+34 SET BED=0
FOR
SET BED=$ORDER(BEDS(SEQ,BED))
if 'BED
QUIT
Begin DoDot:2
+35 IF $LENGTH(BOARD)
IF ($PIECE(^EDPB(231.8,BED,0),U,11)'=BOARD)
QUIT
+36 SET DWHEN=$PIECE(^EDPB(231.8,BED,0),U,7)
+37 ; never display DWHEN=2
+38 if DWHEN=2
QUIT
+39 ; always display DWHEN=1
+40 IF ($DATA(BEDS(SEQ,BED))<10)&(DWHEN=1)
DO EMPTY(BED)
QUIT
+41 ; display if occupied DWHEN=0
+42 SET ACU=0
FOR
SET ACU=$ORDER(BEDS(SEQ,BED,ACU))
if 'ACU
QUIT
Begin DoDot:3
+43 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
+44 ;
+45 DO XML^EDPX("</rows>")
+46 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,ROW,ADMT,NOADMT,CTIME,EDPDISP
+2 SET X0=^EDP(230,LOG,0)
SET X1=$GET(^(1))
SET X3=$GET(^(3))
SET X7=$GET(^(7))
+3 SET ROW("id")=LOG
+4 ;S ROW("bed")=$$BEDNM(BED,$P(X3,U,9))
+5 SET ROW("bed")=BED
+6 SET ROW("bedNm")=$PIECE(^EDPB(231.8,BED,0),U,6)
+7 SET ROW("ptNm")=$PIECE($PIECE(X0,U,4),",")
+8 SET ROW("ptDfn")=$PIECE(X0,U,6)
+9 SET ROW("last4")=$PIECE(X0,U,11)
+10 SET ROW("visit")=($PIECE(X0,U,12)!$PIECE(X0,U,13))
+11 SET ROW("clinic")=$PIECE(X0,U,14)
+12 SET ROW("clinicNm")=$$LOCNM($PIECE(X0,U,14))
+13 SET ROW("complaint")=$PIECE(X1,U,1)
+14 SET ROW("comment")=$PIECE(X3,U,8)
+15 SET ROW("md")=$PIECE(X3,U,5)
+16 SET ROW("mdNm")=$$INITIAL($PIECE(X3,U,5))
+17 SET ROW("rn")=$PIECE(X3,U,6)
+18 SET ROW("rnNm")=$$INITIAL($PIECE(X3,U,6))
+19 SET ROW("res")=$PIECE(X3,U,7)
+20 SET ROW("resNm")=$$INITIAL($PIECE(X3,U,7))
+21 SET ROW("status")=$PIECE(X3,U,2)
+22 SET ROW("statusNm")=$$CAB(EDPSTA_".status",$PIECE(X3,U,2))
+23 SET ROW("acuity")=$PIECE(X3,U,3)
+24 SET ROW("acuityNm")=$$CAB(EDPSTA_".acuity",$PIECE(X3,U,3))
+25 SET ROW("emins")=$$HHMM($$MIN($PIECE(X0,U,8)))
+26 SET ROW("lmins")=$$HHMM($$LMIN(LOG))
+27 SET ROW("similar")=$$SIM^EDPQLP(ROW("ptNm"),ROW("last4"),.DUP)
+28 ;8/14/11 - Adding disposition to display board
+29 ;4/23/13 - bwf - replacing line below with the one that follows
+30 ;S ROW("disposition")=$$GET1^DIQ(233.1,$P(X1,U,2),.02,"E")
+31 SET ROW("disposition")=$$CAB(EDPSTA_".disposition",$PIECE(X1,U,2))
+32 ;*23 Admission Time & Door to Doc Time
+33 SET ADMT=$$ADMIT^EDPRPT(LOG)
SET CTIME=$$NOW^XLFDT
SET EDPDISP=$GET(^EDP(230,LOG,1))
+34 IF $PIECE(EDPDISP,U,2)
IF $PIECE($GET(^EDPB(233.1,+$PIECE(EDPDISP,U,2),0)),U,5)'["A"
SET NOADMT=1
+35 IF ADMT=""
SET ROW("amins")=""
SET NOADMT=1
+36 IF '$GET(NOADMT)
SET ROW("amins")=$$HHMM($$FMDIFF^XLFDT(CTIME,ADMT,2)\60)
+37 SET ROW("d2d")=$$HHMM($$FMDIFF^XLFDT($$MD^EDPRPT(LOG),$PIECE(X0,U,8),2)\60)
+38 IF ROW("d2d")<0
SET ROW("d2d")=""
+39 ;
+40 NEW STS
DO ORDSTS(LOG,.STS)
+41 ; ROW("lab")=STS("LP")_"/"_STS("LC") ; lab pending / lab complete
+42 ; lab pending / lab complete
SET ROW("lab")=STS("LP")_"/"_STS("LC")
+43 ; any STAT labs?
SET ROW("labUrg")=$SELECT(STS("LS"):2,STS("LP"):1,1:0)
+44 ; ROW("rad")=STS("RP")_"/"_STS("RC") ; img pending / img complete
+45 SET ROW("rad")=STS("RP")_"/"_STS("RC")
+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 pending / lab complete
SET ROW("num")=STS("LP")_"/"_STS("LC")
+54 DO XML^EDPX($$XMLA^EDPX("labs",.ROW,""))
+55 ;4/26/13 - BWF removed following two lines
+56 ;I $O(STS("L",0)) D
+57 ;. N ORD M ORD=STS("L") D ADDORD(.ORD,"lab")
+58 DO XML^EDPX("</labs>")
KILL ROW
+59 ;
+60 ; img pending / img complete
SET ROW("num")=STS("RP")_"/"_STS("RC")
+61 DO XML^EDPX($$XMLA^EDPX("rads",.ROW,""))
+62 ;4/26/13 - BWF removed following two lines
+63 ;I $O(STS("R",0)) D
+64 ;. N ORD M ORD=STS("R") D ADDORD(.ORD,"rad")
+65 DO XML^EDPX("</rads>")
+66 ;
+67 ; vitals due
IF $PIECE(X7,U,2)
Begin DoDot:1
+68 NEW LAST,DUE
DO XML^EDPX("<alerts>")
+69 SET LAST=$$LAST^EDPVIT($PIECE(X0,U,6))
SET DUE=$$FMADD^XLFDT(LAST,,,+X7)
+70 SET ROW("name")="vitals"
SET ROW("isDue")="false"
+71 IF DUE<$$NOW^XLFDT
SET ROW("isDue")="true"
SET ROW("timeDue")=DUE
+72 DO XML^EDPX($$XMLA^EDPX("alert",.ROW))
KILL ROW
+73 DO XML^EDPX("</alerts>")
End DoDot:1
+74 ;
+75 DO XML^EDPX("</row>")
+76 QUIT
+77 ;
ADDORD(LIST,TAG) ; add order detail to XML
+1 NEW ROW,IFN,OI,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
+4 SET ROW("status")=$$GET1^DIQ(100,IFN_",",5)
+5 SET OI=$$OI^ORX8(IFN)
SET ROW("name")=$PIECE(OI,U,2)
SET X=""
+6 IF $EXTRACT(TAG)="l"
SET X=$$GET1^DIQ(60,+$PIECE(OI,U,3)_",",51)
+7 IF $EXTRACT(TAG)="r"
SET I=+$ORDER(^ORD(101.43,+OI,2,0))
SET X=$GET(^(I,0))
+8 if $LENGTH(X)
SET ROW("abbre")=X
+9 DO XML^EDPX($$XMLA^EDPX(TAG,.ROW))
End DoDot:1
+10 QUIT
+11 ;
INITIAL(LOCID) ; Return initials
+1 if 'LOCID
QUIT ""
+2 QUIT $PIECE(^VA(200,LOCID,0),U,2)
+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 ;
BEDNM(CURBED,HELDBED) ; Return string for bed
+1 NEW X
SET X=$PIECE(^EDPB(231.8,CURBED,0),U,6)
+2 IF +HELDBED
SET X=X_" ("_$PIECE(^EDPB(231.8,HELDBED,0),U,6)_")"
+3 QUIT X
+4 ;
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
+4 SET STS("RP")=0
SET STS("RO")=9999999
SET STS("RS")=0
SET STS("RC")=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)=""
+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
