TIUPEVNT ; SLC/JER - Event logger for upload/filer ;04-Jun-2012 16:21;DU
;;1.0;TEXT INTEGRATION UTILITIES;**3,21,81,131,113,1009,184,1010**;Jun 20, 1997;Build 24
;IHS/ITSC/LJF 02/26/2003 include chart # in filing alerts messages
; changed PID to HRCN
; added code to escape from alert processing
; added ability to delete filing errors
MAIN(BUFDA,ETYPE,ECODE,TIUTYPE,FDA,MSG) ; ---- Controls branching
N EVNTDA
; ---- 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),.EVNTDA,.FDA,.MSG)
I ETYPE=2 D FIELDS^TIUPEVN1(EVNTDA,.MSG)
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
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
S DIE=DIC,(EVNTDA,DA)=+Y,ERRMSG=$$ERRMSG(ETYPE,ECODE,TIUTYPE,.FDA,.MSG)
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
. D ALERT(+NEWBUF,.ERRMSG,.EVNTDA)
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) ;IHS/ITSC/LJF 02/26/2003
. S Y="FILING ERROR: "_$$GETHRCN_" "_$G(TIUTYPE)_" "_$P(Y(0),U,2) ;IHS/ITSC/LJF 02/26/2003 added HRCN to message
; ---- 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
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 D WHOGETS^TIUPEVN1(.XQA,TYPE) ;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
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
. D WRITEHDR(TIUEVNT)
. S TIUTYPE=+$P(XQADATA,";",4)
. 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."
;
I $G(INQUIRE)=U K XQX1 Q ;IHS/ITSC/LJF 02/26/2003 added escape from alert processing
;
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)
;IHS/ITSC/LJF 02/26/2003 add ability to delete record completely
I ('RETRY) NEW DELETE D
. S DELETE=$$READ^TIUU("YO","Would you like to DELETE this record completely","NO","^D DELHELP^BTIUH2")
. I +DELETE D ALERTDEL(+XQADATA),BUFPURGE^TIUPUTC(+XQADATA)
;IHS/ITSC/LJF 02/26/2003 end of new code
DISPX K XQX1
Q
WRITEHDR(EVNTDA) ; ---- Write header to screen
;Write header, as stored in Upload Log event (NOT buffer record,
;which can be edited w/o refiling)
N TIUI
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
. W !,$G(^TIU(8925.4,+EVNTDA,"HEAD",TIUI,0))
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
GETHRCN() ; IHS/ITSC/LJF 02/26/2003 pull chart # from upload header
NEW I,X,Y,Z
F I=1:1 Q:'$D(^TIU(8925.2,+BUFDA,"TEXT",I))!$D(Z) S X=^(I,0) D
. Q:X'?1"HRCN:".E S Y(" ")="",Z=$$REPLACE^XLFSTR(X,.Y)
Q $G(Z)
;
TIUPEVNT ; SLC/JER - Event logger for upload/filer ;04-Jun-2012 16:21;DU
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**3,21,81,131,113,1009,184,1010**;Jun 20, 1997;Build 24
+2 ;IHS/ITSC/LJF 02/26/2003 include chart # in filing alerts messages
+3 ; changed PID to HRCN
+4 ; added code to escape from alert processing
+5 ; added ability to delete filing errors
MAIN(BUFDA,ETYPE,ECODE,TIUTYPE,FDA,MSG) ; ---- Controls branching
+1 NEW EVNTDA
+2 ; ---- ETYPE = 1: Filing error event
+3 ; ---- ETYPE = 2: Missing/incorrect field error event
+4 ; ---- ETYPE = 0: Other event (no errors)
+5 DO LOG(BUFDA,ETYPE,$GET(ECODE),$GET(TIUTYPE),.EVNTDA,.FDA,.MSG)
+6 IF ETYPE=2
DO FIELDS^TIUPEVN1(EVNTDA,.MSG)
+7 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 SET BUFREC=$GET(^TIU(8925.2,+BUFDA,0))
+5 SET (DIC,DLAYGO)=8925.4
SET DIC(0)="MLX"
SET X=""""_$$NOW^TIULC_""""
DO ^DIC
+6 IF +Y'>0
QUIT
+7 ; ---- File upload log record
+8 SET DIE=DIC
SET (EVNTDA,DA)=+Y
SET ERRMSG=$$ERRMSG(ETYPE,ECODE,TIUTYPE,.FDA,.MSG)
+9 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))
+10 DO ^DIE
KILL DA
+11 IF ETYPE'=1
QUIT
+12 ; ---- Store Header of failed record in log
+13 SET ^TIU(8925.4,+EVNTDA,"HEAD",0)="^^^^"_DT_"^"
+14 SET TIUL=0
FOR TIUK=TIUFRST:1:$SELECT($PIECE(TIUPRM0,U,16)="C":TIUI,1:TIUFRST+1)
Begin DoDot:1
+15 SET TIUL=TIUL+1
SET ^TIU(8925.4,+EVNTDA,"HEAD",TIUL,0)=$GET(^TIU(8925.2,+BUFDA,"TEXT",TIUK,0))
End DoDot:1
+16 SET $PIECE(^TIU(8925.4,+EVNTDA,"HEAD",0),U,3,4)=TIUL_U_TIUL
+17 ; ---- Create a new buffer entry w/ uploaded data
+18 SET NEWBUF=$$MAKEBUF^TIUUPLD
+19 IF +NEWBUF>0
Begin DoDot:1
+20 NEW TIUJ,TIUL,TIUBLIN
+21 SET ^TIU(8925.2,+NEWBUF,"TEXT",0)="^^^^"_DT_"^"
+22 SET TIUJ=TIUFRST
SET TIUL=1
+23 SET ^TIU(8925.2,+NEWBUF,"TEXT",TIUL,0)=$GET(^TIU(8925.2,+BUFDA,"TEXT",TIUJ,0))
KILL ^TIU(8925.2,+BUFDA,"TEXT",TIUJ,0)
+24 FOR
SET TIUJ=$ORDER(^TIU(8925.2,+BUFDA,"TEXT",TIUJ))
IF $SELECT(+TIUJ'>0
QUIT
Begin DoDot:2
+25 SET TIUL=TIUL+1
+26 SET ^TIU(8925.2,+NEWBUF,"TEXT",TIUL,0)=$GET(^TIU(8925.2,+BUFDA,"TEXT",TIUJ,0))
SET TIUI=TIUJ
+27 KILL ^TIU(8925.2,+BUFDA,"TEXT",TIUJ,0)
End DoDot:2
+28 SET $PIECE(^TIU(8925.2,+NEWBUF,"TEXT",0),U,3,4)=TIUL_U_TIUL
+29 ; ---- Stuff new buffer entry pointer into event log file
+30 SET DIE=8925.4
SET DA=+EVNTDA
SET DR=".05////"_+NEWBUF
DO ^DIE
+31 ; ---- File the error log pointer in buffer file
+32 SET ^TIU(8925.2,+NEWBUF,"ERR",0)="^8925.22PA^^"
SET DLAYGO=8925.22
+33 SET DA(1)=+NEWBUF
SET DIC="^TIU(8925.2,"_+DA(1)_",""ERR"","
SET DIC(0)="L"
+34 SET X="`"_EVNTDA
+35 DO ^DIC
+36 KILL DIC,DLAYGO
+37 ; ---- Send filing error alerts
+38 DO ALERT(+NEWBUF,.ERRMSG,.EVNTDA)
End DoDot:1
+39 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 ;S Y="FILING ERROR: "_$G(TIUTYPE)_" "_$P(Y(0),U,2) ;IHS/ITSC/LJF 02/26/2003
+9 ;IHS/ITSC/LJF 02/26/2003 added HRCN to message
SET Y="FILING ERROR: "_$$GETHRCN_" "_$G(TIUTYPE)_" "_$PIECE(Y(0),U,2)
End DoDot:1
GOTO ERRMSX
+10 ; ---- If target file is 8925, get info on entry & set missing fld msg
+11 IF $GET(MSG("DIERR",1,"PARAM","FILE"))=8925
Begin DoDot:1
+12 NEW TIU,DA
SET DA=+$ORDER(FDA(8925,""))
DO GETTIU^TIULD(.TIU,DA)
+13 SET Y=$$NAME^TIULS(TIU("PNM"),"LAST,FI MI ")
+14 IF $GET(TIUHDR("TIUTITLE"))]""
SET TIUTYPE=TIUHDR("TIUTITLE")
+15 SET Y=Y_TIU("PID")_": "_$$DATE^TIULS(+TIU("EDT"),"MM/DD/YY ")_$GET(TIUTYPE)_" is missing fields."
End DoDot:1
GOTO ERRMSX
+16 ; ---- Otherwise get message from FM Filer error msg array
+17 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 SET BUFREC=$GET(^TIU(8925.2,+BUFDA,0))
+3 ; ---- TIU*1*81 TIUHDR is newed in MAIN+11^TIUPUTC, set in
+4 ; GETREC^TIUPUTC1, so it exists for file errs.
+5 SET TYPE=+$$WHATITLE^TIUPUTU($GET(TIUHDR("TIUTITLE")))
+6 IF TYPE'>0
SET TYPE=+$GET(TIUREC("TYPE"))
+7 ;TIU*1*81 New TIUDAD here, not in WHOGETS
IF TYPE
NEW TIUDAD
DO WHOGETS^TIUPEVN1(.XQA,TYPE)
+8 ; ---- If no 8925.95 (Document Parameter) recipients, get 8925.99
+9 ; (Site Parameter) recipients
+10 IF $DATA(XQA)'>9
Begin DoDot:1
+11 SET TIUI=$ORDER(^TIU(8925.99,"B",+$GET(DUZ(2)),0))
IF +TIUI'>0
SET TIUI=+$ORDER(^TIU(8925.99,0))
+12 SET TIUSUB=0
FOR
SET TIUSUB=$ORDER(^TIU(8925.99,+TIUI,2,TIUSUB))
IF TIUSUB'>0
QUIT
Begin DoDot:2
+13 SET XQA($GET(^TIU(8925.99,+TIUI,2,TIUSUB,0)))=""
End DoDot:2
End DoDot:1
+14 IF $DATA(XQA)'>9
QUIT
+15 SET XQAID="TIUERR"_+BUFDA
+16 SET XQAMSG=ERRMSG
+17 IF '$DATA(ZTQUEUED)
WRITE !!,XQAMSG,!
+18 SET XQADATA=BUFDA_";"_ERRMSG_";"_EVNTDA_";"_$GET(TIUREC("TYPE"))
+19 SET XQAROU="DISPLAY^TIUPEVNT"
+20 DO SETUP^XQALERT
+21 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
+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 DO WRITEHDR(TIUEVNT)
+11 SET TIUTYPE=+$PIECE(XQADATA,";",4)
+12 IF TIUTYPE>0
SET RESCODE=$$FIXCODE^TIULC1(TIUTYPE)
+13 ;E S RESCODE="D GETPAT^TIUCHLP"
+14 IF $GET(RESCODE)]""
Begin DoDot:2
+15 WRITE !
SET INQUIRE=$$READ^TIUU("YO","Inquire to patient record","YES","^D INQRHELP^TIUPEVNT")
+16 IF $DATA(DIRUT)
SET TIUSKIP=1
QUIT
+17 IF +INQUIRE
XECUTE RESCODE
+18 ; Redundant if all RESCODEs do RESOLVE:
+19 IF +$GET(TIUDONE)
IF +$GET(TIUEVNT)
DO RESOLVE(+$GET(TIUEVNT))
End DoDot:2
QUIT
+20 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
+21 ;
+22 ;IHS/ITSC/LJF 02/26/2003 added escape from alert processing
IF $GET(INQUIRE)=U
KILL XQX1
QUIT
+23 ;
+24 WRITE !!,"You may now edit the buffered upload data in an attempt to resolve error:",!,$PIECE(XQADATA,";",2),!
+25 IF '$$READ^TIUU("EA","Press RETURN to continue and edit the buffer or '^' to exit: ")
GOTO DISPX
+26 SET DIC="^TIU(8925.2,"_TIUBUF_",""TEXT"","
SET DWPK=1
DO EN^DIWE
+27 SET RETRY=$$READ^TIUU("YO","Now would you like to retry the filer","YES","^D FIL^TIUDIRH")
+28 ; -- If refiling, tell Patient Record Flag LOOKUP to ask for flag link:
+29 IF +RETRY
SET PRFILERR=1
+30 ; -- Refile
+31 IF +RETRY
DO ALERTDEL(TIUBUF)
+32 IF +RETRY
DO RESOLVE(TIUEVNT,1)
+33 IF +RETRY
DO FILE^TIUUPLD(TIUBUF)
+34 ;IHS/ITSC/LJF 02/26/2003 add ability to delete record completely
+35 IF ('RETRY)
NEW DELETE
Begin DoDot:1
+36 SET DELETE=$$READ^TIUU("YO","Would you like to DELETE this record completely","NO","^D DELHELP^BTIUH2")
+37 IF +DELETE
DO ALERTDEL(+XQADATA)
DO BUFPURGE^TIUPUTC(+XQADATA)
End DoDot:1
+38 ;IHS/ITSC/LJF 02/26/2003 end of new code
DISPX KILL XQX1
+1 QUIT
WRITEHDR(EVNTDA) ; ---- 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 NEW TIUI
+4 SET TIUI=0
+5 WRITE !!,"The header of the original, failed record looks like this:",!
+6 FOR
SET TIUI=$ORDER(^TIU(8925.4,+EVNTDA,"HEAD",TIUI))
IF +TIUI'>0
QUIT
Begin DoDot:1
+7 WRITE !,$GET(^TIU(8925.4,+EVNTDA,"HEAD",TIUI,0))
End DoDot:1
+8 QUIT
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
GETHRCN() ; IHS/ITSC/LJF 02/26/2003 pull chart # from upload header
+1 NEW I,X,Y,Z
+2 FOR I=1:1
IF '$DATA(^TIU(8925.2,+BUFDA,"TEXT",I))!$DATA(Z)
QUIT
SET X=^(I,0)
Begin DoDot:1
+3 IF X'?1"HRCN
QUIT
SET Y(" ")=""
SET Z=$$REPLACE^XLFSTR(X,.Y)
End DoDot:1
+4 QUIT $GET(Z)
+5 ;
