Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIUPEVNT

TIUPEVNT.m

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