AMEREDIT ; IHS/OIT/SCR - Primary Routine for ER VISIT edit interface
;;3.0;ER VISIT SYSTEM;**1,3,5,6,8**;MAR 03, 2009;Build 23
;
; ALGORITHM:
; 1. Allow user to select from ER VISITS
; 2. Check PCC last update and sych ERS info with what is in it if it is more current.
; 3. Display the visit information
; 4. Allow user to edit OR "verify" selected visit
; 5. Allow user to quit or return to 1
;
; 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
;
RUN ; EP - from Main Menu option AMER EDIT to Edit ER VISIT
N AMERDA,AMERAIEN,AMEREDNO,AMERDUZ,AMERLINE,DIC,DIR,X,Y
N AMERHD1,AMERHD2,AUPNDAYS,AUPNDOB,AUPNDOD,AUPNPAT,AUPNSEX,AGE,AMERX1,AMERD1,AMERDIFF,X1,X2
N AMERPAT,AMERDOB,AMERHRN
I $D(IOF) W @IOF
D UP^AMERBAN
D EN^DDIOL("","","!!!")
S %="",$P(%,"~",80)="",AMERLINE=% K %
S AMEREDNO=0
S DIR(0)="DO"
S DIR("A")="Start with date"
S DIR("?")="leave blank to start with first ER VISIT for this patient"
S Y=DT
X ^DD("DD")
S DIR("B")=Y
D ^DIR
I $D(DUOUT)!($D(DTOUT)) K DTOUT,DUOUT S AMERQUIT="" Q
I X="" D EN^DDIOL("Start at First ER VISIT","","") S Y=2950101.0001
S AMERX1=Y
X ^DD("DD") S AMERD1=Y
S DIC="^DPT(",DIC(0)="AEQM",DIC("A")="Enter name, DOB or chart number: "
S DIC("?N?",9009080)=10
D ^DIC
I $D(DUOUT)!($D(DTOUT)) K DTOUT,DUOUT S AMERQUIT="" Q
I Y=-1 D EN^DDIOL("Patient not found","","!!")
I Y>0 D
.S DIC("S")="I $P(^(0),U,1)>"_AMERX1
.S DIC="^AMERVSIT(",DIC(0)="E",D="AC",X=+Y
.D IX^DIC
.I $D(DUOUT)!($D(DTOUT)) K DTOUT,DUOUT S AMERQUIT="" Q
.I Y<1 D EN^DDIOL("Cannot find an ER VISIT for this patient in this time frame","","!?5")
.I Y>0 D
..S AMERDA=$P(Y,U,1)
..;IHS/OIT/SCR 12/30/08 synch ERS data with what is in PCC if PCC date is more current
..S AMERPCC=$$FINDVSIT^AMERPCC(AMERDA)
..I AMERPCC<0 D Q ;IHS/SCR/OIT 05/07/09 patch 1
...D EN^DDIOL("Cannot identify PCC VISIT for AMERVSIT IEN "_AMERDA_"!","","!!?5")
...S DIR(0)="Y"
...S DIR("A")="Do you want to delete this ERS VISIT?"
...S DIR("B")="YES"
...D ^DIR
...I $D(DUOUT)!($D(DTOUT)) K DTOUT,DUOUT S AMERQUIT="" Q
...I Y=1 D
....D DELETVST^AMERVSIT(AMERDA)
....D EN^DDIOL("This VISIT has been deleted")
....Q
...Q
..S AMERDIFF=0
..S X1=$P($G(^AMERVSIT(AMERDA,6)),"^",12) ;AMERVSIT MOST CURRENT MEANS WE ARE IN SYNCH (X2 is subtrated from X1)
..S X2=$$DLM^APCLV(AMERPCC,"I")
..D ^%DTC
..S:Y AMERDIFF=X
..I AMERDIFF<=0 D
...D SYNCHERA^AMERERS(AMERDA,AMERPCC) ;SYNCH VISIT DATA
...D SYNCHERD^AMERERS(AMERDA,AMERPCC) ;SYNCH V PROVIDER DATA
...;AMER*3.0*6;Do not sync V POV DATA
...;D SYNCHERX^AMERERS(AMERDA,AMERPCC) ;SYNCH V POV DATA
...Q
..;IHS/OIT/SCR 12/30/08 END CHANGES
..;IHS/OIT/SCR 01/09/08 GET CURRENT VALUES IN PATIENT REG FOR DOB AND CHART NUMBER AND UPDATE IF DIFFERENT
..S AMERPAT=$P($G(^AMERVSIT(AMERDA,0)),U,2) ; AMERPAT IS THE IEN OF PATIENT
..I AMERPAT'="" D SYNCHERP^AMERERS(AMERPAT,AMERDA)
..;
..;AMER*3.0*5 - Now log the activity
..I $G(AMERPCC)]"" D LOG^AMERBUSA("P","Q","AMER","AMER: Display Patient ER visit information ("_AMERDA_")","^"_AMERPCC)
..;
..D PRINT(AMERDA)
..S DIR("A")="Do you want to EDIT this ER VISIT"
..S DIR(0)="Y",DIR("B")="YES"
..D ^DIR
..I Y=1 D ;create the audit record that will track this session
...S AMERDUZ=DUZ
...S AMERAIEN=$$CREATAUD^AMEREDAU(AMERDA,AMERDUZ) Q:AMERAIEN<0 ;CREATE AN AUDIT FILE RECORD
...D EDITERV(AMERDA,AMERAIEN,.AMEREDNO) ;CURRENTLY EDITS ALL FIELDS
...D EXIT(AMERDA,0)
...Q
..Q
.Q
D EN^DDIOL("","","!!")
S DIR(0)="Y"
S DIR("A")="Would you like to EDIT another ER VISIT"
S DIR("B")="NO"
D ^DIR
I Y=1 K AMERDA,AMERAIEN,AMEREDNO,AMERDUZ D RUN
E D EN^DDIOL("No ER VISITS selected for edit","","!!")
K AMERDA,AMERAIEN,AMEREDNO,AMERDUZ,AMERLINE,DIC,DIR,AMERVER,AMERHD1,AMERHD2,AUPNDAYS,AUPNDOB,AUPNDOD,AUPNPAT,AUPNSEX,AGE
Q
PRINT(DA) ; PRINT SELECTED VISIT TO SCREEN
N DIC,BY,FR,TO,FLDS
S DIC="^AMERVSIT(",BY="NUMBER",(FR,TO)=DA,FLDS="[AMER DETAIL"
D EN1^DIP
;
;AMER*3.0*5 - Now log the activity
I $G(AMERPCC)]"" D LOG^AMERBUSA("P","P","AMER","AMER: Printed Patient ER visit information","^"_AMERPCC)
;
K DIC,BY,FR,TO,FLDS
Q
;
EDITERV(AMERDA,AMERAIEN,AMEREDNO) ; EDIT SELECTED VISIT
; NEED TO PARTITION SELECTIONS INTO PCC FIELD EDIT AND ERS FIELD EDIT
;
;AMER*3.0*5 - Now log the activity
I $G(AMERPCC)]"" D LOG^AMERBUSA("P","E","AMER","AMER: Edit Patient ER visit information ("_AMERDA_")","^"_AMERPCC)
;
N AMERQUIT,AMERSEL,DIR,AMERQUIT
S AMERQUIT=0
;D EN^DDIOL("***ENTRIES MARKED WITH '*' contain LOCKED fields***","","!!,?5")
S DIR(0)="SO^1:ADMISSION SUMMARY;2:TRIAGE INFO;3:INJURY INFO;"
;AMER*3*6;Added (Option Disabled)
S DIR(0)=DIR(0)_"4:PROCEDURES;5:DIAGNOSES (OPTION DISABLED);6:EXIT ASSESSMENT;"
S DIR(0)=DIR(0)_"7:DISCHARGE INFO;8:FOLLOW UP INSTRUCTIONS;9:ER CONSULTANTS;"
S DIR(0)=DIR(0)_"10:ALL"
S DIR("A")="ENTER NUMBER OF SECTION TO EDIT (OR '<return>' TO QUIT)",DIR("?")="Enter the number of the section you want to edit"
S DA=AMERDA
D ^DIR
I Y=""!(Y="^") D
.I '$D(^XUSEC("AMERZ9999",DUZ)) Q ;only holders of the coding key can update a DX
.S AMERQUIT=1
.I '$$CHKVSIT^AMEREDPC(AMERDA,AMERAIEN) D
..D EN^DDIOL("**The primary diagnosis for this ER visit is uncoded**","","!")
..;AMER*3*6;No longer allow DX to be fixed
..D EN^DDIOL("**Please fix the issue using EHR/PCC**","","!")
..Q
..;
..S DIR(0)="Y",DIR("A")="Would you like to update the .9999 code now",DIR("B")="YES"
..D ^DIR
..I Y=0 S Y=""
..I Y=1 S AMERQUIT=0,Y=5
..Q
.Q
Q:AMERQUIT
S AMERSEL=Y
K DIR,Y,DA
D EDIT(AMERSEL,AMERDA,AMERAIEN,.AMEREDNO)
;
K AMERQUIT,AMERSEL
Q
;
EDIT(AMERSEL,AMERDA,AMERAIEN,AMEREDNO) ;
N DIC,DR,AMERDUZ,AMERNEW,AMEROLD,AMERSTRG,AMERQUIT
S AMERQUIT=0
D EN^DDIOL(AMERLINE,"","!!")
I AMERSEL=1!(AMERSEL=10) D
.I '$$EDADMIT^AMEREDTA(AMERDA,AMERAIEN) S AMERQUIT=1 Q ;ADMISSION SUMMARY
.;
.;AMER*3.0*5 - Now log the activity
.I $G(AMERPCC)]"" D LOG^AMERBUSA("P","E","AMER","AMER: Edited ER Admission Summary Information ("_AMERDA_")","^"_AMERPCC)
.;
.D EN^DDIOL(AMERLINE,"","!!")
.D EN^DDIOL("","","!")
.Q
I AMERQUIT D EXIT(AMERDA,AMERQUIT) Q
I AMERSEL=2!(AMERSEL=10) D ;TRIAGE INFO
.I '$$ADMTRIAG^AMEREDTT(AMERDA,AMERAIEN) S AMERQUIT=1 Q ;WORK RELATED,ADMITTING PROVIDERS,ADMITTING TRIAGE CATEGORY
.;
.;AMER*3.0*5 - Now log the activity
.I $G(AMERPCC)]"" D LOG^AMERBUSA("P","E","AMER","AMER: Edited ER Triage Information ("_AMERDA_")","^"_AMERPCC)
.;
.D EN^DDIOL(AMERLINE,"","!!")
.D EN^DDIOL("","","!")
.Q
I AMERQUIT D EXIT(AMERDA,AMERQUIT) Q
I AMERSEL=3!(AMERSEL=10) D ;INJURY
.I '$$EDINJRY^AMEREDTI(AMERDA,AMERAIEN) S AMERQUIT=1 Q
.;
.;AMER*3.0*5 - Now log the activity
.I $G(AMERPCC)]"" D LOG^AMERBUSA("P","E","AMER","AMER: Edited ER Injury Information ("_AMERDA_")","^"_AMERPCC)
.;
.D EN^DDIOL(AMERLINE,"","!!")
.D EN^DDIOL("","","!")
.Q
I AMERQUIT D EXIT(AMERDA,AMERQUIT) Q
I AMERSEL=4!(AMERSEL=10) D ;PROCEDURE
.I '$$EDPROCS^AMEREDTD(AMERDA,.AMEREDNO,AMERAIEN) S AMERQUIT=1 Q
.;
.;AMER*3.0*5 - Now log the activity
.I $G(AMERPCC)]"" D LOG^AMERBUSA("P","E","AMER","AMER: Edited ER Procedure Information ("_AMERDA_")","^"_AMERPCC)
.;
.D EN^DDIOL(AMERLINE,"","!!")
.D EN^DDIOL("","","!")
.Q
I AMERQUIT D EXIT(AMERDA,AMERQUIT) Q
I AMERSEL=5!(AMERSEL=10) D
.;
.;Automatically sync with PCC
.D SYNCHERX^AMERERS(AMERDA,AMERPCC) ;SYNCH V POV DATA
.;
.;AMER*3*6;Disable DX entry
.I AMERSEL=5 D H 3
..D EN^DDIOL("DX entry has been disabled in AMER.","","")
..D EN^DDIOL("Please use PCC to update visit POV information.","","!!") H 3
.Q
.;
.I '$$EDDIAGS^AMEREDDX(AMERDA,.AMEREDNO,AMERAIEN) S AMERQUIT=1 Q ;DIAGNOSES
.;
.;AMER*3.0*5 - Now log the activity
.I $G(AMERPCC)]"" D LOG^AMERBUSA("P","E","AMER","AMER: Edited ER Diagnosis Information ("_AMERDA_")","^"_AMERPCC)
.;
.D EN^DDIOL(AMERLINE,"","!!")
.D EN^DDIOL("","","!")
.Q
I AMERQUIT D EXIT(AMERDA,AMERQUIT) Q
;IHS/OIT/SCR - 10/15/08 the visit can be deleted here and AMERDA is passed by reference
I AMERSEL=6!(AMERSEL=10) D
.I '$$EDEXTAS^AMEREDTD(.AMERDA,AMERAIEN) S AMERQUIT=1 Q ;EXIT ASSESSMENT
.;
.;AMER*3.0*5 - Now log the activity
.I $G(AMERPCC)]"" D LOG^AMERBUSA("P","E","AMER","AMER: Edited ER Exit Assessment Information ("_AMERDA_")","^"_AMERPCC)
.;
.D EN^DDIOL(AMERLINE,"","!!")
.D EN^DDIOL("","","!")
.I (AMERDA=0) S AMERQUIT=1
.Q
I AMERQUIT D EXIT(AMERDA,AMERQUIT) Q
I AMERSEL=7!(AMERSEL=10) D ;DISCHARGE
.I '$$EDDISCHG^AMEREDTD(AMERDA,AMERAIEN) S AMERQUIT=1 Q
.;
.;AMER*3.0*5 - Now log the activity
.I $G(AMERPCC)]"" D LOG^AMERBUSA("P","E","AMER","AMER: Edited ER Discharge Information ("_AMERDA_")","^"_AMERPCC)
.;
.D EN^DDIOL(AMERLINE,"","!!")
.D EN^DDIOL("","","!")
.Q
I AMERQUIT D EXIT(AMERDA,AMERQUIT) Q
I AMERSEL=8!(AMERSEL=10) D ;FOLLOW UP INSTRUCTIONS
.I '$$EDFUINST^AMEREDTD(AMERDA,AMERAIEN) S AMERQUIT=1 Q
.;
.;AMER*3.0*5 - Now log the activity
.I $G(AMERPCC)]"" D LOG^AMERBUSA("P","E","AMER","AMER: Edited ER Follow up Instructions ("_AMERDA_")","^"_AMERPCC)
.;
.D EN^DDIOL(AMERLINE,"","!!")
.D EN^DDIOL("","","!")
.Q
I AMERQUIT D EXIT(AMERDA,AMERQUIT) Q
I AMERSEL=9!(AMERSEL=10) D ;ER CONSULTANT
.I '$$EDTCNSLT^AMEREDTE(AMERDA,.AMEREDNO,AMERAIEN) S AMERQUIT=1 Q
.;
.;AMER*3.0*5 - Now log the activity
.I $G(AMERPCC)]"" D LOG^AMERBUSA("P","E","AMER","AMER: Edited ER Consultant Information ("_AMERDA_")","^"_AMERPCC)
.;
.D EN^DDIOL(AMERLINE,"","!!")
.D EN^DDIOL("","","!")
.Q
;
;AMER*3.0*8;Update V EMERGENCY VISIT record
D VER^AMERVER($G(DFN),$G(AMERPCC))
;
D:AMERSEL'="" EDITERV(AMERDA,AMERAIEN,.AMEREDNO)
Q
;
EXIT(AMERDA,AMERQUIT) ;
D COMPUTE^AMERTIME(AMERDA)
D:'AMERQUIT
.S DIR("A")="Do you want to PRINT this ER VISIT"
.S DIR(0)="Y",DIR("B")="NO"
.D ^DIR
.D:Y=1 PRINT(AMERDA)
Q
;
DIE(AMERDA,AMERDR) ; EP from multiple AMERED* ROUTINES
; 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,DIK,DA,DR
S DA=AMERDA
S DR=AMERDR
S DIE="^AMERVSIT("
DIE1 L +^AMERVSIT(DA):3 E Q
D ^DIE
S DIK=DIE
D EN^DIK
L -^AMERVSIT(DA)
;IHS/OIT/SCR 12/18/08
D TIMESTMP^AMERSAV1(DA)
K DIE,DA,DR
Q
;
TXTREAD ;
S DIR(0)="FO^1:20"
S DIR("?")="Enter free text (30 characters max.)"
D ^DIR K DIR
D CKSC^AMER1 I $D(AMERCKSC) K AMERCKSC G TXTREAD
D OUT^AMER
Q
;
MULTDIE(AMERDIE,AMERDA,AMERDA1,AMERDR) ; EP From Multiple AMERED* routines
; GIVEN AN ENTRY NUMBER AND A DR STRING, EDIT A MULTIPLE FIELD OF THE ER VISIT FILE
; INPUT:
; AMERDIE : the subrecord identifying the multiple field to be updated
; DA : the sub-record identifier that is being updated
; DA1 : The IEN of the ER VISIT being updated
; DR : the "DR" string containing the multiple sub-field and value to be updated
;
N X,Y,%
N D,D0,DI,DIC,DICR,DIE,DIG,DIH,DIV,DIU,DIW,DQ,DR,DA,DIE
S DIE=AMERDIE,DA=AMERDA,DA(1)=AMERDA1,DR=AMERDR
L +^AMERVSIT(AMERDA1):3 E Q
D ^DIE
S DIK=AMERDIE,DA(1)=AMERDA1
D EN^DIK
L -^AMERVSIT(AMERDA1)
;IHS/OIT/SCR 12/15/08 - update ER VISIT FILE with DATE LAST UPDATED (NOW)
D TIMESTMP^AMERSAV1(AMERDA1)
Q
AMEREDIT ; IHS/OIT/SCR - Primary Routine for ER VISIT edit interface
+1 ;;3.0;ER VISIT SYSTEM;**1,3,5,6,8**;MAR 03, 2009;Build 23
+2 ;
+3 ; ALGORITHM:
+4 ; 1. Allow user to select from ER VISITS
+5 ; 2. Check PCC last update and sych ERS info with what is in it if it is more current.
+6 ; 3. Display the visit information
+7 ; 4. Allow user to edit OR "verify" selected visit
+8 ; 5. Allow user to quit or return to 1
+9 ;
+10 ; VARIABLES: The following variables are passed to multiple editing routines
+11 ; AMERDA : the IEN of the ER VISIT that is selected for editing
+12 ; AMERAIEN: The IEN of the ER AUDIT that is created when user begins editing a record
+13 ; AMEREDNO: An integer representing the number of multiple fields that have been edited
+14 ; for uniqueness in multiple field number in audit file
+15 ; Edit Auditing VARIABLES newed and used throughout edit routines:
+16 ; AMEROLD : original value of edited field
+17 ; AMERNEW : new value of edited field
+18 ; AMERSTRG : A ";" deliminated string of edit information for a field
+19 ;
RUN ; EP - from Main Menu option AMER EDIT to Edit ER VISIT
+1 NEW AMERDA,AMERAIEN,AMEREDNO,AMERDUZ,AMERLINE,DIC,DIR,X,Y
+2 NEW AMERHD1,AMERHD2,AUPNDAYS,AUPNDOB,AUPNDOD,AUPNPAT,AUPNSEX,AGE,AMERX1,AMERD1,AMERDIFF,X1,X2
+3 NEW AMERPAT,AMERDOB,AMERHRN
+4 IF $DATA(IOF)
WRITE @IOF
+5 DO UP^AMERBAN
+6 DO EN^DDIOL("","","!!!")
+7 SET %=""
SET $PIECE(%,"~",80)=""
SET AMERLINE=%
KILL %
+8 SET AMEREDNO=0
+9 SET DIR(0)="DO"
+10 SET DIR("A")="Start with date"
+11 SET DIR("?")="leave blank to start with first ER VISIT for this patient"
+12 SET Y=DT
+13 XECUTE ^DD("DD")
+14 SET DIR("B")=Y
+15 DO ^DIR
+16 IF $DATA(DUOUT)!($DATA(DTOUT))
KILL DTOUT,DUOUT
SET AMERQUIT=""
QUIT
+17 IF X=""
DO EN^DDIOL("Start at First ER VISIT","","")
SET Y=2950101.0001
+18 SET AMERX1=Y
+19 XECUTE ^DD("DD")
SET AMERD1=Y
+20 SET DIC="^DPT("
SET DIC(0)="AEQM"
SET DIC("A")="Enter name, DOB or chart number: "
+21 SET DIC("?N?",9009080)=10
+22 DO ^DIC
+23 IF $DATA(DUOUT)!($DATA(DTOUT))
KILL DTOUT,DUOUT
SET AMERQUIT=""
QUIT
+24 IF Y=-1
DO EN^DDIOL("Patient not found","","!!")
+25 IF Y>0
Begin DoDot:1
+26 SET DIC("S")="I $P(^(0),U,1)>"_AMERX1
+27 SET DIC="^AMERVSIT("
SET DIC(0)="E"
SET D="AC"
SET X=+Y
+28 DO IX^DIC
+29 IF $DATA(DUOUT)!($DATA(DTOUT))
KILL DTOUT,DUOUT
SET AMERQUIT=""
QUIT
+30 IF Y<1
DO EN^DDIOL("Cannot find an ER VISIT for this patient in this time frame","","!?5")
+31 IF Y>0
Begin DoDot:2
+32 SET AMERDA=$PIECE(Y,U,1)
+33 ;IHS/OIT/SCR 12/30/08 synch ERS data with what is in PCC if PCC date is more current
+34 SET AMERPCC=$$FINDVSIT^AMERPCC(AMERDA)
+35 ;IHS/SCR/OIT 05/07/09 patch 1
IF AMERPCC<0
Begin DoDot:3
+36 DO EN^DDIOL("Cannot identify PCC VISIT for AMERVSIT IEN "_AMERDA_"!","","!!?5")
+37 SET DIR(0)="Y"
+38 SET DIR("A")="Do you want to delete this ERS VISIT?"
+39 SET DIR("B")="YES"
+40 DO ^DIR
+41 IF $DATA(DUOUT)!($DATA(DTOUT))
KILL DTOUT,DUOUT
SET AMERQUIT=""
QUIT
+42 IF Y=1
Begin DoDot:4
+43 DO DELETVST^AMERVSIT(AMERDA)
+44 DO EN^DDIOL("This VISIT has been deleted")
+45 QUIT
End DoDot:4
+46 QUIT
End DoDot:3
QUIT
+47 SET AMERDIFF=0
+48 ;AMERVSIT MOST CURRENT MEANS WE ARE IN SYNCH (X2 is subtrated from X1)
SET X1=$PIECE($GET(^AMERVSIT(AMERDA,6)),"^",12)
+49 SET X2=$$DLM^APCLV(AMERPCC,"I")
+50 DO ^%DTC
+51 IF Y
SET AMERDIFF=X
+52 IF AMERDIFF<=0
Begin DoDot:3
+53 ;SYNCH VISIT DATA
DO SYNCHERA^AMERERS(AMERDA,AMERPCC)
+54 ;SYNCH V PROVIDER DATA
DO SYNCHERD^AMERERS(AMERDA,AMERPCC)
+55 ;AMER*3.0*6;Do not sync V POV DATA
+56 ;D SYNCHERX^AMERERS(AMERDA,AMERPCC) ;SYNCH V POV DATA
+57 QUIT
End DoDot:3
+58 ;IHS/OIT/SCR 12/30/08 END CHANGES
+59 ;IHS/OIT/SCR 01/09/08 GET CURRENT VALUES IN PATIENT REG FOR DOB AND CHART NUMBER AND UPDATE IF DIFFERENT
+60 ; AMERPAT IS THE IEN OF PATIENT
SET AMERPAT=$PIECE($GET(^AMERVSIT(AMERDA,0)),U,2)
+61 IF AMERPAT'=""
DO SYNCHERP^AMERERS(AMERPAT,AMERDA)
+62 ;
+63 ;AMER*3.0*5 - Now log the activity
+64 IF $GET(AMERPCC)]""
DO LOG^AMERBUSA("P","Q","AMER","AMER: Display Patient ER visit information ("_AMERDA_")","^"_AMERPCC)
+65 ;
+66 DO PRINT(AMERDA)
+67 SET DIR("A")="Do you want to EDIT this ER VISIT"
+68 SET DIR(0)="Y"
SET DIR("B")="YES"
+69 DO ^DIR
+70 ;create the audit record that will track this session
IF Y=1
Begin DoDot:3
+71 SET AMERDUZ=DUZ
+72 ;CREATE AN AUDIT FILE RECORD
SET AMERAIEN=$$CREATAUD^AMEREDAU(AMERDA,AMERDUZ)
IF AMERAIEN<0
QUIT
+73 ;CURRENTLY EDITS ALL FIELDS
DO EDITERV(AMERDA,AMERAIEN,.AMEREDNO)
+74 DO EXIT(AMERDA,0)
+75 QUIT
End DoDot:3
+76 QUIT
End DoDot:2
+77 QUIT
End DoDot:1
+78 DO EN^DDIOL("","","!!")
+79 SET DIR(0)="Y"
+80 SET DIR("A")="Would you like to EDIT another ER VISIT"
+81 SET DIR("B")="NO"
+82 DO ^DIR
+83 IF Y=1
KILL AMERDA,AMERAIEN,AMEREDNO,AMERDUZ
DO RUN
+84 IF '$TEST
DO EN^DDIOL("No ER VISITS selected for edit","","!!")
+85 KILL AMERDA,AMERAIEN,AMEREDNO,AMERDUZ,AMERLINE,DIC,DIR,AMERVER,AMERHD1,AMERHD2,AUPNDAYS,AUPNDOB,AUPNDOD,AUPNPAT,AUPNSEX,AGE
+86 QUIT
PRINT(DA) ; PRINT SELECTED VISIT TO SCREEN
+1 NEW DIC,BY,FR,TO,FLDS
+2 SET DIC="^AMERVSIT("
SET BY="NUMBER"
SET (FR,TO)=DA
SET FLDS="[AMER DETAIL"
+3 DO EN1^DIP
+4 ;
+5 ;AMER*3.0*5 - Now log the activity
+6 IF $GET(AMERPCC)]""
DO LOG^AMERBUSA("P","P","AMER","AMER: Printed Patient ER visit information","^"_AMERPCC)
+7 ;
+8 KILL DIC,BY,FR,TO,FLDS
+9 QUIT
+10 ;
EDITERV(AMERDA,AMERAIEN,AMEREDNO) ; EDIT SELECTED VISIT
+1 ; NEED TO PARTITION SELECTIONS INTO PCC FIELD EDIT AND ERS FIELD EDIT
+2 ;
+3 ;AMER*3.0*5 - Now log the activity
+4 IF $GET(AMERPCC)]""
DO LOG^AMERBUSA("P","E","AMER","AMER: Edit Patient ER visit information ("_AMERDA_")","^"_AMERPCC)
+5 ;
+6 NEW AMERQUIT,AMERSEL,DIR,AMERQUIT
+7 SET AMERQUIT=0
+8 ;D EN^DDIOL("***ENTRIES MARKED WITH '*' contain LOCKED fields***","","!!,?5")
+9 SET DIR(0)="SO^1:ADMISSION SUMMARY;2:TRIAGE INFO;3:INJURY INFO;"
+10 ;AMER*3*6;Added (Option Disabled)
+11 SET DIR(0)=DIR(0)_"4:PROCEDURES;5:DIAGNOSES (OPTION DISABLED);6:EXIT ASSESSMENT;"
+12 SET DIR(0)=DIR(0)_"7:DISCHARGE INFO;8:FOLLOW UP INSTRUCTIONS;9:ER CONSULTANTS;"
+13 SET DIR(0)=DIR(0)_"10:ALL"
+14 SET DIR("A")="ENTER NUMBER OF SECTION TO EDIT (OR '<return>' TO QUIT)"
SET DIR("?")="Enter the number of the section you want to edit"
+15 SET DA=AMERDA
+16 DO ^DIR
+17 IF Y=""!(Y="^")
Begin DoDot:1
+18 ;only holders of the coding key can update a DX
IF '$DATA(^XUSEC("AMERZ9999",DUZ))
QUIT
+19 SET AMERQUIT=1
+20 IF '$$CHKVSIT^AMEREDPC(AMERDA,AMERAIEN)
Begin DoDot:2
+21 DO EN^DDIOL("**The primary diagnosis for this ER visit is uncoded**","","!")
+22 ;AMER*3*6;No longer allow DX to be fixed
+23 DO EN^DDIOL("**Please fix the issue using EHR/PCC**","","!")
+24 QUIT
+25 ;
+26 SET DIR(0)="Y"
SET DIR("A")="Would you like to update the .9999 code now"
SET DIR("B")="YES"
+27 DO ^DIR
+28 IF Y=0
SET Y=""
+29 IF Y=1
SET AMERQUIT=0
SET Y=5
+30 QUIT
End DoDot:2
+31 QUIT
End DoDot:1
+32 IF AMERQUIT
QUIT
+33 SET AMERSEL=Y
+34 KILL DIR,Y,DA
+35 DO EDIT(AMERSEL,AMERDA,AMERAIEN,.AMEREDNO)
+36 ;
+37 KILL AMERQUIT,AMERSEL
+38 QUIT
+39 ;
EDIT(AMERSEL,AMERDA,AMERAIEN,AMEREDNO) ;
+1 NEW DIC,DR,AMERDUZ,AMERNEW,AMEROLD,AMERSTRG,AMERQUIT
+2 SET AMERQUIT=0
+3 DO EN^DDIOL(AMERLINE,"","!!")
+4 IF AMERSEL=1!(AMERSEL=10)
Begin DoDot:1
+5 ;ADMISSION SUMMARY
IF '$$EDADMIT^AMEREDTA(AMERDA,AMERAIEN)
SET AMERQUIT=1
QUIT
+6 ;
+7 ;AMER*3.0*5 - Now log the activity
+8 IF $GET(AMERPCC)]""
DO LOG^AMERBUSA("P","E","AMER","AMER: Edited ER Admission Summary Information ("_AMERDA_")","^"_AMERPCC)
+9 ;
+10 DO EN^DDIOL(AMERLINE,"","!!")
+11 DO EN^DDIOL("","","!")
+12 QUIT
End DoDot:1
+13 IF AMERQUIT
DO EXIT(AMERDA,AMERQUIT)
QUIT
+14 ;TRIAGE INFO
IF AMERSEL=2!(AMERSEL=10)
Begin DoDot:1
+15 ;WORK RELATED,ADMITTING PROVIDERS,ADMITTING TRIAGE CATEGORY
IF '$$ADMTRIAG^AMEREDTT(AMERDA,AMERAIEN)
SET AMERQUIT=1
QUIT
+16 ;
+17 ;AMER*3.0*5 - Now log the activity
+18 IF $GET(AMERPCC)]""
DO LOG^AMERBUSA("P","E","AMER","AMER: Edited ER Triage Information ("_AMERDA_")","^"_AMERPCC)
+19 ;
+20 DO EN^DDIOL(AMERLINE,"","!!")
+21 DO EN^DDIOL("","","!")
+22 QUIT
End DoDot:1
+23 IF AMERQUIT
DO EXIT(AMERDA,AMERQUIT)
QUIT
+24 ;INJURY
IF AMERSEL=3!(AMERSEL=10)
Begin DoDot:1
+25 IF '$$EDINJRY^AMEREDTI(AMERDA,AMERAIEN)
SET AMERQUIT=1
QUIT
+26 ;
+27 ;AMER*3.0*5 - Now log the activity
+28 IF $GET(AMERPCC)]""
DO LOG^AMERBUSA("P","E","AMER","AMER: Edited ER Injury Information ("_AMERDA_")","^"_AMERPCC)
+29 ;
+30 DO EN^DDIOL(AMERLINE,"","!!")
+31 DO EN^DDIOL("","","!")
+32 QUIT
End DoDot:1
+33 IF AMERQUIT
DO EXIT(AMERDA,AMERQUIT)
QUIT
+34 ;PROCEDURE
IF AMERSEL=4!(AMERSEL=10)
Begin DoDot:1
+35 IF '$$EDPROCS^AMEREDTD(AMERDA,.AMEREDNO,AMERAIEN)
SET AMERQUIT=1
QUIT
+36 ;
+37 ;AMER*3.0*5 - Now log the activity
+38 IF $GET(AMERPCC)]""
DO LOG^AMERBUSA("P","E","AMER","AMER: Edited ER Procedure Information ("_AMERDA_")","^"_AMERPCC)
+39 ;
+40 DO EN^DDIOL(AMERLINE,"","!!")
+41 DO EN^DDIOL("","","!")
+42 QUIT
End DoDot:1
+43 IF AMERQUIT
DO EXIT(AMERDA,AMERQUIT)
QUIT
+44 IF AMERSEL=5!(AMERSEL=10)
Begin DoDot:1
+45 ;
+46 ;Automatically sync with PCC
+47 ;SYNCH V POV DATA
DO SYNCHERX^AMERERS(AMERDA,AMERPCC)
+48 ;
+49 ;AMER*3*6;Disable DX entry
+50 IF AMERSEL=5
Begin DoDot:2
+51 DO EN^DDIOL("DX entry has been disabled in AMER.","","")
+52 DO EN^DDIOL("Please use PCC to update visit POV information.","","!!")
HANG 3
End DoDot:2
HANG 3
+53 QUIT
+54 ;
+55 ;DIAGNOSES
IF '$$EDDIAGS^AMEREDDX(AMERDA,.AMEREDNO,AMERAIEN)
SET AMERQUIT=1
QUIT
+56 ;
+57 ;AMER*3.0*5 - Now log the activity
+58 IF $GET(AMERPCC)]""
DO LOG^AMERBUSA("P","E","AMER","AMER: Edited ER Diagnosis Information ("_AMERDA_")","^"_AMERPCC)
+59 ;
+60 DO EN^DDIOL(AMERLINE,"","!!")
+61 DO EN^DDIOL("","","!")
+62 QUIT
End DoDot:1
+63 IF AMERQUIT
DO EXIT(AMERDA,AMERQUIT)
QUIT
+64 ;IHS/OIT/SCR - 10/15/08 the visit can be deleted here and AMERDA is passed by reference
+65 IF AMERSEL=6!(AMERSEL=10)
Begin DoDot:1
+66 ;EXIT ASSESSMENT
IF '$$EDEXTAS^AMEREDTD(.AMERDA,AMERAIEN)
SET AMERQUIT=1
QUIT
+67 ;
+68 ;AMER*3.0*5 - Now log the activity
+69 IF $GET(AMERPCC)]""
DO LOG^AMERBUSA("P","E","AMER","AMER: Edited ER Exit Assessment Information ("_AMERDA_")","^"_AMERPCC)
+70 ;
+71 DO EN^DDIOL(AMERLINE,"","!!")
+72 DO EN^DDIOL("","","!")
+73 IF (AMERDA=0)
SET AMERQUIT=1
+74 QUIT
End DoDot:1
+75 IF AMERQUIT
DO EXIT(AMERDA,AMERQUIT)
QUIT
+76 ;DISCHARGE
IF AMERSEL=7!(AMERSEL=10)
Begin DoDot:1
+77 IF '$$EDDISCHG^AMEREDTD(AMERDA,AMERAIEN)
SET AMERQUIT=1
QUIT
+78 ;
+79 ;AMER*3.0*5 - Now log the activity
+80 IF $GET(AMERPCC)]""
DO LOG^AMERBUSA("P","E","AMER","AMER: Edited ER Discharge Information ("_AMERDA_")","^"_AMERPCC)
+81 ;
+82 DO EN^DDIOL(AMERLINE,"","!!")
+83 DO EN^DDIOL("","","!")
+84 QUIT
End DoDot:1
+85 IF AMERQUIT
DO EXIT(AMERDA,AMERQUIT)
QUIT
+86 ;FOLLOW UP INSTRUCTIONS
IF AMERSEL=8!(AMERSEL=10)
Begin DoDot:1
+87 IF '$$EDFUINST^AMEREDTD(AMERDA,AMERAIEN)
SET AMERQUIT=1
QUIT
+88 ;
+89 ;AMER*3.0*5 - Now log the activity
+90 IF $GET(AMERPCC)]""
DO LOG^AMERBUSA("P","E","AMER","AMER: Edited ER Follow up Instructions ("_AMERDA_")","^"_AMERPCC)
+91 ;
+92 DO EN^DDIOL(AMERLINE,"","!!")
+93 DO EN^DDIOL("","","!")
+94 QUIT
End DoDot:1
+95 IF AMERQUIT
DO EXIT(AMERDA,AMERQUIT)
QUIT
+96 ;ER CONSULTANT
IF AMERSEL=9!(AMERSEL=10)
Begin DoDot:1
+97 IF '$$EDTCNSLT^AMEREDTE(AMERDA,.AMEREDNO,AMERAIEN)
SET AMERQUIT=1
QUIT
+98 ;
+99 ;AMER*3.0*5 - Now log the activity
+100 IF $GET(AMERPCC)]""
DO LOG^AMERBUSA("P","E","AMER","AMER: Edited ER Consultant Information ("_AMERDA_")","^"_AMERPCC)
+101 ;
+102 DO EN^DDIOL(AMERLINE,"","!!")
+103 DO EN^DDIOL("","","!")
+104 QUIT
End DoDot:1
+105 ;
+106 ;AMER*3.0*8;Update V EMERGENCY VISIT record
+107 DO VER^AMERVER($GET(DFN),$GET(AMERPCC))
+108 ;
+109 IF AMERSEL'=""
DO EDITERV(AMERDA,AMERAIEN,.AMEREDNO)
+110 QUIT
+111 ;
EXIT(AMERDA,AMERQUIT) ;
+1 DO COMPUTE^AMERTIME(AMERDA)
+2 IF 'AMERQUIT
Begin DoDot:1
+3 SET DIR("A")="Do you want to PRINT this ER VISIT"
+4 SET DIR(0)="Y"
SET DIR("B")="NO"
+5 DO ^DIR
+6 IF Y=1
DO PRINT(AMERDA)
End DoDot:1
+7 QUIT
+8 ;
DIE(AMERDA,AMERDR) ; EP from multiple AMERED* ROUTINES
+1 ; GIVEN AN ENTRY NUMBER AND A DR STRING, EDIT THE ER VISIT FILE
+2 NEW X,Y,%
+3 NEW D,D0,DI,DIC,DICR,DIE,DIG,DIH,DIV,DIU,DIW,DQ,DIK,DA,DR
+4 SET DA=AMERDA
+5 SET DR=AMERDR
+6 SET DIE="^AMERVSIT("
DIE1 LOCK +^AMERVSIT(DA):3
IF '$TEST
QUIT
+1 DO ^DIE
+2 SET DIK=DIE
+3 DO EN^DIK
+4 LOCK -^AMERVSIT(DA)
+5 ;IHS/OIT/SCR 12/18/08
+6 DO TIMESTMP^AMERSAV1(DA)
+7 KILL DIE,DA,DR
+8 QUIT
+9 ;
TXTREAD ;
+1 SET DIR(0)="FO^1:20"
+2 SET DIR("?")="Enter free text (30 characters max.)"
+3 DO ^DIR
KILL DIR
+4 DO CKSC^AMER1
IF $DATA(AMERCKSC)
KILL AMERCKSC
GOTO TXTREAD
+5 DO OUT^AMER
+6 QUIT
+7 ;
MULTDIE(AMERDIE,AMERDA,AMERDA1,AMERDR) ; EP From Multiple AMERED* routines
+1 ; GIVEN AN ENTRY NUMBER AND A DR STRING, EDIT A MULTIPLE FIELD OF THE ER VISIT FILE
+2 ; INPUT:
+3 ; AMERDIE : the subrecord identifying the multiple field to be updated
+4 ; DA : the sub-record identifier that is being updated
+5 ; DA1 : The IEN of the ER VISIT being updated
+6 ; DR : the "DR" string containing the multiple sub-field and value to be updated
+7 ;
+8 NEW X,Y,%
+9 NEW D,D0,DI,DIC,DICR,DIE,DIG,DIH,DIV,DIU,DIW,DQ,DR,DA,DIE
+10 SET DIE=AMERDIE
SET DA=AMERDA
SET DA(1)=AMERDA1
SET DR=AMERDR
+11 LOCK +^AMERVSIT(AMERDA1):3
IF '$TEST
QUIT
+12 DO ^DIE
+13 SET DIK=AMERDIE
SET DA(1)=AMERDA1
+14 DO EN^DIK
+15 LOCK -^AMERVSIT(AMERDA1)
+16 ;IHS/OIT/SCR 12/15/08 - update ER VISIT FILE with DATE LAST UPDATED (NOW)
+17 DO TIMESTMP^AMERSAV1(AMERDA1)
+18 QUIT
