- TIURE ; SLC/JER - Error handler actions ;Jul 09, 2020@12:07:54
- ;;1.0;TEXT INTEGRATION UTILITIES;**3,21,81,131,113,184,250,335**;Jun 20, 1997;Build 3
- ;
- ; ICR #10018 - ^DIE Routine & DIE, DA, DR, DTOUT, & DUOUT local vars
- ; #10010 - EN1^DIP Routine & BY, DIC, FLDS, FR, L, TO, & IOP local vars
- ; #10028 - EN^DIWE Routine & DIC & DWPK local vars
- ; #10118 - EN^VALM, CLEAR^VALM1, & FULL^VALM1 Routines & VALM("ENTITY"),
- ; VALMBCK, VALMY, & VALMY( Local Vars
- ; #10119 - EN^VALM2 Routine & XQORNOD(0) Local Var
- ; #10081 - DELETEA^XQALERT Routine & XQAKILL & XQAID local vars
- ;
- PRINT ; Print Buffer record associated w/unresolved filing error
- N TIUDA,TIUDATA,TIUI,DIROUT,ZTDESC,ZTRTN
- I '$D(VALMY) D EN^VALM2(XQORNOD(0))
- S TIUI=0
- F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT)
- . S TIUDATA=$G(^TMP("TIUERRIDX",$J,TIUI))
- . S (TIUDA,TIUDA(TIUI))=+$P(TIUDATA,U,3) D RESTORE^TIULM(+$O(@VALMAR@("PICK",TIUI,0)))
- . 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
- I $D(TIUDA)'<9 D
- . S ZTRTN="PRINT1^TIURE",ZTDESC="Print Report Buffer"
- . D CLEAR^VALM1,DEVICE^TIUPRDS
- . S TIUI=$$READ^TIUU("FOA","Press RETURN to continue...")
- K VALMY S VALMBCK="R"
- Q
- PRINT1 ; Print a single buffer record
- N DIC,TIUI,FLDS,FR,TO,L,BY,IOP S TIUI=0
- F S TIUI=$O(TIUDA(TIUI)) Q:+TIUI'>0 D
- . S IOP=$S($D(ZTIO):ZTIO,$D(ION):ION,1:"") Q:IOP']""
- . S DIC="^TIU(8925.2,",FLDS="[TIU PRINT REPORT BUFFER]",L=0
- . S BY=.01,(FR,TO)=+$G(^TIU(8925.2,+TIUDA(TIUI),0))
- . D EN1^DIP
- Q
- EDIT ; Edit Buffer record associated w/unresolved filing error
- N TIUDA,BUFDA,TIUDATA,TIUI,DIROUT,TIUDI
- I '$D(VALMY) D EN^VALM2(XQORNOD(0))
- S TIUI=0
- F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT)
- . N VALMY
- . S TIUDATA=$G(^TMP("TIUERRIDX",$J,TIUI))
- . S BUFDA=+$P(TIUDATA,U,3)
- . W !!,"Resolving Event #",TIUI
- . S TIUDA=+$P(TIUDATA,U,2)
- . D EN^VALM("TIU DISPLAY FILING EVENT")
- . D RESTORE^TIULM(+$O(@VALMAR@("PICK",TIUI,0)))
- W !,"Refreshing the list."
- M TIUDI=^TMP("TIUERR",$J,"DIV")
- D BUILD^TIUELST($P(^TMP("TIUERR",$J,0),U,2),$P(^(0),U,3),TIUEDT,TIULDT,.TIUDI)
- K VALMY S:'$D(VALMBCK) VALMBCK="R"
- Q
- EDIT1 ; Single record edit
- ; Receives TIUDATA
- N DIC,ERRDA,ERRTYPE,RETRY,DWPK K XQAKILL
- D FULL^VALM1
- I '$D(TIUPRM0)!'$D(TIUPRM1) D SETPARM^TIULE
- S ERRDA=+$P(TIUDATA,U,2),ERRTYPE=$P(^TIU(8925.4,+ERRDA,0),U,8)
- I +ERRTYPE=0 W !!,"Item #",+TIUDATA," was a successful filing event." H 3 Q
- I +ERRTYPE=1 D FILERR(ERRDA)
- I +ERRTYPE=2 D FLDERR(ERRDA)
- Q
- FILERR(ERRDA) ; Resolve filing errors
- N DIC,DIRUT,DWPK,TIUI,INQUIRE,BUFDA,TIUTYPE,RESCODE,TIUDONE
- N TIUEVNT,TIUSKIP,ERR0,RETRY,STATUS,PRFILERR,TIUINQ
- ; Set TIUEVNT for PN resolve code:
- S TIUEVNT=+ERRDA
- S TIUI=0,ERR0=$G(^TIU(8925.4,TIUEVNT,0)),STATUS=$P(ERR0,U,6)
- I STATUS=1 W !,"Error has already been resolved.",! Q
- S BUFDA=+$P(ERR0,U,5) I +BUFDA'>0 Q
- I TIUEVNT D I +$G(TIUDONE)!$G(TIUSKIP) G FILEX
- . S TIUTYPE=$P(ERR0,U,3)
- . I $L(TIUTYPE) S TIUTYPE=+$$WHATYPE^TIUPUTPN(TIUTYPE)
- . D WRITEHDR^TIUPEVNT(TIUEVNT,TIUTYPE,.TIUINQ) ; moved this call down 2 lines, added last 2 parameters *335 ajb
- . 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
- . 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(ERR0,U,4),!
- I '$$READ^TIUU("EA","Press RETURN to continue and edit the buffer or '^' to exit: ") G FILEX
- S DIC="^TIU(8925.2,"_+BUFDA_",""TEXT"",",DWPK=1 D EN^DIWE
- S RETRY=$$READ^TIUU("YO","Now would you like to retry the filer","YES","^D FIL^TIUDIRH")
- I +RETRY D
- . S PRFILERR=1 ; Tell Patient Record Flag lookup to get flag link
- . D ALERTDEL^TIUPEVNT(+BUFDA),RESOLVE^TIUPEVNT(TIUEVNT)
- . K TIUDONE
- . D FILE^TIUUPLD(+BUFDA)
- . 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
- FILEX S VALMBCK="Q" ;TIU*1*81 resolving twice creates errors so don't permit.
- Q
- FLDERR(EVNTDA) ; Resolve field errors
- N DIE,DA,DR,ERRDESC,EVNTDA1,EVNTREC,TIUFIX,ERR0,STATUS
- S EVNTDA1=0
- S ERR0=^TIU(8925.4,+EVNTDA,0),STATUS=$P(ERR0,U,6)
- I STATUS=1 W "Error has already been resolved",! Q ;TIU*1*81
- S ERRDESC=$P(ERR0,U,4)
- W !!,"You may now enter the correct information:",!
- W !,ERRDESC
- F S EVNTDA1=$O(^TIU(8925.4,EVNTDA,1,EVNTDA1)) Q:+EVNTDA1'>0 D
- . S EVNTREC=$G(^TIU(8925.4,EVNTDA,1,EVNTDA1,0)) Q:+EVNTREC'>0
- . S DIE=$P(EVNTREC,U),DA=$P(EVNTREC,U,2)
- . S DR=$P(EVNTREC,U,3)_"//"_$P(EVNTREC,U,4)
- . I $$FIXED^TIUPEVN1(DIE,+DA,+DR) Q ;P81 don't ask if already fixed; moved from TIUPEVNT
- . D ^DIE
- . ; P81 If missing field was just corrected, delete alert for that field:
- . S TIUFIX=$$FIXED^TIUPEVN1(DIE,+DA,+DR) ; TIU*1*81 moved from TIUPEVNT
- . I +TIUFIX=1 N XQAKILL,XQAID S XQAKILL=0,XQAID="TIUERR,"_+EVNTDA_","_+EVNTDA1 D DELETEA^XQALERT
- . ; If entry is a TIU Document, do Post-filing action and SEND^TIUALRT
- . I DIE="^TIU(8925," D
- . . N TIUPOST,TIUREC,DR,DIE,TIUD12,TIUD13,TIUAU,TIUEC,TIUEBY
- . . S TIUPOST=$$POSTFILE^TIULC1(+$G(^TIU(8925,DA,0)))
- . . S TIUREC("#")=DA
- . . I TIUPOST]"" X TIUPOST I 1
- . . ;if not entered by the author or expected cosigner record VBC Line Count
- . . S TIUD12=$G(^TIU(8925,DA,12)),TIUD13=$G(^(13))
- . . S TIUEBY=$P(TIUD13,U,2),TIUAU=$P(TIUD12,U,2),TIUEC=$P(TIUD13,U,8)
- . . I ((+TIUEBY>0)&(+TIUAU>0))&((TIUEBY'=TIUAU)&(TIUEBY'=TIUEC)) D LINES^TIUSRVPT(DA)
- . . D SEND^TIUALRT(DA)
- D FLDRSLV^TIUPEVN1(EVNTDA) ; TIU*1*81 moved from TIUPEVNT
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIURE 6003 printed Feb 19, 2025@00:11:42 Page 2
- 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
- +2 ;
- +3 ; ICR #10018 - ^DIE Routine & DIE, DA, DR, DTOUT, & DUOUT local vars
- +4 ; #10010 - EN1^DIP Routine & BY, DIC, FLDS, FR, L, TO, & IOP local vars
- +5 ; #10028 - EN^DIWE Routine & DIC & DWPK local vars
- +6 ; #10118 - EN^VALM, CLEAR^VALM1, & FULL^VALM1 Routines & VALM("ENTITY"),
- +7 ; VALMBCK, VALMY, & VALMY( Local Vars
- +8 ; #10119 - EN^VALM2 Routine & XQORNOD(0) Local Var
- +9 ; #10081 - DELETEA^XQALERT Routine & XQAKILL & XQAID local vars
- +10 ;
- PRINT ; Print Buffer record associated w/unresolved filing error
- +1 NEW TIUDA,TIUDATA,TIUI,DIROUT,ZTDESC,ZTRTN
- +2 IF '$DATA(VALMY)
- DO EN^VALM2(XQORNOD(0))
- +3 SET TIUI=0
- +4 FOR
- SET TIUI=$ORDER(VALMY(TIUI))
- if +TIUI'>0
- QUIT
- Begin DoDot:1
- +5 SET TIUDATA=$GET(^TMP("TIUERRIDX",$JOB,TIUI))
- +6 SET (TIUDA,TIUDA(TIUI))=+$PIECE(TIUDATA,U,3)
- DO RESTORE^TIULM(+$ORDER(@VALMAR@("PICK",TIUI,0)))
- +7 IF +TIUDA'>0!'$DATA(^TIU(8925.2,+TIUDA,0))!+$PIECE(^TIU(8925.4,+$PIECE(TIUDATA,U,2),0),U,6)
- WRITE !!,"Item #",+TIUI," is already resolved."
- KILL TIUDA(TIUI)
- HANG 3
- QUIT
- End DoDot:1
- if $DATA(DIROUT)
- QUIT
- +8 IF $DATA(TIUDA)'<9
- Begin DoDot:1
- +9 SET ZTRTN="PRINT1^TIURE"
- SET ZTDESC="Print Report Buffer"
- +10 DO CLEAR^VALM1
- DO DEVICE^TIUPRDS
- +11 SET TIUI=$$READ^TIUU("FOA","Press RETURN to continue...")
- End DoDot:1
- +12 KILL VALMY
- SET VALMBCK="R"
- +13 QUIT
- PRINT1 ; Print a single buffer record
- +1 NEW DIC,TIUI,FLDS,FR,TO,L,BY,IOP
- SET TIUI=0
- +2 FOR
- SET TIUI=$ORDER(TIUDA(TIUI))
- if +TIUI'>0
- QUIT
- Begin DoDot:1
- +3 SET IOP=$SELECT($DATA(ZTIO):ZTIO,$DATA(ION):ION,1:"")
- if IOP']""
- QUIT
- +4 SET DIC="^TIU(8925.2,"
- SET FLDS="[TIU PRINT REPORT BUFFER]"
- SET L=0
- +5 SET BY=.01
- SET (FR,TO)=+$GET(^TIU(8925.2,+TIUDA(TIUI),0))
- +6 DO EN1^DIP
- End DoDot:1
- +7 QUIT
- EDIT ; Edit Buffer record associated w/unresolved filing error
- +1 NEW TIUDA,BUFDA,TIUDATA,TIUI,DIROUT,TIUDI
- +2 IF '$DATA(VALMY)
- DO EN^VALM2(XQORNOD(0))
- +3 SET TIUI=0
- +4 FOR
- SET TIUI=$ORDER(VALMY(TIUI))
- if +TIUI'>0
- QUIT
- Begin DoDot:1
- +5 NEW VALMY
- +6 SET TIUDATA=$GET(^TMP("TIUERRIDX",$JOB,TIUI))
- +7 SET BUFDA=+$PIECE(TIUDATA,U,3)
- +8 WRITE !!,"Resolving Event #",TIUI
- +9 SET TIUDA=+$PIECE(TIUDATA,U,2)
- +10 DO EN^VALM("TIU DISPLAY FILING EVENT")
- +11 DO RESTORE^TIULM(+$ORDER(@VALMAR@("PICK",TIUI,0)))
- End DoDot:1
- if $DATA(DIROUT)
- QUIT
- +12 WRITE !,"Refreshing the list."
- +13 MERGE TIUDI=^TMP("TIUERR",$JOB,"DIV")
- +14 DO BUILD^TIUELST($PIECE(^TMP("TIUERR",$JOB,0),U,2),$PIECE(^(0),U,3),TIUEDT,TIULDT,.TIUDI)
- +15 KILL VALMY
- if '$DATA(VALMBCK)
- SET VALMBCK="R"
- +16 QUIT
- EDIT1 ; Single record edit
- +1 ; Receives TIUDATA
- +2 NEW DIC,ERRDA,ERRTYPE,RETRY,DWPK
- KILL XQAKILL
- +3 DO FULL^VALM1
- +4 IF '$DATA(TIUPRM0)!'$DATA(TIUPRM1)
- DO SETPARM^TIULE
- +5 SET ERRDA=+$PIECE(TIUDATA,U,2)
- SET ERRTYPE=$PIECE(^TIU(8925.4,+ERRDA,0),U,8)
- +6 IF +ERRTYPE=0
- WRITE !!,"Item #",+TIUDATA," was a successful filing event."
- HANG 3
- QUIT
- +7 IF +ERRTYPE=1
- DO FILERR(ERRDA)
- +8 IF +ERRTYPE=2
- DO FLDERR(ERRDA)
- +9 QUIT
- FILERR(ERRDA) ; Resolve filing errors
- +1 NEW DIC,DIRUT,DWPK,TIUI,INQUIRE,BUFDA,TIUTYPE,RESCODE,TIUDONE
- +2 NEW TIUEVNT,TIUSKIP,ERR0,RETRY,STATUS,PRFILERR,TIUINQ
- +3 ; Set TIUEVNT for PN resolve code:
- +4 SET TIUEVNT=+ERRDA
- +5 SET TIUI=0
- SET ERR0=$GET(^TIU(8925.4,TIUEVNT,0))
- SET STATUS=$PIECE(ERR0,U,6)
- +6 IF STATUS=1
- WRITE !,"Error has already been resolved.",!
- QUIT
- +7 SET BUFDA=+$PIECE(ERR0,U,5)
- IF +BUFDA'>0
- QUIT
- +8 IF TIUEVNT
- Begin DoDot:1
- +9 SET TIUTYPE=$PIECE(ERR0,U,3)
- +10 IF $LENGTH(TIUTYPE)
- SET TIUTYPE=+$$WHATYPE^TIUPUTPN(TIUTYPE)
- +11 ; moved this call down 2 lines, added last 2 parameters *335 ajb
- DO WRITEHDR^TIUPEVNT(TIUEVNT,TIUTYPE,.TIUINQ)
- +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
- End DoDot:2
- QUIT
- +18 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 FILEX
- +19 WRITE !!,"You may now edit the buffered upload data in an attempt to resolve error:",!,$PIECE(ERR0,U,4),!
- +20 IF '$$READ^TIUU("EA","Press RETURN to continue and edit the buffer or '^' to exit: ")
- GOTO FILEX
- +21 SET DIC="^TIU(8925.2,"_+BUFDA_",""TEXT"","
- SET DWPK=1
- DO EN^DIWE
- +22 SET RETRY=$$READ^TIUU("YO","Now would you like to retry the filer","YES","^D FIL^TIUDIRH")
- +23 IF +RETRY
- Begin DoDot:1
- +24 ; Tell Patient Record Flag lookup to get flag link
- SET PRFILERR=1
- +25 DO ALERTDEL^TIUPEVNT(+BUFDA)
- DO RESOLVE^TIUPEVNT(TIUEVNT)
- +26 KILL TIUDONE
- +27 DO FILE^TIUUPLD(+BUFDA)
- +28 IF '$GET(TIUDONE)
- WRITE !,"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.",!
- HANG 5
- End DoDot:1
- FILEX ;TIU*1*81 resolving twice creates errors so don't permit.
- SET VALMBCK="Q"
- +1 QUIT
- FLDERR(EVNTDA) ; Resolve field errors
- +1 NEW DIE,DA,DR,ERRDESC,EVNTDA1,EVNTREC,TIUFIX,ERR0,STATUS
- +2 SET EVNTDA1=0
- +3 SET ERR0=^TIU(8925.4,+EVNTDA,0)
- SET STATUS=$PIECE(ERR0,U,6)
- +4 ;TIU*1*81
- IF STATUS=1
- WRITE "Error has already been resolved",!
- QUIT
- +5 SET ERRDESC=$PIECE(ERR0,U,4)
- +6 WRITE !!,"You may now enter the correct information:",!
- +7 WRITE !,ERRDESC
- +8 FOR
- SET EVNTDA1=$ORDER(^TIU(8925.4,EVNTDA,1,EVNTDA1))
- if +EVNTDA1'>0
- QUIT
- Begin DoDot:1
- +9 SET EVNTREC=$GET(^TIU(8925.4,EVNTDA,1,EVNTDA1,0))
- if +EVNTREC'>0
- QUIT
- +10 SET DIE=$PIECE(EVNTREC,U)
- SET DA=$PIECE(EVNTREC,U,2)
- +11 SET DR=$PIECE(EVNTREC,U,3)_"//"_$PIECE(EVNTREC,U,4)
- +12 ;P81 don't ask if already fixed; moved from TIUPEVNT
- IF $$FIXED^TIUPEVN1(DIE,+DA,+DR)
- QUIT
- +13 DO ^DIE
- +14 ; P81 If missing field was just corrected, delete alert for that field:
- +15 ; TIU*1*81 moved from TIUPEVNT
- SET TIUFIX=$$FIXED^TIUPEVN1(DIE,+DA,+DR)
- +16 IF +TIUFIX=1
- NEW XQAKILL,XQAID
- SET XQAKILL=0
- SET XQAID="TIUERR,"_+EVNTDA_","_+EVNTDA1
- DO DELETEA^XQALERT
- +17 ; If entry is a TIU Document, do Post-filing action and SEND^TIUALRT
- +18 IF DIE="^TIU(8925,"
- Begin DoDot:2
- +19 NEW TIUPOST,TIUREC,DR,DIE,TIUD12,TIUD13,TIUAU,TIUEC,TIUEBY
- +20 SET TIUPOST=$$POSTFILE^TIULC1(+$GET(^TIU(8925,DA,0)))
- +21 SET TIUREC("#")=DA
- +22 IF TIUPOST]""
- XECUTE TIUPOST
- IF 1
- +23 ;if not entered by the author or expected cosigner record VBC Line Count
- +24 SET TIUD12=$GET(^TIU(8925,DA,12))
- SET TIUD13=$GET(^(13))
- +25 SET TIUEBY=$PIECE(TIUD13,U,2)
- SET TIUAU=$PIECE(TIUD12,U,2)
- SET TIUEC=$PIECE(TIUD13,U,8)
- +26 IF ((+TIUEBY>0)&(+TIUAU>0))&((TIUEBY'=TIUAU)&(TIUEBY'=TIUEC))
- DO LINES^TIUSRVPT(DA)
- +27 DO SEND^TIUALRT(DA)
- End DoDot:2
- End DoDot:1
- +28 ; TIU*1*81 moved from TIUPEVNT
- DO FLDRSLV^TIUPEVN1(EVNTDA)
- +29 QUIT