Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: EDPQPP

EDPQPP.m

Go to the documentation of this file.
  1. EDPQPP ;SLC/KCM,MKB - Display Active Log Entries ;2/28/12 08:33am
  1. ;;2.0;EMERGENCY DEPARTMENT;;May 2, 2012;Build 103
  1. ;
  1. GET(AREA,BOARD,LAST) ; Get display board contents
  1. ;I $G(^EDPB(231.9,AREA,230))=TOKEN D XML^EDPX("<rows status='same' />") Q
  1. ;
  1. N EDPTIME S EDPTIME=$$NOW^XLFDT
  1. N EDPNOVAL S EDPNOVAL=+$O(^EDPB(233.1,"B","edp.reserved.novalue",0))
  1. N SEQ,BED,LOG,BEDS,DWHEN,DUP,ACU,LSTUPD,RELOAD,ATT
  1. ;
  1. S LSTUPD=$P($G(^EDPB(231.9,AREA,0)),U,3),RELOAD="true",LAST=$G(LAST)
  1. I (LAST="")!(LAST=LSTUPD) S RELOAD="false"
  1. S ATT("status")="new"
  1. S ATT("reloadConfig")=RELOAD
  1. S ATT("configLastUpdated")=LSTUPD
  1. S ATT("version")=$$VERSRV^EDPQAR
  1. D XML^EDPX($$XMLA^EDPX("rows",.ATT,""))
  1. ;
  1. ; Get a list of all the beds in sequence for this area
  1. S BOARD=$G(BOARD)
  1. S BED=0 F S BED=$O(^EDPB(231.8,"C",EDPSITE,AREA,BED)) Q:'BED D
  1. . S SEQ=$P(^EDPB(231.8,BED,0),U,5) S:'SEQ SEQ=99999
  1. . Q:$P(^EDPB(231.8,BED,0),U,4) ; inactive bed
  1. . S BEDS(SEQ,BED)="",BEDS("B",BED,SEQ)=""
  1. ;
  1. ; Insert the active log entries into the correct sequence for the beds
  1. S BED=0 F S BED=$O(^EDP(230,"AL",EDPSITE,AREA,BED)) Q:'BED D
  1. . S LOG=0 F S LOG=$O(^EDP(230,"AL",EDPSITE,AREA,BED,LOG)) Q:'LOG D
  1. . . I '$D(BEDS("B",BED)) S BEDS(99999,BED)="",BEDS("B",BED,99999)=""
  1. . . S SEQ=$O(BEDS("B",BED,0))
  1. . . S ACU=$P($G(^EDP(230,LOG,3)),U,3) S:'ACU ACU=99
  1. . . S BEDS(SEQ,BED,ACU,LOG)=""
  1. ;
  1. ; Loop thru the sequence of beds to create display board rows
  1. D BLDDUP^EDPQLP(.DUP,AREA)
  1. S SEQ=0 F S SEQ=$O(BEDS(SEQ)) Q:'SEQ D
  1. . S BED=0 F S BED=$O(BEDS(SEQ,BED)) Q:'BED D
  1. . . ; I $L(BOARD),($P(^EDPB(231.8,BED,0),U,11)'=BOARD) Q ; KCM - show all for patient panel
  1. . . S DWHEN=$P(^EDPB(231.8,BED,0),U,7)
  1. . . ; never display DWHEN=2
  1. . . Q:DWHEN=2
  1. . . ; always display DWHEN=1
  1. . . I ($D(BEDS(SEQ,BED))<10)&(DWHEN=1) D EMPTY(BED) Q
  1. . . ; display if occupied DWHEN=0
  1. . . S ACU=0 F S ACU=$O(BEDS(SEQ,BED,ACU)) Q:'ACU D
  1. . . . S LOG=0 F S LOG=$O(BEDS(SEQ,BED,ACU,LOG)) Q:'LOG D OCCUPIED(LOG,.DUP)
  1. ;
  1. D XML^EDPX("</rows>")
  1. Q
  1. EMPTY(BED) ; add row if unoccupied be should show
  1. N ROW
  1. S ROW("bed")=BED
  1. S ROW("bedNm")=$P(^EDPB(231.8,BED,0),U,6)
  1. D XML^EDPX($$XMLA^EDPX("row",.ROW))
  1. Q
  1. OCCUPIED(LOG,DUP) ; add log entry row
  1. N X0,X1,X3,X7,DFN,ROW,EDPRF
  1. S X0=^EDP(230,LOG,0),X1=$G(^(1)),X3=$G(^(3)),X7=$G(^(7)),DFN=$P(X0,U,6)
  1. S ROW("loadTS")=$$NOW^XLFDT
  1. S ROW("id")=LOG
  1. S ROW("ptDfn")=DFN
  1. S ROW("site")=$P(X0,U,2)
  1. S ROW("area")=$P(X0,U,3)
  1. S ROW("name")=$P(X0,U,4)
  1. S ROW("ptNm")=$P($P(X0,U,4),",")
  1. S ROW("dob")=$$DOB^EDPQLE(DFN)
  1. S ROW("ssn")=$S(DFN:$P(^DPT(DFN,0),U,9),1:"")
  1. S ROW("closed")=$P(X0,U,7)
  1. S ROW("inTS")=$P(X0,U,8)
  1. S ROW("outTS")=$P(X0,U,9)
  1. S ROW("arrival")=$$CODE^EDPQLE($P(X0,U,10))
  1. S ROW("last4")=$P(X0,U,11)
  1. S ROW("visit")=($P(X0,U,12)!$P(X0,U,13))
  1. S ROW("clinic")=$P(X0,U,14)
  1. S ROW("clinicNm")=$$LOCNM($P(X0,U,14))
  1. S ROW("bed")=BED
  1. S ROW("bedNm")=$$BEDNM^EDPQDB(BED,$P(X3,U,9))
  1. S ROW("complaint")=$P(X1,U,1)
  1. S ROW("compLong")=$G(^EDP(230,LOG,2))
  1. S ROW("comment")=$P(X3,U,8)
  1. S ROW("md")=$P(X3,U,5)
  1. S ROW("mdNm")=$$USRNM($P(X3,U,5))
  1. S ROW("mdInit")=$$INITIAL($P(X3,U,5))
  1. S ROW("rn")=$P(X3,U,6)
  1. S ROW("rnNm")=$$USRNM($P(X3,U,6))
  1. S ROW("rnInit")=$$INITIAL($P(X3,U,6))
  1. S ROW("res")=$P(X3,U,7)
  1. S ROW("resNm")=$$USRNM($P(X3,U,7))
  1. S ROW("resInit")=$$INITIAL($P(X3,U,7))
  1. S ROW("status")=$$CODE^EDPQLE($P(X3,U,2))
  1. S ROW("statusNm")=$$CAB(EDPSTA_".status",$P(X3,U,2))
  1. S ROW("acuity")=$P(X3,U,3)
  1. S ROW("acuityNm")=$$CAB(EDPSTA_".acuity",$P(X3,U,3))
  1. S ROW("delay")=$$CODE^EDPQLE($P(X1,U,5))
  1. S ROW("disposition")=$$CODE^EDPQLE($P(X1,U,2))
  1. S ROW("emins")=$$HHMM($$MIN($P(X0,U,8)))
  1. S ROW("lmins")=$$HHMM($$LMIN(LOG))
  1. S ROW("similar")=$$SIM^EDPQLP(ROW("ptNm"),ROW("last4"),.DUP)
  1. ;
  1. N STS D ORDSTS(LOG,.STS)
  1. S ROW("labUrg")=$S(STS("LS"):2,STS("LP"):1,1:0) ; any STAT labs?
  1. S ROW("radUrg")=$S(STS("RS"):2,STS("RP"):1,1:0) ; any STAT imgs?
  1. S ROW("ordNew")=STS("ON") ; number of new orders
  1. S ROW("minLab")=STS("LO") ; oldest pending/active lab
  1. S ROW("minRad")=STS("RO") ; oldest pending/active img
  1. S ROW("minVer")=STS("OO") ; oldest "new" order
  1. D XML^EDPX($$XMLA^EDPX("row",.ROW,"")) K ROW
  1. ;
  1. S ROW("num")=STS("LC")_"/"_STS("L") ; lab complete / lab total
  1. D XML^EDPX($$XMLA^EDPX("labs",.ROW,""))
  1. I $O(STS("L",0)) D
  1. . N ORD M ORD=STS("L") D ADDORD(.ORD,"lab")
  1. D XML^EDPX("</labs>") K ROW
  1. ;
  1. S ROW("num")=STS("RC")_"/"_STS("R") ; img complete / img total
  1. D XML^EDPX($$XMLA^EDPX("rads",.ROW,""))
  1. I $O(STS("R",0)) D
  1. . N ORD M ORD=STS("R") D ADDORD(.ORD,"rad")
  1. D XML^EDPX("</rads>") K ROW
  1. ;
  1. I $O(^EDP(230,LOG,4,0)) D ; diagnoses
  1. . N I,X D XML^EDPX("<diagnoses>")
  1. . S I=0 F S I=$O(^EDP(230,LOG,4,I)) Q:I<1 S X=$G(^(I,0)) D
  1. .. S ROW("name")=$P(X,U) S:$P(X,U,3) ROW("primary")="true"
  1. .. D XML^EDPX($$XMLA^EDPX("dx",.ROW)) K ROW
  1. . D XML^EDPX("</diagnoses>")
  1. ;
  1. I $P(X7,U,2) D ; vitals due
  1. . N LAST,DUE D XML^EDPX("<alerts>")
  1. . S LAST=$$LAST^EDPVIT(DFN),DUE=$$FMADD^XLFDT(LAST,,,+X7)
  1. . S ROW("name")="vitals",ROW("isDue")="false"
  1. . I DUE<$$NOW^XLFDT S ROW("isDue")="true",ROW("timeDue")=DUE
  1. . D XML^EDPX($$XMLA^EDPX("alert",.ROW)) K ROW
  1. . D XML^EDPX("</alerts>")
  1. ;
  1. I $$GETACT^DGPFAPI(DFN,"EDPRF") D
  1. . N I,X D XML^EDPX("<patientRecordFlags>")
  1. . S I=0 F S I=$O(EDPRF(I)) Q:I<1 D
  1. .. S X=$G(EDPRF(I,"APPRVBY")) I X S ROW("approvedByID")=+X,ROW("approvedByName")=$P(X,U,2)
  1. .. S X=$G(EDPRF(I,"ASSIGNDT")) I X S ROW("assignmentTS")=+X
  1. .. S X=$G(EDPRF(I,"REVIEWDT")) I X S ROW("reviewDT")=+X
  1. .. S X=$G(EDPRF(I,"FLAG")) I $L(X) S ROW("name")=$P(X,U,2)
  1. .. S X=$G(EDPRF(I,"FLAGTYPE")) I $L(X) S ROW("type")=$P(X,U,2)
  1. .. S X=$P($G(EDPRF(I,"CATEGORY")),U)
  1. .. I $L(X) S ROW("categoryID")=$P(X," "),ROW("categoryName")=$P($P(X,"(",2),")")
  1. .. S X=$G(EDPRF(I,"OWNER")) I X S X=$$NS^XUAF4(+X),ROW("ownerSiteID")=$P(X,U,2),ROW("ownerSiteName")=$P(X,U)
  1. .. S X=$G(EDPRF(I,"ORIGSITE")) I X S X=$$NS^XUAF4(+X),ROW("origSiteID")=$P(X,U,2),ROW("origSiteName")=$P(X,U)
  1. .. S X=$NA(EDPRF(I,"NARR")),ROW("text")=$$STRING(X)
  1. .. D XML^EDPX($$XMLA^EDPX("prf",.ROW)) K ROW
  1. . D XML^EDPX("</patientRecordFlags>")
  1. ;
  1. D XML^EDPX("</row>")
  1. Q
  1. ;
  1. STRING(ARRAY) ; -- Return lines of text in @ARRAY@(N,0) as string
  1. N N,Y S N=$O(@ARRAY@(0)),Y=$G(@ARRAY@(N))
  1. F S N=$O(@ARRAY@(N)) Q:N<1 S Y=Y_$C(13,10)_@ARRAY@(N)
  1. Q Y
  1. ;
  1. ADDORD(LIST,TAG) ; add order detail to XML
  1. N ROW,IFN,ORUPCHUK,STS,OI,BEG,END,X,I
  1. S IFN=0 F S IFN=+$O(LIST(IFN)) Q:IFN<1 K ROW D
  1. . S ROW("orderId")=IFN D EN^ORX8(IFN)
  1. . S STS=+$G(ORUPCHUK("ORSTS")),ROW("statusId")=STS
  1. . S ROW("statusName")=$$STATUS^EDPHIST(STS,TAG,IFN) ;result sts
  1. . S OI=$$OI^ORX8(IFN),ROW("name")=$P(OI,U,2),X=""
  1. . S BEG=$G(ORUPCHUK("ORODT")),END=$G(ORUPCHUK("ORSTOP")) S:'END END=$G(EDPTIME)
  1. . S ROW("elapsed")=$$FMDIFF^XLFDT(END,BEG,2)\60 ;#minutes
  1. . I $E(TAG)="l" D ;return X=print name
  1. .. N ORPK,IDX S ORPK=$G(ORUPCHUK("ORPK"))
  1. .. I $L(ORPK,";")<4 S X=$$GET1^DIQ(60,+$P(OI,U,3)_",",51) Q
  1. .. D RR^LR7OR1(DFN,ORPK) S IDX=$NA(^TMP("LRRR",$J,DFN)),IDX=$Q(@IDX)
  1. .. ;first? loop? panel?
  1. .. S ROW("deviation")=$P(@IDX,U,3),X=$P(@IDX,U,15)
  1. . I $E(TAG)="r" S I=+$O(^ORD(101.43,+OI,2,0)),X=$G(^(I,0))
  1. . S:$L(X) ROW("abbre")=X
  1. . D XML^EDPX($$XMLA^EDPX(TAG,.ROW))
  1. Q
  1. ;
  1. INITIAL(ID) ; Return initials
  1. Q:'ID ""
  1. Q $P(^VA(200,ID,0),U,2)
  1. ;
  1. USRNM(ID) ; Return name
  1. Q:'ID ""
  1. Q $P(^VA(200,ID,0),U)
  1. ;
  1. LOCNM(LOC) ; Return clinic name from 44
  1. Q:'LOC ""
  1. N X S X=$G(^SC(LOC,0)) ; IA#10040
  1. Q:'$L(X) ""
  1. I $L($P(X,U,2)) Q $P(X,U,2)
  1. Q $P(X,U)
  1. ;
  1. CAB(LST,IEN) ; Return code abbreviation
  1. Q:'IEN ""
  1. N LSTDA,ABB,XSITE,XNATL
  1. S LSTDA=$O(^EDPB(233.2,"AS",LST,IEN,0))
  1. S ABB="",XSITE="",XNATL=""
  1. I LSTDA S XSITE=^EDPB(233.2,"AS",LST,IEN,LSTDA)
  1. S ABB=$P(XSITE,U,1) Q:$L(ABB) ABB ;site abbreviation
  1. S XNATL=^EDPB(233.1,IEN,0)
  1. S ABB=$P(XNATL,U,3) Q:$L(ABB) ABB ;nat'l abbreviation
  1. S ABB=$P(XSITE,U,2) Q:$L(ABB) ABB ;site name
  1. S ABB=$P(XNATL,U,2) Q:$L(ABB) ABB ;nat'l name
  1. Q ""
  1. ;
  1. MIN(START) ; Return elapse time
  1. I 'START Q ""
  1. Q $$FMDIFF^XLFDT(EDPTIME,START,2)\60
  1. ;
  1. LMIN(LOG) ; Return time at location
  1. N IEN,TS,TM S TM=0
  1. S TS="" F S TS=$O(^EDP(230.1,"ADF",LOG,TS),-1) Q:'TS D Q:TM
  1. . S IEN=0 F S IEN=$O(^EDP(230.1,"ADF",LOG,TS,IEN)) Q:'IEN D Q:TM
  1. . . I +$P($G(^EDP(230.1,IEN,3)),U,4) S TM=$P($G(^EDP(230.1,IEN,0)),U,2)
  1. I TM Q $$FMDIFF^XLFDT(EDPTIME,TM,2)\60
  1. Q 0
  1. ;
  1. HHMM(MIN) ; Format as hours:minutes
  1. Q MIN ;(the colon messed up the calculations for elapsed time)
  1. ;
  1. N H,M
  1. S H=MIN\60,M=MIN#60
  1. S:$L(M)=1 M="0"_M
  1. Q H_":"_M
  1. ;
  1. ORDSTS(LOG,STS) ; compute statuses of orders
  1. N IEN,X0
  1. S STS("OO")=9999999,STS("ON")=0 ; oldest order, new orders
  1. S STS("LP")=0,STS("LO")=9999999,STS("LS")=0,STS("LC")=0,STS("L")=0
  1. S STS("RP")=0,STS("RO")=9999999,STS("RS")=0,STS("RC")=0,STS("R")=0
  1. S IEN=0 F S IEN=$O(^EDP(230,LOG,8,IEN)) Q:'IEN D
  1. . S X0=^EDP(230,LOG,8,IEN,0)
  1. . S:$L($P(X0,U,2)) STS($P(X0,U,2),+X0)="",STS($P(X0,U,2))=$G(STS($P(X0,U,2)))+1
  1. . I ($P(X0,U,3)="N")!($P(X0,U,3)="A") D
  1. . . I $P(X0,U,5)<STS("OO") S STS("OO")=$P(X0,U,5) ; oldest order
  1. . . I $P(X0,U,2)="L" D
  1. . . . S STS("LP")=STS("LP")+1 ; pending labs
  1. . . . I $P(X0,U,5)<STS("LO") S STS("LO")=$P(X0,U,5) ; oldest lab
  1. . . . I $P(X0,U,4) S STS("LS")=1 ; stat lab
  1. . . I $P(X0,U,2)="R" D
  1. . . . S STS("RP")=STS("RP")+1 ; pending radiology
  1. . . . I $P(X0,U,5)<STS("RO") S STS("RO")=$P(X0,U,5) ; oldest radiology
  1. . . . I $P(X0,U,4) S STS("RS")=1 ; stat radiology
  1. . I $P(X0,U,3)="N" S STS("ON")=STS("ON")+1
  1. . I $P(X0,U,3)="C" D
  1. . . I $P(X0,U,2)="L" S STS("LC")=STS("LC")+1 ; completed labs
  1. . . I $P(X0,U,2)="R" S STS("RC")=STS("RC")+1 ; completed radiology
  1. S STS("OO")=$S(STS("OO")=9999999:0,1:$$MIN(STS("OO")))
  1. S STS("LO")=$S(STS("LO")=9999999:0,1:$$MIN(STS("LO")))
  1. S STS("RO")=$S(STS("RO")=9999999:0,1:$$MIN(STS("RO")))
  1. Q
  1. ;
  1. LISTS(AREA) ; Get selection lists [from EDPQLE]
  1. N CHTS
  1. S CHTS=$P($G(^EDPB(231.9,AREA,231)),U)
  1. D XML^EDPX("<choices ts='"_CHTS_"' >")
  1. ;N CURBED S CURBED="" D BEDS^EDPQLE
  1. D CHOICES^EDPQLE1(AREA)
  1. D CLINLST^EDPQLE1(1)
  1. D XML^EDPX("</choices>")
  1. Q