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

TIURE.m

Go to the documentation of this file.
  1. TIURE ; SLC/JER - Error handler actions ;Jul 09, 2020@12:07:54
  1. ;;1.0;TEXT INTEGRATION UTILITIES;**3,21,81,131,113,184,250,335**;Jun 20, 1997;Build 3
  1. ;
  1. ; ICR #10018 - ^DIE Routine & DIE, DA, DR, DTOUT, & DUOUT local vars
  1. ; #10010 - EN1^DIP Routine & BY, DIC, FLDS, FR, L, TO, & IOP local vars
  1. ; #10028 - EN^DIWE Routine & DIC & DWPK local vars
  1. ; #10118 - EN^VALM, CLEAR^VALM1, & FULL^VALM1 Routines & VALM("ENTITY"),
  1. ; VALMBCK, VALMY, & VALMY( Local Vars
  1. ; #10119 - EN^VALM2 Routine & XQORNOD(0) Local Var
  1. ; #10081 - DELETEA^XQALERT Routine & XQAKILL & XQAID local vars
  1. ;
  1. PRINT ; Print Buffer record associated w/unresolved filing error
  1. N TIUDA,TIUDATA,TIUI,DIROUT,ZTDESC,ZTRTN
  1. I '$D(VALMY) D EN^VALM2(XQORNOD(0))
  1. S TIUI=0
  1. F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT)
  1. . S TIUDATA=$G(^TMP("TIUERRIDX",$J,TIUI))
  1. . S (TIUDA,TIUDA(TIUI))=+$P(TIUDATA,U,3) D RESTORE^TIULM(+$O(@VALMAR@("PICK",TIUI,0)))
  1. . I +TIUDA'>0!'$D(^TIU(8925.2,+TIUDA,0))!+$P(^TIU(8925.4,+$P(TIUDATA,U,2),0),U,6) W !!,"Item #",+TIUI," is already resolved." K TIUDA(TIUI) H 3 Q
  1. I $D(TIUDA)'<9 D
  1. . S ZTRTN="PRINT1^TIURE",ZTDESC="Print Report Buffer"
  1. . D CLEAR^VALM1,DEVICE^TIUPRDS
  1. . S TIUI=$$READ^TIUU("FOA","Press RETURN to continue...")
  1. K VALMY S VALMBCK="R"
  1. Q
  1. PRINT1 ; Print a single buffer record
  1. N DIC,TIUI,FLDS,FR,TO,L,BY,IOP S TIUI=0
  1. F S TIUI=$O(TIUDA(TIUI)) Q:+TIUI'>0 D
  1. . S IOP=$S($D(ZTIO):ZTIO,$D(ION):ION,1:"") Q:IOP']""
  1. . S DIC="^TIU(8925.2,",FLDS="[TIU PRINT REPORT BUFFER]",L=0
  1. . S BY=.01,(FR,TO)=+$G(^TIU(8925.2,+TIUDA(TIUI),0))
  1. . D EN1^DIP
  1. Q
  1. EDIT ; Edit Buffer record associated w/unresolved filing error
  1. N TIUDA,BUFDA,TIUDATA,TIUI,DIROUT,TIUDI
  1. I '$D(VALMY) D EN^VALM2(XQORNOD(0))
  1. S TIUI=0
  1. F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT)
  1. . N VALMY
  1. . S TIUDATA=$G(^TMP("TIUERRIDX",$J,TIUI))
  1. . S BUFDA=+$P(TIUDATA,U,3)
  1. . W !!,"Resolving Event #",TIUI
  1. . S TIUDA=+$P(TIUDATA,U,2)
  1. . D EN^VALM("TIU DISPLAY FILING EVENT")
  1. . D RESTORE^TIULM(+$O(@VALMAR@("PICK",TIUI,0)))
  1. W !,"Refreshing the list."
  1. M TIUDI=^TMP("TIUERR",$J,"DIV")
  1. D BUILD^TIUELST($P(^TMP("TIUERR",$J,0),U,2),$P(^(0),U,3),TIUEDT,TIULDT,.TIUDI)
  1. K VALMY S:'$D(VALMBCK) VALMBCK="R"
  1. Q
  1. EDIT1 ; Single record edit
  1. ; Receives TIUDATA
  1. N DIC,ERRDA,ERRTYPE,RETRY,DWPK K XQAKILL
  1. D FULL^VALM1
  1. I '$D(TIUPRM0)!'$D(TIUPRM1) D SETPARM^TIULE
  1. S ERRDA=+$P(TIUDATA,U,2),ERRTYPE=$P(^TIU(8925.4,+ERRDA,0),U,8)
  1. I +ERRTYPE=0 W !!,"Item #",+TIUDATA," was a successful filing event." H 3 Q
  1. I +ERRTYPE=1 D FILERR(ERRDA)
  1. I +ERRTYPE=2 D FLDERR(ERRDA)
  1. Q
  1. FILERR(ERRDA) ; Resolve filing errors
  1. N DIC,DIRUT,DWPK,TIUI,INQUIRE,BUFDA,TIUTYPE,RESCODE,TIUDONE
  1. N TIUEVNT,TIUSKIP,ERR0,RETRY,STATUS,PRFILERR,TIUINQ
  1. ; Set TIUEVNT for PN resolve code:
  1. S TIUEVNT=+ERRDA
  1. S TIUI=0,ERR0=$G(^TIU(8925.4,TIUEVNT,0)),STATUS=$P(ERR0,U,6)
  1. I STATUS=1 W !,"Error has already been resolved.",! Q
  1. S BUFDA=+$P(ERR0,U,5) I +BUFDA'>0 Q
  1. I TIUEVNT D I +$G(TIUDONE)!$G(TIUSKIP) G FILEX
  1. . S TIUTYPE=$P(ERR0,U,3)
  1. . I $L(TIUTYPE) S TIUTYPE=+$$WHATYPE^TIUPUTPN(TIUTYPE)
  1. . D WRITEHDR^TIUPEVNT(TIUEVNT,TIUTYPE,.TIUINQ) ; moved this call down 2 lines, added last 2 parameters *335 ajb
  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. . 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(ERR0,U,4),!
  1. I '$$READ^TIUU("EA","Press RETURN to continue and edit the buffer or '^' to exit: ") G FILEX
  1. S DIC="^TIU(8925.2,"_+BUFDA_",""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. I +RETRY D
  1. . S PRFILERR=1 ; Tell Patient Record Flag lookup to get flag link
  1. . D ALERTDEL^TIUPEVNT(+BUFDA),RESOLVE^TIUPEVNT(TIUEVNT)
  1. . K TIUDONE
  1. . D FILE^TIUUPLD(+BUFDA)
  1. . I '$G(TIUDONE) W !,"Old error marked resolved; new error created. New error may take several more",!,"seconds to file, and may not be within current date/time range.",! H 5
  1. FILEX S VALMBCK="Q" ;TIU*1*81 resolving twice creates errors so don't permit.
  1. Q
  1. FLDERR(EVNTDA) ; Resolve field errors
  1. N DIE,DA,DR,ERRDESC,EVNTDA1,EVNTREC,TIUFIX,ERR0,STATUS
  1. S EVNTDA1=0
  1. S ERR0=^TIU(8925.4,+EVNTDA,0),STATUS=$P(ERR0,U,6)
  1. I STATUS=1 W "Error has already been resolved",! Q ;TIU*1*81
  1. S ERRDESC=$P(ERR0,U,4)
  1. W !!,"You may now enter the correct information:",!
  1. W !,ERRDESC
  1. F S EVNTDA1=$O(^TIU(8925.4,EVNTDA,1,EVNTDA1)) Q:+EVNTDA1'>0 D
  1. . S EVNTREC=$G(^TIU(8925.4,EVNTDA,1,EVNTDA1,0)) Q:+EVNTREC'>0
  1. . S DIE=$P(EVNTREC,U),DA=$P(EVNTREC,U,2)
  1. . S DR=$P(EVNTREC,U,3)_"//"_$P(EVNTREC,U,4)
  1. . I $$FIXED^TIUPEVN1(DIE,+DA,+DR) Q ;P81 don't ask if already fixed; moved from TIUPEVNT
  1. . D ^DIE
  1. . ; P81 If missing field was just corrected, delete alert for that field:
  1. . S TIUFIX=$$FIXED^TIUPEVN1(DIE,+DA,+DR) ; TIU*1*81 moved from TIUPEVNT
  1. . I +TIUFIX=1 N XQAKILL,XQAID S XQAKILL=0,XQAID="TIUERR,"_+EVNTDA_","_+EVNTDA1 D DELETEA^XQALERT
  1. . ; If entry is a TIU Document, do Post-filing action and SEND^TIUALRT
  1. . I DIE="^TIU(8925," D
  1. . . N TIUPOST,TIUREC,DR,DIE,TIUD12,TIUD13,TIUAU,TIUEC,TIUEBY
  1. . . S TIUPOST=$$POSTFILE^TIULC1(+$G(^TIU(8925,DA,0)))
  1. . . S TIUREC("#")=DA
  1. . . I TIUPOST]"" X TIUPOST I 1
  1. . . ;if not entered by the author or expected cosigner record VBC Line Count
  1. . . S TIUD12=$G(^TIU(8925,DA,12)),TIUD13=$G(^(13))
  1. . . S TIUEBY=$P(TIUD13,U,2),TIUAU=$P(TIUD12,U,2),TIUEC=$P(TIUD13,U,8)
  1. . . I ((+TIUEBY>0)&(+TIUAU>0))&((TIUEBY'=TIUAU)&(TIUEBY'=TIUEC)) D LINES^TIUSRVPT(DA)
  1. . . D SEND^TIUALRT(DA)
  1. D FLDRSLV^TIUPEVN1(EVNTDA) ; TIU*1*81 moved from TIUPEVNT
  1. Q