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