AMEREDAU ; IHS/OIT/SCR - 03/25/06 -Primary routine for audit trail of edited ER VISIT fields
;;3.0;ER VISIT SYSTEM;**2,6**;MAR 03, 2009;Build 30
;
EDAUDIT(FIELD,OLDVAL,NEWVAL,FLDNAME) ; EP From all AMERED* routines
; Provides audit trail interface
; INPUT:
; FIELD : the Field number of ER VISIT file that is being changed
; OLDVAL : the original value of the field before editing
; NEWVAL : the value that the field is being changed to
; FLDNAME : User friendly field name for ease in creating readable audit trail reports
;
N X,Y,%
N DIC,DIR,DIE,AMERREAS,AMERDATE,AMERTIME,AMERCOMM,AMEREDAU,AMERDT
S (AMERREAS,AMERCOMM)=""
D NOW^%DTC ;GET CURRENT DATE AND TIME - FM format is returned in X
S (AMERDT,Y)=% D DD^%DT
S AMERDATE=$P(Y,"@",1),AMERTIME=$P(Y,"@",2)
D EN^DDIOL("EDIT DATE: "_AMERDATE,"","!!")
D EN^DDIOL("EDIT TIME: "_AMERTIME,"","!!")
D EN^DDIOL("FIELD NAME BEING EDITED: "_FLDNAME,"","!!")
D EN^DDIOL("OLD VALUE: "_OLDVAL,"","!!")
D EN^DDIOL("NEW VALUE: "_NEWVAL,"","!!")
I FIELD="PCC" S AMERREAS="ADM" ;hard code reason
E S AMERREAS=$$EDREASON()
I AMERREAS="^" S AMEREDAU="^" Q AMEREDAU
K DIR("B"),%,Y,X
S DIR(0)="FO^1:100",DIR("A")="Comment"
S DIR("?")="Enter free text comment (200 characters max.)"
D ^DIR K DIR
I Y'=-1 S AMERCOMM=Y
E S AMERCOMM="^"
I AMERCOMM="^"!(AMERREAS="^") S AMEREDAU="^"
E S AMEREDAU=FIELD_";"_AMERDT_";"_OLDVAL_";"_NEWVAL_";"_AMERREAS_";"_FLDNAME_";"_AMERCOMM
Q AMEREDAU
;
EDDISPL(AMERVAL,AMERTYPE) ; EP from multiple AMERED* routines
; Provides a user friendly format for audit trail interface
;AMERVAL IS THE VALUE THAT IS BEING DISPLAYED
;AMER TYPE IS ONE OF:
; D - DATE AMERVAL IS A DATE IN FILE MAN FORMAT
; B - BOOLEAN
; P - PATIENT AMERVAL IS A POINTER TO THE PERSON FILE
; T - TRANSFER AMERVAL IS A POINTER TO THE ER OPTIONS FILE
; M - MODE OF TRANSPORT AMERVAL IS A POINTER TO ER OPTIONS FILE
; A - AMBULANCE COMPANY AMERVAL IS A POINTER TO ER OPTIONS FILE
; N - PROVIDER - AMERVAL IS A POINTER TO NEW PERSON FILE
; S - SETTING OF ACCIDENT OR INJURY - AMERVAL IS A POINTER TO ER OPTIONS FILE
; C - CAUSE OF INJURY
; Q - SAFETY EQUIPMENT
; R - PROCEDURES - AMERVAL IS A POINTER TO THE ER OPTIONS FILE
; X - DIAGNOSIS - AMERVAL IS A POINTER TO THE ICD9 FILE
; I - DISPOSITION AMERVAL IS A POINTER TO ER OPTIONS FILE
; F - FOLLOW UP INSTRUCTIONS AMERVAL IS A POINTER TO ER OPTIONS FILE
; E - ER CONSULTANT - AMERVAL IS A POINTER TO THE ER CONSULTANT FILE
; V - VISIT TYPE - AMERVAL IS A POINTER TO THE ER OPTIONS FILE
; L - CLINIC TYPE - AMERVAL IS APOINTER TO THE ER OPTIONS FILE
;
Q:AMERVAL="" AMERVAL ;IF THERE IS NO VALUE, DON'T TRY TO MAKE IT PRETTY
N AMERNVAL,DIC,X,Y,AMERTEMP
S AMERNVAL=""
I AMERTYPE="D" D ;DATE
.S Y=AMERVAL D DD^%DT S AMERNVAL=Y
.Q
I AMERTYPE="B" D ;BOOLEON
.S AMERNVAL=$S(AMERVAL=1:"YES",1:"NO")
.Q
I AMERTYPE="P" D ;PATIENT
.S:AMERVAL'="" AMERNVAL=$P($G(^DPT(AMERVAL,0)),U,1)
.Q
I AMERTYPE="M" D ;MODE OF TRANSPORT
.S DIC="^AMER(3,",DIC("S")="I $P(^(0),U,2)="_$$CAT^AMER0("MODE OF TRANSPORT")
.S DIC(0)="OXN"
.S X=AMERVAL
.D ^DIC K DIC
.S AMERNVAL=$P($G(Y),U,2)
.Q
I AMERTYPE="T" D ;TRANSFER
.S DIC="^AMER(3,",DIC("S")="I $P(^(0),U,2)="_$$CAT^AMER0("TRANSFER DETAILS")
.S DIC(0)="OXN"
.S X=AMERVAL
.D ^DIC K DIC
.S AMERNVAL=$P($G(Y),U,2)
.Q
I AMERTYPE="A" D ;AMBULANCE COMPANY
.S DIC="^AMER(3,"
.S DIC("S")="I $P(^(0),U,2)="_$$CAT^AMER0("AMBULANCE COMPANY")
.S DIC(0)="OXN"
.S X=AMERVAL
.D ^DIC K DIC
.S AMERNVAL=$P($G(Y),U,2)
.Q
I AMERTYPE="N" D ;PROVIDER
.S AMERNVAL=$P($G(^VA(200,AMERVAL,0)),U,1)
.Q
I AMERTYPE="S" D
.S DIC="^AMER(3,"
.S DIC("S")="I $P(^(0),U,2)="_$$CAT^AMER0("SCENE OF INJURY")
.S DIC(0)="OXN"
.S X=AMERVAL
.D ^DIC K DIC
.S AMERNVAL=$P($G(Y),U,2)
.Q
I AMERTYPE="C" D ;CAUSE OF INJURY
.;AMER*3.0*6;Changing to ICD9/ICD10 lookup
.S:AMERVAL'="" AMERNVAL=$$DX^AMERPOV(+AMERVAL,$G(AMERDA))
.Q
I AMERTYPE="Q" D ;SAFETEY EQUIPMENT
.S DIC="^AMER(3,"
.S DIC("S")="I $P(^(0),U,2)="_$$CAT^AMER0("SAFETY EQUIPMENT")
.S DIC(0)="OXN"
.S X=AMERVAL
.D ^DIC K DIC
.S AMERNVAL=$P($G(Y),U,2)
.Q
I AMERTYPE="R" D
.S DIC="^AMER(3,"
.S DIC("S")="I $P(^(0),U,2)=20"
.S DIC(0)="OXN"
.S X=AMERVAL
.D ^DIC K DIC
.S AMERNVAL=$P($G(Y),U,2)
.Q
I AMERTYPE="X" D
.I AMERVAL="" S AMERNVAL="" Q
.S AMERNVAL=$P($$ICDDX^ICDCODE(AMERVAL,,,1),U,2)
.S AMERNVAL=AMERNVAL_" {"_$P($$ICDDX^ICDCODE(AMERVAL,,,1),U,4)_"}"
.Q
I AMERTYPE="I" D ;DISPOSITION
.S DIC="^AMER(3,"
.S DIC("S")="I $P(^(0),U,2)="_$$CAT^AMER0("DISPOSITION")
.S DIC(0)="OXN"
.S X=AMERVAL
.D ^DIC K DIC
.S AMERNVAL=$P($G(Y),U,2)
.Q
I AMERTYPE="F" D ;FOLLOW-UP INSTRUCTIONS
.S DIC="^AMER(3,"
.S DIC("S")="I $P(^(0),U,2)="_$$CAT^AMER0("FOLLOW UP INSTRUCTIONS")
.S DIC(0)="OXN"
.S X=AMERVAL
.D ^DIC K DIC
.S AMERNVAL=$P($G(Y),U,2)
.Q
I AMERTYPE="E" D ;CONSULTANT
.S DIC="^AMER(2.9,"
.S DIC(0)="OXN"
.S X=AMERVAL
.D ^DIC K DIC
.S AMERNVAL=$P($G(Y),U,2)
.Q
I AMERTYPE="V" D ;VISIT TYPE
.S DIC="^AMER(3,"
.S DIC("S")="I $P(^(0),U,2)="_$$CAT^AMER0("VISIT TYPE")
.S DIC(0)="OXN"
.S X=AMERVAL
.D ^DIC K DIC
.S AMERNVAL=$P($G(Y),U,2)
.Q
I AMERTYPE="L" D ;CLINIC TYPE
.S DIC="^AMER(3,"
.S DIC("S")="I $P(^(0),U,2)="_$$CAT^AMER0("CLINIC TYPE")
.S DIC(0)="OXN"
.S X=AMERVAL
.D ^DIC K DIC
.;S AMERNVAL=$P($G(Y),U,1)
.S AMERNVAL=$P($G(Y),U,2) ;SCR/OIT/IHS 071509 PATCH 2
.Q
Q AMERNVAL
;
EDREASON() ;
; Returns user selected edit reason code
; DE Data entry error
; ADM Administrative
; ID Mistaken patient ID
; PT Patient corrected
; OT Other
N DIR,REASON
S DIR(0)="SO^DE:Data entry error;ADM:Administrative;ID:Mistaken patient ID;"
S DIR(0)=DIR(0)_"PT:Patient corrected;OT:Other"
S DIR("A")="PLEASE ENTER A PRIMARY REASON FOR CHANGE",DIR("?")="Enter '^' to leave with out changing"
S DIR("B")="ADM"
D ^DIR K DIR
I Y=""!(Y="^") S REASON="^"
E S REASON=Y
Q REASON
;
DIEREC(AMERAIEN,AMERSTRG) ; EP from multiple AMERED* routines
;UPDATES ^AMERAUDT WITH A SINGLE AUDIT LINE
;INPUT:
; AMERIEN : The ien of the ER AUDIT FILE record being updated
; AMERSTRG : a single audit line to be associated with this record
N DR,DIC,DIE
S DA(1)=AMERAIEN,DIC="^AMERAUDT(DA(1),2,",DIC(0)="L"
S X=$P(AMERSTRG,";",1)
D ^DIC I Y=-1 Q ;create the multiple record
S DIE=DIC,DA(1)=AMERAIEN,DA=+Y ;edit the newly created muliple record
S DR=".02////"_$P(AMERSTRG,";",2) ;the time of edit
S DR=DR_";.03////"_$P(AMERSTRG,";",3) ;the value originally in this field
S DR=DR_";.04////"_$P(AMERSTRG,";",4) ;the value that was saved during edit
S DR=DR_";.05////"_$P(AMERSTRG,";",5) ;the edit-reason code
S DR=DR_";1.2////"_$P(AMERSTRG,";",6) ;the name of the modified field
S DR=DR_";1////"_$P(AMERSTRG,";",7) ;the free-text comment
L +^AMERAUDT:3 E Q
D ^DIE
L -^AMERAUDT
K DIC,DIE,DA(1)
Q
;
CREATAUD(ERVSTIEN,USERID) ; EP FROM AMEREDIT
N X,Y,%
N AMERDR,AMERAUID
D NOW^%DTC ;GET CURRENT DATE AND TIME - FM format is returned in X
S AMERAUID=$$DIC(%)
I AMERAUID>0 D
.S AMERDR=".02////"_ERVSTIEN_";.03////"_USERID
.D DIE(AMERAUID,AMERDR)
.Q
K AMERDR,X,%,%H,%I
Q AMERAUID
;
DIC(AMERSTMP) ;
; GIVEN AN AUDIT TIMESTAMP CREATE AN ENTRY IN THE ER AUDIT FILE AND RETURN THE IEN
N DIC,Y,AMERAUDT
I '$G(AMERSTMP) Q ""
S X=AMERSTMP
N Y,DIC
S DIC="^AMERAUDT(",DIC(0)="L",DIADD=1
K DD,DO
D FILE^DICN
I Y=-1 S AMERAUDT=""
E S AMERAUDT=+Y
K DIC,DIADD
Q AMERAUDT
;
DIE(DA,DR) ; GIVEN AN ENTRY NUMBER AND A DR STRING, EDIT THE ER AUDIT FILE
N DIE,X,Y,%
N D,D0,DI,DIC,DICR,DIE,DIG,DIH,DIV,DIU,DIW,DQ
S DIE="^AMERAUDT("
DIE1 L +^AMERAUDT:3 E Q
D ^DIE
L -^AMERAUDT
K DIE,X,Y,%
Q
;
MULTAUDT(AMEREDTS,AMERAIEN) ; EP from multiple AMERED* routines
;Inserts multiple audit records into ER VISIT AUDIT file
;INPUT:
; AMEREDTS : a "^" deliniated string of audit records for insertion
; AMERAIEN : The IEN of the ER VISIT AUDIT record being updated
;
N AMEREDTN,AMERSTRG
F AMEREDTN=1:1 S AMERSTRG=$P(AMEREDTS,U,AMEREDTN) Q:AMERSTRG="" D DIEREC(AMERAIEN,AMERSTRG)
Q
AMEREDAU ; IHS/OIT/SCR - 03/25/06 -Primary routine for audit trail of edited ER VISIT fields
+1 ;;3.0;ER VISIT SYSTEM;**2,6**;MAR 03, 2009;Build 30
+2 ;
EDAUDIT(FIELD,OLDVAL,NEWVAL,FLDNAME) ; EP From all AMERED* routines
+1 ; Provides audit trail interface
+2 ; INPUT:
+3 ; FIELD : the Field number of ER VISIT file that is being changed
+4 ; OLDVAL : the original value of the field before editing
+5 ; NEWVAL : the value that the field is being changed to
+6 ; FLDNAME : User friendly field name for ease in creating readable audit trail reports
+7 ;
+8 NEW X,Y,%
+9 NEW DIC,DIR,DIE,AMERREAS,AMERDATE,AMERTIME,AMERCOMM,AMEREDAU,AMERDT
+10 SET (AMERREAS,AMERCOMM)=""
+11 ;GET CURRENT DATE AND TIME - FM format is returned in X
DO NOW^%DTC
+12 SET (AMERDT,Y)=%
DO DD^%DT
+13 SET AMERDATE=$PIECE(Y,"@",1)
SET AMERTIME=$PIECE(Y,"@",2)
+14 DO EN^DDIOL("EDIT DATE: "_AMERDATE,"","!!")
+15 DO EN^DDIOL("EDIT TIME: "_AMERTIME,"","!!")
+16 DO EN^DDIOL("FIELD NAME BEING EDITED: "_FLDNAME,"","!!")
+17 DO EN^DDIOL("OLD VALUE: "_OLDVAL,"","!!")
+18 DO EN^DDIOL("NEW VALUE: "_NEWVAL,"","!!")
+19 ;hard code reason
IF FIELD="PCC"
SET AMERREAS="ADM"
+20 IF '$TEST
SET AMERREAS=$$EDREASON()
+21 IF AMERREAS="^"
SET AMEREDAU="^"
QUIT AMEREDAU
+22 KILL DIR("B"),%,Y,X
+23 SET DIR(0)="FO^1:100"
SET DIR("A")="Comment"
+24 SET DIR("?")="Enter free text comment (200 characters max.)"
+25 DO ^DIR
KILL DIR
+26 IF Y'=-1
SET AMERCOMM=Y
+27 IF '$TEST
SET AMERCOMM="^"
+28 IF AMERCOMM="^"!(AMERREAS="^")
SET AMEREDAU="^"
+29 IF '$TEST
SET AMEREDAU=FIELD_";"_AMERDT_";"_OLDVAL_";"_NEWVAL_";"_AMERREAS_";"_FLDNAME_";"_AMERCOMM
+30 QUIT AMEREDAU
+31 ;
EDDISPL(AMERVAL,AMERTYPE) ; EP from multiple AMERED* routines
+1 ; Provides a user friendly format for audit trail interface
+2 ;AMERVAL IS THE VALUE THAT IS BEING DISPLAYED
+3 ;AMER TYPE IS ONE OF:
+4 ; D - DATE AMERVAL IS A DATE IN FILE MAN FORMAT
+5 ; B - BOOLEAN
+6 ; P - PATIENT AMERVAL IS A POINTER TO THE PERSON FILE
+7 ; T - TRANSFER AMERVAL IS A POINTER TO THE ER OPTIONS FILE
+8 ; M - MODE OF TRANSPORT AMERVAL IS A POINTER TO ER OPTIONS FILE
+9 ; A - AMBULANCE COMPANY AMERVAL IS A POINTER TO ER OPTIONS FILE
+10 ; N - PROVIDER - AMERVAL IS A POINTER TO NEW PERSON FILE
+11 ; S - SETTING OF ACCIDENT OR INJURY - AMERVAL IS A POINTER TO ER OPTIONS FILE
+12 ; C - CAUSE OF INJURY
+13 ; Q - SAFETY EQUIPMENT
+14 ; R - PROCEDURES - AMERVAL IS A POINTER TO THE ER OPTIONS FILE
+15 ; X - DIAGNOSIS - AMERVAL IS A POINTER TO THE ICD9 FILE
+16 ; I - DISPOSITION AMERVAL IS A POINTER TO ER OPTIONS FILE
+17 ; F - FOLLOW UP INSTRUCTIONS AMERVAL IS A POINTER TO ER OPTIONS FILE
+18 ; E - ER CONSULTANT - AMERVAL IS A POINTER TO THE ER CONSULTANT FILE
+19 ; V - VISIT TYPE - AMERVAL IS A POINTER TO THE ER OPTIONS FILE
+20 ; L - CLINIC TYPE - AMERVAL IS APOINTER TO THE ER OPTIONS FILE
+21 ;
+22 ;IF THERE IS NO VALUE, DON'T TRY TO MAKE IT PRETTY
IF AMERVAL=""
QUIT AMERVAL
+23 NEW AMERNVAL,DIC,X,Y,AMERTEMP
+24 SET AMERNVAL=""
+25 ;DATE
IF AMERTYPE="D"
Begin DoDot:1
+26 SET Y=AMERVAL
DO DD^%DT
SET AMERNVAL=Y
+27 QUIT
End DoDot:1
+28 ;BOOLEON
IF AMERTYPE="B"
Begin DoDot:1
+29 SET AMERNVAL=$SELECT(AMERVAL=1:"YES",1:"NO")
+30 QUIT
End DoDot:1
+31 ;PATIENT
IF AMERTYPE="P"
Begin DoDot:1
+32 IF AMERVAL'=""
SET AMERNVAL=$PIECE($GET(^DPT(AMERVAL,0)),U,1)
+33 QUIT
End DoDot:1
+34 ;MODE OF TRANSPORT
IF AMERTYPE="M"
Begin DoDot:1
+35 SET DIC="^AMER(3,"
SET DIC("S")="I $P(^(0),U,2)="_$$CAT^AMER0("MODE OF TRANSPORT")
+36 SET DIC(0)="OXN"
+37 SET X=AMERVAL
+38 DO ^DIC
KILL DIC
+39 SET AMERNVAL=$PIECE($GET(Y),U,2)
+40 QUIT
End DoDot:1
+41 ;TRANSFER
IF AMERTYPE="T"
Begin DoDot:1
+42 SET DIC="^AMER(3,"
SET DIC("S")="I $P(^(0),U,2)="_$$CAT^AMER0("TRANSFER DETAILS")
+43 SET DIC(0)="OXN"
+44 SET X=AMERVAL
+45 DO ^DIC
KILL DIC
+46 SET AMERNVAL=$PIECE($GET(Y),U,2)
+47 QUIT
End DoDot:1
+48 ;AMBULANCE COMPANY
IF AMERTYPE="A"
Begin DoDot:1
+49 SET DIC="^AMER(3,"
+50 SET DIC("S")="I $P(^(0),U,2)="_$$CAT^AMER0("AMBULANCE COMPANY")
+51 SET DIC(0)="OXN"
+52 SET X=AMERVAL
+53 DO ^DIC
KILL DIC
+54 SET AMERNVAL=$PIECE($GET(Y),U,2)
+55 QUIT
End DoDot:1
+56 ;PROVIDER
IF AMERTYPE="N"
Begin DoDot:1
+57 SET AMERNVAL=$PIECE($GET(^VA(200,AMERVAL,0)),U,1)
+58 QUIT
End DoDot:1
+59 IF AMERTYPE="S"
Begin DoDot:1
+60 SET DIC="^AMER(3,"
+61 SET DIC("S")="I $P(^(0),U,2)="_$$CAT^AMER0("SCENE OF INJURY")
+62 SET DIC(0)="OXN"
+63 SET X=AMERVAL
+64 DO ^DIC
KILL DIC
+65 SET AMERNVAL=$PIECE($GET(Y),U,2)
+66 QUIT
End DoDot:1
+67 ;CAUSE OF INJURY
IF AMERTYPE="C"
Begin DoDot:1
+68 ;AMER*3.0*6;Changing to ICD9/ICD10 lookup
+69 IF AMERVAL'=""
SET AMERNVAL=$$DX^AMERPOV(+AMERVAL,$GET(AMERDA))
+70 QUIT
End DoDot:1
+71 ;SAFETEY EQUIPMENT
IF AMERTYPE="Q"
Begin DoDot:1
+72 SET DIC="^AMER(3,"
+73 SET DIC("S")="I $P(^(0),U,2)="_$$CAT^AMER0("SAFETY EQUIPMENT")
+74 SET DIC(0)="OXN"
+75 SET X=AMERVAL
+76 DO ^DIC
KILL DIC
+77 SET AMERNVAL=$PIECE($GET(Y),U,2)
+78 QUIT
End DoDot:1
+79 IF AMERTYPE="R"
Begin DoDot:1
+80 SET DIC="^AMER(3,"
+81 SET DIC("S")="I $P(^(0),U,2)=20"
+82 SET DIC(0)="OXN"
+83 SET X=AMERVAL
+84 DO ^DIC
KILL DIC
+85 SET AMERNVAL=$PIECE($GET(Y),U,2)
+86 QUIT
End DoDot:1
+87 IF AMERTYPE="X"
Begin DoDot:1
+88 IF AMERVAL=""
SET AMERNVAL=""
QUIT
+89 SET AMERNVAL=$PIECE($$ICDDX^ICDCODE(AMERVAL,,,1),U,2)
+90 SET AMERNVAL=AMERNVAL_" {"_$PIECE($$ICDDX^ICDCODE(AMERVAL,,,1),U,4)_"}"
+91 QUIT
End DoDot:1
+92 ;DISPOSITION
IF AMERTYPE="I"
Begin DoDot:1
+93 SET DIC="^AMER(3,"
+94 SET DIC("S")="I $P(^(0),U,2)="_$$CAT^AMER0("DISPOSITION")
+95 SET DIC(0)="OXN"
+96 SET X=AMERVAL
+97 DO ^DIC
KILL DIC
+98 SET AMERNVAL=$PIECE($GET(Y),U,2)
+99 QUIT
End DoDot:1
+100 ;FOLLOW-UP INSTRUCTIONS
IF AMERTYPE="F"
Begin DoDot:1
+101 SET DIC="^AMER(3,"
+102 SET DIC("S")="I $P(^(0),U,2)="_$$CAT^AMER0("FOLLOW UP INSTRUCTIONS")
+103 SET DIC(0)="OXN"
+104 SET X=AMERVAL
+105 DO ^DIC
KILL DIC
+106 SET AMERNVAL=$PIECE($GET(Y),U,2)
+107 QUIT
End DoDot:1
+108 ;CONSULTANT
IF AMERTYPE="E"
Begin DoDot:1
+109 SET DIC="^AMER(2.9,"
+110 SET DIC(0)="OXN"
+111 SET X=AMERVAL
+112 DO ^DIC
KILL DIC
+113 SET AMERNVAL=$PIECE($GET(Y),U,2)
+114 QUIT
End DoDot:1
+115 ;VISIT TYPE
IF AMERTYPE="V"
Begin DoDot:1
+116 SET DIC="^AMER(3,"
+117 SET DIC("S")="I $P(^(0),U,2)="_$$CAT^AMER0("VISIT TYPE")
+118 SET DIC(0)="OXN"
+119 SET X=AMERVAL
+120 DO ^DIC
KILL DIC
+121 SET AMERNVAL=$PIECE($GET(Y),U,2)
+122 QUIT
End DoDot:1
+123 ;CLINIC TYPE
IF AMERTYPE="L"
Begin DoDot:1
+124 SET DIC="^AMER(3,"
+125 SET DIC("S")="I $P(^(0),U,2)="_$$CAT^AMER0("CLINIC TYPE")
+126 SET DIC(0)="OXN"
+127 SET X=AMERVAL
+128 DO ^DIC
KILL DIC
+129 ;S AMERNVAL=$P($G(Y),U,1)
+130 ;SCR/OIT/IHS 071509 PATCH 2
SET AMERNVAL=$PIECE($GET(Y),U,2)
+131 QUIT
End DoDot:1
+132 QUIT AMERNVAL
+133 ;
EDREASON() ;
+1 ; Returns user selected edit reason code
+2 ; DE Data entry error
+3 ; ADM Administrative
+4 ; ID Mistaken patient ID
+5 ; PT Patient corrected
+6 ; OT Other
+7 NEW DIR,REASON
+8 SET DIR(0)="SO^DE:Data entry error;ADM:Administrative;ID:Mistaken patient ID;"
+9 SET DIR(0)=DIR(0)_"PT:Patient corrected;OT:Other"
+10 SET DIR("A")="PLEASE ENTER A PRIMARY REASON FOR CHANGE"
SET DIR("?")="Enter '^' to leave with out changing"
+11 SET DIR("B")="ADM"
+12 DO ^DIR
KILL DIR
+13 IF Y=""!(Y="^")
SET REASON="^"
+14 IF '$TEST
SET REASON=Y
+15 QUIT REASON
+16 ;
DIEREC(AMERAIEN,AMERSTRG) ; EP from multiple AMERED* routines
+1 ;UPDATES ^AMERAUDT WITH A SINGLE AUDIT LINE
+2 ;INPUT:
+3 ; AMERIEN : The ien of the ER AUDIT FILE record being updated
+4 ; AMERSTRG : a single audit line to be associated with this record
+5 NEW DR,DIC,DIE
+6 SET DA(1)=AMERAIEN
SET DIC="^AMERAUDT(DA(1),2,"
SET DIC(0)="L"
+7 SET X=$PIECE(AMERSTRG,";",1)
+8 ;create the multiple record
DO ^DIC
IF Y=-1
QUIT
+9 ;edit the newly created muliple record
SET DIE=DIC
SET DA(1)=AMERAIEN
SET DA=+Y
+10 ;the time of edit
SET DR=".02////"_$PIECE(AMERSTRG,";",2)
+11 ;the value originally in this field
SET DR=DR_";.03////"_$PIECE(AMERSTRG,";",3)
+12 ;the value that was saved during edit
SET DR=DR_";.04////"_$PIECE(AMERSTRG,";",4)
+13 ;the edit-reason code
SET DR=DR_";.05////"_$PIECE(AMERSTRG,";",5)
+14 ;the name of the modified field
SET DR=DR_";1.2////"_$PIECE(AMERSTRG,";",6)
+15 ;the free-text comment
SET DR=DR_";1////"_$PIECE(AMERSTRG,";",7)
+16 LOCK +^AMERAUDT:3
IF '$TEST
QUIT
+17 DO ^DIE
+18 LOCK -^AMERAUDT
+19 KILL DIC,DIE,DA(1)
+20 QUIT
+21 ;
CREATAUD(ERVSTIEN,USERID) ; EP FROM AMEREDIT
+1 NEW X,Y,%
+2 NEW AMERDR,AMERAUID
+3 ;GET CURRENT DATE AND TIME - FM format is returned in X
DO NOW^%DTC
+4 SET AMERAUID=$$DIC(%)
+5 IF AMERAUID>0
Begin DoDot:1
+6 SET AMERDR=".02////"_ERVSTIEN_";.03////"_USERID
+7 DO DIE(AMERAUID,AMERDR)
+8 QUIT
End DoDot:1
+9 KILL AMERDR,X,%,%H,%I
+10 QUIT AMERAUID
+11 ;
DIC(AMERSTMP) ;
+1 ; GIVEN AN AUDIT TIMESTAMP CREATE AN ENTRY IN THE ER AUDIT FILE AND RETURN THE IEN
+2 NEW DIC,Y,AMERAUDT
+3 IF '$GET(AMERSTMP)
QUIT ""
+4 SET X=AMERSTMP
+5 NEW Y,DIC
+6 SET DIC="^AMERAUDT("
SET DIC(0)="L"
SET DIADD=1
+7 KILL DD,DO
+8 DO FILE^DICN
+9 IF Y=-1
SET AMERAUDT=""
+10 IF '$TEST
SET AMERAUDT=+Y
+11 KILL DIC,DIADD
+12 QUIT AMERAUDT
+13 ;
DIE(DA,DR) ; GIVEN AN ENTRY NUMBER AND A DR STRING, EDIT THE ER AUDIT FILE
+1 NEW DIE,X,Y,%
+2 NEW D,D0,DI,DIC,DICR,DIE,DIG,DIH,DIV,DIU,DIW,DQ
+3 SET DIE="^AMERAUDT("
DIE1 LOCK +^AMERAUDT:3
IF '$TEST
QUIT
+1 DO ^DIE
+2 LOCK -^AMERAUDT
+3 KILL DIE,X,Y,%
+4 QUIT
+5 ;
MULTAUDT(AMEREDTS,AMERAIEN) ; EP from multiple AMERED* routines
+1 ;Inserts multiple audit records into ER VISIT AUDIT file
+2 ;INPUT:
+3 ; AMEREDTS : a "^" deliniated string of audit records for insertion
+4 ; AMERAIEN : The IEN of the ER VISIT AUDIT record being updated
+5 ;
+6 NEW AMEREDTN,AMERSTRG
+7 FOR AMEREDTN=1:1
SET AMERSTRG=$PIECE(AMEREDTS,U,AMEREDTN)
IF AMERSTRG=""
QUIT
DO DIEREC(AMERAIEN,AMERSTRG)
+8 QUIT
