EDPLOGH ;SLC/KCM - Add History Entry for ED Log ;2/28/12 08:33am
;;2.0;EMERGENCY DEPARTMENT;**6**;Feb 24, 2012;Build 200
;
;TODO: add transaction processing
;
SAVE(IEN,TIME,HIST) ; save a new history entry for changed fields
Q:$D(HIST)<10
;
N HISTIEN,DIERR
S HIST(230.1,"+1,",.01)=IEN
S HIST(230.1,"+1,",.02)=TIME
S HIST(230.1,"+1,",.03)=EDPUSER
D UPDATE^DIE("","HIST","HISTIEN","ERR")
Q
COLLIDE(LOG,LOADTS) ; return true if new updates since load time
N I,J,TS,IEN,FLDS,MODS
;S TS=LOADTS-0.000001
S TS=LOADTS
F S TS=$O(^EDP(230.1,"ADF",LOG,TS)) Q:'TS D
. S IEN=0 F S IEN=$O(^EDP(230.1,"ADF",LOG,TS,IEN)) Q:'IEN D
.. S MODS=$P($G(^EDP(230.1,IEN,9)),U)
.. F J=1:1:$L(MODS,";") I $L($P(MODS,";",J)) S FLDS($P(MODS,";",J))=""
; no collisions
I $D(FLDS)<10 Q 0
;
; handle collisions
D XML^EDPX("<upd id='"_LOG_"' status='collision' loadTS='"_$$NOW^XLFDT_"'>")
D XML^EDPX("Since you loaded this entry, changes have been made by someone else:")
D XML^EDPX(" ")
N X,X0,X1,X2,X3,PT
S X0=^EDP(230,LOG,0),X1=$G(^(1)),X2=$G(^(2)),X3=$G(^(3)),PT=0
S I=0 F S I=$O(FLDS(I)) Q:'I D
. I I=.04 S X=$P(X0,U,4) D MSG(X,"Patient Name") S PT=1
. I (I=.06),'PT S X=$P(X0,U,6) D MSG($P($G(^DPT(+X,0)),U),"Patient Name")
. I I=.1 S X=$P(X0,U,10) D MSG($$CODE(X),"Source")
. I I=1.1 S X=$P(X1,U,1) D MSG(X,"Complaint")
. I I=1.2 S X=$P(X1,U,2) D MSG($$CODE(X),"Disposition")
. I I=1.5 S X=$P(X1,U,5) D MSG($$CODE(X),"Delay Reason")
. I I=2 S X=$P(X2,U,1) D MSG(X,"Long Complaint")
. I I=3.2 S X=$P(X3,U,2) D MSG($$CODE(X),"Status")
. I I=3.3 S X=$P(X3,U,3) D MSG($$CODE(X),"Acuity")
. I I=3.4 S X=$P(X3,U,4) D MSG($P($G(^EDPB(231.8,+X,0)),U),"Room/Area")
. I I=3.5 S X=$P(X3,U,5) D MSG($$NP(X),"Provider")
. I I=3.6 S X=$P(X3,U,6) D MSG($$NP(X),"Nurse")
. I I=3.7 S X=$P(X3,U,7) D MSG($$NP(X),"Resident")
. I I=3.8 S X=$P(X3,U,8) D MSG(X,"Comment")
. I I=4 D MSG($$DIAG(LOG),"Diagnosis")
D XML^EDPX(" ")
D XML^EDPX("If you wish to overwrite with your changes,")
D XML^EDPX("close this window and click SAVE again.")
D XML^EDPX("If you wish to leave this entry as is,")
D XML^EDPX("close this window and click CANCEL.")
D XML^EDPX("</upd>")
Q 1
;
BEDGONE(AREA,CURBED,HOLDBED,BED) ; return true if bed is no longer available
I 'BED Q 0
I BED=CURBED Q 0
I BED=HOLDBED Q 0
N MULTI S MULTI=$P(^EDPB(231.8,BED,0),U,9) S:MULTI=3 MULTI=0
I MULTI Q 0
N OCCUPIED
S OCCUPIED=$D(^EDP(230,"AL",EDPSITE,AREA,BED))!$D(^EDP(230,"AH",EDPSITE,AREA,BED))
I 'OCCUPIED Q 0
Q 1
;
UPDHOLD(FDA,IEN,CURBED) ; hold the current bed if primary > secondary
Q:'$G(FDA(230,IEN_",",3.4)) ; no change in bed
N NEWBED,HOLDBED
S NEWBED=FDA(230,IEN_",",3.4),HOLDBED=""
; new bed is none, set hold bed to none
I (NEWBED="@")!(NEWBED=0) S HOLDBED="@"
; new bed is primary, set hold bed to none
I NEWBED,($P(^EDPB(231.8,NEWBED,0),U,13)<2) S HOLDBED="@"
; new bed is secondary, set hold bed to current bed if primary
I ($P(^EDPB(231.8,NEWBED,0),U,13)=2),($P(^EDPB(231.8,CURBED,0),U,13)<2) S HOLDBED=CURBED
;
I $L(HOLDBED) S FDA(230,IEN_",",3.9)=HOLDBED
Q
MSG(VAL,LBL) ; add to XML message
D XML^EDPX(LBL_" changed to: "_VAL)
Q
CODE(IEN) ; return coded value
I IEN Q $P(^EDPB(233.1,IEN,0),U,2)
Q ""
NP(IEN) ; return New Person name
I IEN Q $P(^VA(200,IEN,0),U)
Q ""
DIAG(LOG) ; return list of diagnoses
N I,X
S I=0,X=""
F S I=$O(^EDP(230,LOG,4,I)) Q:'I S X=X_$S($L(X):",",1:"")_$P($G(^EDP(230,LOG,4,I,0)),U)
Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEDPLOGH 3534 printed Dec 13, 2024@01:52:01 Page 2
EDPLOGH ;SLC/KCM - Add History Entry for ED Log ;2/28/12 08:33am
+1 ;;2.0;EMERGENCY DEPARTMENT;**6**;Feb 24, 2012;Build 200
+2 ;
+3 ;TODO: add transaction processing
+4 ;
SAVE(IEN,TIME,HIST) ; save a new history entry for changed fields
+1 if $DATA(HIST)<10
QUIT
+2 ;
+3 NEW HISTIEN,DIERR
+4 SET HIST(230.1,"+1,",.01)=IEN
+5 SET HIST(230.1,"+1,",.02)=TIME
+6 SET HIST(230.1,"+1,",.03)=EDPUSER
+7 DO UPDATE^DIE("","HIST","HISTIEN","ERR")
+8 QUIT
COLLIDE(LOG,LOADTS) ; return true if new updates since load time
+1 NEW I,J,TS,IEN,FLDS,MODS
+2 ;S TS=LOADTS-0.000001
+3 SET TS=LOADTS
+4 FOR
SET TS=$ORDER(^EDP(230.1,"ADF",LOG,TS))
if 'TS
QUIT
Begin DoDot:1
+5 SET IEN=0
FOR
SET IEN=$ORDER(^EDP(230.1,"ADF",LOG,TS,IEN))
if 'IEN
QUIT
Begin DoDot:2
+6 SET MODS=$PIECE($GET(^EDP(230.1,IEN,9)),U)
+7 FOR J=1:1:$LENGTH(MODS,";")
IF $LENGTH($PIECE(MODS,";",J))
SET FLDS($PIECE(MODS,";",J))=""
End DoDot:2
End DoDot:1
+8 ; no collisions
+9 IF $DATA(FLDS)<10
QUIT 0
+10 ;
+11 ; handle collisions
+12 DO XML^EDPX("<upd id='"_LOG_"' status='collision' loadTS='"_$$NOW^XLFDT_"'>")
+13 DO XML^EDPX("Since you loaded this entry, changes have been made by someone else:")
+14 DO XML^EDPX(" ")
+15 NEW X,X0,X1,X2,X3,PT
+16 SET X0=^EDP(230,LOG,0)
SET X1=$GET(^(1))
SET X2=$GET(^(2))
SET X3=$GET(^(3))
SET PT=0
+17 SET I=0
FOR
SET I=$ORDER(FLDS(I))
if 'I
QUIT
Begin DoDot:1
+18 IF I=.04
SET X=$PIECE(X0,U,4)
DO MSG(X,"Patient Name")
SET PT=1
+19 IF (I=.06)
IF 'PT
SET X=$PIECE(X0,U,6)
DO MSG($PIECE($GET(^DPT(+X,0)),U),"Patient Name")
+20 IF I=.1
SET X=$PIECE(X0,U,10)
DO MSG($$CODE(X),"Source")
+21 IF I=1.1
SET X=$PIECE(X1,U,1)
DO MSG(X,"Complaint")
+22 IF I=1.2
SET X=$PIECE(X1,U,2)
DO MSG($$CODE(X),"Disposition")
+23 IF I=1.5
SET X=$PIECE(X1,U,5)
DO MSG($$CODE(X),"Delay Reason")
+24 IF I=2
SET X=$PIECE(X2,U,1)
DO MSG(X,"Long Complaint")
+25 IF I=3.2
SET X=$PIECE(X3,U,2)
DO MSG($$CODE(X),"Status")
+26 IF I=3.3
SET X=$PIECE(X3,U,3)
DO MSG($$CODE(X),"Acuity")
+27 IF I=3.4
SET X=$PIECE(X3,U,4)
DO MSG($PIECE($GET(^EDPB(231.8,+X,0)),U),"Room/Area")
+28 IF I=3.5
SET X=$PIECE(X3,U,5)
DO MSG($$NP(X),"Provider")
+29 IF I=3.6
SET X=$PIECE(X3,U,6)
DO MSG($$NP(X),"Nurse")
+30 IF I=3.7
SET X=$PIECE(X3,U,7)
DO MSG($$NP(X),"Resident")
+31 IF I=3.8
SET X=$PIECE(X3,U,8)
DO MSG(X,"Comment")
+32 IF I=4
DO MSG($$DIAG(LOG),"Diagnosis")
End DoDot:1
+33 DO XML^EDPX(" ")
+34 DO XML^EDPX("If you wish to overwrite with your changes,")
+35 DO XML^EDPX("close this window and click SAVE again.")
+36 DO XML^EDPX("If you wish to leave this entry as is,")
+37 DO XML^EDPX("close this window and click CANCEL.")
+38 DO XML^EDPX("</upd>")
+39 QUIT 1
+40 ;
BEDGONE(AREA,CURBED,HOLDBED,BED) ; return true if bed is no longer available
+1 IF 'BED
QUIT 0
+2 IF BED=CURBED
QUIT 0
+3 IF BED=HOLDBED
QUIT 0
+4 NEW MULTI
SET MULTI=$PIECE(^EDPB(231.8,BED,0),U,9)
if MULTI=3
SET MULTI=0
+5 IF MULTI
QUIT 0
+6 NEW OCCUPIED
+7 SET OCCUPIED=$DATA(^EDP(230,"AL",EDPSITE,AREA,BED))!$DATA(^EDP(230,"AH",EDPSITE,AREA,BED))
+8 IF 'OCCUPIED
QUIT 0
+9 QUIT 1
+10 ;
UPDHOLD(FDA,IEN,CURBED) ; hold the current bed if primary > secondary
+1 ; no change in bed
if '$GET(FDA(230,IEN_",",3.4))
QUIT
+2 NEW NEWBED,HOLDBED
+3 SET NEWBED=FDA(230,IEN_",",3.4)
SET HOLDBED=""
+4 ; new bed is none, set hold bed to none
+5 IF (NEWBED="@")!(NEWBED=0)
SET HOLDBED="@"
+6 ; new bed is primary, set hold bed to none
+7 IF NEWBED
IF ($PIECE(^EDPB(231.8,NEWBED,0),U,13)<2)
SET HOLDBED="@"
+8 ; new bed is secondary, set hold bed to current bed if primary
+9 IF ($PIECE(^EDPB(231.8,NEWBED,0),U,13)=2)
IF ($PIECE(^EDPB(231.8,CURBED,0),U,13)<2)
SET HOLDBED=CURBED
+10 ;
+11 IF $LENGTH(HOLDBED)
SET FDA(230,IEN_",",3.9)=HOLDBED
+12 QUIT
MSG(VAL,LBL) ; add to XML message
+1 DO XML^EDPX(LBL_" changed to: "_VAL)
+2 QUIT
CODE(IEN) ; return coded value
+1 IF IEN
QUIT $PIECE(^EDPB(233.1,IEN,0),U,2)
+2 QUIT ""
NP(IEN) ; return New Person name
+1 IF IEN
QUIT $PIECE(^VA(200,IEN,0),U)
+2 QUIT ""
DIAG(LOG) ; return list of diagnoses
+1 NEW I,X
+2 SET I=0
SET X=""
+3 FOR
SET I=$ORDER(^EDP(230,LOG,4,I))
if 'I
QUIT
SET X=X_$SELECT($LENGTH(X):",",1:"")_$PIECE($GET(^EDP(230,LOG,4,I,0)),U)
+4 QUIT X
