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

AMERTIME.m

Go to the documentation of this file. 
  1. AMERTIME ; IHS/OIT/SCR - CHECKS TIMES FOR PROPER RELATIONSHIP 
  1.  ;;3.0;ER VISIT SYSTEM;**2**;FEB 23, 2009
  1.  ;
  1. CHKTIME(AMERARV,AMERAIEN) ; EP from AMEREDIT
  1.  ; AMERARV- ARIVAL TIME IN FILEMAN FORMAT
  1.  ; AMERAIEN : AUDIT IEN
  1.  ;
  1.  ; INJURY TIME < ADMIT TIME < TRIAGE AND PROVIDER TIME < DISCHARGE TIME
  1.  ; ARVTIME has been modified so 
  1.  ; 1. check TRIAGE time - prompt for and delete if before ARVTIME
  1.  ; 2. check PROVIDER time - prompt for and delte if before ARVTIME
  1.  ; 3. check DEPARTURE time - prompt for and delete if before ARVTIME,TRIAGE OR PROVIDER time
  1.  N AMERPRVT,AMERTRIT,AMERDEPT,AMERDIFF,DR,DIE,DIR
  1.  N AMEROLD,AMERNEW,AMEREDTS,AMERSTRG,AMERQUIT,AMERCSLT,AMERDOC,AMERCNO,AMERADMT,AMERCHKT
  1.  S (AMEROLD,AMERNEW,AMEREDTS,AMERSTRG,DR)=""
  1.  S AMERQUIT=0
  1.  S (AMEROLD,AMERTRIT)=$P(^AMERVSIT(AMERDA,12),U,2)
  1.  ; I ARRIVE TIME compared to TRIAGE TIME is after go onto loop, else it's ok
  1.  I $$TCOMP(AMERARV,AMERTRIT,1)=1 D
  1.  .S Y=AMERTRIT X ^DD("DD")
  1.  .S AMERTRIT=Y  ; TRIAGE NURSE TIME IN EXTERNAL FORMAT FOR DIC("B")
  1.  .S DR="12.2////@"
  1.  .S DIR(0)="D^::ER",DIR("A")="*What time did the patient see the triage nurse"
  1.  .S DIR("?")="Enter an exact date and time in Fileman format (e.g. T@1PM)"
  1.  .S DIR("B")=AMERTRIT
  1.  .F  Q:Y="^"!(Y="")  D
  1.  ..D ^DIR
  1.  ..I X="^" S Y="^"
  1.  ..I $D(DUOUT)!$D(DTOUT) K DIR,DUOUT,DTOUT,Y S Y="^" Q
  1.  ..I $$TCK^AMER2A(AMERARV,Y,1,"admission")=0  D
  1.  ...S AMERNEW=Y
  1.  ...I AMERNEW=AMEROLD S Y="" Q
  1.  ...S AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"D")
  1.  ...S AMERNEW=$$EDDISPL^AMEREDAU(AMERNEW,"D")
  1.  ...S AMERSTRG=$$EDAUDIT^AMEREDAU("12.2",AMEROLD,AMERNEW,"TRG NURSE TIME")
  1.  ...I AMERSTRG="^" S AMERQUIT=1 Q
  1.  ...S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
  1.  ...S DR="12.2////"_Y
  1.  ...S AMERDIFF=$$DT^AMERSAV1(Y,AMERARV,"M")
  1.  ...S DR=DR_";12.4////"_AMERDIFF
  1.  ...S Y=""
  1.  ...Q
  1.  ..Q
  1.  .I Y="^" S AMERQUIT=1
  1.  .I (DR'=""&(AMEROLD'="")) D
  1.  ..I DR="12.2////@" D
  1.  ...;IHS/OIT/SCR 090309 patch 2
  1.  ...;D EN^DDIOL("Deleting TRIAGE NURSE TIME can't be before date/time of admission","","!")
  1.  ...D EN^DDIOL("Deleting TRIAGE NURSE TIME which is before new date/time of admission","","!")
  1.  ...D EN^DDIOL("Please update TRIATE NURSE triage time in TRIAGE edit section","","!!")
  1.  ...S AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"D")
  1.  ...S AMERSTRG=$$EDAUDIT^AMEREDAU("12.2",AMEROLD,"","TRG NURSE TIME")
  1.  ...S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
  1.  ...Q
  1.  ..Q:AMERQUIT
  1.  ..D DIE(AMERDA,DR)
  1.  ..D MULTAUDT^AMEREDAU(AMEREDTS,AMERAIEN)
  1.  ..Q
  1.  ..Q
  1.  .K DIR
  1.  .S DR=""
  1.  .Q
  1.  S (AMEROLD,AMERPRVT)=$P(^AMERVSIT(AMERDA,12),U,1)
  1.  ; If ARRIVE TIME IS after PROV TIME then do
  1.  I $$TCOMP(AMERARV,AMERPRVT,1)=1 D
  1.  .S Y=AMERPRVT X ^DD("DD")
  1.  .S AMERPRVT=Y   ; ADMITTING PROV TIME IN EXTERNAL FORMAT
  1.  .S DR="12.1////@"
  1.  .S DIR(0)="DO^::ER",DIR("A")="*What time did the patient see the admitting provider"
  1.  .S DIR("?")="Enter an exact date and time in Fileman format (e.g. T@1PM)"
  1.  .S DIR("B")=AMERPRVT
  1.  .F  Q:Y="^"!(Y="")  D:'AMERQUIT
  1.  ..D ^DIR
  1.  ..I X="^" S Y="^"
  1.  ..I $D(DUOUT)!$D(DTOUT) K DIR,DUOUT,DTOUT S Y="^" Q
  1.  ..I $$TCK^AMER2A(AMERARV,Y,1,"admission")=0  D
  1.  ...S AMERNEW=Y
  1.  ...I AMERNEW=AMEROLD D EN^DDIOL("The ADMITTING PROVIDER TIME must be AFTER time of addmission","","!!") Q
  1.  ...S AMERNEW=$$EDDISPL^AMEREDAU(AMERNEW,"D")  ; Tranforms fileman date into user friendly date
  1.  ...S AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"D")
  1.  ...S AMERSTRG=$$EDAUDIT^AMEREDAU("12.1",AMEROLD,AMERNEW,"ADMITTING PROVIDER TIME")
  1.  ...I AMERSTRG="^" S AMERQUIT=1 Q
  1.  ...S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
  1.  ...S DR="12.1////"_Y
  1.  ...S AMERDIFF=$$DT^AMERSAV1(Y,AMERARV,"M")
  1.  ...S DR=DR_";12.3////"_AMERDIFF
  1.  ...S Y=""
  1.  ...Q
  1.  ..Q
  1.  .I Y="^" S AMERQUIT=1
  1.  .I (DR'=""&(AMEROLD'="")) D
  1.  ..I DR="12.1////@" D
  1.  ...D EN^DDIOL("Deleting ADMITTING PROVIDER TIME - can't be before date/time of admission","","!!")
  1.  ...S AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"D")
  1.  ...S AMERSTRG=$$EDAUDIT^AMEREDAU("12.1",AMEROLD,"","ADMITTING PROVIDER TIME")
  1.  ...S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
  1.  ...Q
  1.  ..D DIE(AMERDA,DR)
  1.  ..D MULTAUDT^AMEREDAU(AMEREDTS,AMERAIEN)
  1.  ..Q
  1.  .Q
  1.  .S DR=""
  1.  .Q
  1.  S (AMEROLD,Y)=$P(^AMERVSIT(AMERDA,6),U,2)
  1.  ; If ARRIVE TIME compared to DEPART TIME is AFTER then do
  1.  I $$TCOMP(AMERARV,AMEROLD,1)=1 D
  1.  .S Y=AMEROLD X ^DD("DD")
  1.  .S AMERDEPT=Y  ; DEPART TIME IN EXTERNAL FORMAT
  1.  .S DR="6.2////@"
  1.  .S DIR(0)="DO^::ER",DIR("A")="*What time did the patient depart from the ER"
  1.  .S DIR("?")="Enter an exact date and time in Fileman format (e.g. T@1PM)"
  1.  .S DIR("B")=AMERDEPT
  1.  .F  Q:Y="^"!(Y="")  D:'AMERQUIT
  1.  ..D ^DIR
  1.  ..I X="^" S Y="^" Q
  1.  ..I $D(DUOUT)!$D(DTOUT) K DIR,DUOUT,DTOUT S Y="^" Q
  1.  ..; TVAL returns 0 if user says "yes they are sure they want this time..."
  1.  ..I $$TVAL^AMER2A($P($G(^AMERVSIT(AMERDA,0)),U,1),AMERNEW,6) Q
  1.  ..I $$TCK^AMER2A(AMERARV,Y,1,"admission")=0 D
  1.  ...S AMERNEW=Y
  1.  ...I AMERNEW=AMEROLD D EN^DDIOL("The ADMITTING PROVIDER TIME must be AFTER time of addmission","","!!") Q
  1.  ...S AMERNEW=$$EDDISPL^AMEREDAU(AMERNEW,"D")  ; Tranforms fileman date into user friendly date
  1.  ...S AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"D")
  1.  ...S AMERSTRG=$$EDAUDIT^AMEREDAU("6.2",AMEROLD,AMERNEW,"DEPARTURE TIME")
  1.  ...I AMERSTRG="^" S AMERQUIT=1 Q
  1.  ...S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
  1.  ...S DR="6.2////"_Y
  1.  ...S AMERDIFF=$$DT^AMERSAV1(Y,AMERARV,"M")
  1.  ...S DR=DR_";12.5////"_AMERDIFF
  1.  ...S Y=""
  1.  ...Q
  1.  ..Q
  1.  .I Y="^" S AMERQUIT=1
  1.  .I (DR'=""&(AMEROLD'="")) D
  1.  ..I DR="6.2////@" D
  1.  ...D EN^DDIOL("Deleting DEPARTURE TIME - can't be before date/time of admission","","!!")
  1.  ...S AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"D")
  1.  ...S AMERSTRG=$$EDAUDIT^AMEREDAU("6.2",AMEROLD,"","DEPARTURE TIME")
  1.  ...S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
  1.  ...Q
  1.  ..D DIE(AMERDA,DR)
  1.  ..;IHS/OIT/SCR 12/15/08 - update ER VISIT FILE with DATE LAST UPDATED (NOW)
  1.  ..D TIMESTMP^AMERSAV1(AMERDA)
  1.  ..D MULTAUDT^AMEREDAU(AMEREDTS,AMERAIEN)
  1.  ..Q
  1.  .S DR=""
  1.  .Q
  1.  S (AMEROLD,INJTIME)=$P($G(^AMERVSIT(AMERDA,3)),U,4)
  1.  ; If ARRIVE TIME is after INJ TIME then do
  1.  I $$TCOMP(AMERARV,AMEROLD,1)=0 D
  1.  .Q:AMEROLD=""
  1.  .S Y=INJTIME X ^DD("DD")   ; INJURED TIME IN FILEMAN FORMAT
  1.  .S INJTIME=Y
  1.  .S DR="3.4////@"
  1.  .S DIR(0)="DO^::ER",DIR("A")="*Please enter date and time of injury"
  1.  .S DIR("?")="Enter an exact date and time in Fileman format (e.g. T@1PM)"
  1.  .S DIR("B")=INJTIME
  1.  .F  Q:Y="^"!(Y="")  D:'AMERQUIT
  1.  ..D ^DIR
  1.  ..I X="^" S Y="^" Q
  1.  ..I $D(DUOUT)!$D(DTOUT) K DIR,DUOUT,DTOUT S Y="^" Q
  1.  ..S AMERCHKT=$$TCK^AMER2A(Y,AMERARV,0,"admission")
  1.  ..I AMERCHKT=0 D
  1.  ...S AMERNEW=Y
  1.  ...I AMERNEW=AMEROLD Q
  1.  ...S AMERSTRG=$$EDAUDIT^AMEREDAU("3.4",AMEROLD,AMERNEW,"TIME OF INJURY")
  1.  ...I AMERSTRG="^" S AMERQUIT=1 Q
  1.  ...S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
  1.  ...S:Y="" DR="3.4////@;8.1////@",Y="^"
  1.  ...I AMERCHKT=1 D
  1.  ....S DR="3.4////"_Y
  1.  ....S AMERDIFF=$$DT^AMERSAV1(AMERARV,Y,"M")
  1.  ....S DR=DR_";8.1////"_AMERDIFF
  1.  ....S Y="^"
  1.  ....Q
  1.  ...Q
  1.  ..Q
  1.  .I Y="^" S AMERQUIT=1
  1.  .I DR'="" D
  1.  ..I DR="3.4////@" D
  1.  ...D EN^DDIOL("Deleting TIME OF INJURY - can't be after date/time of admission","","!!")
  1.  ...S AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"D")
  1.  ...S AMERSTRG=$$EDAUDIT^AMEREDAU("3.4",AMEROLD,"","TIME OF INJURY")
  1.  ...S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
  1.  ...Q
  1.  ..D DIE(AMERDA,DR) K DIE
  1.  ..;IHS/OIT/SCR 12/15/08 - update ER VISIT FILE with DATE LAST UPDATED (NOW)
  1.  ..D TIMESTMP^AMERSAV1(AMERDA)
  1.  ..S DR=""
  1.  ..Q
  1.  .Q
  1.  ; Finally, display ER Consultants and ask if user wants to edit times
  1.  I $P($G(^AMERVSIT(AMERDA,19,0)),U,4)'="" D
  1.  .S AMERCSLT=$O(^AMERVSIT(AMERDA,19,"B",0))
  1.  .S AMERDOC=$G(^AMER(2.9,AMERCSLT,0))
  1.  .D EN^DDIOL("The following ER CONSULTANT types and times have been entered","","!")
  1.  .D DSPCONS^AMEREDTE(AMERDA)
  1.  .S DIR(0)="Y",DIR("A")="Do you want to change ER CONSULTANT times",DIR("B")="YES"
  1.  .D ^DIR
  1.  .S AMERQUIT=0
  1.  .I Y=1 D
  1.  ..F  Q:AMERQUIT=1  D
  1.  ...K DIC("B")
  1.  ...S DIC="^AMER(2.9,",DIC(0)="AMEQ",Y=""
  1.  ...S DIC("A")="Edit time for ER CONSULTANT TYPE: "
  1.  ...D ^DIC K DIC
  1.  ...I $D(DUOUT)!($D(DTOUT)!(+Y<0)) S AMERQUIT=1 Q
  1.  ...S AMERCSLT=$P($G(Y),U,1)
  1.  ...I AMERCSLT>0 D
  1.  ....S AMEREDNO=AMEREDNO+1
  1.  ....S AMERCNO=0,AMEROLD=AMERCSLT
  1.  ....F  S AMERCNO=$O(^AMERVSIT(AMERDA,19,AMERCNO)) Q:AMERCNO="B"!(AMERCNO="")  I $P($G(^AMERVSIT(AMERDA,19,AMERCNO,0)),U,1)=AMERCSLT D
  1.  .....S Y=$P($G(^AMERVSIT(AMERDA,19,AMERCNO,0)),U,2)
  1.  .....S AMERTIME=Y
  1.  .....S DIR(0)="D^::ER",DIR("A")="Date and time of ER CONSULTANT"
  1.  .....S AMEROLD=AMERTIME
  1.  .....I AMERTIME'="" S Y=AMERTIME D DD^%DT S DIR("B")=Y
  1.  .....S DIR("?")="Enter date and time in the usual Fileman format (e.g. 1/1/2000@1PM)"
  1.  .....D ^DIR K DIR
  1.  .....I $D(DUOUT)!$D(DTOUT) S AMERQUIT=1 Q
  1.  .....S (AMERTIME,AMERNEW)=Y
  1.  .....I AMEROLD'=AMERNEW D
  1.  ......S AMERSTRG=$$EDAUDIT^AMEREDAU("19-02"_"."_AMEREDNO,$$EDDISPL^AMEREDAU(AMEROLD,"D"),$$EDDISPL^AMEREDAU(AMERNEW,"D"),"ER CONSULTANT TIME")
  1.  ......I AMERSTRG="^" S AMERQUIT=1 Q
  1.  ......S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
  1.  ......S DR=$S(DR'="":DR_";",1:""),DR=DR_".02////"_AMERNEW
  1.  ......S DIE="^AMERVSIT(DA(1),19,",DA(1)=AMERDA,DA=AMERCNO
  1.  ......D MULTDIE^AMEREDIT(DIE,DA,DA(1),DR)
  1.  ......;IHS/OIT/SCR 12/15/08 - update ER VISIT FILE with DATE LAST UPDATED (NOW)
  1.  ......D TIMESTMP^AMERSAV1(AMERDA)
  1.  ......D MULTAUDT^AMEREDAU(AMEREDTS,AMERAIEN)
  1.  ......S (DR,AMEREDTS)=""
  1.  ......Q
  1.  .....Q
  1.  ....Q
  1.  ...Q
  1.  ..Q
  1.  .Q
  1.  K DIE,DR,DIR,Y,AMEROLD,AMERNEW,AMEREDTS,AMERSTRG
  1.  Q
  1. TCOMP(AMERTIM1,AMERTIM2,AMERAFTR) ; EP FROM CHKVSIT^AMEREDPC AND AMERREPT
  1.  ;  TIME COMPARE ROUTINE
  1.  ;  INPUT
  1.  ;     AMERTIM1=DATE/TIME IN FILEMAN FORMAT
  1.  ;     AMERTIM2=COMPARISON DATE/TIME IN FILEMAN FORMAT
  1.  ;     AMERAFTR=1:AMERTIM1 IS AFTER AMERTIM2
  1.  ;     AMERAFTR=0:AMERTIM1 IS BEFORE AMERTIM2
  1.  ; RETURNS 1 IF COMPARE IS TRUE, 0 OTHERWISE
  1.  N %,Y,X1,X2,X
  1.  I $G(AMERTIM1)="" Q ""
  1.  I $G(AMERTIM2)="" Q 1
  1.  I AMERAFTR,AMERTIM1<AMERTIM2 Q 0
  1.  I 'AMERAFTR,AMERTIM2<AMERTIM1 Q 0
  1.  Q 1
  1. DIE(DA,DR) ; GIVEN AN ENTRY NUMBER AND A DR STRING, EDIT THE ER VISIT FILE
  1.  N X,Y,%
  1.  N D,D0,DI,DIC,DICR,DIE,DIG,DIH,DIV,DIU,DIW,DQ
  1.  S DIE="^AMERVSIT("
  1. DIE1 L +^AMERVSIT:3 E  Q
  1.  D ^DIE
  1.  L -^AMERVSIT
  1.  Q
  1. COMPUTE(AMERDA) ; EP from AMEREDIT
  1.  ; COMPUTED FIELDS
  1.  ; C0 ; REVOLVING DOOR
  1.  N X,Y,Z,%,%H,%T,%Y,DR
  1.  S Z=$P($G(^AMERVSIT(AMERDA,0)),U,1),DR=""
  1.  ; If there is an injury time saved, compute this field
  1.  S X=$P($G(^AMERVSIT(AMERDA,3)),U,4)
  1.  I X'="" S %=$$DT^AMERSAV1(Z,X,"M"),DR=$S(DR'="":DR_";",1:""),DR=DR_"8.1////"_%
  1.  E  S DR=$S(DR'="":DR_";",1:""),DR=DR_"8.1////@"
  1.  ; C2 ; DOC WAIT
  1.  S X=$P($G(^AMERVSIT(AMERDA,12)),U,1)
  1.  I X'="" S %=$$DT^AMERSAV1(X,Z,"M"),DR=$S(DR'="":DR_";",1:""),DR=DR_"12.3////"_%
  1.  E  S DR=$S(DR'="":DR_";",1:""),DR=DR_"12.3////@"
  1.  ; C3 ; TRIAGE WAIT
  1.  S X=$P($G(^AMERVSIT(AMERDA,12)),U,2)
  1.  I X'="" S %=$$DT^AMERSAV1(X,Z,"M"),DR=$S(DR'="":DR_";",1:""),DR=DR_"12.4////"_%
  1.  E  S DR=$S(DR'="":DR_";",1:""),DR=DR_"12.4////@"
  1.  ; C4 ; VISIT DURATION
  1.  S X=$P($G(^AMERVSIT(AMERDA,6)),U,2)
  1.  I X'="" S %=$$DT^AMERSAV1(X,Z,"M"),DR=$S(DR'="":DR_";",1:""),DR=DR_"12.5////"_%
  1.  E  S DR=$S(DR'="":DR_";",1:""),DR=DR_"12.5////@"
  1.  D DIE(AMERDA,DR)
  1.  ;IHS/OIT/SCR 12/15/08 - update ER VISIT FILE with DATE LAST UPDATED (NOW)
  1.  D TIMESTMP^AMERSAV1(AMERDA)
  1.  K A,B,C,E,X,%,%H,Z,DR
  1.  Q