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

EDPLOG.m

Go to the documentation of this file.
  1. EDPLOG ;SLC/KCM - Update ED Log - Update ;2/28/12 08:33am
  1. ;;2.0;EMERGENCY DEPARTMENT;**6,2**;Feb 24, 2012;Build 23
  1. ;
  1. ;TODO: add transaction processing
  1. ;
  1. UPD(REQ,REMOVE,RESTORE) ; Update a record
  1. N REC,EDPFAIL D NVPARSE^EDPX(.REC,REQ)
  1. S EDPFAIL=0
  1. N IEN S IEN=$$VAL("id")
  1. I '$G(IEN) D FAIL("upd",2300007) Q EDPFAIL
  1. I '$D(^EDP(230,IEN,0)) D FAIL("upd",2300006) Q EDPFAIL
  1. N ERR S ERR=$$VALID^EDPLOG1(.REC) I $L(ERR) D FAIL("upd",ERR) Q EDPFAIL
  1. N AMB S AMB="(ambulance en route)"
  1. ;
  1. ; compute the local time & "no value" ien
  1. N TIME S TIME=$$NOW^XLFDT
  1. N EDPNOVAL S EDPNOVAL=+$O(^EDPB(233.1,"B","edp.reserved.novalue",0))
  1. ; before allowing remove, check the required fields
  1. S REMOVE=$G(REMOVE,0)!$P(^EDP(230,IEN,0),U,7) ; removing or closed
  1. S RESTORE=$G(RESTORE,"") ; restoring to board
  1. I REMOVE D RDY2RMV I 'REC("closed") Q EDPFAIL
  1. I REMOVE S REC("closedBy")=$G(DUZ) ; if we are removing, set up the 'closedBy' and 'closed' value
  1. ;
  1. ; get the existing log entry
  1. N X0,X1,X2,X3,AREA,I
  1. S X0=^EDP(230,IEN,0),X1=$G(^(1)),X2=$G(^(2)),X3=$G(^(3))
  1. S AREA=$P(X0,U,3),^EDPB(231.9,AREA,230)=$H ; last update timestamp
  1. ;
  1. ; if we are restoring to the board, set 'closed' to "" (removing the closed status)
  1. ; and set the bed to the waiting room
  1. I RESTORE D
  1. .S REC("closed")="",REC("bed")=$P(^EDPB(231.9,AREA,1),U,12),REC("restoredBy")=$G(DUZ),REC("restorePatient")=1,REC("outTS")=""
  1. .; if a bed is not defined at this point, use the EDIS_DEFAULT bed
  1. .I 'REC("bed") S REC("bed")=$O(^EDPB(231.8,"B","EDIS_DEFAULT",0))
  1. ;
  1. N NAME,DFN,SSN,PCE
  1. S NAME=$$VAL("name"),DFN=$$VAL("dfn"),SSN=""
  1. I DFN S SSN=$P(^DPT(DFN,0),U,9)
  1. I '$P(X0,U,8),((NAME'=AMB)!DFN) S REC("inTS")=TIME
  1. ; Update any fields that have values passed in
  1. N FDA,FDAIEN,DIERR,HIST
  1. D SETFDA(X0,4,"name",.04)
  1. ;D SETFDA(X0,5,"ssn",.05) -- NtoL
  1. D SETFDA(X0,6,"dfn",.06)
  1. D SETFDA(X0,7,"closed",.07)
  1. D SETFDA(X0,8,"inTS",.08)
  1. D SETFDA(X0,9,"outTS",.09)
  1. D SETFDA(X0,10,"arrival",.1)
  1. D SETFDA(X0,14,"clinic",.14)
  1. D SETFDA(X1,1,"complaint",1.1)
  1. D SETFDA(X2,1,"compLong",2)
  1. D SETFDA(X3,2,"status",3.2)
  1. D SETFDA(X3,3,"acuity",3.3)
  1. D SETFDA(X3,4,"bed",3.4)
  1. D SETFDA(X3,5,"provider",3.5)
  1. D SETFDA(X3,6,"nurse",3.6)
  1. D SETFDA(X3,7,"resident",3.7)
  1. D SETFDA(X3,8,"comment",3.8)
  1. D SETFDA(X1,5,"delay",1.5)
  1. D SETFDA(X1,2,"disposition",1.2)
  1. ; 10-18-2011 bwf: add handling of fields related to removal and restoring of patient to the board
  1. I $G(REMOVE) D
  1. .D SETFDA(X0,16,"closedBy",.072) ; DFN of the user who 'closed' this record.
  1. I $G(RESTORE) D
  1. .; bwf - 2/16/2012
  1. .; The following fields should only be set if this record is actually being restored to the board
  1. .; There is a trigger x-ref that we need to stay consistent and not be changing every time we save the log entry.
  1. .D SETFDA(X0,17,"restorePatient",.073) ; flag - if the entry is found to have been 'Removed In Error'
  1. .D SETFDA(X0,18,"restoredBy",.074) ; DFN of the user who 'restored' this patient to the board. Triggers Restored By Date/Time field
  1. ; end changes
  1. D UPDHOLD^EDPLOGH(.FDA,IEN,$P(X3,U,4))
  1. I $G(FDA(230,IEN_",",1.2)) S FDA(230,IEN_",",1.3)=TIME
  1. I $L(NAME)&$L(SSN) S FDA(230,IEN_",",.11)=$E(NAME)_$E(SSN,6,9)
  1. I $$VAL("updDiag") S HIST(230.1,"+1,",9.1)=$G(HIST(230.1,"+1,",9.1))_"4;"
  1. ;
  1. L +^EDP(230,IEN):3 E D FAIL("upd",2300015) Q EDPFAIL
  1. ; be sure to unlock before quitting!
  1. I $$COLLIDE^EDPLOGH(IEN,$$VAL("loadTS")) L -^EDP(230,IEN) Q EDPFAIL
  1. I $$BEDGONE^EDPLOGH(AREA,$P(X3,U,4),$P(X3,U,9),$$VAL("bed")) D FAIL("upd",2300016) L -^EDP(230,IEN) Q EDPFAIL
  1. I $D(HIST)>9 D SAVE^EDPLOGH(IEN,TIME,.HIST)
  1. I $D(FDA)>9 D FILE^DIE("","FDA","ERR")
  1. I '$D(DIERR),$$VAL("updDiag") D UPDDIAG
  1. L -^EDP(230,IEN)
  1. I $D(DIERR) D FAIL("upd",2300008) Q EDPFAIL
  1. ;
  1. M ^XDJE(1)=PCE
  1. D UPDVISIT^EDPLPCE(IEN,.PCE)
  1. ;
  1. I (DFN&'$P(X0,U,6))!($G(REC("inTS"))&'$P(X0,U,8)) D EVT^EDPLOGA(IEN)
  1. ;
  1. D XML^EDPX("<upd status='ok' id='"_IEN_"' />")
  1. Q EDPFAIL
  1. UPDDIAG ; process diagnoses
  1. ; called from UPD^EDPLOG
  1. ; expects REC,PCE,IEN,TIME,AREA to be defined
  1. ; drp BEGIN EDP*2.0*2
  1. N DIAG,I,FDA,FDAIEN,ERR,CODED,CODE,EDPLCIEN,EDPLCSYS
  1. S DIAG="diagnosis-0",I=0,CODED=$P($G(^EDPB(231.9,AREA,1)),U,2)
  1. F S DIAG=$O(REC(DIAG)) Q:$E(DIAG,1,10)'="diagnosis-" D
  1. . S I=I+1,REC("diagnosis",I)=REC(DIAG),REC("inTS",I)=REC("inTS")
  1. . I CODED S PCE($P(REC(DIAG),U),I)=REC(DIAG)
  1. I $D(REC("diagnosis"))<10 Q
  1. ; replace the diagnosis multiple
  1. D DELDIAG(IEN)
  1. S FDA(230,IEN_",",1.4)=TIME
  1. S I=0 F S I=$O(REC("diagnosis",I)) Q:'I D
  1. . Q:$P(REC("diagnosis",I),U,6) ; entry being removed
  1. . S EDPLCIEN=$P(REC("diagnosis",I),U,2)
  1. . S EDPLCSYS=$$CSYS^EDPLEX(REC("inTS",I)) ; added drp
  1. . ; EDPLCIEN for ICD9 will be a file 757.01 IEN
  1. . ; for ICD10 "10D" codes it will be a File 80 IEN.
  1. . ; Process below converts 757.01 pointer to an 80 pointer
  1. . I EDPLCSYS="ICD" D
  1. . . S CODE=$S(+EDPLCIEN:$$ONE^LEXU(EDPLCIEN,REC("inTS",I),EDPLCSYS),1:"") ;drp patch 2
  1. . . S:'$L(CODE) CODE=$P($P(REC("diagnosis",I),U,3),"/",1)
  1. . . S:$L(CODE) EDPLCIEN=$P($$ICDDATA^EDPLEX(EDPLCSYS,CODE,REC("inTS",I),"E"),U,1) ;drp patch 2
  1. . .Q
  1. . S FDA(230.04,"+"_I_","_IEN_",",.01)=$P(REC("diagnosis",I),U,4)
  1. . S FDA(230.04,"+"_I_","_IEN_",",.02)=EDPLCIEN
  1. . ;drp END EDP*2.0*2 CHANGES
  1. . S FDA(230.04,"+"_I_","_IEN_",",.03)=$P(REC("diagnosis",I),U,8)
  1. D UPDATE^DIE("","FDA","FDAIEN","ERR")
  1. Q
  1. DELDIAG(IEN) ; delete the diagnosis multiple
  1. I '$O(^EDP(230,IEN,4,0)) Q ; no child nodes
  1. N DA,DIK S DA=0,DA(1)=IEN,DIK="^EDP(230,"_DA(1)_",4,"
  1. F S DA=$O(^EDP(230,IEN,4,DA)) Q:'DA D ^DIK
  1. Q
  1. HAVEDIAG() ; return true if a diagnosis is present
  1. ; expects REC to be defined
  1. N FOUND S FOUND=0
  1. N DIAG S DIAG="diagnosis-0"
  1. F S DIAG=$O(REC(DIAG)) Q:$E(DIAG,1,10)'="diagnosis-" D Q:FOUND
  1. . I '$P(REC(DIAG),U,6) S FOUND=1 ; 6th piece is delete flag
  1. Q FOUND
  1. ;
  1. RDY2RMV ; check required fields & set up so ready to remove
  1. ; called from UPD, expects REC and IEN and TIME
  1. ;
  1. ; check special dispositions first
  1. N DISP,CLOSE
  1. S DISP=+$$VAL("disposition"),CLOSE=0
  1. I DISP=+$O(^EDPB(233.1,"B","edp.disposition.error",0)) S CLOSE=1
  1. I DISP=+$O(^EDPB(233.1,"B","edp.disposition.nec",0)) S CLOSE=1
  1. I DISP=+$O(^EDPB(233.1,"B","edp.disposition.left",0)) S CLOSE=1
  1. I CLOSE S:'$$VAL("outTS") REC("outTS")=TIME S REC("closed")=1 Q
  1. ;
  1. ; check the generally required fields
  1. N MISSING S MISSING=""
  1. S REC("closed")=0
  1. I '$L($$VAL("complaint")) S MISSING=MISSING_"Complaint "
  1. I '$$VAL("bed") S MISSING=MISSING_"Room/Area "
  1. I '$$VAL("provider") S MISSING=MISSING_"Provider "
  1. I $$NOVAL("acuity") S MISSING=MISSING_"Acuity "
  1. ;
  1. ; check the other disposition required fields
  1. N X1,AREA,MIN,STS,OUT
  1. S AREA=$P(^EDP(230,IEN,0),U,3),STS=$P($G(^(3)),U,2)
  1. S X1=$G(^EDPB(231.9,AREA,1))
  1. S MIN=$$VAL("inTS") S:'MIN MIN=$P(^EDP(230,IEN,0),U,8)
  1. S OUT=$$VAL("outTS") S:'OUT OUT=TIME
  1. S MIN=$$FMDIFF^XLFDT(OUT,MIN,2)\60
  1. I $P(X1,U,1),'$$HAVEDIAG S MISSING=MISSING_"Diagnosis "
  1. I $P(X1,U,3),$$NOVAL("disposition") S MISSING=MISSING_"Disposition "
  1. ; (client parses for string "Delay Reason" to know whether to enable delay reason control)
  1. ; bwf 4/26/13 - per Dr. Gelman, want delay reason no matter whether patient is in observation or not.
  1. ; replaced line below with the one that follows
  1. ;I $P(X1,U,4),(MIN>$P(X1,U,5)),$$NOVAL("delay"),'$$OBS(STS) S MISSING=MISSING_"Delay Reason "
  1. I $P(X1,U,4),(MIN>$P(X1,U,5)),$$NOVAL("delay") S MISSING=MISSING_"Delay Reason "
  1. I $L(MISSING) D FAIL("upd","Fields required for removal are missing: "_MISSING) Q
  1. S:'$$VAL("outTS") REC("outTS")=TIME S REC("closed")=1
  1. Q
  1. VAL(X) ; Returns parameter value or null
  1. ; HTTP passes HTML-escaped values in an array as REC(param)
  1. Q $G(REC(X))
  1. ;
  1. NOVAL(X) ; Returns true if value is empty, 0, or edp.reserved.novalue
  1. ; expects EDPNOVAL to be defined
  1. I +$G(REC(X))=0 Q 1
  1. I +$G(REC(X))=EDPNOVAL Q 1
  1. Q 0
  1. ;
  1. OBS(X) ; Returns 1 or 0, if observation status X
  1. Q ($P($G(^EDPB(233.1,+$G(X),0)),U,5)["O")
  1. ;
  1. SETFDA(NODE,P,SUB,FLD) ; Creates value in FDA & HIST arrays as appropriate
  1. ; from UPD, expects REC, FDA, HIST to be defined
  1. Q:'$D(REC(SUB)) ; value not sent in message
  1. Q:$P(NODE,U,P)=REC(SUB) ; value is the same
  1. ; don't save switch from null to 0 or NOVAL to 0
  1. ; since 0 is always sent as none value for combo box fields
  1. I (REC(SUB)=0),($P(NODE,U,P)=""),("^.1^1.2^1.5^3.2^3.3^3.4^3.5^3.6^3.7^"[(U_FLD_U)) Q
  1. I (REC(SUB)=0),($P(NODE,U,P)=EDPNOVAL),("^.1^1.2^1.5^3.2^3.3^"[(U_FLD_U)) Q
  1. ;
  1. I REC(SUB)="" S REC(SUB)="@" ; we must be deleting field if empty
  1. S FDA(230,IEN_",",FLD)=REC(SUB)
  1. ; save the changed fields in the history
  1. I $L(REC(SUB)) D
  1. . S HIST(230.1,"+1,",9.1)=$G(HIST(230.1,"+1,",9.1))_FLD_";"
  1. . S:FLD=.07 FLD=.0701 ; closed
  1. . S:FLD=1.1 FLD=.07 ; complaint
  1. . S:FLD=1.2 FLD=.11 ; disposition
  1. . S:FLD=1.5 FLD=.12 ; delay
  1. . S HIST(230.1,"+1,",FLD)=REC(SUB)
  1. . ; check for updated providers
  1. . S:FLD=3.5 PCE("PRV",1)=REC(SUB),PCE("PRI")=REC(SUB) ; primary provider
  1. . S:FLD=3.6 PCE("PRV",2)=REC(SUB) ; nurse
  1. . S:FLD=3.7 PCE("PRV",3)=REC(SUB) ; resident
  1. Q
  1. FAIL(ELEM,MSG) ; creates failure node for returned XML
  1. N X,EDPFAIL
  1. S EDPFAIL=0
  1. I +MSG S MSG=$$MSG^EDPX(MSG)
  1. S X="<"_ELEM_" id='"_$$VAL("id")_"' status='fail' msg='"_MSG_"' />"
  1. D XML^EDPX(X)
  1. S EDPFAIL=1
  1. Q EDPFAIL