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 - 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
  1.  ;IHS/ITSC/LJF 02/26/2003 include chart # in filing alerts messages
  1.  ;                        changed PID to HRCN
  1.  ;                        added code to escape from alert processing
  1.  ;                        added ability to delete filing errors
  1. MAIN(BUFDA,ETYPE,ECODE,TIUTYPE,FDA,MSG) ; ---- Controls branching
  1.  N EVNTDA
  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),.EVNTDA,.FDA,.MSG)
  1.  I ETYPE=2 D FIELDS^TIUPEVN1(EVNTDA,.MSG)
  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.  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.  S DIE=DIC,(EVNTDA,DA)=+Y,ERRMSG=$$ERRMSG(ETYPE,ECODE,TIUTYPE,.FDA,.MSG)
  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.  . D ALERT(+NEWBUF,.ERRMSG,.EVNTDA)
  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)                ;IHS/ITSC/LJF 02/26/2003
  1.  . S Y="FILING ERROR: "_$$GETHRCN_" "_$G(TIUTYPE)_" "_$P(Y(0),U,2)   ;IHS/ITSC/LJF 02/26/2003 added HRCN to message
  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.  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 D WHOGETS^TIUPEVN1(.XQA,TYPE) ;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
  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.  . D WRITEHDR(TIUEVNT)
  1.  . S TIUTYPE=+$P(XQADATA,";",4)
  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.  ;
  1.  I $G(INQUIRE)=U K XQX1 Q     ;IHS/ITSC/LJF 02/26/2003 added escape from alert processing
  1.  ;
  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.  ;IHS/ITSC/LJF 02/26/2003 add ability to delete record completely
  1.  I ('RETRY) NEW DELETE D
  1.  . S DELETE=$$READ^TIUU("YO","Would you like to DELETE this record completely","NO","^D DELHELP^BTIUH2")
  1.  . I +DELETE D ALERTDEL(+XQADATA),BUFPURGE^TIUPUTC(+XQADATA)
  1.  ;IHS/ITSC/LJF 02/26/2003 end of new code
  1. DISPX K XQX1
  1.  Q
  1. WRITEHDR(EVNTDA) ; ---- 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.  N TIUI
  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.  . W !,$G(^TIU(8925.4,+EVNTDA,"HEAD",TIUI,0))
  1.  Q
  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
  1. GETHRCN() ; IHS/ITSC/LJF 02/26/2003 pull chart # from upload header
  1.  NEW I,X,Y,Z
  1.  F I=1:1 Q:'$D(^TIU(8925.2,+BUFDA,"TEXT",I))!$D(Z)  S X=^(I,0) D
  1.  . Q:X'?1"HRCN:".E  S Y("  ")="",Z=$$REPLACE^XLFSTR(X,.Y)
  1.  Q $G(Z)
  1.  ;