- 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 Feb 19, 2025@00:09:38 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