AMERTIME ; IHS/OIT/SCR - CHECKS TIMES FOR PROPER RELATIONSHIP
;;3.0;ER VISIT SYSTEM;**2**;FEB 23, 2009
;
CHKTIME(AMERARV,AMERAIEN) ; EP from AMEREDIT
; AMERARV- ARIVAL TIME IN FILEMAN FORMAT
; AMERAIEN : AUDIT IEN
;
; INJURY TIME < ADMIT TIME < TRIAGE AND PROVIDER TIME < DISCHARGE TIME
; ARVTIME has been modified so
; 1. check TRIAGE time - prompt for and delete if before ARVTIME
; 2. check PROVIDER time - prompt for and delte if before ARVTIME
; 3. check DEPARTURE time - prompt for and delete if before ARVTIME,TRIAGE OR PROVIDER time
N AMERPRVT,AMERTRIT,AMERDEPT,AMERDIFF,DR,DIE,DIR
N AMEROLD,AMERNEW,AMEREDTS,AMERSTRG,AMERQUIT,AMERCSLT,AMERDOC,AMERCNO,AMERADMT,AMERCHKT
S (AMEROLD,AMERNEW,AMEREDTS,AMERSTRG,DR)=""
S AMERQUIT=0
S (AMEROLD,AMERTRIT)=$P(^AMERVSIT(AMERDA,12),U,2)
; I ARRIVE TIME compared to TRIAGE TIME is after go onto loop, else it's ok
I $$TCOMP(AMERARV,AMERTRIT,1)=1 D
.S Y=AMERTRIT X ^DD("DD")
.S AMERTRIT=Y ; TRIAGE NURSE TIME IN EXTERNAL FORMAT FOR DIC("B")
.S DR="12.2////@"
.S DIR(0)="D^::ER",DIR("A")="*What time did the patient see the triage nurse"
.S DIR("?")="Enter an exact date and time in Fileman format (e.g. T@1PM)"
.S DIR("B")=AMERTRIT
.F Q:Y="^"!(Y="") D
..D ^DIR
..I X="^" S Y="^"
..I $D(DUOUT)!$D(DTOUT) K DIR,DUOUT,DTOUT,Y S Y="^" Q
..I $$TCK^AMER2A(AMERARV,Y,1,"admission")=0 D
...S AMERNEW=Y
...I AMERNEW=AMEROLD S Y="" Q
...S AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"D")
...S AMERNEW=$$EDDISPL^AMEREDAU(AMERNEW,"D")
...S AMERSTRG=$$EDAUDIT^AMEREDAU("12.2",AMEROLD,AMERNEW,"TRG NURSE TIME")
...I AMERSTRG="^" S AMERQUIT=1 Q
...S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
...S DR="12.2////"_Y
...S AMERDIFF=$$DT^AMERSAV1(Y,AMERARV,"M")
...S DR=DR_";12.4////"_AMERDIFF
...S Y=""
...Q
..Q
.I Y="^" S AMERQUIT=1
.I (DR'=""&(AMEROLD'="")) D
..I DR="12.2////@" D
...;IHS/OIT/SCR 090309 patch 2
...;D EN^DDIOL("Deleting TRIAGE NURSE TIME can't be before date/time of admission","","!")
...D EN^DDIOL("Deleting TRIAGE NURSE TIME which is before new date/time of admission","","!")
...D EN^DDIOL("Please update TRIATE NURSE triage time in TRIAGE edit section","","!!")
...S AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"D")
...S AMERSTRG=$$EDAUDIT^AMEREDAU("12.2",AMEROLD,"","TRG NURSE TIME")
...S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
...Q
..Q:AMERQUIT
..D DIE(AMERDA,DR)
..D MULTAUDT^AMEREDAU(AMEREDTS,AMERAIEN)
..Q
..Q
.K DIR
.S DR=""
.Q
S (AMEROLD,AMERPRVT)=$P(^AMERVSIT(AMERDA,12),U,1)
; If ARRIVE TIME IS after PROV TIME then do
I $$TCOMP(AMERARV,AMERPRVT,1)=1 D
.S Y=AMERPRVT X ^DD("DD")
.S AMERPRVT=Y ; ADMITTING PROV TIME IN EXTERNAL FORMAT
.S DR="12.1////@"
.S DIR(0)="DO^::ER",DIR("A")="*What time did the patient see the admitting provider"
.S DIR("?")="Enter an exact date and time in Fileman format (e.g. T@1PM)"
.S DIR("B")=AMERPRVT
.F Q:Y="^"!(Y="") D:'AMERQUIT
..D ^DIR
..I X="^" S Y="^"
..I $D(DUOUT)!$D(DTOUT) K DIR,DUOUT,DTOUT S Y="^" Q
..I $$TCK^AMER2A(AMERARV,Y,1,"admission")=0 D
...S AMERNEW=Y
...I AMERNEW=AMEROLD D EN^DDIOL("The ADMITTING PROVIDER TIME must be AFTER time of addmission","","!!") Q
...S AMERNEW=$$EDDISPL^AMEREDAU(AMERNEW,"D") ; Tranforms fileman date into user friendly date
...S AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"D")
...S AMERSTRG=$$EDAUDIT^AMEREDAU("12.1",AMEROLD,AMERNEW,"ADMITTING PROVIDER TIME")
...I AMERSTRG="^" S AMERQUIT=1 Q
...S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
...S DR="12.1////"_Y
...S AMERDIFF=$$DT^AMERSAV1(Y,AMERARV,"M")
...S DR=DR_";12.3////"_AMERDIFF
...S Y=""
...Q
..Q
.I Y="^" S AMERQUIT=1
.I (DR'=""&(AMEROLD'="")) D
..I DR="12.1////@" D
...D EN^DDIOL("Deleting ADMITTING PROVIDER TIME - can't be before date/time of admission","","!!")
...S AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"D")
...S AMERSTRG=$$EDAUDIT^AMEREDAU("12.1",AMEROLD,"","ADMITTING PROVIDER TIME")
...S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
...Q
..D DIE(AMERDA,DR)
..D MULTAUDT^AMEREDAU(AMEREDTS,AMERAIEN)
..Q
.Q
.S DR=""
.Q
S (AMEROLD,Y)=$P(^AMERVSIT(AMERDA,6),U,2)
; If ARRIVE TIME compared to DEPART TIME is AFTER then do
I $$TCOMP(AMERARV,AMEROLD,1)=1 D
.S Y=AMEROLD X ^DD("DD")
.S AMERDEPT=Y ; DEPART TIME IN EXTERNAL FORMAT
.S DR="6.2////@"
.S DIR(0)="DO^::ER",DIR("A")="*What time did the patient depart from the ER"
.S DIR("?")="Enter an exact date and time in Fileman format (e.g. T@1PM)"
.S DIR("B")=AMERDEPT
.F Q:Y="^"!(Y="") D:'AMERQUIT
..D ^DIR
..I X="^" S Y="^" Q
..I $D(DUOUT)!$D(DTOUT) K DIR,DUOUT,DTOUT S Y="^" Q
..; TVAL returns 0 if user says "yes they are sure they want this time..."
..I $$TVAL^AMER2A($P($G(^AMERVSIT(AMERDA,0)),U,1),AMERNEW,6) Q
..I $$TCK^AMER2A(AMERARV,Y,1,"admission")=0 D
...S AMERNEW=Y
...I AMERNEW=AMEROLD D EN^DDIOL("The ADMITTING PROVIDER TIME must be AFTER time of addmission","","!!") Q
...S AMERNEW=$$EDDISPL^AMEREDAU(AMERNEW,"D") ; Tranforms fileman date into user friendly date
...S AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"D")
...S AMERSTRG=$$EDAUDIT^AMEREDAU("6.2",AMEROLD,AMERNEW,"DEPARTURE TIME")
...I AMERSTRG="^" S AMERQUIT=1 Q
...S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
...S DR="6.2////"_Y
...S AMERDIFF=$$DT^AMERSAV1(Y,AMERARV,"M")
...S DR=DR_";12.5////"_AMERDIFF
...S Y=""
...Q
..Q
.I Y="^" S AMERQUIT=1
.I (DR'=""&(AMEROLD'="")) D
..I DR="6.2////@" D
...D EN^DDIOL("Deleting DEPARTURE TIME - can't be before date/time of admission","","!!")
...S AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"D")
...S AMERSTRG=$$EDAUDIT^AMEREDAU("6.2",AMEROLD,"","DEPARTURE TIME")
...S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
...Q
..D DIE(AMERDA,DR)
..;IHS/OIT/SCR 12/15/08 - update ER VISIT FILE with DATE LAST UPDATED (NOW)
..D TIMESTMP^AMERSAV1(AMERDA)
..D MULTAUDT^AMEREDAU(AMEREDTS,AMERAIEN)
..Q
.S DR=""
.Q
S (AMEROLD,INJTIME)=$P($G(^AMERVSIT(AMERDA,3)),U,4)
; If ARRIVE TIME is after INJ TIME then do
I $$TCOMP(AMERARV,AMEROLD,1)=0 D
.Q:AMEROLD=""
.S Y=INJTIME X ^DD("DD") ; INJURED TIME IN FILEMAN FORMAT
.S INJTIME=Y
.S DR="3.4////@"
.S DIR(0)="DO^::ER",DIR("A")="*Please enter date and time of injury"
.S DIR("?")="Enter an exact date and time in Fileman format (e.g. T@1PM)"
.S DIR("B")=INJTIME
.F Q:Y="^"!(Y="") D:'AMERQUIT
..D ^DIR
..I X="^" S Y="^" Q
..I $D(DUOUT)!$D(DTOUT) K DIR,DUOUT,DTOUT S Y="^" Q
..S AMERCHKT=$$TCK^AMER2A(Y,AMERARV,0,"admission")
..I AMERCHKT=0 D
...S AMERNEW=Y
...I AMERNEW=AMEROLD Q
...S AMERSTRG=$$EDAUDIT^AMEREDAU("3.4",AMEROLD,AMERNEW,"TIME OF INJURY")
...I AMERSTRG="^" S AMERQUIT=1 Q
...S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
...S:Y="" DR="3.4////@;8.1////@",Y="^"
...I AMERCHKT=1 D
....S DR="3.4////"_Y
....S AMERDIFF=$$DT^AMERSAV1(AMERARV,Y,"M")
....S DR=DR_";8.1////"_AMERDIFF
....S Y="^"
....Q
...Q
..Q
.I Y="^" S AMERQUIT=1
.I DR'="" D
..I DR="3.4////@" D
...D EN^DDIOL("Deleting TIME OF INJURY - can't be after date/time of admission","","!!")
...S AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"D")
...S AMERSTRG=$$EDAUDIT^AMEREDAU("3.4",AMEROLD,"","TIME OF INJURY")
...S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
...Q
..D DIE(AMERDA,DR) K DIE
..;IHS/OIT/SCR 12/15/08 - update ER VISIT FILE with DATE LAST UPDATED (NOW)
..D TIMESTMP^AMERSAV1(AMERDA)
..S DR=""
..Q
.Q
; Finally, display ER Consultants and ask if user wants to edit times
I $P($G(^AMERVSIT(AMERDA,19,0)),U,4)'="" D
.S AMERCSLT=$O(^AMERVSIT(AMERDA,19,"B",0))
.S AMERDOC=$G(^AMER(2.9,AMERCSLT,0))
.D EN^DDIOL("The following ER CONSULTANT types and times have been entered","","!")
.D DSPCONS^AMEREDTE(AMERDA)
.S DIR(0)="Y",DIR("A")="Do you want to change ER CONSULTANT times",DIR("B")="YES"
.D ^DIR
.S AMERQUIT=0
.I Y=1 D
..F Q:AMERQUIT=1 D
...K DIC("B")
...S DIC="^AMER(2.9,",DIC(0)="AMEQ",Y=""
...S DIC("A")="Edit time for ER CONSULTANT TYPE: "
...D ^DIC K DIC
...I $D(DUOUT)!($D(DTOUT)!(+Y<0)) S AMERQUIT=1 Q
...S AMERCSLT=$P($G(Y),U,1)
...I AMERCSLT>0 D
....S AMEREDNO=AMEREDNO+1
....S AMERCNO=0,AMEROLD=AMERCSLT
....F S AMERCNO=$O(^AMERVSIT(AMERDA,19,AMERCNO)) Q:AMERCNO="B"!(AMERCNO="") I $P($G(^AMERVSIT(AMERDA,19,AMERCNO,0)),U,1)=AMERCSLT D
.....S Y=$P($G(^AMERVSIT(AMERDA,19,AMERCNO,0)),U,2)
.....S AMERTIME=Y
.....S DIR(0)="D^::ER",DIR("A")="Date and time of ER CONSULTANT"
.....S AMEROLD=AMERTIME
.....I AMERTIME'="" S Y=AMERTIME D DD^%DT S DIR("B")=Y
.....S DIR("?")="Enter date and time in the usual Fileman format (e.g. 1/1/2000@1PM)"
.....D ^DIR K DIR
.....I $D(DUOUT)!$D(DTOUT) S AMERQUIT=1 Q
.....S (AMERTIME,AMERNEW)=Y
.....I AMEROLD'=AMERNEW D
......S AMERSTRG=$$EDAUDIT^AMEREDAU("19-02"_"."_AMEREDNO,$$EDDISPL^AMEREDAU(AMEROLD,"D"),$$EDDISPL^AMEREDAU(AMERNEW,"D"),"ER CONSULTANT TIME")
......I AMERSTRG="^" S AMERQUIT=1 Q
......S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
......S DR=$S(DR'="":DR_";",1:""),DR=DR_".02////"_AMERNEW
......S DIE="^AMERVSIT(DA(1),19,",DA(1)=AMERDA,DA=AMERCNO
......D MULTDIE^AMEREDIT(DIE,DA,DA(1),DR)
......;IHS/OIT/SCR 12/15/08 - update ER VISIT FILE with DATE LAST UPDATED (NOW)
......D TIMESTMP^AMERSAV1(AMERDA)
......D MULTAUDT^AMEREDAU(AMEREDTS,AMERAIEN)
......S (DR,AMEREDTS)=""
......Q
.....Q
....Q
...Q
..Q
.Q
K DIE,DR,DIR,Y,AMEROLD,AMERNEW,AMEREDTS,AMERSTRG
Q
TCOMP(AMERTIM1,AMERTIM2,AMERAFTR) ; EP FROM CHKVSIT^AMEREDPC AND AMERREPT
; TIME COMPARE ROUTINE
; INPUT
; AMERTIM1=DATE/TIME IN FILEMAN FORMAT
; AMERTIM2=COMPARISON DATE/TIME IN FILEMAN FORMAT
; AMERAFTR=1:AMERTIM1 IS AFTER AMERTIM2
; AMERAFTR=0:AMERTIM1 IS BEFORE AMERTIM2
; RETURNS 1 IF COMPARE IS TRUE, 0 OTHERWISE
N %,Y,X1,X2,X
I $G(AMERTIM1)="" Q ""
I $G(AMERTIM2)="" Q 1
I AMERAFTR,AMERTIM1<AMERTIM2 Q 0
I 'AMERAFTR,AMERTIM2<AMERTIM1 Q 0
Q 1
DIE(DA,DR) ; GIVEN AN ENTRY NUMBER AND A DR STRING, EDIT THE ER VISIT FILE
N X,Y,%
N D,D0,DI,DIC,DICR,DIE,DIG,DIH,DIV,DIU,DIW,DQ
S DIE="^AMERVSIT("
DIE1 L +^AMERVSIT:3 E Q
D ^DIE
L -^AMERVSIT
Q
COMPUTE(AMERDA) ; EP from AMEREDIT
; COMPUTED FIELDS
; C0 ; REVOLVING DOOR
N X,Y,Z,%,%H,%T,%Y,DR
S Z=$P($G(^AMERVSIT(AMERDA,0)),U,1),DR=""
; If there is an injury time saved, compute this field
S X=$P($G(^AMERVSIT(AMERDA,3)),U,4)
I X'="" S %=$$DT^AMERSAV1(Z,X,"M"),DR=$S(DR'="":DR_";",1:""),DR=DR_"8.1////"_%
E S DR=$S(DR'="":DR_";",1:""),DR=DR_"8.1////@"
; C2 ; DOC WAIT
S X=$P($G(^AMERVSIT(AMERDA,12)),U,1)
I X'="" S %=$$DT^AMERSAV1(X,Z,"M"),DR=$S(DR'="":DR_";",1:""),DR=DR_"12.3////"_%
E S DR=$S(DR'="":DR_";",1:""),DR=DR_"12.3////@"
; C3 ; TRIAGE WAIT
S X=$P($G(^AMERVSIT(AMERDA,12)),U,2)
I X'="" S %=$$DT^AMERSAV1(X,Z,"M"),DR=$S(DR'="":DR_";",1:""),DR=DR_"12.4////"_%
E S DR=$S(DR'="":DR_";",1:""),DR=DR_"12.4////@"
; C4 ; VISIT DURATION
S X=$P($G(^AMERVSIT(AMERDA,6)),U,2)
I X'="" S %=$$DT^AMERSAV1(X,Z,"M"),DR=$S(DR'="":DR_";",1:""),DR=DR_"12.5////"_%
E S DR=$S(DR'="":DR_";",1:""),DR=DR_"12.5////@"
D DIE(AMERDA,DR)
;IHS/OIT/SCR 12/15/08 - update ER VISIT FILE with DATE LAST UPDATED (NOW)
D TIMESTMP^AMERSAV1(AMERDA)
K A,B,C,E,X,%,%H,Z,DR
Q
AMERTIME ; IHS/OIT/SCR - CHECKS TIMES FOR PROPER RELATIONSHIP
+1 ;;3.0;ER VISIT SYSTEM;**2**;FEB 23, 2009
+2 ;
CHKTIME(AMERARV,AMERAIEN) ; EP from AMEREDIT
+1 ; AMERARV- ARIVAL TIME IN FILEMAN FORMAT
+2 ; AMERAIEN : AUDIT IEN
+3 ;
+4 ; INJURY TIME < ADMIT TIME < TRIAGE AND PROVIDER TIME < DISCHARGE TIME
+5 ; ARVTIME has been modified so
+6 ; 1. check TRIAGE time - prompt for and delete if before ARVTIME
+7 ; 2. check PROVIDER time - prompt for and delte if before ARVTIME
+8 ; 3. check DEPARTURE time - prompt for and delete if before ARVTIME,TRIAGE OR PROVIDER time
+9 NEW AMERPRVT,AMERTRIT,AMERDEPT,AMERDIFF,DR,DIE,DIR
+10 NEW AMEROLD,AMERNEW,AMEREDTS,AMERSTRG,AMERQUIT,AMERCSLT,AMERDOC,AMERCNO,AMERADMT,AMERCHKT
+11 SET (AMEROLD,AMERNEW,AMEREDTS,AMERSTRG,DR)=""
+12 SET AMERQUIT=0
+13 SET (AMEROLD,AMERTRIT)=$PIECE(^AMERVSIT(AMERDA,12),U,2)
+14 ; I ARRIVE TIME compared to TRIAGE TIME is after go onto loop, else it's ok
+15 IF $$TCOMP(AMERARV,AMERTRIT,1)=1
Begin DoDot:1
+16 SET Y=AMERTRIT
XECUTE ^DD("DD")
+17 ; TRIAGE NURSE TIME IN EXTERNAL FORMAT FOR DIC("B")
SET AMERTRIT=Y
+18 SET DR="12.2////@"
+19 SET DIR(0)="D^::ER"
SET DIR("A")="*What time did the patient see the triage nurse"
+20 SET DIR("?")="Enter an exact date and time in Fileman format (e.g. T@1PM)"
+21 SET DIR("B")=AMERTRIT
+22 FOR
IF Y="^"!(Y="")
QUIT
Begin DoDot:2
+23 DO ^DIR
+24 IF X="^"
SET Y="^"
+25 IF $DATA(DUOUT)!$DATA(DTOUT)
KILL DIR,DUOUT,DTOUT,Y
SET Y="^"
QUIT
+26 IF $$TCK^AMER2A(AMERARV,Y,1,"admission")=0
Begin DoDot:3
+27 SET AMERNEW=Y
+28 IF AMERNEW=AMEROLD
SET Y=""
QUIT
+29 SET AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"D")
+30 SET AMERNEW=$$EDDISPL^AMEREDAU(AMERNEW,"D")
+31 SET AMERSTRG=$$EDAUDIT^AMEREDAU("12.2",AMEROLD,AMERNEW,"TRG NURSE TIME")
+32 IF AMERSTRG="^"
SET AMERQUIT=1
QUIT
+33 SET AMEREDTS=$SELECT(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
+34 SET DR="12.2////"_Y
+35 SET AMERDIFF=$$DT^AMERSAV1(Y,AMERARV,"M")
+36 SET DR=DR_";12.4////"_AMERDIFF
+37 SET Y=""
+38 QUIT
End DoDot:3
+39 QUIT
End DoDot:2
+40 IF Y="^"
SET AMERQUIT=1
+41 IF (DR'=""&(AMEROLD'=""))
Begin DoDot:2
+42 IF DR="12.2////@"
Begin DoDot:3
+43 ;IHS/OIT/SCR 090309 patch 2
+44 ;D EN^DDIOL("Deleting TRIAGE NURSE TIME can't be before date/time of admission","","!")
+45 DO EN^DDIOL("Deleting TRIAGE NURSE TIME which is before new date/time of admission","","!")
+46 DO EN^DDIOL("Please update TRIATE NURSE triage time in TRIAGE edit section","","!!")
+47 SET AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"D")
+48 SET AMERSTRG=$$EDAUDIT^AMEREDAU("12.2",AMEROLD,"","TRG NURSE TIME")
+49 SET AMEREDTS=$SELECT(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
+50 QUIT
End DoDot:3
+51 IF AMERQUIT
QUIT
+52 DO DIE(AMERDA,DR)
+53 DO MULTAUDT^AMEREDAU(AMEREDTS,AMERAIEN)
+54 QUIT
+55 QUIT
End DoDot:2
+56 KILL DIR
+57 SET DR=""
+58 QUIT
End DoDot:1
+59 SET (AMEROLD,AMERPRVT)=$PIECE(^AMERVSIT(AMERDA,12),U,1)
+60 ; If ARRIVE TIME IS after PROV TIME then do
+61 IF $$TCOMP(AMERARV,AMERPRVT,1)=1
Begin DoDot:1
+62 SET Y=AMERPRVT
XECUTE ^DD("DD")
+63 ; ADMITTING PROV TIME IN EXTERNAL FORMAT
SET AMERPRVT=Y
+64 SET DR="12.1////@"
+65 SET DIR(0)="DO^::ER"
SET DIR("A")="*What time did the patient see the admitting provider"
+66 SET DIR("?")="Enter an exact date and time in Fileman format (e.g. T@1PM)"
+67 SET DIR("B")=AMERPRVT
+68 FOR
IF Y="^"!(Y="")
QUIT
IF 'AMERQUIT
Begin DoDot:2
+69 DO ^DIR
+70 IF X="^"
SET Y="^"
+71 IF $DATA(DUOUT)!$DATA(DTOUT)
KILL DIR,DUOUT,DTOUT
SET Y="^"
QUIT
+72 IF $$TCK^AMER2A(AMERARV,Y,1,"admission")=0
Begin DoDot:3
+73 SET AMERNEW=Y
+74 IF AMERNEW=AMEROLD
DO EN^DDIOL("The ADMITTING PROVIDER TIME must be AFTER time of addmission","","!!")
QUIT
+75 ; Tranforms fileman date into user friendly date
SET AMERNEW=$$EDDISPL^AMEREDAU(AMERNEW,"D")
+76 SET AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"D")
+77 SET AMERSTRG=$$EDAUDIT^AMEREDAU("12.1",AMEROLD,AMERNEW,"ADMITTING PROVIDER TIME")
+78 IF AMERSTRG="^"
SET AMERQUIT=1
QUIT
+79 SET AMEREDTS=$SELECT(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
+80 SET DR="12.1////"_Y
+81 SET AMERDIFF=$$DT^AMERSAV1(Y,AMERARV,"M")
+82 SET DR=DR_";12.3////"_AMERDIFF
+83 SET Y=""
+84 QUIT
End DoDot:3
+85 QUIT
End DoDot:2
+86 IF Y="^"
SET AMERQUIT=1
+87 IF (DR'=""&(AMEROLD'=""))
Begin DoDot:2
+88 IF DR="12.1////@"
Begin DoDot:3
+89 DO EN^DDIOL("Deleting ADMITTING PROVIDER TIME - can't be before date/time of admission","","!!")
+90 SET AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"D")
+91 SET AMERSTRG=$$EDAUDIT^AMEREDAU("12.1",AMEROLD,"","ADMITTING PROVIDER TIME")
+92 SET AMEREDTS=$SELECT(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
+93 QUIT
End DoDot:3
+94 DO DIE(AMERDA,DR)
+95 DO MULTAUDT^AMEREDAU(AMEREDTS,AMERAIEN)
+96 QUIT
End DoDot:2
+97 QUIT
+98 SET DR=""
+99 QUIT
End DoDot:1
+100 SET (AMEROLD,Y)=$PIECE(^AMERVSIT(AMERDA,6),U,2)
+101 ; If ARRIVE TIME compared to DEPART TIME is AFTER then do
+102 IF $$TCOMP(AMERARV,AMEROLD,1)=1
Begin DoDot:1
+103 SET Y=AMEROLD
XECUTE ^DD("DD")
+104 ; DEPART TIME IN EXTERNAL FORMAT
SET AMERDEPT=Y
+105 SET DR="6.2////@"
+106 SET DIR(0)="DO^::ER"
SET DIR("A")="*What time did the patient depart from the ER"
+107 SET DIR("?")="Enter an exact date and time in Fileman format (e.g. T@1PM)"
+108 SET DIR("B")=AMERDEPT
+109 FOR
IF Y="^"!(Y="")
QUIT
IF 'AMERQUIT
Begin DoDot:2
+110 DO ^DIR
+111 IF X="^"
SET Y="^"
QUIT
+112 IF $DATA(DUOUT)!$DATA(DTOUT)
KILL DIR,DUOUT,DTOUT
SET Y="^"
QUIT
+113 ; TVAL returns 0 if user says "yes they are sure they want this time..."
+114 IF $$TVAL^AMER2A($PIECE($GET(^AMERVSIT(AMERDA,0)),U,1),AMERNEW,6)
QUIT
+115 IF $$TCK^AMER2A(AMERARV,Y,1,"admission")=0
Begin DoDot:3
+116 SET AMERNEW=Y
+117 IF AMERNEW=AMEROLD
DO EN^DDIOL("The ADMITTING PROVIDER TIME must be AFTER time of addmission","","!!")
QUIT
+118 ; Tranforms fileman date into user friendly date
SET AMERNEW=$$EDDISPL^AMEREDAU(AMERNEW,"D")
+119 SET AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"D")
+120 SET AMERSTRG=$$EDAUDIT^AMEREDAU("6.2",AMEROLD,AMERNEW,"DEPARTURE TIME")
+121 IF AMERSTRG="^"
SET AMERQUIT=1
QUIT
+122 SET AMEREDTS=$SELECT(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
+123 SET DR="6.2////"_Y
+124 SET AMERDIFF=$$DT^AMERSAV1(Y,AMERARV,"M")
+125 SET DR=DR_";12.5////"_AMERDIFF
+126 SET Y=""
+127 QUIT
End DoDot:3
+128 QUIT
End DoDot:2
+129 IF Y="^"
SET AMERQUIT=1
+130 IF (DR'=""&(AMEROLD'=""))
Begin DoDot:2
+131 IF DR="6.2////@"
Begin DoDot:3
+132 DO EN^DDIOL("Deleting DEPARTURE TIME - can't be before date/time of admission","","!!")
+133 SET AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"D")
+134 SET AMERSTRG=$$EDAUDIT^AMEREDAU("6.2",AMEROLD,"","DEPARTURE TIME")
+135 SET AMEREDTS=$SELECT(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
+136 QUIT
End DoDot:3
+137 DO DIE(AMERDA,DR)
+138 ;IHS/OIT/SCR 12/15/08 - update ER VISIT FILE with DATE LAST UPDATED (NOW)
+139 DO TIMESTMP^AMERSAV1(AMERDA)
+140 DO MULTAUDT^AMEREDAU(AMEREDTS,AMERAIEN)
+141 QUIT
End DoDot:2
+142 SET DR=""
+143 QUIT
End DoDot:1
+144 SET (AMEROLD,INJTIME)=$PIECE($GET(^AMERVSIT(AMERDA,3)),U,4)
+145 ; If ARRIVE TIME is after INJ TIME then do
+146 IF $$TCOMP(AMERARV,AMEROLD,1)=0
Begin DoDot:1
+147 IF AMEROLD=""
QUIT
+148 ; INJURED TIME IN FILEMAN FORMAT
SET Y=INJTIME
XECUTE ^DD("DD")
+149 SET INJTIME=Y
+150 SET DR="3.4////@"
+151 SET DIR(0)="DO^::ER"
SET DIR("A")="*Please enter date and time of injury"
+152 SET DIR("?")="Enter an exact date and time in Fileman format (e.g. T@1PM)"
+153 SET DIR("B")=INJTIME
+154 FOR
IF Y="^"!(Y="")
QUIT
IF 'AMERQUIT
Begin DoDot:2
+155 DO ^DIR
+156 IF X="^"
SET Y="^"
QUIT
+157 IF $DATA(DUOUT)!$DATA(DTOUT)
KILL DIR,DUOUT,DTOUT
SET Y="^"
QUIT
+158 SET AMERCHKT=$$TCK^AMER2A(Y,AMERARV,0,"admission")
+159 IF AMERCHKT=0
Begin DoDot:3
+160 SET AMERNEW=Y
+161 IF AMERNEW=AMEROLD
QUIT
+162 SET AMERSTRG=$$EDAUDIT^AMEREDAU("3.4",AMEROLD,AMERNEW,"TIME OF INJURY")
+163 IF AMERSTRG="^"
SET AMERQUIT=1
QUIT
+164 SET AMEREDTS=$SELECT(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
+165 IF Y=""
SET DR="3.4////@;8.1////@"
SET Y="^"
+166 IF AMERCHKT=1
Begin DoDot:4
+167 SET DR="3.4////"_Y
+168 SET AMERDIFF=$$DT^AMERSAV1(AMERARV,Y,"M")
+169 SET DR=DR_";8.1////"_AMERDIFF
+170 SET Y="^"
+171 QUIT
End DoDot:4
+172 QUIT
End DoDot:3
+173 QUIT
End DoDot:2
+174 IF Y="^"
SET AMERQUIT=1
+175 IF DR'=""
Begin DoDot:2
+176 IF DR="3.4////@"
Begin DoDot:3
+177 DO EN^DDIOL("Deleting TIME OF INJURY - can't be after date/time of admission","","!!")
+178 SET AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"D")
+179 SET AMERSTRG=$$EDAUDIT^AMEREDAU("3.4",AMEROLD,"","TIME OF INJURY")
+180 SET AMEREDTS=$SELECT(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
+181 QUIT
End DoDot:3
+182 DO DIE(AMERDA,DR)
KILL DIE
+183 ;IHS/OIT/SCR 12/15/08 - update ER VISIT FILE with DATE LAST UPDATED (NOW)
+184 DO TIMESTMP^AMERSAV1(AMERDA)
+185 SET DR=""
+186 QUIT
End DoDot:2
+187 QUIT
End DoDot:1
+188 ; Finally, display ER Consultants and ask if user wants to edit times
+189 IF $PIECE($GET(^AMERVSIT(AMERDA,19,0)),U,4)'=""
Begin DoDot:1
+190 SET AMERCSLT=$ORDER(^AMERVSIT(AMERDA,19,"B",0))
+191 SET AMERDOC=$GET(^AMER(2.9,AMERCSLT,0))
+192 DO EN^DDIOL("The following ER CONSULTANT types and times have been entered","","!")
+193 DO DSPCONS^AMEREDTE(AMERDA)
+194 SET DIR(0)="Y"
SET DIR("A")="Do you want to change ER CONSULTANT times"
SET DIR("B")="YES"
+195 DO ^DIR
+196 SET AMERQUIT=0
+197 IF Y=1
Begin DoDot:2
+198 FOR
IF AMERQUIT=1
QUIT
Begin DoDot:3
+199 KILL DIC("B")
+200 SET DIC="^AMER(2.9,"
SET DIC(0)="AMEQ"
SET Y=""
+201 SET DIC("A")="Edit time for ER CONSULTANT TYPE: "
+202 DO ^DIC
KILL DIC
+203 IF $DATA(DUOUT)!($DATA(DTOUT)!(+Y<0))
SET AMERQUIT=1
QUIT
+204 SET AMERCSLT=$PIECE($GET(Y),U,1)
+205 IF AMERCSLT>0
Begin DoDot:4
+206 SET AMEREDNO=AMEREDNO+1
+207 SET AMERCNO=0
SET AMEROLD=AMERCSLT
+208 FOR
SET AMERCNO=$ORDER(^AMERVSIT(AMERDA,19,AMERCNO))
IF AMERCNO="B"!(AMERCNO="")
QUIT
IF $PIECE($GET(^AMERVSIT(AMERDA,19,AMERCNO,0)),U,1)=AMERCSLT
Begin DoDot:5
+209 SET Y=$PIECE($GET(^AMERVSIT(AMERDA,19,AMERCNO,0)),U,2)
+210 SET AMERTIME=Y
+211 SET DIR(0)="D^::ER"
SET DIR("A")="Date and time of ER CONSULTANT"
+212 SET AMEROLD=AMERTIME
+213 IF AMERTIME'=""
SET Y=AMERTIME
DO DD^%DT
SET DIR("B")=Y
+214 SET DIR("?")="Enter date and time in the usual Fileman format (e.g. 1/1/2000@1PM)"
+215 DO ^DIR
KILL DIR
+216 IF $DATA(DUOUT)!$DATA(DTOUT)
SET AMERQUIT=1
QUIT
+217 SET (AMERTIME,AMERNEW)=Y
+218 IF AMEROLD'=AMERNEW
Begin DoDot:6
+219 SET AMERSTRG=$$EDAUDIT^AMEREDAU("19-02"_"."_AMEREDNO,$$EDDISPL^AMEREDAU(AMEROLD,"D"),$$EDDISPL^AMEREDAU(AMERNEW,"D"),"ER CONSULTANT TIME")
+220 IF AMERSTRG="^"
SET AMERQUIT=1
QUIT
+221 SET AMEREDTS=$SELECT(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
+222 SET DR=$SELECT(DR'="":DR_";",1:"")
SET DR=DR_".02////"_AMERNEW
+223 SET DIE="^AMERVSIT(DA(1),19,"
SET DA(1)=AMERDA
SET DA=AMERCNO
+224 DO MULTDIE^AMEREDIT(DIE,DA,DA(1),DR)
+225 ;IHS/OIT/SCR 12/15/08 - update ER VISIT FILE with DATE LAST UPDATED (NOW)
+226 DO TIMESTMP^AMERSAV1(AMERDA)
+227 DO MULTAUDT^AMEREDAU(AMEREDTS,AMERAIEN)
+228 SET (DR,AMEREDTS)=""
+229 QUIT
End DoDot:6
+230 QUIT
End DoDot:5
+231 QUIT
End DoDot:4
+232 QUIT
End DoDot:3
+233 QUIT
End DoDot:2
+234 QUIT
End DoDot:1
+235 KILL DIE,DR,DIR,Y,AMEROLD,AMERNEW,AMEREDTS,AMERSTRG
+236 QUIT
TCOMP(AMERTIM1,AMERTIM2,AMERAFTR) ; EP FROM CHKVSIT^AMEREDPC AND AMERREPT
+1 ; TIME COMPARE ROUTINE
+2 ; INPUT
+3 ; AMERTIM1=DATE/TIME IN FILEMAN FORMAT
+4 ; AMERTIM2=COMPARISON DATE/TIME IN FILEMAN FORMAT
+5 ; AMERAFTR=1:AMERTIM1 IS AFTER AMERTIM2
+6 ; AMERAFTR=0:AMERTIM1 IS BEFORE AMERTIM2
+7 ; RETURNS 1 IF COMPARE IS TRUE, 0 OTHERWISE
+8 NEW %,Y,X1,X2,X
+9 IF $GET(AMERTIM1)=""
QUIT ""
+10 IF $GET(AMERTIM2)=""
QUIT 1
+11 IF AMERAFTR
IF AMERTIM1<AMERTIM2
QUIT 0
+12 IF 'AMERAFTR
IF AMERTIM2<AMERTIM1
QUIT 0
+13 QUIT 1
DIE(DA,DR) ; GIVEN AN ENTRY NUMBER AND A DR STRING, EDIT THE ER VISIT FILE
+1 NEW X,Y,%
+2 NEW D,D0,DI,DIC,DICR,DIE,DIG,DIH,DIV,DIU,DIW,DQ
+3 SET DIE="^AMERVSIT("
DIE1 LOCK +^AMERVSIT:3
IF '$TEST
QUIT
+1 DO ^DIE
+2 LOCK -^AMERVSIT
+3 QUIT
COMPUTE(AMERDA) ; EP from AMEREDIT
+1 ; COMPUTED FIELDS
+2 ; C0 ; REVOLVING DOOR
+3 NEW X,Y,Z,%,%H,%T,%Y,DR
+4 SET Z=$PIECE($GET(^AMERVSIT(AMERDA,0)),U,1)
SET DR=""
+5 ; If there is an injury time saved, compute this field
+6 SET X=$PIECE($GET(^AMERVSIT(AMERDA,3)),U,4)
+7 IF X'=""
SET %=$$DT^AMERSAV1(Z,X,"M")
SET DR=$SELECT(DR'="":DR_";",1:"")
SET DR=DR_"8.1////"_%
+8 IF '$TEST
SET DR=$SELECT(DR'="":DR_";",1:"")
SET DR=DR_"8.1////@"
+9 ; C2 ; DOC WAIT
+10 SET X=$PIECE($GET(^AMERVSIT(AMERDA,12)),U,1)
+11 IF X'=""
SET %=$$DT^AMERSAV1(X,Z,"M")
SET DR=$SELECT(DR'="":DR_";",1:"")
SET DR=DR_"12.3////"_%
+12 IF '$TEST
SET DR=$SELECT(DR'="":DR_";",1:"")
SET DR=DR_"12.3////@"
+13 ; C3 ; TRIAGE WAIT
+14 SET X=$PIECE($GET(^AMERVSIT(AMERDA,12)),U,2)
+15 IF X'=""
SET %=$$DT^AMERSAV1(X,Z,"M")
SET DR=$SELECT(DR'="":DR_";",1:"")
SET DR=DR_"12.4////"_%
+16 IF '$TEST
SET DR=$SELECT(DR'="":DR_";",1:"")
SET DR=DR_"12.4////@"
+17 ; C4 ; VISIT DURATION
+18 SET X=$PIECE($GET(^AMERVSIT(AMERDA,6)),U,2)
+19 IF X'=""
SET %=$$DT^AMERSAV1(X,Z,"M")
SET DR=$SELECT(DR'="":DR_";",1:"")
SET DR=DR_"12.5////"_%
+20 IF '$TEST
SET DR=$SELECT(DR'="":DR_";",1:"")
SET DR=DR_"12.5////@"
+21 DO DIE(AMERDA,DR)
+22 ;IHS/OIT/SCR 12/15/08 - update ER VISIT FILE with DATE LAST UPDATED (NOW)
+23 DO TIMESTMP^AMERSAV1(AMERDA)
+24 KILL A,B,C,E,X,%,%H,Z,DR
+25 QUIT
