AMEREDTA ; IHS/OIT/SCR - SUB-ROUTINE FOR ER VISIT EDIT of ADMIT information
;;3.0;ER VISIT SYSTEM;**2,10**;MAR 3, 2009;Build 23
;
;GDIT/HS/BEE 05/10/2018;CR#10213 - AMER*3.0*10 - Save updated clinic and hospital location
;
; 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
;
EDADMIT(AMERDA,AMERAIEN) ;EP - CALLED BY AMEREDIT when "ADMIT" is selected for editing
N AMERCHRT,AMERDOB,AMERSEX,AMERDR,DIR,Y,AMERNEW,AMEROLD,AMEREDTS,AMERSTRG
N AMERQUIT,AMERISNW,AMERONAM,AMERNNAM,AMERANS,AMEROTIM,AMERNTIM,X
S (AMERCHRT,AMERDOB,AMERSEX,AMERDR,AMEROLD,AMERNEW,AMEREDTS,AMERSTRG,AMERQUIT,AMERTIM)=""
Q:'$D(^XUSEC("AMERZ9999",DUZ)) $$ERSEDTA(AMERDA,AMERAIEN)
D EN^DDIOL("**Changing the PATIENT will change chart number, age and other fields**","","!!?3")
D EN^DDIOL("*** AND will also cause a new PCC VISIT to be created ***","","!?10")
S DIR(0)="Y",DIR("A")="Change Patient",DIR("B")="NO"
D ^DIR K DIR
I $D(DUOUT)!$D(DTOUT)!(Y<0) K DUOUT,DTOUT Q 0
I Y=1 D
.S (AMERDFN,AMEROLD)=$P($G(^AMERVSIT(AMERDA,0)),U,2)
.S AMERISNW=$$NEWREG^AMERVSIT(AMERDFN,AMERDA)
.I AMERISNW D ;THIS PATIENT WAS CREATED THE SAME DAY AS THIS VISIT
..D EN^DDIOL("The patient record was created on the same day as the ER VISIT being edited","","!")
..S DIR(0)="SO^1:UPDATE NEW PATIENT RECORD;2:REPLACE WITH AN EXISITING PATIENT"
..S DIR("A")="Which would you like to do"
..D ^DIR K DIR
..Q:Y=""!(Y="^")
..S AMERANS=Y
..I AMERANS=1 D ;PATIENT DFN DOES NOT CHANGE, BUT INFORMATION IN IT DOES
...S AMERONAM=$P($G(^DPT(AMERDFN,0)),U,1)
...S AMERCHNG=$$UPDATPAT^AMERVSIT(AMERDFN) ;CALLS PATIENT REG PEPs TO UPDATE FIELDS ORIGINALLY ENTERED
...Q:AMERCHNG=0
...S AMERCHRT=$P($G(^AUPNPAT(AMERDFN,41,DUZ(2),0)),U,2)
...S AMERSEX=$P($G(^DPT(AMERDFN,0)),U,2)
...S AMERDOB=$P($G(^DPT(AMERDFN,0)),U,3)
...S AMERNNAM=$P($G(^DPT(AMERDFN,0)),U,1)
...;S AMERDR=".12///"_AMERDOB_";.18///"_AMERSEX_";.19///"_$G(DUZ)
...S AMERDR=".12///"_AMERDOB_";.18///"_AMERSEX_";.19////"_$G(DUZ) ;IHS/OIT/SCR 071509 patch 2
...S AMERSTRG=$$EDAUDIT^AMEREDAU(".02",AMERONAM,AMERNNAM,"PATIENT")
...I AMERSTRG="^" S AMERQUIT=1 Q
...D DIE^AMEREDIT(AMERDA,AMERDR)
...D DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
...Q
..I AMERANS=2 D
...S AMERDFN=$$CHANGPAT^AMERVSIT(AMEROLD,AMERDA,AMERISNW) ;THIS ROUTINE REMOVES V POV AND V PROVIDER ENTRIES FOR THE VISIT ASSOCIATED TO THE OLD DFN
..Q
.I 'AMERISNW S AMERDFN=$$CHANGPAT^AMERVSIT(AMEROLD,AMERDA,AMERISNW)
.I AMERDFN=0 Q ;$$CHANGPAT RETURNS 0 IF USER HAS TIMED OR UPPED OUT
.I AMEROLD'=AMERDFN D
..S AMERCHRT=$P($G(^AUPNPAT(AMERDFN,41,DUZ(2),0)),U,2)
..S AMERSEX=$P($G(^DPT(AMERDFN,0)),U,2)
..;S AMERDOB=$P($G(^DPT(AMERDFN,0)),U,3)
..S AMERDOB=$$DOB^AUPNPAT(AMERDFN) ;IHS/OIT/SCR 071509 patch 2
..;S AMERDR=".02////"_AMERDFN_";.13////"_AMERCHRT_";.12///"_AMERDOB_";.18///"_AMERSEX_";.19///"_$G(DUZ)
..S AMERDR=".02////"_AMERDFN_";.13////"_AMERCHRT_";.12///"_AMERDOB_";.18///"_AMERSEX_";.19////"_$G(DUZ) ;IHS/OIT/SCR 071509 patch 2
..S AMERNEW=$$EDDISPL^AMEREDAU(AMERDFN,"P")
..S AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"P")
..S AMERSTRG=$$EDAUDIT^AMEREDAU(".02",AMEROLD,AMERNEW,"PATIENT")
..I AMERSTRG="^" S AMERQUIT=1 Q
..D DIE^AMEREDIT(AMERDA,AMERDR)
..D DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
..D SYNCHPCC^AMERPCC(AMERDA) ;THIS ROUTINE ADDS THE V PROVIDER AND V POV ENTRIES TO THE NEW VISIT CREATED FOR THIS PATIENT
..Q
.Q
Q:AMERQUIT 0
S AMERDR=""
D EN^DDIOL("**Changing the ADMISSION TIME can cause other time related data to be deleted**","","!!")
S DIR(0)="Y",DIR("A")="Change Admission Time",DIR("B")="NO"
D ^DIR
I $D(DUOUT)!$D(DTOUT)!(Y<0) K DIR,DUOUT,DTOUT,Y Q 0
I Y=1 D
.S DIR(0)="D^::ER",DIR("A")="Date and time of admission to ER"
.S (Y,AMEROTIM)=$P($G(^AMERVSIT(AMERDA,0)),U,1)
.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) K DUOUT,DTOUT S AMERQUIT=1 Q
.I Y>0 D
..S AMERDR=".01///"_Y,AMERNTIM=Y
..I AMERNTIM'=AMEROTIM D
...S AMERNEW=$$EDDISPL^AMEREDAU(AMERNTIM,"D") ;tranforms fileman date into user friendly date
...S AMEROLD=$$EDDISPL^AMEREDAU(AMEROTIM,"D")
...S AMERSTRG=$$EDAUDIT^AMEREDAU(".01",AMEROLD,AMERNEW,"ADMISSION TIMESTAMP")
...I AMERSTRG="^" Q
...D DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
...D DIE^AMEREDIT(AMERDA,AMERDR) ;Updates the AMERVSIT with correct time
...D UPDTVTIM^AMERVSIT(AMERDA,AMEROTIM,AMERNTIM) ;looks up PCC VISIT with old time and updates it with new time
...D CHKTIME^AMERTIME(AMERNTIM,AMERAIEN)
...Q
..I AMERSTRG="^" S AMERQUIT=1 Q
..S AMERDR=""
..Q
.Q
Q:AMERQUIT 0
;
;GDIT/HS/BEE 05/10/2018;CR#10213 - AMER*3.0*10 - Save updated clinic and hospital location
;Reworked entire section to save custom clinics and differing hospital locations
;
;allow user to update "clinic type"
D EN^DDIOL("","","!")
;S AMEROLD=$P($G(^AMERVSIT(AMERDA,0)),U,4)
;S:AMEROLD'="" DIC("B")=$P($G(^AMER(3,AMEROLD,0)),U,1)
;S DIC("A")="Clinic type (EMERGENCY or URGENT): "
;S DIC="^AMER(3,",DIC("S")="I $P(^(0),U,2)="_$$CAT^AMER0("CLINIC TYPE"),DIC(0)="AEQ"
;D ^DIC K DIC
;I $D(DUOUT)!$D(DTOUT) K DIC,DUOUT,DTOUT Q 0
;S AMERNEW=$P(Y,U,1)
;I AMEROLD'=AMERNEW D
;.S AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"L")
;.S AMERNEW=$$EDDISPL^AMEREDAU(AMERNEW,"L")
;.S AMERSTRG=$$EDAUDIT^AMEREDAU(".05",AMEROLD,AMERNEW,"CLINIC TYPE")
;.I AMERSTRG="^" S AMERQUIT=1 Q
;.S AMERDR=$S(AMERDR'="":AMERDR_";",1:""),AMERDR=AMERDR_".04///"_AMERNEW
;.D DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
;.D DIE^AMEREDIT(AMERDA,AMERDR)
;.S (AMERDR,Y,AMERNEW,AMEROLD)=""
;.Q
N VIEN,NCLN,OCLN
;
;Get visit
S VIEN=$$GET1^DIQ(9009080,AMERDA_",",.03,"I") I VIEN="" Q 0
;
;Update clinic
S (NCLN,OCLN,AMERQUIT)=""
I VIEN>0 D
.NEW DIC,X,Y,AMERCLN,AMERTYP,AMERDR
.S DIC("B")=""
.S AMERCLN=$$GETCLN^AMER2A(VIEN) ;Pull Hospital Location
.I AMERCLN]"" S OCLN=AMERCLN,DIC("B")=$$GET1^DIQ(9009083,AMERCLN,.01,"E") ;Get AMER clinic text
.S DIC="^AMER(3,"
.S DIC("S")="I '$P(^(0),U,5),$P(^(0),U,2)="_$$CAT^AMER0("CLINIC TYPE")
.S DIC(0)="AEQ"
.S DIC("A")="*Clinic type: "
.D ^DIC I '+Y S AMERQUIT=1 Q
.S NCLN=+Y
.S AMERDR=".04///"_NCLN
.D DIE^AMEREDIT(AMERDA,AMERDR)
;
;Need to update clinic and hospital location if overrides on file
I OCLN'=NCLN,VIEN>0,'AMERQUIT D
. NEW ERR,AMEROLD,AMERNEW
. ;
. ;GDIT/HS/BEE 05/10/2018;CR#10213/10423 - AMER*3.0*10 - Save updated clinic and hospital location
. ;Need to update clinic and hospital location if overrides on file
. S ERR=$$CKHLOC^AMERBSD(VIEN,NCLN)
. ;
. S AMEROLD=$$EDDISPL^AMEREDAU(OCLN,"L")
. S AMERNEW=$$EDDISPL^AMEREDAU(NCLN,"L")
. S AMERSTRG=$$EDAUDIT^AMEREDAU(".05",AMEROLD,AMERNEW,"CLINIC TYPE")
. D DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
;
Q:AMERQUIT 0
PQ ;NOW allow user to update "presenting complaint'
S Y=$G(^AMERVSIT(AMERDA,1))
S AMEROLD=Y
S:AMEROLD'="" DIR("B")=AMEROLD
S DIR(0)="FOr^1:80",DIR("A")="Presenting complaint",DIR("?")="Enter free text chief complaint (80 characters max.)"
D ^DIR K DIR
I $D(DUOUT)!$D(DTOUT)!(Y<0) K DUOUT,DTOUT,Y Q 0
;IHS/OIT/SCR 071509 patch 2 START CHANGES
;D CKSC^AMER1 I $D(AMERCKSC) S Y=DIR("B") K AMERCKSC Q
D CKSC^AMER1
I $D(AMERCKSC) D G PQ
.S Y=$G(DIR("B"))
.K AMERCKSC
.Q
;IHS/OIT/SCR 071509 patch 2 END CHANGES
S AMERNEW=Y
I AMEROLD'=AMERNEW D
.S AMERSTRG=$$EDAUDIT^AMEREDAU("1",AMEROLD,AMERNEW,"PRESENTING COMPLAINT")
.I AMERSTRG="^" S AMERQUIT=1 Q
.S AMERDR=$S(AMERDR'="":AMERDR_";",1:""),AMERDR=AMERDR_"1////"_AMERNEW
.D DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
.D DIE^AMEREDIT(AMERDA,AMERDR)
.S (AMERDR,Y,AMERNEW,AMEROLD)=""
.Q
Q:AMERQUIT 0
D EN^DDIOL("","","!")
K DIC,AMERDR,DIR,AMEREDTS
D EN^DDIOL("ERS PCC Data Entry is complete for this option","","!!")
S DIR("A")="Edit more admission data"
S DIR(0)="Y",DIR("B")="NO"
D ^DIR K DIR
I Y=1 Q $$ERSEDTA(AMERDA,AMERAIEN) ;Return with value that subroutine returns
Q 1
;
ERSEDTA(AMERDA,AMERAIEN) ;SUBROUTINE TO ISOLATE FIELDS THAT DO NOT GO TO PCC THAT DO NOT REQUIRE A LOCK
;NOW allow user to update "visit type"
N AMERTRAN
S (AMERDR,AMEROLD,AMERNEW,AMEREDTS,AMERSTRG,AMERQUIT,AMERTRAN)=""
D EN^DDIOL("","","!")
S Y=$P($G(^AMERVSIT(AMERDA,0)),U,5)
S AMEROLD=Y
S:AMEROLD'="" DIC("B")=AMEROLD
S DIC="^AMER(3,"
S DIC("S")="I $P(^(0),U,2)="_$$CAT^AMER0("VISIT TYPE")
S DIC(0)="AEQ"
S DIC("A")="Visit Type: "
D ^DIC K DIC
I $D(DUOUT)!$D(DTOUT) K DIC,DUOUT,DTOUT Q 0
S AMERNEW=$P(Y,U,1)
I AMEROLD'=AMERNEW D
.S AMERSTRG=$$EDAUDIT^AMEREDAU(".05",$$EDDISPL^AMEREDAU(AMEROLD,"V"),$$EDDISPL^AMEREDAU(AMERNEW,"V"),"VISIT TYPE")
.I AMERSTRG="^" S AMERQUIT=1 Q
.S AMERDR=$S(AMERDR'="":AMERDR_";",1:""),AMERDR=AMERDR_".05///"_AMERNEW
.D DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
.D DIE^AMEREDIT(AMERDA,AMERDR)
.;IHS/OIT/SCR 12/15/08 - update ER VISIT FILE with DATE LAST UPDATED (NOW)
.D TIMESTMP^AMERSAV1(AMERDA)
.S (AMERDR,Y,AMERNEW,AMEROLD)=""
.Q
Q:AMERQUIT 0
;TRANSFER
S AMEROLD=""
S (DIR("B"),AMEROLD)="NO"
I $P($G(^AMERVSIT(AMERDA,17)),U,1)=1 S (DIR("B"),AMEROLD)="YES"
S DIR(0)="YO",DIR("A")="*Was this patient transferred from another facility"
D ^DIR K DIR
I $D(DUOUT)!$D(DTOUT) K DUOUT,DTOUT Q 0
S AMERNEW=$$EDDISPL^AMEREDAU(Y,"B") ; "BOOLEAN" translates from 0 to NO
I AMERNEW'=AMEROLD D
.S AMERDR=$S(AMERDR'="":AMERDR_";",1:""),AMERDR=AMERDR_"17.1///"_AMERNEW
.;REMOVE all "MODE OF TRANSPORT" and all ambulance and related info if
.;MODE OF TRANSPORT is a different type from "TRANSFERED BY" and we just changed
.S:AMERNEW="YES" AMERDR=$S($D(AMERDR):AMERDR_";",1:""),AMERDR=AMERDR_".25////@;.14////@;.15////@;.21////@"
.S AMERSTRG=$$EDAUDIT^AMEREDAU("17.1",AMEROLD,AMERNEW,"TRANSFERED")
.I AMERSTRG="^" S AMERQUIT=1 Q
.I AMERNEW="NO" D
..;if the original transfered value was "yes" and it is being changed to "no"
..;then we have to remove the HER Transfer facility stuff and medical attendant
..S AMERDR=$S($D(AMERDR):AMERDR_";",1:""),AMERDR=AMERDR_"17.1////0;17.2////@;17.3////@;17.4////@"
..S AMERHERN=0
..F S AMERHERN=$O(^AMERVSIT(AMERDA,18,AMERHERN)) Q:AMERHERN="B"!(AMERHERN="") I $P($G(^AMERVSIT(AMERDA,18,AMERHERN,0)),U,2)="A" D
...S DA=AMERHERN
...S DA(1)=AMERDA,DIK="^AMERVSIT(DA(1),18,"
...D ^DIK,EN^DIK K DIK ;Kill the sub-record and Re-index
...K DIK,DA(1),DA
...Q
..Q
.D DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
.D DIE^AMEREDIT(AMERDA,AMERDR)
.S (AMERDR,Y)=""
.Q
I AMERNEW="YES" D TRANSFER^AMEREDTU(AMERDA)
I AMERNEW="NO" D
.D EN^DDIOL("**Changing the MODE of TRANSPORT can cause ambulance data to be deleted**","","!!?3")
.S DIC("A")="Mode of transport to the ER: "
.S AMEROLD=$P($G(^AMERVSIT(AMERDA,0)),U,25)
.I AMEROLD="" K DIC("B")
.I AMEROLD'="" S DIC("B")=$P($G(^AMER(3,AMEROLD,0)),U,1)
.S (Y,AMEROLD)=$P($G(^AMERVSIT(AMERDA,0)),U,25)
.S DIC="^AMER(3,",DIC("S")="I $P(^(0),U,2)="_$$CAT^AMER0("MODE OF TRANSPORT")
.S DIC(0)="AEQ"
.D ^DIC K DIC
.I $D(DUOUT)!$D(DTOUT) K DUOUT,DTOUT,DIC S AMERQUIT=1 Q
.S AMERNEW=$P(Y,U,1),AMERTRAN=$P(Y,U,2)
.I AMEROLD'=AMERNEW D
..S AMERDR=$S(AMERDR'="":AMERDR_";",1:""),AMERDR=AMERDR_".25////"_AMERNEW
..S AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"M") ;TRANSLATE number to MODE OF TRANSPORT description
..I AMEROLD["AMBULANCE" S AMERDR=$S(AMERDR'="":AMERDR_";",1:""),AMERDR=AMERDR_".14////@;.15////@;.21////@"
..S AMERSTRG=$$EDAUDIT^AMEREDAU(".25",AMEROLD,AMERTRAN,"MODE OF TRANSPORT")
..I AMERSTRG="^" S AMERQUIT=1 Q
..S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG) ;concactonate edit strings
..D DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
..D DIE^AMEREDIT(AMERDA,AMERDR)
..S (AMERDR,Y)=""
..Q
.I AMERTRAN["AMBULANCE" D AMBULNCE^AMEREDTU
.Q
Q:AMERQUIT 0
I $D(DUOUT)!$D(DTOUT) K DUOUT,DTOUT Q 0
Q 1
AMEREDTA ; IHS/OIT/SCR - SUB-ROUTINE FOR ER VISIT EDIT of ADMIT information
+1 ;;3.0;ER VISIT SYSTEM;**2,10**;MAR 3, 2009;Build 23
+2 ;
+3 ;GDIT/HS/BEE 05/10/2018;CR#10213 - AMER*3.0*10 - Save updated clinic and hospital location
+4 ;
+5 ; VARIABLES: The following variables are passed to multiple editing routines
+6 ; AMERDA : the IEN of the ER VISIT that is selected for editing
+7 ; AMERAIEN: The IEN of the ER AUDIT that is created when user begins editing a record
+8 ; AMEREDNO: An integer representing the number of multiple fields that have been edited
+9 ; for uniqueness in multiple field number in audit file
+10 ;
+11 ; Edit Auditing VARIABLES newed and used throughout edit routines:
+12 ; AMEROLD : original value of edited field
+13 ; AMERNEW : new value of edited field
+14 ; AMERSTRG : A ";" deliminated string of edit information for a field
+15 ;
EDADMIT(AMERDA,AMERAIEN) ;EP - CALLED BY AMEREDIT when "ADMIT" is selected for editing
+1 NEW AMERCHRT,AMERDOB,AMERSEX,AMERDR,DIR,Y,AMERNEW,AMEROLD,AMEREDTS,AMERSTRG
+2 NEW AMERQUIT,AMERISNW,AMERONAM,AMERNNAM,AMERANS,AMEROTIM,AMERNTIM,X
+3 SET (AMERCHRT,AMERDOB,AMERSEX,AMERDR,AMEROLD,AMERNEW,AMEREDTS,AMERSTRG,AMERQUIT,AMERTIM)=""
+4 IF '$DATA(^XUSEC("AMERZ9999",DUZ))
QUIT $$ERSEDTA(AMERDA,AMERAIEN)
+5 DO EN^DDIOL("**Changing the PATIENT will change chart number, age and other fields**","","!!?3")
+6 DO EN^DDIOL("*** AND will also cause a new PCC VISIT to be created ***","","!?10")
+7 SET DIR(0)="Y"
SET DIR("A")="Change Patient"
SET DIR("B")="NO"
+8 DO ^DIR
KILL DIR
+9 IF $DATA(DUOUT)!$DATA(DTOUT)!(Y<0)
KILL DUOUT,DTOUT
QUIT 0
+10 IF Y=1
Begin DoDot:1
+11 SET (AMERDFN,AMEROLD)=$PIECE($GET(^AMERVSIT(AMERDA,0)),U,2)
+12 SET AMERISNW=$$NEWREG^AMERVSIT(AMERDFN,AMERDA)
+13 ;THIS PATIENT WAS CREATED THE SAME DAY AS THIS VISIT
IF AMERISNW
Begin DoDot:2
+14 DO EN^DDIOL("The patient record was created on the same day as the ER VISIT being edited","","!")
+15 SET DIR(0)="SO^1:UPDATE NEW PATIENT RECORD;2:REPLACE WITH AN EXISITING PATIENT"
+16 SET DIR("A")="Which would you like to do"
+17 DO ^DIR
KILL DIR
+18 IF Y=""!(Y="^")
QUIT
+19 SET AMERANS=Y
+20 ;PATIENT DFN DOES NOT CHANGE, BUT INFORMATION IN IT DOES
IF AMERANS=1
Begin DoDot:3
+21 SET AMERONAM=$PIECE($GET(^DPT(AMERDFN,0)),U,1)
+22 ;CALLS PATIENT REG PEPs TO UPDATE FIELDS ORIGINALLY ENTERED
SET AMERCHNG=$$UPDATPAT^AMERVSIT(AMERDFN)
+23 IF AMERCHNG=0
QUIT
+24 SET AMERCHRT=$PIECE($GET(^AUPNPAT(AMERDFN,41,DUZ(2),0)),U,2)
+25 SET AMERSEX=$PIECE($GET(^DPT(AMERDFN,0)),U,2)
+26 SET AMERDOB=$PIECE($GET(^DPT(AMERDFN,0)),U,3)
+27 SET AMERNNAM=$PIECE($GET(^DPT(AMERDFN,0)),U,1)
+28 ;S AMERDR=".12///"_AMERDOB_";.18///"_AMERSEX_";.19///"_$G(DUZ)
+29 ;IHS/OIT/SCR 071509 patch 2
SET AMERDR=".12///"_AMERDOB_";.18///"_AMERSEX_";.19////"_$GET(DUZ)
+30 SET AMERSTRG=$$EDAUDIT^AMEREDAU(".02",AMERONAM,AMERNNAM,"PATIENT")
+31 IF AMERSTRG="^"
SET AMERQUIT=1
QUIT
+32 DO DIE^AMEREDIT(AMERDA,AMERDR)
+33 DO DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
+34 QUIT
End DoDot:3
+35 IF AMERANS=2
Begin DoDot:3
+36 ;THIS ROUTINE REMOVES V POV AND V PROVIDER ENTRIES FOR THE VISIT ASSOCIATED TO THE OLD DFN
SET AMERDFN=$$CHANGPAT^AMERVSIT(AMEROLD,AMERDA,AMERISNW)
End DoDot:3
+37 QUIT
End DoDot:2
+38 IF 'AMERISNW
SET AMERDFN=$$CHANGPAT^AMERVSIT(AMEROLD,AMERDA,AMERISNW)
+39 ;$$CHANGPAT RETURNS 0 IF USER HAS TIMED OR UPPED OUT
IF AMERDFN=0
QUIT
+40 IF AMEROLD'=AMERDFN
Begin DoDot:2
+41 SET AMERCHRT=$PIECE($GET(^AUPNPAT(AMERDFN,41,DUZ(2),0)),U,2)
+42 SET AMERSEX=$PIECE($GET(^DPT(AMERDFN,0)),U,2)
+43 ;S AMERDOB=$P($G(^DPT(AMERDFN,0)),U,3)
+44 ;IHS/OIT/SCR 071509 patch 2
SET AMERDOB=$$DOB^AUPNPAT(AMERDFN)
+45 ;S AMERDR=".02////"_AMERDFN_";.13////"_AMERCHRT_";.12///"_AMERDOB_";.18///"_AMERSEX_";.19///"_$G(DUZ)
+46 ;IHS/OIT/SCR 071509 patch 2
SET AMERDR=".02////"_AMERDFN_";.13////"_AMERCHRT_";.12///"_AMERDOB_";.18///"_AMERSEX_";.19////"_$GET(DUZ)
+47 SET AMERNEW=$$EDDISPL^AMEREDAU(AMERDFN,"P")
+48 SET AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"P")
+49 SET AMERSTRG=$$EDAUDIT^AMEREDAU(".02",AMEROLD,AMERNEW,"PATIENT")
+50 IF AMERSTRG="^"
SET AMERQUIT=1
QUIT
+51 DO DIE^AMEREDIT(AMERDA,AMERDR)
+52 DO DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
+53 ;THIS ROUTINE ADDS THE V PROVIDER AND V POV ENTRIES TO THE NEW VISIT CREATED FOR THIS PATIENT
DO SYNCHPCC^AMERPCC(AMERDA)
+54 QUIT
End DoDot:2
+55 QUIT
End DoDot:1
+56 IF AMERQUIT
QUIT 0
+57 SET AMERDR=""
+58 DO EN^DDIOL("**Changing the ADMISSION TIME can cause other time related data to be deleted**","","!!")
+59 SET DIR(0)="Y"
SET DIR("A")="Change Admission Time"
SET DIR("B")="NO"
+60 DO ^DIR
+61 IF $DATA(DUOUT)!$DATA(DTOUT)!(Y<0)
KILL DIR,DUOUT,DTOUT,Y
QUIT 0
+62 IF Y=1
Begin DoDot:1
+63 SET DIR(0)="D^::ER"
SET DIR("A")="Date and time of admission to ER"
+64 SET (Y,AMEROTIM)=$PIECE($GET(^AMERVSIT(AMERDA,0)),U,1)
+65 DO DD^%DT
+66 SET DIR("B")=Y
+67 SET DIR("?")="Enter date and time in the usual Fileman format (e.g. 1/1/2000@1PM)"
+68 DO ^DIR
KILL DIR
+69 IF $DATA(DUOUT)!$DATA(DTOUT)
KILL DUOUT,DTOUT
SET AMERQUIT=1
QUIT
+70 IF Y>0
Begin DoDot:2
+71 SET AMERDR=".01///"_Y
SET AMERNTIM=Y
+72 IF AMERNTIM'=AMEROTIM
Begin DoDot:3
+73 ;tranforms fileman date into user friendly date
SET AMERNEW=$$EDDISPL^AMEREDAU(AMERNTIM,"D")
+74 SET AMEROLD=$$EDDISPL^AMEREDAU(AMEROTIM,"D")
+75 SET AMERSTRG=$$EDAUDIT^AMEREDAU(".01",AMEROLD,AMERNEW,"ADMISSION TIMESTAMP")
+76 IF AMERSTRG="^"
QUIT
+77 DO DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
+78 ;Updates the AMERVSIT with correct time
DO DIE^AMEREDIT(AMERDA,AMERDR)
+79 ;looks up PCC VISIT with old time and updates it with new time
DO UPDTVTIM^AMERVSIT(AMERDA,AMEROTIM,AMERNTIM)
+80 DO CHKTIME^AMERTIME(AMERNTIM,AMERAIEN)
+81 QUIT
End DoDot:3
+82 IF AMERSTRG="^"
SET AMERQUIT=1
QUIT
+83 SET AMERDR=""
+84 QUIT
End DoDot:2
+85 QUIT
End DoDot:1
+86 IF AMERQUIT
QUIT 0
+87 ;
+88 ;GDIT/HS/BEE 05/10/2018;CR#10213 - AMER*3.0*10 - Save updated clinic and hospital location
+89 ;Reworked entire section to save custom clinics and differing hospital locations
+90 ;
+91 ;allow user to update "clinic type"
+92 DO EN^DDIOL("","","!")
+93 ;S AMEROLD=$P($G(^AMERVSIT(AMERDA,0)),U,4)
+94 ;S:AMEROLD'="" DIC("B")=$P($G(^AMER(3,AMEROLD,0)),U,1)
+95 ;S DIC("A")="Clinic type (EMERGENCY or URGENT): "
+96 ;S DIC="^AMER(3,",DIC("S")="I $P(^(0),U,2)="_$$CAT^AMER0("CLINIC TYPE"),DIC(0)="AEQ"
+97 ;D ^DIC K DIC
+98 ;I $D(DUOUT)!$D(DTOUT) K DIC,DUOUT,DTOUT Q 0
+99 ;S AMERNEW=$P(Y,U,1)
+100 ;I AMEROLD'=AMERNEW D
+101 ;.S AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"L")
+102 ;.S AMERNEW=$$EDDISPL^AMEREDAU(AMERNEW,"L")
+103 ;.S AMERSTRG=$$EDAUDIT^AMEREDAU(".05",AMEROLD,AMERNEW,"CLINIC TYPE")
+104 ;.I AMERSTRG="^" S AMERQUIT=1 Q
+105 ;.S AMERDR=$S(AMERDR'="":AMERDR_";",1:""),AMERDR=AMERDR_".04///"_AMERNEW
+106 ;.D DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
+107 ;.D DIE^AMEREDIT(AMERDA,AMERDR)
+108 ;.S (AMERDR,Y,AMERNEW,AMEROLD)=""
+109 ;.Q
+110 NEW VIEN,NCLN,OCLN
+111 ;
+112 ;Get visit
+113 SET VIEN=$$GET1^DIQ(9009080,AMERDA_",",.03,"I")
IF VIEN=""
QUIT 0
+114 ;
+115 ;Update clinic
+116 SET (NCLN,OCLN,AMERQUIT)=""
+117 IF VIEN>0
Begin DoDot:1
+118 NEW DIC,X,Y,AMERCLN,AMERTYP,AMERDR
+119 SET DIC("B")=""
+120 ;Pull Hospital Location
SET AMERCLN=$$GETCLN^AMER2A(VIEN)
+121 ;Get AMER clinic text
IF AMERCLN]""
SET OCLN=AMERCLN
SET DIC("B")=$$GET1^DIQ(9009083,AMERCLN,.01,"E")
+122 SET DIC="^AMER(3,"
+123 SET DIC("S")="I '$P(^(0),U,5),$P(^(0),U,2)="_$$CAT^AMER0("CLINIC TYPE")
+124 SET DIC(0)="AEQ"
+125 SET DIC("A")="*Clinic type: "
+126 DO ^DIC
IF '+Y
SET AMERQUIT=1
QUIT
+127 SET NCLN=+Y
+128 SET AMERDR=".04///"_NCLN
+129 DO DIE^AMEREDIT(AMERDA,AMERDR)
End DoDot:1
+130 ;
+131 ;Need to update clinic and hospital location if overrides on file
+132 IF OCLN'=NCLN
IF VIEN>0
IF 'AMERQUIT
Begin DoDot:1
+133 NEW ERR,AMEROLD,AMERNEW
+134 ;
+135 ;GDIT/HS/BEE 05/10/2018;CR#10213/10423 - AMER*3.0*10 - Save updated clinic and hospital location
+136 ;Need to update clinic and hospital location if overrides on file
+137 SET ERR=$$CKHLOC^AMERBSD(VIEN,NCLN)
+138 ;
+139 SET AMEROLD=$$EDDISPL^AMEREDAU(OCLN,"L")
+140 SET AMERNEW=$$EDDISPL^AMEREDAU(NCLN,"L")
+141 SET AMERSTRG=$$EDAUDIT^AMEREDAU(".05",AMEROLD,AMERNEW,"CLINIC TYPE")
+142 DO DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
End DoDot:1
+143 ;
+144 IF AMERQUIT
QUIT 0
PQ ;NOW allow user to update "presenting complaint'
+1 SET Y=$GET(^AMERVSIT(AMERDA,1))
+2 SET AMEROLD=Y
+3 IF AMEROLD'=""
SET DIR("B")=AMEROLD
+4 SET DIR(0)="FOr^1:80"
SET DIR("A")="Presenting complaint"
SET DIR("?")="Enter free text chief complaint (80 characters max.)"
+5 DO ^DIR
KILL DIR
+6 IF $DATA(DUOUT)!$DATA(DTOUT)!(Y<0)
KILL DUOUT,DTOUT,Y
QUIT 0
+7 ;IHS/OIT/SCR 071509 patch 2 START CHANGES
+8 ;D CKSC^AMER1 I $D(AMERCKSC) S Y=DIR("B") K AMERCKSC Q
+9 DO CKSC^AMER1
+10 IF $DATA(AMERCKSC)
Begin DoDot:1
+11 SET Y=$GET(DIR("B"))
+12 KILL AMERCKSC
+13 QUIT
End DoDot:1
GOTO PQ
+14 ;IHS/OIT/SCR 071509 patch 2 END CHANGES
+15 SET AMERNEW=Y
+16 IF AMEROLD'=AMERNEW
Begin DoDot:1
+17 SET AMERSTRG=$$EDAUDIT^AMEREDAU("1",AMEROLD,AMERNEW,"PRESENTING COMPLAINT")
+18 IF AMERSTRG="^"
SET AMERQUIT=1
QUIT
+19 SET AMERDR=$SELECT(AMERDR'="":AMERDR_";",1:"")
SET AMERDR=AMERDR_"1////"_AMERNEW
+20 DO DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
+21 DO DIE^AMEREDIT(AMERDA,AMERDR)
+22 SET (AMERDR,Y,AMERNEW,AMEROLD)=""
+23 QUIT
End DoDot:1
+24 IF AMERQUIT
QUIT 0
+25 DO EN^DDIOL("","","!")
+26 KILL DIC,AMERDR,DIR,AMEREDTS
+27 DO EN^DDIOL("ERS PCC Data Entry is complete for this option","","!!")
+28 SET DIR("A")="Edit more admission data"
+29 SET DIR(0)="Y"
SET DIR("B")="NO"
+30 DO ^DIR
KILL DIR
+31 ;Return with value that subroutine returns
IF Y=1
QUIT $$ERSEDTA(AMERDA,AMERAIEN)
+32 QUIT 1
+33 ;
ERSEDTA(AMERDA,AMERAIEN) ;SUBROUTINE TO ISOLATE FIELDS THAT DO NOT GO TO PCC THAT DO NOT REQUIRE A LOCK
+1 ;NOW allow user to update "visit type"
+2 NEW AMERTRAN
+3 SET (AMERDR,AMEROLD,AMERNEW,AMEREDTS,AMERSTRG,AMERQUIT,AMERTRAN)=""
+4 DO EN^DDIOL("","","!")
+5 SET Y=$PIECE($GET(^AMERVSIT(AMERDA,0)),U,5)
+6 SET AMEROLD=Y
+7 IF AMEROLD'=""
SET DIC("B")=AMEROLD
+8 SET DIC="^AMER(3,"
+9 SET DIC("S")="I $P(^(0),U,2)="_$$CAT^AMER0("VISIT TYPE")
+10 SET DIC(0)="AEQ"
+11 SET DIC("A")="Visit Type: "
+12 DO ^DIC
KILL DIC
+13 IF $DATA(DUOUT)!$DATA(DTOUT)
KILL DIC,DUOUT,DTOUT
QUIT 0
+14 SET AMERNEW=$PIECE(Y,U,1)
+15 IF AMEROLD'=AMERNEW
Begin DoDot:1
+16 SET AMERSTRG=$$EDAUDIT^AMEREDAU(".05",$$EDDISPL^AMEREDAU(AMEROLD,"V"),$$EDDISPL^AMEREDAU(AMERNEW,"V"),"VISIT TYPE")
+17 IF AMERSTRG="^"
SET AMERQUIT=1
QUIT
+18 SET AMERDR=$SELECT(AMERDR'="":AMERDR_";",1:"")
SET AMERDR=AMERDR_".05///"_AMERNEW
+19 DO DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
+20 DO DIE^AMEREDIT(AMERDA,AMERDR)
+21 ;IHS/OIT/SCR 12/15/08 - update ER VISIT FILE with DATE LAST UPDATED (NOW)
+22 DO TIMESTMP^AMERSAV1(AMERDA)
+23 SET (AMERDR,Y,AMERNEW,AMEROLD)=""
+24 QUIT
End DoDot:1
+25 IF AMERQUIT
QUIT 0
+26 ;TRANSFER
+27 SET AMEROLD=""
+28 SET (DIR("B"),AMEROLD)="NO"
+29 IF $PIECE($GET(^AMERVSIT(AMERDA,17)),U,1)=1
SET (DIR("B"),AMEROLD)="YES"
+30 SET DIR(0)="YO"
SET DIR("A")="*Was this patient transferred from another facility"
+31 DO ^DIR
KILL DIR
+32 IF $DATA(DUOUT)!$DATA(DTOUT)
KILL DUOUT,DTOUT
QUIT 0
+33 ; "BOOLEAN" translates from 0 to NO
SET AMERNEW=$$EDDISPL^AMEREDAU(Y,"B")
+34 IF AMERNEW'=AMEROLD
Begin DoDot:1
+35 SET AMERDR=$SELECT(AMERDR'="":AMERDR_";",1:"")
SET AMERDR=AMERDR_"17.1///"_AMERNEW
+36 ;REMOVE all "MODE OF TRANSPORT" and all ambulance and related info if
+37 ;MODE OF TRANSPORT is a different type from "TRANSFERED BY" and we just changed
+38 IF AMERNEW="YES"
SET AMERDR=$SELECT($DATA(AMERDR):AMERDR_";",1:"")
SET AMERDR=AMERDR_".25////@;.14////@;.15////@;.21////@"
+39 SET AMERSTRG=$$EDAUDIT^AMEREDAU("17.1",AMEROLD,AMERNEW,"TRANSFERED")
+40 IF AMERSTRG="^"
SET AMERQUIT=1
QUIT
+41 IF AMERNEW="NO"
Begin DoDot:2
+42 ;if the original transfered value was "yes" and it is being changed to "no"
+43 ;then we have to remove the HER Transfer facility stuff and medical attendant
+44 SET AMERDR=$SELECT($DATA(AMERDR):AMERDR_";",1:"")
SET AMERDR=AMERDR_"17.1////0;17.2////@;17.3////@;17.4////@"
+45 SET AMERHERN=0
+46 FOR
SET AMERHERN=$ORDER(^AMERVSIT(AMERDA,18,AMERHERN))
IF AMERHERN="B"!(AMERHERN="")
QUIT
IF $PIECE($GET(^AMERVSIT(AMERDA,18,AMERHERN,0)),U,2)="A"
Begin DoDot:3
+47 SET DA=AMERHERN
+48 SET DA(1)=AMERDA
SET DIK="^AMERVSIT(DA(1),18,"
+49 ;Kill the sub-record and Re-index
DO ^DIK
DO EN^DIK
KILL DIK
+50 KILL DIK,DA(1),DA
+51 QUIT
End DoDot:3
+52 QUIT
End DoDot:2
+53 DO DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
+54 DO DIE^AMEREDIT(AMERDA,AMERDR)
+55 SET (AMERDR,Y)=""
+56 QUIT
End DoDot:1
+57 IF AMERNEW="YES"
DO TRANSFER^AMEREDTU(AMERDA)
+58 IF AMERNEW="NO"
Begin DoDot:1
+59 DO EN^DDIOL("**Changing the MODE of TRANSPORT can cause ambulance data to be deleted**","","!!?3")
+60 SET DIC("A")="Mode of transport to the ER: "
+61 SET AMEROLD=$PIECE($GET(^AMERVSIT(AMERDA,0)),U,25)
+62 IF AMEROLD=""
KILL DIC("B")
+63 IF AMEROLD'=""
SET DIC("B")=$PIECE($GET(^AMER(3,AMEROLD,0)),U,1)
+64 SET (Y,AMEROLD)=$PIECE($GET(^AMERVSIT(AMERDA,0)),U,25)
+65 SET DIC="^AMER(3,"
SET DIC("S")="I $P(^(0),U,2)="_$$CAT^AMER0("MODE OF TRANSPORT")
+66 SET DIC(0)="AEQ"
+67 DO ^DIC
KILL DIC
+68 IF $DATA(DUOUT)!$DATA(DTOUT)
KILL DUOUT,DTOUT,DIC
SET AMERQUIT=1
QUIT
+69 SET AMERNEW=$PIECE(Y,U,1)
SET AMERTRAN=$PIECE(Y,U,2)
+70 IF AMEROLD'=AMERNEW
Begin DoDot:2
+71 SET AMERDR=$SELECT(AMERDR'="":AMERDR_";",1:"")
SET AMERDR=AMERDR_".25////"_AMERNEW
+72 ;TRANSLATE number to MODE OF TRANSPORT description
SET AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"M")
+73 IF AMEROLD["AMBULANCE"
SET AMERDR=$SELECT(AMERDR'="":AMERDR_";",1:"")
SET AMERDR=AMERDR_".14////@;.15////@;.21////@"
+74 SET AMERSTRG=$$EDAUDIT^AMEREDAU(".25",AMEROLD,AMERTRAN,"MODE OF TRANSPORT")
+75 IF AMERSTRG="^"
SET AMERQUIT=1
QUIT
+76 ;concactonate edit strings
SET AMEREDTS=$SELECT(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
+77 DO DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
+78 DO DIE^AMEREDIT(AMERDA,AMERDR)
+79 SET (AMERDR,Y)=""
+80 QUIT
End DoDot:2
+81 IF AMERTRAN["AMBULANCE"
DO AMBULNCE^AMEREDTU
+82 QUIT
End DoDot:1
+83 IF AMERQUIT
QUIT 0
+84 IF $DATA(DUOUT)!$DATA(DTOUT)
KILL DUOUT,DTOUT
QUIT 0
+85 QUIT 1
