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 Dec 13, 2024@02:45:13 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
