AMEREDTT ; IHS/OIT/SCR - SUB-ROUTINE FOR ER VISIT EDIT of Triage Information
;;3.0;ER VISIT SYSTEM;**6**;MAR 03, 2009;Build 30
;
;VARIABLES: The following variables are passed to multiple editing routines
; AMERDA : the IEN of the ER VISIT that is selected for editing
; AMERAIEN: The IEN of the ER AUDIT that is created when user begins editing a record
; AMEREDNO: An integer representing the number of multiple fields that have been edited
; for uniqueness in multiple field number in audit file
;
; Edit Auditing VARIABLES newed and used throughout edit routines:
; AMEROLD : original value of edited field
; AMERNEW : new value of edited field
; AMERSTRG : A ";" deliminated string of edit information for a field
;
ADMTRIAG(AMERDA,AMERAIEN) ; EP from AMEREDIT
N AMEROLD,AMERNEW,AMEREDTS,AMERSTRG,DR,DIR,DIC,AMERSKIP
S (AMEROLD,AMERNEW,AMEREDTS,AMERSTRG,DR)=""
Q:'$D(^XUSEC("AMERZ9999",DUZ)) $$ERSEDTT(AMERDA,AMERAIEN) ; PROGRAMATICALLY locking fields that pass to PCC
S AMERSKIP=0
; ED PROVIDER
N DIC,DIR
S DIC("A")="*ED Provider: "
S AMEROLD=$P($G(^AMERVSIT(AMERDA,0)),U,6)
;screening so that only valid PCC providers identified
S DIC("S")="I $D(^VA(200,""AK.PROVIDER"",$P($G(^VA(200,+Y,0)),U),+Y))"
I AMEROLD'="" S DIC("B")=$P(^VA(200,AMEROLD,0),U)
S DIC="^VA(200,",DIC(0)="AEQ" ;
D ^DIC
I $D(DUOUT)!$D(DTOUT) K DUOUT,DTOUT Q 0
I Y>0 S AMERNEW=+Y
E S AMERNEW=""
I AMEROLD=AMERNEW D
.I AMERNEW="" S AMERSKIP=1 Q
.; If discharge provider is same as ED provider, don't let 'em delete it
.I AMERNEW=$P($G(^AMERVSIT(AMERDA,6)),U,3) D Q
..D EN^DDIOL("ED provider is same as DISCHARGE provider","","!!")
..D EN^DDIOL("cannot remove ED provider until DISCHARGE provider is updated","","!")
..D EN^DDIOL("","","!!")
.S DIR("A")="Do you want to REMOVE this provider from the ER VISIT"
.S DIR(0)="Y",DIR("B")="NO"
.D ^DIR
.I Y=1 D
..S DR=$S(DR'="":DR_";",1:""),DR=DR_".06////@;12.1////@" ;delete any time as well
..S AMERNEW="",AMERSKIP=1
..S AMERSTRG=$$EDAUDIT^AMEREDAU(".06",AMEROLD,AMERNEW,"INITIAL ED PROVIDER")
..I AMERSTRG="^" Q
..S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
.Q
I AMEROLD'=AMERNEW D
.S DR=$S(DR'="":DR_";",1:""),DR=DR_".06////"_AMERNEW
.S AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"N") ;translates from new person ien to name
.S AMERNEW=$$EDDISPL^AMEREDAU(AMERNEW,"N")
.S AMERSTRG=$$EDAUDIT^AMEREDAU(".06",AMEROLD,AMERNEW,"INITIAL ED PROVIDER")
.I AMERSTRG="^" S AMERQUIT=1,DR="" Q
.S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
.Q
K DIC,DIR
; DOC TIME
N DIR
S AMEROLD=$P($G(^AMERVSIT(AMERDA,12)),U,1)
I AMEROLD'="" S Y=AMEROLD X ^DD("DD") S DIR("B")=Y
S DIR(0)="DO^::ER",DIR("A")="*What was the ED Provider Medical Screening Exam Time"
S DIR("?")="Enter an exact date and time in Fileman format (e.g. T@1PM)"
F Q:Y="^"!(Y="") D
.D ^DIR
.I $D(DUOUT)!$D(DTOUT) Q
.S AMERNEW=Y
.I AMERNEW,$$TVAL^AMER2A($P($G(^AMERVSIT(AMERDA,0)),U,1),AMERNEW,6) Q
.I AMERNEW="" D
..I AMEROLD=AMERNEW S Y="^" Q
..S DR=$S(DR'="":DR_";",1:""),DR=DR_"12.1////@"
..S AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"D") ;tranforms fileman date into user friendly date
..S AMERSTRG=$$EDAUDIT^AMEREDAU("12.1",AMEROLD,AMERNEW,"INITIAL ED PROVIDER TIME")
..I AMERSTRG="^" Q
..S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
..S Y="^"
..Q
.Q:AMERNEW=""
.D:'$$TCK^AMER2A($P($G(^AMERVSIT(AMERDA,0)),U,1),AMERNEW,1,"admission")
..I AMEROLD=AMERNEW S Y="^" Q
..I AMEROLD'=AMERNEW D
...S DR=$S(DR'="":DR_";",1:""),DR=DR_"12.1////"_AMERNEW
...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,"INITIAL ED PROVIDER TIME")
...I AMERSTRG="^" Q
...S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
...S Y="^"
...Q
..Q
.Q
I $D(DUOUT)!$D(DTOUT) K DUOUT,DTOUT Q 0
D:AMEREDTS'="" MULTAUDT^AMEREDAU(AMEREDTS,AMERAIEN)
I DR'="" D DIE^AMEREDIT(AMERDA,DR)
S (DR,AMEREDTS)=""
K DIR
; TRIAGE NURSE
N DIC,DIR
S DR="",AMERSKIP=0
S DIC("A")="*Triage nurse: " K DIC("B")
S AMEROLD=$P($G(^AMERVSIT(AMERDA,0)),U,7)
I AMEROLD'="" S DIC("B")=$P($G(^VA(200,AMEROLD,0)),U)
S DIC="^VA(200,",DIC(0)="AEQM"
;screening so that only valid PCC providers identified
S DIC("S")="I $D(^VA(200,""AK.PROVIDER"",$P($G(^VA(200,+Y,0)),U),+Y))"
D ^DIC K DIC
I $D(DUOUT)!$D(DTOUT) K DUOUT,DTOUT D:AMEREDTS'="" MULTAUDT^AMEREDAU(AMEREDTS,AMERAIEN) Q 0
I Y>0 S AMERNEW=+Y
E S AMERNEW=""
I AMEROLD=AMERNEW D
.I AMERNEW="" S AMERSKIP=1 Q
.; If discharge nurse is same as admitting nurse, don't let 'em delete it
.I AMERNEW=$P($G(^AMERVSIT(AMERDA,6)),U,4) D Q
..D EN^DDIOL("TRIAGE nurse is same as DISCHARGE nurse","","!!")
..D EN^DDIOL("cannot remove TRIAGE nurse until DISCHARGE nurse is updated","","!")
..D EN^DDIOL("","","!!")
..Q
.S DIR("A")="Do you want to REMOVE this Triage nurse from this visit"
.S DIR(0)="Y",DIR("B")="NO"
.D ^DIR K DIR
.I Y=1 D
..S AMERNEW="",AMERSKIP=1
..S DR=$S(DR'="":DR_";",1:""),DR=DR_".07////@;12.2////@"
..S AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"N") ;translates from new person ien to name
..S AMERSTRG=$$EDAUDIT^AMEREDAU(".07",AMEROLD,AMERNEW,"TRIAGE NURSE")
..I AMERSTRG="^" Q
..S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
.Q
I AMEROLD'=AMERNEW D
.S AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"N") ;translates from new person ien to name
.S AMERNEW=$$EDDISPL^AMEREDAU(AMERNEW,"N")
.S AMERSTRG=$$EDAUDIT^AMEREDAU(".07",AMEROLD,AMERNEW,"TRIAGE NURSE")
.I AMERSTRG="^" Q
.S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
.S DR=$S(DR'="":DR_";",1:""),DR=DR_".07////"_+Y
.Q
K DIR,DIC
; TRIAGE TIME
N DIR
S AMEROLD=$P($G(^AMERVSIT(AMERDA,12)),U,2)
I AMEROLD'="" S Y=AMEROLD X ^DD("DD") S DIR("B")=Y
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)"
F Q:Y="^"!(Y="") D
.D ^DIR K DIR
.I $D(DUOUT)!$D(DTOUT) Q
.S AMERNEW=Y
.I AMERNEW,$$TVAL^AMER2A($P($G(^AMERVSIT(AMERDA,0)),U,1),AMERNEW,6) Q
.I AMERNEW="" D
..I AMEROLD=AMERNEW S Y="^" Q
..S DR=$S(DR'="":DR_";",1:""),DR=DR_"12.2////@"
..S AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"D") ;tranforms fileman date into user friendly date
..S AMERSTRG=$$EDAUDIT^AMEREDAU("12.2",AMEROLD,AMERNEW)
..I AMERSTRG="^" Q
..S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
..S Y="^"
..Q
.Q:AMERNEW=""
.D:'$$TCK^AMER2A($P($G(^AMERVSIT(AMERDA,0)),U,1),Y,1,"admission")
..I AMEROLD=AMERNEW S Y="^" Q
..I AMEROLD'=AMERNEW D
...S DR=$S(DR'="":DR_";",1:""),DR=DR_"12.2////"_AMERNEW
...S AMERNEW=$$EDDISPL^AMEREDAU(AMERNEW,"D") ;tranforms fileman date into user friendly date
...S AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"D")
...S AMERSTRG=$$EDAUDIT^AMEREDAU("12.2",AMEROLD,AMERNEW,"TRIAGE TIME")
...I AMERSTRG="^" Q
...S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
...S Y="^"
...Q
..Q
.Q
;
;Edit the Decision to Admit Date
D
. NEW AMERRUN,AMERSTRT,AMERFIN,X,Y,AMERPCC,AUPNVSIT,AMEROLD,AMERNEW,AMERSTRG
. ;
. ;Get the visit
. S AMERPCC=$$GET1^DIQ(9009080,AMERDA_",",.03,"I") Q:AMERPCC=""
. ;
. ;Get the old value
. S AMEROLD=$$GET1^DIQ(9000010,AMERPCC_",",1116,"E")
. ;
. ;Call the edit
. D QD28^AMER2A(AMERPCC)
. ;
. ;Get the new value
. S AMERNEW=$$GET1^DIQ(9000010,AMERPCC_",",1116,"E")
. ;
. ;Perform Audit
. I AMEROLD'=AMERNEW D
.. S AMERSTRG=$$EDAUDIT^AMEREDAU("12.8",AMEROLD,AMERNEW,"DECISION TO ADMIT DT")
..I AMERSTRG="^" Q
..S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
. ;
. ;Update ^AMERVSIT
. S AUPNVSIT=AMERPCC
. D MOD^AUPNVSIT
;
S DR=$G(DR),AMEREDTS=$G(AMEREDTS)
I $D(DUOUT)!$D(DTOUT) K DUOUT,DTOUT Q 0
I DR'="" D DIE^AMEREDIT(AMERDA,DR)
D:AMEREDTS'="" MULTAUDT^AMEREDAU(AMEREDTS,AMERAIEN)
S (DR,AMEREDTS)=""
K DIR
K AMEROLD,AMERNEW,AMEREDTS,AMERSTRG,DR,DIR,AMERSKIP
D EN^DDIOL("ERS PCC Data Entry is complete for this option","","!!")
S DIR("A")="Edit more TRIAGE data"
S DIR(0)="Y",DIR("B")="NO"
D ^DIR K DIR
I Y=1 Q $$ERSEDTT(AMERDA,AMERAIEN)
Q 1
ERSEDTT(AMERDA,AMERAIEN) ;SUBROUTINE FOR EDIT OF ERS FIELDS THAT DO NOT PASS TO PCC
S (AMERDR,AMEROLD,AMERNEW,AMEREDTS,AMERSTRG,AMERQUIT)=""
; INITIAL TRIAGE
N DIR
S AMEROLD=$P($G(^AMERVSIT(AMERDA,0)),U,24)
I AMEROLD'="" S DIR("B")=AMEROLD
S DIR(0)="N^1:5:0",DIR("A")="Enter initial triage assessment from RN"
S DIR("?")="Enter a number from 1 to 5"
S DIR("?",1)="This is a site-specified value that indicates severity of visit"
D ^DIR K DIR
I $D(DUOUT)!$D(DTOUT) K DUOUT,DTOUT D:AMEREDTS'="" MULTAUDT^AMEREDAU(AMEREDTS,AMERAIEN) Q 0
S AMERNEW=+Y
I (AMERNEW'=AMEROLD) D
.S DR=".24////"_AMERNEW
.S AMERSTRG=$$EDAUDIT^AMEREDAU(".24",AMEROLD,AMERNEW,"INITIAL ACUITY")
.I AMERSTRG="^" Q
.D DIE^AMEREDIT(AMERDA,DR)
.D DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
.Q
;Work related
N DIR
S AMEROLD=$G(^AMERVSIT(AMERDA,2.1))
S DIR("B")=$S(AMEROLD=0:"NO",AMEROLD=1:"YES",1:"NO")
I DIR("B")="NO" S AMEROLD=0 ;NULL VALUE WILL BE UPDATED WITH 0
S DIR(0)="YO",DIR("A")="Was this ER visit WORK-RELATED"
D ^DIR
I $D(DUOUT)!$D(DTOUT)!(Y<0) K DUOUT,DTOUT,Y Q 0
S AMERNEW=Y
Q:Y<0
I AMEROLD'=AMERNEW D
.S DR="2.1///"_Y
.S AMERNEW=$$EDDISPL^AMEREDAU(AMERNEW,"B") ;TRANSLATE FROM 0 TO "NO"
.S AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"B")
.S AMERSTRG=$$EDAUDIT^AMEREDAU("2.1",AMEROLD,AMERNEW,"WORK RELATED")
.D DIE^AMEREDIT(AMERDA,DR)
.S DR=""
.D:AMERSTRG'="" DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
.S AMERSTRG=""
.Q
K DIR
Q 1
AMEREDTT ; IHS/OIT/SCR - SUB-ROUTINE FOR ER VISIT EDIT of Triage Information
+1 ;;3.0;ER VISIT SYSTEM;**6**;MAR 03, 2009;Build 30
+2 ;
+3 ;VARIABLES: The following variables are passed to multiple editing routines
+4 ; AMERDA : the IEN of the ER VISIT that is selected for editing
+5 ; AMERAIEN: The IEN of the ER AUDIT that is created when user begins editing a record
+6 ; AMEREDNO: An integer representing the number of multiple fields that have been edited
+7 ; for uniqueness in multiple field number in audit file
+8 ;
+9 ; Edit Auditing VARIABLES newed and used throughout edit routines:
+10 ; AMEROLD : original value of edited field
+11 ; AMERNEW : new value of edited field
+12 ; AMERSTRG : A ";" deliminated string of edit information for a field
+13 ;
ADMTRIAG(AMERDA,AMERAIEN) ; EP from AMEREDIT
+1 NEW AMEROLD,AMERNEW,AMEREDTS,AMERSTRG,DR,DIR,DIC,AMERSKIP
+2 SET (AMEROLD,AMERNEW,AMEREDTS,AMERSTRG,DR)=""
+3 ; PROGRAMATICALLY locking fields that pass to PCC
IF '$DATA(^XUSEC("AMERZ9999",DUZ))
QUIT $$ERSEDTT(AMERDA,AMERAIEN)
+4 SET AMERSKIP=0
+5 ; ED PROVIDER
+6 NEW DIC,DIR
+7 SET DIC("A")="*ED Provider: "
+8 SET AMEROLD=$PIECE($GET(^AMERVSIT(AMERDA,0)),U,6)
+9 ;screening so that only valid PCC providers identified
+10 SET DIC("S")="I $D(^VA(200,""AK.PROVIDER"",$P($G(^VA(200,+Y,0)),U),+Y))"
+11 IF AMEROLD'=""
SET DIC("B")=$PIECE(^VA(200,AMEROLD,0),U)
+12 ;
SET DIC="^VA(200,"
SET DIC(0)="AEQ"
+13 DO ^DIC
+14 IF $DATA(DUOUT)!$DATA(DTOUT)
KILL DUOUT,DTOUT
QUIT 0
+15 IF Y>0
SET AMERNEW=+Y
+16 IF '$TEST
SET AMERNEW=""
+17 IF AMEROLD=AMERNEW
Begin DoDot:1
+18 IF AMERNEW=""
SET AMERSKIP=1
QUIT
+19 ; If discharge provider is same as ED provider, don't let 'em delete it
+20 IF AMERNEW=$PIECE($GET(^AMERVSIT(AMERDA,6)),U,3)
Begin DoDot:2
+21 DO EN^DDIOL("ED provider is same as DISCHARGE provider","","!!")
+22 DO EN^DDIOL("cannot remove ED provider until DISCHARGE provider is updated","","!")
+23 DO EN^DDIOL("","","!!")
End DoDot:2
QUIT
+24 SET DIR("A")="Do you want to REMOVE this provider from the ER VISIT"
+25 SET DIR(0)="Y"
SET DIR("B")="NO"
+26 DO ^DIR
+27 IF Y=1
Begin DoDot:2
+28 ;delete any time as well
SET DR=$SELECT(DR'="":DR_";",1:"")
SET DR=DR_".06////@;12.1////@"
+29 SET AMERNEW=""
SET AMERSKIP=1
+30 SET AMERSTRG=$$EDAUDIT^AMEREDAU(".06",AMEROLD,AMERNEW,"INITIAL ED PROVIDER")
+31 IF AMERSTRG="^"
QUIT
+32 SET AMEREDTS=$SELECT(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
End DoDot:2
+33 QUIT
End DoDot:1
+34 IF AMEROLD'=AMERNEW
Begin DoDot:1
+35 SET DR=$SELECT(DR'="":DR_";",1:"")
SET DR=DR_".06////"_AMERNEW
+36 ;translates from new person ien to name
SET AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"N")
+37 SET AMERNEW=$$EDDISPL^AMEREDAU(AMERNEW,"N")
+38 SET AMERSTRG=$$EDAUDIT^AMEREDAU(".06",AMEROLD,AMERNEW,"INITIAL ED PROVIDER")
+39 IF AMERSTRG="^"
SET AMERQUIT=1
SET DR=""
QUIT
+40 SET AMEREDTS=$SELECT(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
+41 QUIT
End DoDot:1
+42 KILL DIC,DIR
+43 ; DOC TIME
+44 NEW DIR
+45 SET AMEROLD=$PIECE($GET(^AMERVSIT(AMERDA,12)),U,1)
+46 IF AMEROLD'=""
SET Y=AMEROLD
XECUTE ^DD("DD")
SET DIR("B")=Y
+47 SET DIR(0)="DO^::ER"
SET DIR("A")="*What was the ED Provider Medical Screening Exam Time"
+48 SET DIR("?")="Enter an exact date and time in Fileman format (e.g. T@1PM)"
+49 FOR
IF Y="^"!(Y="")
QUIT
Begin DoDot:1
+50 DO ^DIR
+51 IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+52 SET AMERNEW=Y
+53 IF AMERNEW
IF $$TVAL^AMER2A($PIECE($GET(^AMERVSIT(AMERDA,0)),U,1),AMERNEW,6)
QUIT
+54 IF AMERNEW=""
Begin DoDot:2
+55 IF AMEROLD=AMERNEW
SET Y="^"
QUIT
+56 SET DR=$SELECT(DR'="":DR_";",1:"")
SET DR=DR_"12.1////@"
+57 ;tranforms fileman date into user friendly date
SET AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"D")
+58 SET AMERSTRG=$$EDAUDIT^AMEREDAU("12.1",AMEROLD,AMERNEW,"INITIAL ED PROVIDER TIME")
+59 IF AMERSTRG="^"
QUIT
+60 SET AMEREDTS=$SELECT(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
+61 SET Y="^"
+62 QUIT
End DoDot:2
+63 IF AMERNEW=""
QUIT
+64 IF '$$TCK^AMER2A($PIECE($GET(^AMERVSIT(AMERDA,0)),U,1),AMERNEW,1,"admission")
Begin DoDot:2
+65 IF AMEROLD=AMERNEW
SET Y="^"
QUIT
+66 IF AMEROLD'=AMERNEW
Begin DoDot:3
+67 SET DR=$SELECT(DR'="":DR_";",1:"")
SET DR=DR_"12.1////"_AMERNEW
+68 ;tranforms fileman date into user friendly date
SET AMERNEW=$$EDDISPL^AMEREDAU(AMERNEW,"D")
+69 SET AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"D")
+70 SET AMERSTRG=$$EDAUDIT^AMEREDAU("12.1",AMEROLD,AMERNEW,"INITIAL ED PROVIDER TIME")
+71 IF AMERSTRG="^"
QUIT
+72 SET AMEREDTS=$SELECT(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
+73 SET Y="^"
+74 QUIT
End DoDot:3
+75 QUIT
End DoDot:2
+76 QUIT
End DoDot:1
+77 IF $DATA(DUOUT)!$DATA(DTOUT)
KILL DUOUT,DTOUT
QUIT 0
+78 IF AMEREDTS'=""
DO MULTAUDT^AMEREDAU(AMEREDTS,AMERAIEN)
+79 IF DR'=""
DO DIE^AMEREDIT(AMERDA,DR)
+80 SET (DR,AMEREDTS)=""
+81 KILL DIR
+82 ; TRIAGE NURSE
+83 NEW DIC,DIR
+84 SET DR=""
SET AMERSKIP=0
+85 SET DIC("A")="*Triage nurse: "
KILL DIC("B")
+86 SET AMEROLD=$PIECE($GET(^AMERVSIT(AMERDA,0)),U,7)
+87 IF AMEROLD'=""
SET DIC("B")=$PIECE($GET(^VA(200,AMEROLD,0)),U)
+88 SET DIC="^VA(200,"
SET DIC(0)="AEQM"
+89 ;screening so that only valid PCC providers identified
+90 SET DIC("S")="I $D(^VA(200,""AK.PROVIDER"",$P($G(^VA(200,+Y,0)),U),+Y))"
+91 DO ^DIC
KILL DIC
+92 IF $DATA(DUOUT)!$DATA(DTOUT)
KILL DUOUT,DTOUT
IF AMEREDTS'=""
DO MULTAUDT^AMEREDAU(AMEREDTS,AMERAIEN)
QUIT 0
+93 IF Y>0
SET AMERNEW=+Y
+94 IF '$TEST
SET AMERNEW=""
+95 IF AMEROLD=AMERNEW
Begin DoDot:1
+96 IF AMERNEW=""
SET AMERSKIP=1
QUIT
+97 ; If discharge nurse is same as admitting nurse, don't let 'em delete it
+98 IF AMERNEW=$PIECE($GET(^AMERVSIT(AMERDA,6)),U,4)
Begin DoDot:2
+99 DO EN^DDIOL("TRIAGE nurse is same as DISCHARGE nurse","","!!")
+100 DO EN^DDIOL("cannot remove TRIAGE nurse until DISCHARGE nurse is updated","","!")
+101 DO EN^DDIOL("","","!!")
+102 QUIT
End DoDot:2
QUIT
+103 SET DIR("A")="Do you want to REMOVE this Triage nurse from this visit"
+104 SET DIR(0)="Y"
SET DIR("B")="NO"
+105 DO ^DIR
KILL DIR
+106 IF Y=1
Begin DoDot:2
+107 SET AMERNEW=""
SET AMERSKIP=1
+108 SET DR=$SELECT(DR'="":DR_";",1:"")
SET DR=DR_".07////@;12.2////@"
+109 ;translates from new person ien to name
SET AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"N")
+110 SET AMERSTRG=$$EDAUDIT^AMEREDAU(".07",AMEROLD,AMERNEW,"TRIAGE NURSE")
+111 IF AMERSTRG="^"
QUIT
+112 SET AMEREDTS=$SELECT(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
End DoDot:2
+113 QUIT
End DoDot:1
+114 IF AMEROLD'=AMERNEW
Begin DoDot:1
+115 ;translates from new person ien to name
SET AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"N")
+116 SET AMERNEW=$$EDDISPL^AMEREDAU(AMERNEW,"N")
+117 SET AMERSTRG=$$EDAUDIT^AMEREDAU(".07",AMEROLD,AMERNEW,"TRIAGE NURSE")
+118 IF AMERSTRG="^"
QUIT
+119 SET AMEREDTS=$SELECT(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
+120 SET DR=$SELECT(DR'="":DR_";",1:"")
SET DR=DR_".07////"_+Y
+121 QUIT
End DoDot:1
+122 KILL DIR,DIC
+123 ; TRIAGE TIME
+124 NEW DIR
+125 SET AMEROLD=$PIECE($GET(^AMERVSIT(AMERDA,12)),U,2)
+126 IF AMEROLD'=""
SET Y=AMEROLD
XECUTE ^DD("DD")
SET DIR("B")=Y
+127 SET DIR(0)="D^::ER"
SET DIR("A")="*What time did the patient see the triage nurse"
+128 SET DIR("?")="Enter an exact date and time in Fileman format (e.g. T@1PM)"
+129 FOR
IF Y="^"!(Y="")
QUIT
Begin DoDot:1
+130 DO ^DIR
KILL DIR
+131 IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+132 SET AMERNEW=Y
+133 IF AMERNEW
IF $$TVAL^AMER2A($PIECE($GET(^AMERVSIT(AMERDA,0)),U,1),AMERNEW,6)
QUIT
+134 IF AMERNEW=""
Begin DoDot:2
+135 IF AMEROLD=AMERNEW
SET Y="^"
QUIT
+136 SET DR=$SELECT(DR'="":DR_";",1:"")
SET DR=DR_"12.2////@"
+137 ;tranforms fileman date into user friendly date
SET AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"D")
+138 SET AMERSTRG=$$EDAUDIT^AMEREDAU("12.2",AMEROLD,AMERNEW)
+139 IF AMERSTRG="^"
QUIT
+140 SET AMEREDTS=$SELECT(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
+141 SET Y="^"
+142 QUIT
End DoDot:2
+143 IF AMERNEW=""
QUIT
+144 IF '$$TCK^AMER2A($PIECE($GET(^AMERVSIT(AMERDA,0)),U,1),Y,1,"admission")
Begin DoDot:2
+145 IF AMEROLD=AMERNEW
SET Y="^"
QUIT
+146 IF AMEROLD'=AMERNEW
Begin DoDot:3
+147 SET DR=$SELECT(DR'="":DR_";",1:"")
SET DR=DR_"12.2////"_AMERNEW
+148 ;tranforms fileman date into user friendly date
SET AMERNEW=$$EDDISPL^AMEREDAU(AMERNEW,"D")
+149 SET AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"D")
+150 SET AMERSTRG=$$EDAUDIT^AMEREDAU("12.2",AMEROLD,AMERNEW,"TRIAGE TIME")
+151 IF AMERSTRG="^"
QUIT
+152 SET AMEREDTS=$SELECT(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
+153 SET Y="^"
+154 QUIT
End DoDot:3
+155 QUIT
End DoDot:2
+156 QUIT
End DoDot:1
+157 ;
+158 ;Edit the Decision to Admit Date
+159 Begin DoDot:1
+160 NEW AMERRUN,AMERSTRT,AMERFIN,X,Y,AMERPCC,AUPNVSIT,AMEROLD,AMERNEW,AMERSTRG
+161 ;
+162 ;Get the visit
+163 SET AMERPCC=$$GET1^DIQ(9009080,AMERDA_",",.03,"I")
IF AMERPCC=""
QUIT
+164 ;
+165 ;Get the old value
+166 SET AMEROLD=$$GET1^DIQ(9000010,AMERPCC_",",1116,"E")
+167 ;
+168 ;Call the edit
+169 DO QD28^AMER2A(AMERPCC)
+170 ;
+171 ;Get the new value
+172 SET AMERNEW=$$GET1^DIQ(9000010,AMERPCC_",",1116,"E")
+173 ;
+174 ;Perform Audit
+175 IF AMEROLD'=AMERNEW
Begin DoDot:2
+176 SET AMERSTRG=$$EDAUDIT^AMEREDAU("12.8",AMEROLD,AMERNEW,"DECISION TO ADMIT DT")
+177 IF AMERSTRG="^"
QUIT
+178 SET AMEREDTS=$SELECT(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
End DoDot:2
+179 ;
+180 ;Update ^AMERVSIT
+181 SET AUPNVSIT=AMERPCC
+182 DO MOD^AUPNVSIT
End DoDot:1
+183 ;
+184 SET DR=$GET(DR)
SET AMEREDTS=$GET(AMEREDTS)
+185 IF $DATA(DUOUT)!$DATA(DTOUT)
KILL DUOUT,DTOUT
QUIT 0
+186 IF DR'=""
DO DIE^AMEREDIT(AMERDA,DR)
+187 IF AMEREDTS'=""
DO MULTAUDT^AMEREDAU(AMEREDTS,AMERAIEN)
+188 SET (DR,AMEREDTS)=""
+189 KILL DIR
+190 KILL AMEROLD,AMERNEW,AMEREDTS,AMERSTRG,DR,DIR,AMERSKIP
+191 DO EN^DDIOL("ERS PCC Data Entry is complete for this option","","!!")
+192 SET DIR("A")="Edit more TRIAGE data"
+193 SET DIR(0)="Y"
SET DIR("B")="NO"
+194 DO ^DIR
KILL DIR
+195 IF Y=1
QUIT $$ERSEDTT(AMERDA,AMERAIEN)
+196 QUIT 1
ERSEDTT(AMERDA,AMERAIEN) ;SUBROUTINE FOR EDIT OF ERS FIELDS THAT DO NOT PASS TO PCC
+1 SET (AMERDR,AMEROLD,AMERNEW,AMEREDTS,AMERSTRG,AMERQUIT)=""
+2 ; INITIAL TRIAGE
+3 NEW DIR
+4 SET AMEROLD=$PIECE($GET(^AMERVSIT(AMERDA,0)),U,24)
+5 IF AMEROLD'=""
SET DIR("B")=AMEROLD
+6 SET DIR(0)="N^1:5:0"
SET DIR("A")="Enter initial triage assessment from RN"
+7 SET DIR("?")="Enter a number from 1 to 5"
+8 SET DIR("?",1)="This is a site-specified value that indicates severity of visit"
+9 DO ^DIR
KILL DIR
+10 IF $DATA(DUOUT)!$DATA(DTOUT)
KILL DUOUT,DTOUT
IF AMEREDTS'=""
DO MULTAUDT^AMEREDAU(AMEREDTS,AMERAIEN)
QUIT 0
+11 SET AMERNEW=+Y
+12 IF (AMERNEW'=AMEROLD)
Begin DoDot:1
+13 SET DR=".24////"_AMERNEW
+14 SET AMERSTRG=$$EDAUDIT^AMEREDAU(".24",AMEROLD,AMERNEW,"INITIAL ACUITY")
+15 IF AMERSTRG="^"
QUIT
+16 DO DIE^AMEREDIT(AMERDA,DR)
+17 DO DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
+18 QUIT
End DoDot:1
+19 ;Work related
+20 NEW DIR
+21 SET AMEROLD=$GET(^AMERVSIT(AMERDA,2.1))
+22 SET DIR("B")=$SELECT(AMEROLD=0:"NO",AMEROLD=1:"YES",1:"NO")
+23 ;NULL VALUE WILL BE UPDATED WITH 0
IF DIR("B")="NO"
SET AMEROLD=0
+24 SET DIR(0)="YO"
SET DIR("A")="Was this ER visit WORK-RELATED"
+25 DO ^DIR
+26 IF $DATA(DUOUT)!$DATA(DTOUT)!(Y<0)
KILL DUOUT,DTOUT,Y
QUIT 0
+27 SET AMERNEW=Y
+28 IF Y<0
QUIT
+29 IF AMEROLD'=AMERNEW
Begin DoDot:1
+30 SET DR="2.1///"_Y
+31 ;TRANSLATE FROM 0 TO "NO"
SET AMERNEW=$$EDDISPL^AMEREDAU(AMERNEW,"B")
+32 SET AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"B")
+33 SET AMERSTRG=$$EDAUDIT^AMEREDAU("2.1",AMEROLD,AMERNEW,"WORK RELATED")
+34 DO DIE^AMEREDIT(AMERDA,DR)
+35 SET DR=""
+36 IF AMERSTRG'=""
DO DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
+37 SET AMERSTRG=""
+38 QUIT
End DoDot:1
+39 KILL DIR
+40 QUIT 1
