source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIURE.m@ 862

Last change on this file since 862 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.8 KB
RevLine 
[613]1TIURE ; SLC/JER - Error handler actions ;3/30/05
2 ;;1.0;TEXT INTEGRATION UTILITIES;**3,21,81,131,113,184**;Jun 20, 1997
3PRINT ; Print Buffer record associated w/unresolved filing error
4 N TIUDA,TIUDATA,TIUI,DIROUT
5 I '$D(VALMY) D EN^VALM2(XQORNOD(0))
6 S TIUI=0
7 F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT)
8 . S TIUDATA=$G(^TMP("TIUERRIDX",$J,TIUI))
9 . S (TIUDA,TIUDA(TIUI))=+$P(TIUDATA,U,3) D RESTORE^TIULM(+$O(@VALMAR@("PICK",TIUI,0)))
10 . 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
11 I $D(TIUDA)'<9 D
12 . S ZTRTN="PRINT1^TIURE",ZTDESC="Print Report Buffer"
13 . D CLEAR^VALM1,DEVICE^TIUPRDS
14 . S TIUI=$$READ^TIUU("FOA","Press RETURN to continue...")
15 K VALMY S VALMBCK="R"
16 Q
17PRINT1 ; Print a single buffer record
18 N DIC,TIUI,FLDS,FR,TO,L,BY,IOP S TIUI=0
19 F S TIUI=$O(TIUDA(TIUI)) Q:+TIUI'>0 D
20 . S IOP=$S($D(ZTIO):ZTIO,$D(ION):ION,1:"") Q:IOP']""
21 . S DIC="^TIU(8925.2,",FLDS="[TIU PRINT REPORT BUFFER]",L=0
22 . S BY=.01,(FR,TO)=+$G(^TIU(8925.2,+TIUDA(TIUI),0))
23 . D EN1^DIP
24 Q
25EDIT ; Edit Buffer record associated w/unresolved filing error
26 N TIUDA,BUFDA,TIUDATA,TIUI,DIROUT,TIUDI
27 I '$D(VALMY) D EN^VALM2(XQORNOD(0))
28 S TIUI=0
29 F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT)
30 . N VALMY
31 . S TIUDATA=$G(^TMP("TIUERRIDX",$J,TIUI))
32 . S BUFDA=+$P(TIUDATA,U,3)
33 . W !!,"Resolving Event #",TIUI
34 . S TIUDA=+$P(TIUDATA,U,2)
35 . D EN^VALM("TIU DISPLAY FILING EVENT")
36 . D RESTORE^TIULM(+$O(@VALMAR@("PICK",TIUI,0)))
37 W !,"Refreshing the list."
38 M TIUDI=^TMP("TIUERR",$J,"DIV")
39 D BUILD^TIUELST($P(^TMP("TIUERR",$J,0),U,2),$P(^(0),U,3),TIUEDT,TIULDT,.TIUDI)
40 K VALMY S:'$D(VALMBCK) VALMBCK="R"
41 Q
42EDIT1 ; Single record edit
43 ; Receives TIUDATA
44 N DIC,ERRDA,ERRTYPE,RETRY,DWPK K XQAKILL
45 D FULL^VALM1
46 I '$D(TIUPRM0)!'$D(TIUPRM1) D SETPARM^TIULE
47 S ERRDA=+$P(TIUDATA,U,2),ERRTYPE=$P(^TIU(8925.4,+ERRDA,0),U,8)
48 I +ERRTYPE=0 W !!,"Item #",+TIUDATA," was a successful filing event." H 3 Q
49 I +ERRTYPE=1 D FILERR(ERRDA)
50 I +ERRTYPE=2 D FLDERR(ERRDA)
51 Q
52FILERR(ERRDA) ; Resolve filing errors
53 N TIUI,INQUIRE,BUFDA,TIUTYPE,RESCODE,TIUDONE
54 N TIUEVNT,TIUSKIP,ERR0,STATUS,PRFILERR
55 ; Set TIUEVNT for PN resolve code:
56 S TIUEVNT=+ERRDA
57 S TIUI=0,ERR0=$G(^TIU(8925.4,TIUEVNT,0)),STATUS=$P(ERR0,U,6)
58 I STATUS=1 W !,"Error has already been resolved.",! Q
59 S BUFDA=+$P(ERR0,U,5) I +BUFDA'>0 Q
60 I TIUEVNT D I +$G(TIUDONE)!$G(TIUSKIP) G FILEX
61 . D WRITEHDR^TIUPEVNT(TIUEVNT)
62 . S TIUTYPE=$P(ERR0,U,3)
63 . I $L(TIUTYPE) S TIUTYPE=+$$WHATYPE^TIUPUTPN(TIUTYPE)
64 . I TIUTYPE>0 S RESCODE=$$FIXCODE^TIULC1(+TIUTYPE)
65 . ;E S RESCODE="D GETPAT^TIUCHLP"
66 . I $G(RESCODE)]"" D Q
67 . . W ! S INQUIRE=$$READ^TIUU("YO","Inquire to patient record","YES","^D INQRHELP^TIUPEVNT")
68 . . I $D(DIRUT) S TIUSKIP=1 Q
69 . . I +INQUIRE X RESCODE
70 . W !!,"Filing error resolution code could not found for this document type.",!,"Please edit the buffered data directly and refile."
71 W !!,"You may now edit the buffered upload data in an attempt to resolve error:",!,$P(ERR0,U,4),!
72 I '$$READ^TIUU("EA","Press RETURN to continue and edit the buffer or '^' to exit: ") G FILEX
73 S DIC="^TIU(8925.2,"_+BUFDA_",""TEXT"",",DWPK=1 D EN^DIWE
74 S RETRY=$$READ^TIUU("YO","Now would you like to retry the filer","YES","^D FIL^TIUDIRH")
75 I +RETRY D
76 . S PRFILERR=1 ; Tell Patient Record Flag lookup to get flag link
77 . D ALERTDEL^TIUPEVNT(+BUFDA),RESOLVE^TIUPEVNT(TIUEVNT)
78 . K TIUDONE
79 . D FILE^TIUUPLD(+BUFDA)
80 . 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
81FILEX S VALMBCK="Q" ;TIU*1*81 resolving twice creates errors so don't permit.
82 Q
83FLDERR(EVNTDA) ; Resolve field errors
84 N DIE,DA,DR,ERRDESC,EVNTDA1,EVNTREC,TIUFIX,ERR0,STATUS
85 S EVNTDA1=0
86 S ERR0=^TIU(8925.4,+EVNTDA,0),STATUS=$P(ERR0,U,6)
87 I STATUS=1 W "Error has already been resolved",! Q ;TIU*1*81
88 S ERRDESC=$P(ERR0,U,4)
89 W !!,"You may now enter the correct information:",!
90 W !,ERRDESC
91 F S EVNTDA1=$O(^TIU(8925.4,EVNTDA,1,EVNTDA1)) Q:+EVNTDA1'>0 D
92 . S EVNTREC=$G(^TIU(8925.4,EVNTDA,1,EVNTDA1,0)) Q:+EVNTREC'>0
93 . S DIE=$P(EVNTREC,U),DA=$P(EVNTREC,U,2)
94 . S DR=$P(EVNTREC,U,3)_"//"_$P(EVNTREC,U,4)
95 . I $$FIXED^TIUPEVN1(DIE,+DA,+DR) Q ;P81 don't ask if already fixed; moved from TIUPEVNT
96 . D ^DIE
97 . ; P81 If missing field was just corrected, delete alert for that field:
98 . S TIUFIX=$$FIXED^TIUPEVN1(DIE,+DA,+DR) ; TIU*1*81 moved from TIUPEVNT
99 . I +TIUFIX=1 N XQAKILL,XQAID S XQAKILL=0,XQAID="TIUERR,"_+EVNTDA_","_+EVNTDA1 D DELETEA^XQALERT
100 . ; If entry is a TIU Document, do Post-filing action and SEND^TIUALRT
101 . I DIE="^TIU(8925," D
102 . . N TIUPOST,TIUREC,DR,DIE
103 . . S TIUPOST=$$POSTFILE^TIULC1(+$G(^TIU(8925,DA,0)))
104 . . S TIUREC("#")=DA
105 . . I TIUPOST]"" X TIUPOST I 1
106 . . D SEND^TIUALRT(DA)
107 D FLDRSLV^TIUPEVN1(EVNTDA) ; TIU*1*81 moved from TIUPEVNT
108 Q
Note: See TracBrowser for help on using the repository browser.