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