TIUPEVNT ; SLC/JER,AJB - Event logger for upload/filer ;Sep 18, 2021@22:54:45
;;1.0;TEXT INTEGRATION UTILITIES;**3,21,81,131,113,184,290,335,338**;Jun 20, 1997;Build 9
;
MAIN(BUFDA,ETYPE,ECODE,TIUTYPE,FDA,MSG) ; ---- Controls branching
N TIUEVTDA,TIUFDA,TIUMSG,EVNTDA
M TIUFDA=FDA M TIUMSG=MSG
; ---- ETYPE = 1: Filing error event
; ---- ETYPE = 2: Missing/incorrect field error event
; ---- ETYPE = 0: Other event (no errors)
D LOG(BUFDA,ETYPE,$G(ECODE),$G(TIUTYPE),.TIUEVTDA,.TIUFDA,.TIUMSG)
S EVNTDA=TIUEVTDA M FDA=TIUFDA
I ETYPE=2 D FIELDS^TIUPEVN1(EVNTDA,.TIUMSG)
M MSG=TIUMSG
Q
LOG(BUFDA,ETYPE,ECODE,TIUTYPE,EVNTDA,FDA,MSG) ; ---- Register event in
; TIU UPLOAD LOG file
; (#8925.4)
N BUFREC,ERRMSG,NEWBUF,DIC,DLAYGO,DIE,DA,DR,TIUK,TIUL,X,Y
N TIUEVTDA,TIUFDA,TIUMSG,TIUERMSG
S BUFREC=$G(^TIU(8925.2,+BUFDA,0))
S (DIC,DLAYGO)=8925.4,DIC(0)="MLX",X=""""_$$NOW^TIULC_"""" D ^DIC
Q:+Y'>0
; ---- File upload log record
M TIUFDA=FDA M TIUMSG=MSG
S DIE=DIC,(EVNTDA,DA)=+Y,ERRMSG=$$ERRMSG(ETYPE,ECODE,TIUTYPE,.TIUFDA,.TIUMSG)
M FDA=TIUFDA M MSG=TIUMSG
S DR=".02////"_$P(BUFREC,U,2)_";.03////"_TIUTYPE_";.04////"_ERRMSG_";.06////"_$S(+ETYPE:0,1:"")_";.08////"_ETYPE_";.09////"_$S($G(TIUINST):TIUINST,1:DUZ(2))
D ^DIE K DA
I ETYPE'=1 Q
; ---- Store Header of failed record in log
S ^TIU(8925.4,+EVNTDA,"HEAD",0)="^^^^"_DT_"^"
S TIUL=0 F TIUK=TIUFRST:1:$S($P(TIUPRM0,U,16)="C":TIUI,1:TIUFRST+1) D
. S TIUL=TIUL+1,^TIU(8925.4,+EVNTDA,"HEAD",TIUL,0)=$G(^TIU(8925.2,+BUFDA,"TEXT",TIUK,0))
S $P(^TIU(8925.4,+EVNTDA,"HEAD",0),U,3,4)=TIUL_U_TIUL
; ---- Create a new buffer entry w/ uploaded data
S NEWBUF=$$MAKEBUF^TIUUPLD
I +NEWBUF>0 D
. N TIUJ,TIUL,TIUBLIN
. S ^TIU(8925.2,+NEWBUF,"TEXT",0)="^^^^"_DT_"^"
. S TIUJ=TIUFRST,TIUL=1
. S ^TIU(8925.2,+NEWBUF,"TEXT",TIUL,0)=$G(^TIU(8925.2,+BUFDA,"TEXT",TIUJ,0)) K ^TIU(8925.2,+BUFDA,"TEXT",TIUJ,0)
. F S TIUJ=$O(^TIU(8925.2,+BUFDA,"TEXT",TIUJ)) Q:$S(+TIUJ'>0:1,($G(^TIU(8925.2,+BUFDA,"TEXT",TIUJ,0))[TIUHSIG):1,1:0) D
. . S TIUL=TIUL+1
. . S ^TIU(8925.2,+NEWBUF,"TEXT",TIUL,0)=$G(^TIU(8925.2,+BUFDA,"TEXT",TIUJ,0)),TIUI=TIUJ
. . K ^TIU(8925.2,+BUFDA,"TEXT",TIUJ,0)
. S $P(^TIU(8925.2,+NEWBUF,"TEXT",0),U,3,4)=TIUL_U_TIUL
. ; ---- Stuff new buffer entry pointer into event log file
. S DIE=8925.4,DA=+EVNTDA,DR=".05////"_+NEWBUF D ^DIE
. ; ---- File the error log pointer in buffer file
. S ^TIU(8925.2,+NEWBUF,"ERR",0)="^8925.22PA^^",DLAYGO=8925.22
. S DA(1)=+NEWBUF,DIC="^TIU(8925.2,"_+DA(1)_",""ERR"",",DIC(0)="L"
. S X="`"_EVNTDA
. D ^DIC
. K DIC,DLAYGO
. ; ---- Send filing error alerts
. S TIUEVTDA=EVNTDA M TIUERMSG=ERRMSG
. D ALERT(+NEWBUF,.TIUERMSG,.TIUEVTDA)
. S EVNTDA=TIUEVTDA M ERRMSG=TIUERMSG
Q
ERRMSG(ETYPE,ECODE,TIUTYPE,FDA,MSG) ; ---- Set error messages
N DIC,DIE,DA,X,Y
I +ETYPE'>0 S Y="" G ERRMSX
S TIUTYPE=$S($G(TIUTITLE)]"":$G(TIUTITLE),1:$G(TIUTYPE))
I +$G(TIUREC("FILE"))=8925,($G(TIUHDR(.09))="PRIORITY"),($G(TIUTYPE)]"") S TIUTYPE="STAT "_$G(TIUTYPE)
; ---- Set filing error message
I +ETYPE=1,+ECODE D G ERRMSX
. S DIC=8925.3,DIC(0)="MXZ",X="`"_ECODE D ^DIC
. S Y="FILING ERROR: "_$G(TIUTYPE)_" "_$P(Y(0),U,2)
; ---- If target file is 8925, get info on entry & set missing fld msg
I $G(MSG("DIERR",1,"PARAM","FILE"))=8925 D G ERRMSX
. N TIU,DA S DA=+$O(FDA(8925,"")) D GETTIU^TIULD(.TIU,DA)
. S Y=$$NAME^TIULS(TIU("PNM"),"LAST,FI MI ")
. S:$G(TIUHDR("TIUTITLE"))]"" TIUTYPE=TIUHDR("TIUTITLE")
. S Y=Y_TIU("PID")_": "_$$DATE^TIULS(+TIU("EDT"),"MM/DD/YY ")_$G(TIUTYPE)_" is missing fields."
; ---- Otherwise get message from FM Filer error msg array
S Y=$G(MSG("DIERR",1,"TEXT",1))
ERRMSX Q Y
ALERT(BUFDA,ERRMSG,EVNTDA) ; ---- Send alerts for filing errors
N BUFREC,XQA,XQAID,XQADATA,XQAMSG,XQAKILL,XQAROU,TIUI,TIUSUB,TYPE
N TIUXQA
S BUFREC=$G(^TIU(8925.2,+BUFDA,0))
; ---- TIU*1*81 TIUHDR is newed in MAIN+11^TIUPUTC, set in
; GETREC^TIUPUTC1, so it exists for file errs.
S TYPE=+$$WHATITLE^TIUPUTU($G(TIUHDR("TIUTITLE")))
I TYPE'>0 S TYPE=+$G(TIUREC("TYPE"))
I TYPE N TIUDAD M TIUXQA=XQA D WHOGETS^TIUPEVN1(.TIUXQA,TYPE) M XQA=TIUXQA ;TIU*1*81 New TIUDAD here, not in WHOGETS
; ---- If no 8925.95 (Document Parameter) recipients, get 8925.99
; (Site Parameter) recipients
I $D(XQA)'>9 D
. S TIUI=$O(^TIU(8925.99,"B",+$G(DUZ(2)),0)) S:+TIUI'>0 TIUI=+$O(^TIU(8925.99,0))
. S TIUSUB=0 F S TIUSUB=$O(^TIU(8925.99,+TIUI,2,TIUSUB)) Q:TIUSUB'>0 D
. . S XQA($G(^TIU(8925.99,+TIUI,2,TIUSUB,0)))=""
Q:$D(XQA)'>9
S XQAID="TIUERR"_+BUFDA
S XQAMSG=ERRMSG
W:'$D(ZTQUEUED) !!,XQAMSG,!
S XQADATA=BUFDA_";"_ERRMSG_";"_EVNTDA_";"_$G(TIUREC("TYPE"))
S XQAROU="DISPLAY^TIUPEVNT"
D SETUP^XQALERT
Q
DISPLAY ; ---- Alert followup action for filing errors
N DIC,INQUIRE,RETRY,DWPK,EVNTDA,TIU K XQAKILL,RESCODE,TIUTYPE,TIUDONE
N TIUEVNT,TIUSKIP,TIUBUF,PRFILERR,TIUINQ
I '$D(TIUPRM0)!'$D(TIUPRM1) D SETPARM^TIULE
; Set EVNTDA for backward compatibility, TIUEVNT for PN resolve code
S (EVNTDA,TIUEVNT)=+$P(XQADATA,";",3)
; Set TIUBUF for similarity w TIURE. DON'T set BUFDA since
; old code interprets that as set by TIURE only:
S TIUBUF=+XQADATA
I TIUEVNT D I +$G(TIUDONE)!$G(TIUSKIP) G DISPX
. S TIUTYPE=+$P(XQADATA,";",4)
. ; If no author or dict dt, can't evaluate if auth requires EC so force refile until they are included.
. ;(Inquire does not refile.) TIU*1*273:
. S TIUINQ=1 D WRITEHDR(TIUEVNT,TIUTYPE,.TIUINQ)
. I TIUTYPE>0 S RESCODE=$$FIXCODE^TIULC1(TIUTYPE)
. ;E S RESCODE="D GETPAT^TIUCHLP"
. I $G(RESCODE)]"" D Q
. . W ! S INQUIRE=$$READ^TIUU("YO","Inquire to patient record","YES","^D INQRHELP^TIUPEVNT")
. . I $D(DIRUT) S TIUSKIP=1 Q
. . I +INQUIRE X RESCODE
. . ; Redundant if all RESCODEs do RESOLVE:
. . I +$G(TIUDONE),+$G(TIUEVNT) D RESOLVE(+$G(TIUEVNT))
. W !!,"Filing error resolution code could not be found for this document type.",!,"Please edit the buffered data directly and refile."
W !!,"You may now edit the buffered upload data in an attempt to resolve error:",!,$P(XQADATA,";",2),!
I '$$READ^TIUU("EA","Press RETURN to continue and edit the buffer or '^' to exit: ") G DISPX
S DIC="^TIU(8925.2,"_TIUBUF_",""TEXT"",",DWPK=1 D EN^DIWE
S RETRY=$$READ^TIUU("YO","Now would you like to retry the filer","YES","^D FIL^TIUDIRH")
; -- If refiling, tell Patient Record Flag LOOKUP to ask for flag link:
I +RETRY S PRFILERR=1
; -- Refile
I +RETRY D ALERTDEL(TIUBUF)
I +RETRY D RESOLVE(TIUEVNT,1)
I +RETRY D FILE^TIUUPLD(TIUBUF)
DISPX K XQX1
Q
;
WRITEHDR(EVNTDA,TIUTYPE,TIUINQ) ; ---- Write header to screen
;Write header, as stored in Upload Log event (NOT buffer record,
;which can be edited w/o refiling)
; TIUINQ - See TIUPUTC1. Patch 273
N TIUI,TIULINE,TIUVALID,TIUFLD
S TIUVALID="YES"
S TIUI=0
W !!,"The header of the original, failed record looks like this:",!
F S TIUI=$O(^TIU(8925.4,+EVNTDA,"HEAD",TIUI)) Q:+TIUI'>0 D
. S TIULINE=$G(^TIU(8925.4,+EVNTDA,"HEAD",TIUI,0)) W !,TIULINE
. I (TIUTYPE=3),(TIULINE["AUTHOR")!(TIULINE["DATE/TIME OF DICT")!(TIULINE["TITLE") D
. . Q:TIUVALID="NO"
. . S TIUFLD=$S(TIULINE["AUTHOR":"1202",TIULINE["TITLE":".01",1:"1307") ; added TITLE to $S, *335 ajb
. . D VALID(TIULINE,TIUFLD,.TIUVALID)
I TIUVALID="NO" S TIUINQ=0
Q
;
VALID(TIULINE,TIUFLD,TIUVALID) ;Is header missing valid Author or DDT?
S TIULINE=$$STRIP^TIULS($P(TIULINE,":",2,99))
D CHK^DIE(8925,TIUFLD,,TIULINE,.TIUVALID)
I TIUVALID["^" S TIUVALID="NO"
Q
;
ALERTDEL(DA) ; ---- Delete alerts associated with a given record
N XQA,XQAID,XQAKILL S XQAID="TIUERR"_+DA
F D DELETEA^XQALERT S XQAID="TIUERR"_+DA Q:'$D(^VA(200,"AXQAN",XQAID))
Q
RESOLVE(EVNTDA,ECHO) ; ---- Indicate resolution of error
N DA,DIE,DR,TIUI,RESTIME,X,Y
W:+$G(ECHO) !,"Filing Record/Resolving Error..."
S RESTIME=$$NOW^TIULC
S DIE="^TIU(8925.4,"
S DA=+$G(EVNTDA) Q:+DA'>0
; ---- If already resolved, Quit. (Go on to next record)
I +$P(^TIU(8925.4,DA,0),U,6)>0 Q
; ---- Mark error log record as resolved
S DR=".05///@;.06////1;.07////"_RESTIME_";1///@"
D ^DIE
Q
INQRHELP ; Help for Upload Error Inquire to Patient Record prompt
W !,"Do you wish to be prompted for the data necessary to resolve the filing error?"
W !,"If not, answer NO to proceed and edit the buffered data directly without"
W !,"prompts, or enter '^' to come back and resolve the error later."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUPEVNT 8552 printed Dec 13, 2024@02:43:09 Page 2
TIUPEVNT ; SLC/JER,AJB - Event logger for upload/filer ;Sep 18, 2021@22:54:45
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**3,21,81,131,113,184,290,335,338**;Jun 20, 1997;Build 9
+2 ;
MAIN(BUFDA,ETYPE,ECODE,TIUTYPE,FDA,MSG) ; ---- Controls branching
+1 NEW TIUEVTDA,TIUFDA,TIUMSG,EVNTDA
+2 MERGE TIUFDA=FDA
MERGE TIUMSG=MSG
+3 ; ---- ETYPE = 1: Filing error event
+4 ; ---- ETYPE = 2: Missing/incorrect field error event
+5 ; ---- ETYPE = 0: Other event (no errors)
+6 DO LOG(BUFDA,ETYPE,$GET(ECODE),$GET(TIUTYPE),.TIUEVTDA,.TIUFDA,.TIUMSG)
+7 SET EVNTDA=TIUEVTDA
MERGE FDA=TIUFDA
+8 IF ETYPE=2
DO FIELDS^TIUPEVN1(EVNTDA,.TIUMSG)
+9 MERGE MSG=TIUMSG
+10 QUIT
LOG(BUFDA,ETYPE,ECODE,TIUTYPE,EVNTDA,FDA,MSG) ; ---- Register event in
+1 ; TIU UPLOAD LOG file
+2 ; (#8925.4)
+3 NEW BUFREC,ERRMSG,NEWBUF,DIC,DLAYGO,DIE,DA,DR,TIUK,TIUL,X,Y
+4 NEW TIUEVTDA,TIUFDA,TIUMSG,TIUERMSG
+5 SET BUFREC=$GET(^TIU(8925.2,+BUFDA,0))
+6 SET (DIC,DLAYGO)=8925.4
SET DIC(0)="MLX"
SET X=""""_$$NOW^TIULC_""""
DO ^DIC
+7 if +Y'>0
QUIT
+8 ; ---- File upload log record
+9 MERGE TIUFDA=FDA
MERGE TIUMSG=MSG
+10 SET DIE=DIC
SET (EVNTDA,DA)=+Y
SET ERRMSG=$$ERRMSG(ETYPE,ECODE,TIUTYPE,.TIUFDA,.TIUMSG)
+11 MERGE FDA=TIUFDA
MERGE MSG=TIUMSG
+12 SET DR=".02////"_$PIECE(BUFREC,U,2)_";.03////"_TIUTYPE_";.04////"_ERRMSG_";.06////"_$SELECT(+ETYPE:0,1:"")_";.08////"_ETYPE_";.09////"_$SELECT($GET(TIUINST):TIUINST,1:DUZ(2))
+13 DO ^DIE
KILL DA
+14 IF ETYPE'=1
QUIT
+15 ; ---- Store Header of failed record in log
+16 SET ^TIU(8925.4,+EVNTDA,"HEAD",0)="^^^^"_DT_"^"
+17 SET TIUL=0
FOR TIUK=TIUFRST:1:$SELECT($PIECE(TIUPRM0,U,16)="C":TIUI,1:TIUFRST+1)
Begin DoDot:1
+18 SET TIUL=TIUL+1
SET ^TIU(8925.4,+EVNTDA,"HEAD",TIUL,0)=$GET(^TIU(8925.2,+BUFDA,"TEXT",TIUK,0))
End DoDot:1
+19 SET $PIECE(^TIU(8925.4,+EVNTDA,"HEAD",0),U,3,4)=TIUL_U_TIUL
+20 ; ---- Create a new buffer entry w/ uploaded data
+21 SET NEWBUF=$$MAKEBUF^TIUUPLD
+22 IF +NEWBUF>0
Begin DoDot:1
+23 NEW TIUJ,TIUL,TIUBLIN
+24 SET ^TIU(8925.2,+NEWBUF,"TEXT",0)="^^^^"_DT_"^"
+25 SET TIUJ=TIUFRST
SET TIUL=1
+26 SET ^TIU(8925.2,+NEWBUF,"TEXT",TIUL,0)=$GET(^TIU(8925.2,+BUFDA,"TEXT",TIUJ,0))
KILL ^TIU(8925.2,+BUFDA,"TEXT",TIUJ,0)
+27 FOR
SET TIUJ=$ORDER(^TIU(8925.2,+BUFDA,"TEXT",TIUJ))
if $SELECT(+TIUJ'>0
QUIT
Begin DoDot:2
+28 SET TIUL=TIUL+1
+29 SET ^TIU(8925.2,+NEWBUF,"TEXT",TIUL,0)=$GET(^TIU(8925.2,+BUFDA,"TEXT",TIUJ,0))
SET TIUI=TIUJ
+30 KILL ^TIU(8925.2,+BUFDA,"TEXT",TIUJ,0)
End DoDot:2
+31 SET $PIECE(^TIU(8925.2,+NEWBUF,"TEXT",0),U,3,4)=TIUL_U_TIUL
+32 ; ---- Stuff new buffer entry pointer into event log file
+33 SET DIE=8925.4
SET DA=+EVNTDA
SET DR=".05////"_+NEWBUF
DO ^DIE
+34 ; ---- File the error log pointer in buffer file
+35 SET ^TIU(8925.2,+NEWBUF,"ERR",0)="^8925.22PA^^"
SET DLAYGO=8925.22
+36 SET DA(1)=+NEWBUF
SET DIC="^TIU(8925.2,"_+DA(1)_",""ERR"","
SET DIC(0)="L"
+37 SET X="`"_EVNTDA
+38 DO ^DIC
+39 KILL DIC,DLAYGO
+40 ; ---- Send filing error alerts
+41 SET TIUEVTDA=EVNTDA
MERGE TIUERMSG=ERRMSG
+42 DO ALERT(+NEWBUF,.TIUERMSG,.TIUEVTDA)
+43 SET EVNTDA=TIUEVTDA
MERGE ERRMSG=TIUERMSG
End DoDot:1
+44 QUIT
ERRMSG(ETYPE,ECODE,TIUTYPE,FDA,MSG) ; ---- Set error messages
+1 NEW DIC,DIE,DA,X,Y
+2 IF +ETYPE'>0
SET Y=""
GOTO ERRMSX
+3 SET TIUTYPE=$SELECT($GET(TIUTITLE)]"":$GET(TIUTITLE),1:$GET(TIUTYPE))
+4 IF +$GET(TIUREC("FILE"))=8925
IF ($GET(TIUHDR(.09))="PRIORITY")
IF ($GET(TIUTYPE)]"")
SET TIUTYPE="STAT "_$GET(TIUTYPE)
+5 ; ---- Set filing error message
+6 IF +ETYPE=1
IF +ECODE
Begin DoDot:1
+7 SET DIC=8925.3
SET DIC(0)="MXZ"
SET X="`"_ECODE
DO ^DIC
+8 SET Y="FILING ERROR: "_$GET(TIUTYPE)_" "_$PIECE(Y(0),U,2)
End DoDot:1
GOTO ERRMSX
+9 ; ---- If target file is 8925, get info on entry & set missing fld msg
+10 IF $GET(MSG("DIERR",1,"PARAM","FILE"))=8925
Begin DoDot:1
+11 NEW TIU,DA
SET DA=+$ORDER(FDA(8925,""))
DO GETTIU^TIULD(.TIU,DA)
+12 SET Y=$$NAME^TIULS(TIU("PNM"),"LAST,FI MI ")
+13 if $GET(TIUHDR("TIUTITLE"))]""
SET TIUTYPE=TIUHDR("TIUTITLE")
+14 SET Y=Y_TIU("PID")_": "_$$DATE^TIULS(+TIU("EDT"),"MM/DD/YY ")_$GET(TIUTYPE)_" is missing fields."
End DoDot:1
GOTO ERRMSX
+15 ; ---- Otherwise get message from FM Filer error msg array
+16 SET Y=$GET(MSG("DIERR",1,"TEXT",1))
ERRMSX QUIT Y
ALERT(BUFDA,ERRMSG,EVNTDA) ; ---- Send alerts for filing errors
+1 NEW BUFREC,XQA,XQAID,XQADATA,XQAMSG,XQAKILL,XQAROU,TIUI,TIUSUB,TYPE
+2 NEW TIUXQA
+3 SET BUFREC=$GET(^TIU(8925.2,+BUFDA,0))
+4 ; ---- TIU*1*81 TIUHDR is newed in MAIN+11^TIUPUTC, set in
+5 ; GETREC^TIUPUTC1, so it exists for file errs.
+6 SET TYPE=+$$WHATITLE^TIUPUTU($GET(TIUHDR("TIUTITLE")))
+7 IF TYPE'>0
SET TYPE=+$GET(TIUREC("TYPE"))
+8 ;TIU*1*81 New TIUDAD here, not in WHOGETS
IF TYPE
NEW TIUDAD
MERGE TIUXQA=XQA
DO WHOGETS^TIUPEVN1(.TIUXQA,TYPE)
MERGE XQA=TIUXQA
+9 ; ---- If no 8925.95 (Document Parameter) recipients, get 8925.99
+10 ; (Site Parameter) recipients
+11 IF $DATA(XQA)'>9
Begin DoDot:1
+12 SET TIUI=$ORDER(^TIU(8925.99,"B",+$GET(DUZ(2)),0))
if +TIUI'>0
SET TIUI=+$ORDER(^TIU(8925.99,0))
+13 SET TIUSUB=0
FOR
SET TIUSUB=$ORDER(^TIU(8925.99,+TIUI,2,TIUSUB))
if TIUSUB'>0
QUIT
Begin DoDot:2
+14 SET XQA($GET(^TIU(8925.99,+TIUI,2,TIUSUB,0)))=""
End DoDot:2
End DoDot:1
+15 if $DATA(XQA)'>9
QUIT
+16 SET XQAID="TIUERR"_+BUFDA
+17 SET XQAMSG=ERRMSG
+18 if '$DATA(ZTQUEUED)
WRITE !!,XQAMSG,!
+19 SET XQADATA=BUFDA_";"_ERRMSG_";"_EVNTDA_";"_$GET(TIUREC("TYPE"))
+20 SET XQAROU="DISPLAY^TIUPEVNT"
+21 DO SETUP^XQALERT
+22 QUIT
DISPLAY ; ---- Alert followup action for filing errors
+1 NEW DIC,INQUIRE,RETRY,DWPK,EVNTDA,TIU
KILL XQAKILL,RESCODE,TIUTYPE,TIUDONE
+2 NEW TIUEVNT,TIUSKIP,TIUBUF,PRFILERR,TIUINQ
+3 IF '$DATA(TIUPRM0)!'$DATA(TIUPRM1)
DO SETPARM^TIULE
+4 ; Set EVNTDA for backward compatibility, TIUEVNT for PN resolve code
+5 SET (EVNTDA,TIUEVNT)=+$PIECE(XQADATA,";",3)
+6 ; Set TIUBUF for similarity w TIURE. DON'T set BUFDA since
+7 ; old code interprets that as set by TIURE only:
+8 SET TIUBUF=+XQADATA
+9 IF TIUEVNT
Begin DoDot:1
+10 SET TIUTYPE=+$PIECE(XQADATA,";",4)
+11 ; If no author or dict dt, can't evaluate if auth requires EC so force refile until they are included.
+12 ;(Inquire does not refile.) TIU*1*273:
+13 SET TIUINQ=1
DO WRITEHDR(TIUEVNT,TIUTYPE,.TIUINQ)
+14 IF TIUTYPE>0
SET RESCODE=$$FIXCODE^TIULC1(TIUTYPE)
+15 ;E S RESCODE="D GETPAT^TIUCHLP"
+16 IF $GET(RESCODE)]""
Begin DoDot:2
+17 WRITE !
SET INQUIRE=$$READ^TIUU("YO","Inquire to patient record","YES","^D INQRHELP^TIUPEVNT")
+18 IF $DATA(DIRUT)
SET TIUSKIP=1
QUIT
+19 IF +INQUIRE
XECUTE RESCODE
+20 ; Redundant if all RESCODEs do RESOLVE:
+21 IF +$GET(TIUDONE)
IF +$GET(TIUEVNT)
DO RESOLVE(+$GET(TIUEVNT))
End DoDot:2
QUIT
+22 WRITE !!,"Filing error resolution code could not be found for this document type.",!,"Please edit the buffered data directly and refile."
End DoDot:1
IF +$GET(TIUDONE)!$GET(TIUSKIP)
GOTO DISPX
+23 WRITE !!,"You may now edit the buffered upload data in an attempt to resolve error:",!,$PIECE(XQADATA,";",2),!
+24 IF '$$READ^TIUU("EA","Press RETURN to continue and edit the buffer or '^' to exit: ")
GOTO DISPX
+25 SET DIC="^TIU(8925.2,"_TIUBUF_",""TEXT"","
SET DWPK=1
DO EN^DIWE
+26 SET RETRY=$$READ^TIUU("YO","Now would you like to retry the filer","YES","^D FIL^TIUDIRH")
+27 ; -- If refiling, tell Patient Record Flag LOOKUP to ask for flag link:
+28 IF +RETRY
SET PRFILERR=1
+29 ; -- Refile
+30 IF +RETRY
DO ALERTDEL(TIUBUF)
+31 IF +RETRY
DO RESOLVE(TIUEVNT,1)
+32 IF +RETRY
DO FILE^TIUUPLD(TIUBUF)
DISPX KILL XQX1
+1 QUIT
+2 ;
WRITEHDR(EVNTDA,TIUTYPE,TIUINQ) ; ---- Write header to screen
+1 ;Write header, as stored in Upload Log event (NOT buffer record,
+2 ;which can be edited w/o refiling)
+3 ; TIUINQ - See TIUPUTC1. Patch 273
+4 NEW TIUI,TIULINE,TIUVALID,TIUFLD
+5 SET TIUVALID="YES"
+6 SET TIUI=0
+7 WRITE !!,"The header of the original, failed record looks like this:",!
+8 FOR
SET TIUI=$ORDER(^TIU(8925.4,+EVNTDA,"HEAD",TIUI))
if +TIUI'>0
QUIT
Begin DoDot:1
+9 SET TIULINE=$GET(^TIU(8925.4,+EVNTDA,"HEAD",TIUI,0))
WRITE !,TIULINE
+10 IF (TIUTYPE=3)
IF (TIULINE["AUTHOR")!(TIULINE["DATE/TIME OF DICT")!(TIULINE["TITLE")
Begin DoDot:2
+11 if TIUVALID="NO"
QUIT
+12 ; added TITLE to $S, *335 ajb
SET TIUFLD=$SELECT(TIULINE["AUTHOR":"1202",TIULINE["TITLE":".01",1:"1307")
+13 DO VALID(TIULINE,TIUFLD,.TIUVALID)
End DoDot:2
End DoDot:1
+14 IF TIUVALID="NO"
SET TIUINQ=0
+15 QUIT
+16 ;
VALID(TIULINE,TIUFLD,TIUVALID) ;Is header missing valid Author or DDT?
+1 SET TIULINE=$$STRIP^TIULS($PIECE(TIULINE,":",2,99))
+2 DO CHK^DIE(8925,TIUFLD,,TIULINE,.TIUVALID)
+3 IF TIUVALID["^"
SET TIUVALID="NO"
+4 QUIT
+5 ;
ALERTDEL(DA) ; ---- Delete alerts associated with a given record
+1 NEW XQA,XQAID,XQAKILL
SET XQAID="TIUERR"_+DA
+2 FOR
DO DELETEA^XQALERT
SET XQAID="TIUERR"_+DA
if '$DATA(^VA(200,"AXQAN",XQAID))
QUIT
+3 QUIT
RESOLVE(EVNTDA,ECHO) ; ---- Indicate resolution of error
+1 NEW DA,DIE,DR,TIUI,RESTIME,X,Y
+2 if +$GET(ECHO)
WRITE !,"Filing Record/Resolving Error..."
+3 SET RESTIME=$$NOW^TIULC
+4 SET DIE="^TIU(8925.4,"
+5 SET DA=+$GET(EVNTDA)
if +DA'>0
QUIT
+6 ; ---- If already resolved, Quit. (Go on to next record)
+7 IF +$PIECE(^TIU(8925.4,DA,0),U,6)>0
QUIT
+8 ; ---- Mark error log record as resolved
+9 SET DR=".05///@;.06////1;.07////"_RESTIME_";1///@"
+10 DO ^DIE
+11 QUIT
INQRHELP ; Help for Upload Error Inquire to Patient Record prompt
+1 WRITE !,"Do you wish to be prompted for the data necessary to resolve the filing error?"
+2 WRITE !,"If not, answer NO to proceed and edit the buffered data directly without"
+3 WRITE !,"prompts, or enter '^' to come back and resolve the error later."
+4 QUIT
