EDPARPT1 ;SLC/BWF - Ad Hoc Reports ;5/16/2012 11:51am
;;2.0;EMERGENCY DEPARTMENT;**6**;Feb 24, 2012;Build 200
Q
ELAPSED(LIEN) ; elapsed time
N ELAPSE,IN,OUT
S ELAPSE=""
S OUT=$$GET1^DIQ(230,LIEN,.09,"I")
I 'OUT Q "" ; patient has no 'out' time
I $$GET1^DIQ(230,LIEN,.0701,"I")'=1 Q "" ; patient's record is not closed
S IN=$$GET1^DIQ(230,LIEN,.08,"I")
S ELAPSE=$$FMDIFF^XLFDT(IN,OUT,2)
I ELAPSE>60 S ELAPSE=ELAPSE/60 Q $P(ELAPSE,".") ; get minutes
Q ""
SMULT(LIEN,IARRY,FLD) ; list of doctors/nurses/residents/status/acuity or any 'standard multiples (single fields that can change) associated with the patient for this ed visit
N CNT,INVDT,HIEN,VAL,FDATA,FERR,LOCAL,PIEN
S CNT=0
; get field values in the reverse order that they were assigned to the patient
S INVDT=0 F S INVDT=$O(^EDP(230.1,"ADR",LIEN,INVDT)) Q:'INVDT D
.S HIEN=0 F S HIEN=$O(^EDP(230.1,"ADR",LIEN,INVDT,HIEN)) Q:'HIEN D
..; quit if this field is null
..I $$GET1^DIQ(230.1,HIEN,FLD,"I")="" Q
..D FIELD^DID(230.1,FLD,,"TYPE;POINTER","FDATA","FERR")
..I $G(FDATA("TYPE"))="POINTER" D Q
...; if the field is a pointer, and it is pointing to VA(200, get the elements needed (name^initials^log history time)
...I $G(FDATA("POINTER"))="VA(200," D Q
....S PIEN=$$GET1^DIQ(230.1,HIEN,FLD,"I")
....S VAL=$$GET1^DIQ(200,PIEN,.01,"E")_" ("_$$GET1^DIQ(230.1,HIEN,.02,"E")_")"
....S CNT=CNT+1,IARRY(CNT)=VAL,LOCAL($P(VAL,U))=""
...; force the log history timestamp to ALWAYS be on piece 3 for now, to provide consistency with pointers to VA(200
...; this helps when using the FORMAT LOGIC from file 232.11
...S VAL=$$GET1^DIQ(230.1,HIEN,FLD,"E")_" ("_$$GET1^DIQ(230.1,HIEN,.02,"E")_")"
...S CNT=CNT+1,IARRY(CNT)=VAL
Q
TRIAGE(LIEN) ; The elapsed time between the patient's time-in and his or her initial acuity assessment.
N ACU,IDT,FOUND,ETIME,IN,TRNURSE
S FOUND=0,ETIME="",TRNURSE=""
S IDT=0 F S IDT=$O(^EDP(230.1,"ADR",LIEN,IDT)) Q:'IDT D
.S HIEN=0 F S HIEN=$O(^EDP(230.1,"ADR",LIEN,IDT,HIEN)) Q:'HIEN!(FOUND) D
..; this field was not edited or added
..I $$GET1^DIQ(230.1,HIEN,3.3,"I")="" Q
..S FOUND=1
..S IN=$$GET1^DIQ(230,LIEN,.08,"I")
..S ETIME=$$FMDIFF^XLFDT($$GET1^DIQ(230.1,HIEN,.02,"I"),IN,2)
..S ETIME=ETIME/60
..S TRNURSE=$$GET1^DIQ(230.1,HIEN,3.6,"E")
Q $P(ETIME,".")_U_TRNURSE
;
D2DOC(LIEN) ; elapsed time from door to doc
N ETIME,HIEN,IDT,FOUND,IN,DOCTIME
S ETIME=""
S (FOUND,IDT)=0 F S IDT=$O(^EDP(230.1,"ADR",LIEN,IDT)) Q:'IDT!(FOUND) D
.S HIEN=0 F S HIEN=$O(^EDP(230.1,"ADR",LIEN,IDT,HIEN)) Q:'HIEN!(FOUND) D
..; this field was not edited or added
..I $$GET1^DIQ(230.1,HIEN,3.5,"I")="" Q
..S FOUND=1
..S IN=$$GET1^DIQ(230,LIEN,.08,"I"),DOCTIME=$$GET1^DIQ(230.1,HIEN,.02,"I")
..S ETIME=$$FMDIFF^XLFDT(DOCTIME,IN,2),ETIME=ETIME/60
Q $P(ETIME,".")
;
WAIT(LIEN,AREA) ; The elapsed time between the patient's time-in and his or her first assignment to a location other than the waiting room
N WAIT,IDT,FOUND,HIEN,ETIME,IN
S ETIME=""
S (IDT,FOUND)=0 F S IDT=$O(^EDP(230.1,"ADR",LIEN,IDT)) Q:'IDT!(FOUND) D
.S HIEN=0 F S HIEN=$O(^EDP(230.1,"ADR",LIEN,IDT,HIEN)) Q:'HIEN!(FOUND) D
..I $$GET1^DIQ(230.1,HIEN,3.4,"I")="" Q
..; the patient is still in the waiting room
..I $$GET1^DIQ(230.1,HIEN,3.4,"E")=$$GET1^DIQ(231.9,AREA,1.12,"E") Q
..S IN=$$GET1^DIQ(230,LIEN,.08,"I"),FOUND=1
..S ETIME=$$FMDIFF^XLFDT($$GET1^DIQ(230.1,HIEN,.02,"I"),IN,2),ETIME=ETIME/60
Q $P(ETIME,".")
;
; input
; LIEN - Log entry ien from file 230 (required)
; TYPE - type of data being requested (required)
; 1 - admdec
; 2 - admdel
ADMDECL(LIEN,TYPE) ; elapsed time between the patient's time-in and the status change to 'Admit to.'
N ADMDEC,IN,HIEN,IDT,FOUND,ELAPSE,STAT,STIME
S ELAPSE=""
S (IDT,FOUND)=0 F S IDT=$O(^EDP(230.1,"ADR",LIEN,IDT)) Q:'IDT!(FOUND) D
.S HIEN=0 F S HIEN=$O(^EDP(230.1,"ADR",LIEN,IDT,HIEN)) Q:'HIEN!(FOUND) D
..S STAT=$$GET1^DIQ(230.1,HIEN,3.2,"E")
..I TYPE=1,STAT'="adm.status.admitted" Q
..I TYPE=2,STAT'["edp.disposition" Q
..S FOUND=1
..S STIME=$$GET1^DIQ(230.1,HIEN,.02,"I"),IN=$$GET1^DIQ(230,LIEN,.08,"I")
..S ELAPSE=$$FMDIFF^XLFDT(STIME,IN,2),ELAPSE=ELAPSE/60
Q $P(ELAPSE,".")
;
; input:
; LIEN - log ien (required)
; IARRY - data storage location IARRY(CNT)=DATA (required)
; AREA - the AREA associated with this log entry
; TYPE - 1: ICD coded dx list
; 2: free text dx list
DXMULT(LIEN,IARRY,AREA,TYPE) ; patients free text or ICD-9-CM diagnosis - could be multiple
N EDPVISIT
I TYPE=1 D Q
.S EDPVISIT=$P(^EDP(230,LIEN,0),U,12)
.I EDPVISIT,$P($G(^EDPB(231.9,AREA,1)),U,2) D DXPCE^EDPQPCE(EDPVISIT,.IARRY)
I TYPE=2 D DXFREE2^EDPQPCE(LIEN,.IARRY)
Q
PID(DFN) ;
N PID,PNAME,SSN
D ^VADPT
S PID=$E(VADM(1),1)_VA("BID")
K VA,VADM
Q PID
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEDPARPT1 4902 printed Nov 22, 2024@17:01:38 Page 2
EDPARPT1 ;SLC/BWF - Ad Hoc Reports ;5/16/2012 11:51am
+1 ;;2.0;EMERGENCY DEPARTMENT;**6**;Feb 24, 2012;Build 200
+2 QUIT
ELAPSED(LIEN) ; elapsed time
+1 NEW ELAPSE,IN,OUT
+2 SET ELAPSE=""
+3 SET OUT=$$GET1^DIQ(230,LIEN,.09,"I")
+4 ; patient has no 'out' time
IF 'OUT
QUIT ""
+5 ; patient's record is not closed
IF $$GET1^DIQ(230,LIEN,.0701,"I")'=1
QUIT ""
+6 SET IN=$$GET1^DIQ(230,LIEN,.08,"I")
+7 SET ELAPSE=$$FMDIFF^XLFDT(IN,OUT,2)
+8 ; get minutes
IF ELAPSE>60
SET ELAPSE=ELAPSE/60
QUIT $PIECE(ELAPSE,".")
+9 QUIT ""
SMULT(LIEN,IARRY,FLD) ; list of doctors/nurses/residents/status/acuity or any 'standard multiples (single fields that can change) associated with the patient for this ed visit
+1 NEW CNT,INVDT,HIEN,VAL,FDATA,FERR,LOCAL,PIEN
+2 SET CNT=0
+3 ; get field values in the reverse order that they were assigned to the patient
+4 SET INVDT=0
FOR
SET INVDT=$ORDER(^EDP(230.1,"ADR",LIEN,INVDT))
if 'INVDT
QUIT
Begin DoDot:1
+5 SET HIEN=0
FOR
SET HIEN=$ORDER(^EDP(230.1,"ADR",LIEN,INVDT,HIEN))
if 'HIEN
QUIT
Begin DoDot:2
+6 ; quit if this field is null
+7 IF $$GET1^DIQ(230.1,HIEN,FLD,"I")=""
QUIT
+8 DO FIELD^DID(230.1,FLD,,"TYPE;POINTER","FDATA","FERR")
+9 IF $GET(FDATA("TYPE"))="POINTER"
Begin DoDot:3
+10 ; if the field is a pointer, and it is pointing to VA(200, get the elements needed (name^initials^log history time)
+11 IF $GET(FDATA("POINTER"))="VA(200,"
Begin DoDot:4
+12 SET PIEN=$$GET1^DIQ(230.1,HIEN,FLD,"I")
+13 SET VAL=$$GET1^DIQ(200,PIEN,.01,"E")_" ("_$$GET1^DIQ(230.1,HIEN,.02,"E")_")"
+14 SET CNT=CNT+1
SET IARRY(CNT)=VAL
SET LOCAL($PIECE(VAL,U))=""
End DoDot:4
QUIT
+15 ; force the log history timestamp to ALWAYS be on piece 3 for now, to provide consistency with pointers to VA(200
+16 ; this helps when using the FORMAT LOGIC from file 232.11
+17 SET VAL=$$GET1^DIQ(230.1,HIEN,FLD,"E")_" ("_$$GET1^DIQ(230.1,HIEN,.02,"E")_")"
+18 SET CNT=CNT+1
SET IARRY(CNT)=VAL
End DoDot:3
QUIT
End DoDot:2
End DoDot:1
+19 QUIT
TRIAGE(LIEN) ; The elapsed time between the patient's time-in and his or her initial acuity assessment.
+1 NEW ACU,IDT,FOUND,ETIME,IN,TRNURSE
+2 SET FOUND=0
SET ETIME=""
SET TRNURSE=""
+3 SET IDT=0
FOR
SET IDT=$ORDER(^EDP(230.1,"ADR",LIEN,IDT))
if 'IDT
QUIT
Begin DoDot:1
+4 SET HIEN=0
FOR
SET HIEN=$ORDER(^EDP(230.1,"ADR",LIEN,IDT,HIEN))
if 'HIEN!(FOUND)
QUIT
Begin DoDot:2
+5 ; this field was not edited or added
+6 IF $$GET1^DIQ(230.1,HIEN,3.3,"I")=""
QUIT
+7 SET FOUND=1
+8 SET IN=$$GET1^DIQ(230,LIEN,.08,"I")
+9 SET ETIME=$$FMDIFF^XLFDT($$GET1^DIQ(230.1,HIEN,.02,"I"),IN,2)
+10 SET ETIME=ETIME/60
+11 SET TRNURSE=$$GET1^DIQ(230.1,HIEN,3.6,"E")
End DoDot:2
End DoDot:1
+12 QUIT $PIECE(ETIME,".")_U_TRNURSE
+13 ;
D2DOC(LIEN) ; elapsed time from door to doc
+1 NEW ETIME,HIEN,IDT,FOUND,IN,DOCTIME
+2 SET ETIME=""
+3 SET (FOUND,IDT)=0
FOR
SET IDT=$ORDER(^EDP(230.1,"ADR",LIEN,IDT))
if 'IDT!(FOUND)
QUIT
Begin DoDot:1
+4 SET HIEN=0
FOR
SET HIEN=$ORDER(^EDP(230.1,"ADR",LIEN,IDT,HIEN))
if 'HIEN!(FOUND)
QUIT
Begin DoDot:2
+5 ; this field was not edited or added
+6 IF $$GET1^DIQ(230.1,HIEN,3.5,"I")=""
QUIT
+7 SET FOUND=1
+8 SET IN=$$GET1^DIQ(230,LIEN,.08,"I")
SET DOCTIME=$$GET1^DIQ(230.1,HIEN,.02,"I")
+9 SET ETIME=$$FMDIFF^XLFDT(DOCTIME,IN,2)
SET ETIME=ETIME/60
End DoDot:2
End DoDot:1
+10 QUIT $PIECE(ETIME,".")
+11 ;
WAIT(LIEN,AREA) ; The elapsed time between the patient's time-in and his or her first assignment to a location other than the waiting room
+1 NEW WAIT,IDT,FOUND,HIEN,ETIME,IN
+2 SET ETIME=""
+3 SET (IDT,FOUND)=0
FOR
SET IDT=$ORDER(^EDP(230.1,"ADR",LIEN,IDT))
if 'IDT!(FOUND)
QUIT
Begin DoDot:1
+4 SET HIEN=0
FOR
SET HIEN=$ORDER(^EDP(230.1,"ADR",LIEN,IDT,HIEN))
if 'HIEN!(FOUND)
QUIT
Begin DoDot:2
+5 IF $$GET1^DIQ(230.1,HIEN,3.4,"I")=""
QUIT
+6 ; the patient is still in the waiting room
+7 IF $$GET1^DIQ(230.1,HIEN,3.4,"E")=$$GET1^DIQ(231.9,AREA,1.12,"E")
QUIT
+8 SET IN=$$GET1^DIQ(230,LIEN,.08,"I")
SET FOUND=1
+9 SET ETIME=$$FMDIFF^XLFDT($$GET1^DIQ(230.1,HIEN,.02,"I"),IN,2)
SET ETIME=ETIME/60
End DoDot:2
End DoDot:1
+10 QUIT $PIECE(ETIME,".")
+11 ;
+12 ; input
+13 ; LIEN - Log entry ien from file 230 (required)
+14 ; TYPE - type of data being requested (required)
+15 ; 1 - admdec
+16 ; 2 - admdel
ADMDECL(LIEN,TYPE) ; elapsed time between the patient's time-in and the status change to 'Admit to.'
+1 NEW ADMDEC,IN,HIEN,IDT,FOUND,ELAPSE,STAT,STIME
+2 SET ELAPSE=""
+3 SET (IDT,FOUND)=0
FOR
SET IDT=$ORDER(^EDP(230.1,"ADR",LIEN,IDT))
if 'IDT!(FOUND)
QUIT
Begin DoDot:1
+4 SET HIEN=0
FOR
SET HIEN=$ORDER(^EDP(230.1,"ADR",LIEN,IDT,HIEN))
if 'HIEN!(FOUND)
QUIT
Begin DoDot:2
+5 SET STAT=$$GET1^DIQ(230.1,HIEN,3.2,"E")
+6 IF TYPE=1
IF STAT'="adm.status.admitted"
QUIT
+7 IF TYPE=2
IF STAT'["edp.disposition"
QUIT
+8 SET FOUND=1
+9 SET STIME=$$GET1^DIQ(230.1,HIEN,.02,"I")
SET IN=$$GET1^DIQ(230,LIEN,.08,"I")
+10 SET ELAPSE=$$FMDIFF^XLFDT(STIME,IN,2)
SET ELAPSE=ELAPSE/60
End DoDot:2
End DoDot:1
+11 QUIT $PIECE(ELAPSE,".")
+12 ;
+13 ; input:
+14 ; LIEN - log ien (required)
+15 ; IARRY - data storage location IARRY(CNT)=DATA (required)
+16 ; AREA - the AREA associated with this log entry
+17 ; TYPE - 1: ICD coded dx list
+18 ; 2: free text dx list
DXMULT(LIEN,IARRY,AREA,TYPE) ; patients free text or ICD-9-CM diagnosis - could be multiple
+1 NEW EDPVISIT
+2 IF TYPE=1
Begin DoDot:1
+3 SET EDPVISIT=$PIECE(^EDP(230,LIEN,0),U,12)
+4 IF EDPVISIT
IF $PIECE($GET(^EDPB(231.9,AREA,1)),U,2)
DO DXPCE^EDPQPCE(EDPVISIT,.IARRY)
End DoDot:1
QUIT
+5 IF TYPE=2
DO DXFREE2^EDPQPCE(LIEN,.IARRY)
+6 QUIT
PID(DFN) ;
+1 NEW PID,PNAME,SSN
+2 DO ^VADPT
+3 SET PID=$EXTRACT(VADM(1),1)_VA("BID")
+4 KILL VA,VADM
+5 QUIT PID
