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