source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUPEVN1.m@ 1800

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

initial load of WorldVistAEHR
File size: 5.4 KB
Line 
1TIUPEVN1 ; SLC/JER - Event logger Cont'd ;21-OCT-1999 10:47:05
2 ;;1.0;TEXT INTEGRATION UTILITIES;**81**;Jun 20, 1997
3 ;
4FIELDS(EVNTDA,MSG) ; ---- Log missing/incorrect field errors for
5 ; specific fields in UPLOAD LOG file (#8925.4),
6 ; in multiple fl. TIU*1*81 moved from TIUPEVNT
7 N TIUI S TIUI=0
8 F S TIUI=$O(MSG("DIERR",TIUI)) Q:+TIUI'>0 D
9 . N DA,DR,DIC,DIE,DLAYGO S DIC="^TIU(8925.4,"_EVNTDA_",1,",DIC(0)="L"
10 . I '$D(MSG("DIERR",TIUI,"PARAM","FILE")) Q
11 . S ^TIU(8925.4,EVNTDA,1,0)="^8925.42^^",DA(1)=EVNTDA
12 . S DLAYGO=8925.42,X=""""_MSG("DIERR",TIUI,"PARAM","FILE")_""""
13 . D ^DIC Q:+Y'>0
14 . S DIE=DIC,DA(1)=EVNTDA,DA=+Y
15 . S DR=".02///"_+$G(MSG("DIERR",TIUI,"PARAM","IENS"))_";.03///"_$G(MSG("DIERR",TIUI,"PARAM","FIELD"))_";.04///"_$G(MSG("DIERR",TIUI,"PARAM",3))
16 . D ^DIE,FLDALRT(EVNTDA,DA,$P($G(^TIU(8925.4,+EVNTDA,0)),U,4))
17 Q
18FLDALRT(EVNTDA,EVNTDA1,ERRMSG) ; ---- Send alerts for missing field errors
19 ; TIU*1*81 moved from TIUPEVNT
20 N XQA,XQAID,XQADATA,XQAMSG,XQAKILL,XQAROU,TIUI,TIUSUB,TYPE,EVNTDA10
21 N NOTEDA
22 ; ---- TIU*1*81 If this is a TIU docmt, get its title for TYPE
23 S EVNTDA10=$G(^TIU(8925.4,EVNTDA,1,EVNTDA1,0))
24 I $P(EVNTDA10,U)=8925 D
25 . S NOTEDA=$P(EVNTDA10,U,2),NOTE0=$G(^TIU(8925,NOTEDA,0)),TYPE=+NOTE0
26 . ; ---- TIU*1*81 If note is addendum, get type of parent note instead
27 . I +$$ISADDNDM^TIULC1(NOTEDA) S TYPE=+$$DADTYPE^TIUPUTC(NOTEDA)
28 ; ---- else get TYPE from $HDR line, e.g. Progress Notes (3)
29 I $G(TYPE)'>0 S TYPE=+$G(TIUREC("TYPE"))
30 I TYPE D WHOGETS^TIUPEVN1(.XQA,TYPE)
31 ; ---- If no docmt def param recipients found, try site recipients
32 I $D(XQA)'>9 D
33 . S TIUI=$O(^TIU(8925.99,"B",+$G(DUZ(2)),0)) S:+TIUI'>0 TIUI=+$O(^TIU(8925.99,0))
34 . S TIUSUB=0 F S TIUSUB=$O(^TIU(8925.99,+TIUI,2,TIUSUB)) Q:TIUSUB'>0 D
35 . . S XQA($G(^TIU(8925.99,+TIUI,2,TIUSUB,0)))=""
36 Q:$D(XQA)'>9
37 S XQAID="TIUERR"_","_EVNTDA_","_EVNTDA1
38 S XQAMSG=ERRMSG
39 W:'$D(ZTQUEUED) !!,XQAMSG
40 S XQADATA=ERRMSG_";"_EVNTDA_";"_EVNTDA1
41 S XQAROU="FLDISP^TIUPEVN1" ; TIU*1*81 moved from TIUPEVNT
42 D SETUP^XQALERT
43 Q
44FLDISP ; ---- Alert follow-up action for missing field errors
45 ; TIU*1*81 moved from TIUPEVNT
46 N DIE,DA,DR,EVNTDA,EVNTDA1,EVNTREC,TIUFIX,TIULINK S TIUFIX=0
47 S EVNTDA=+$P(XQADATA,";",2),EVNTDA1=+$P(XQADATA,";",3)
48 S EVNTREC=$G(^TIU(8925.4,EVNTDA,1,EVNTDA1,0)) Q:+EVNTREC'>0
49 S DIE=$P(EVNTREC,U),DA=$P(EVNTREC,U,2)
50 S DR=$P(EVNTREC,U,3)_"//"_$P(EVNTREC,U,4)
51 S TIUFIX=$$FIXED(DIE,+DA,+DR)
52 I +TIUFIX>0 D Q
53 . W:TIUFIX=1 !!,"Missing field already filled in by another method..."
54 . W:TIUFIX=2 !!,"Record #",DA," has been deleted by an authorized user..."
55 . W !," Nothing left to resolve." H 3
56 . S XQAKILL=0 D FLDRSLV(EVNTDA)
57 W !!,"You may now enter the correct information:",!
58 W !,$P(XQADATA,";"),!
59 D RECDISP(DIE,DA)
60 I DIE=8925,(+DR=1405) D
61 . N TIUREASX,TIUDA
62 . S TIUDA=+DA
63 . S TIUREASX=$$REASSIGN^TIULC1(+$G(^TIU(8925,+TIUDA,0)))
64 . I TIUREASX]"" X TIUREASX S TIULINK=1
65 I '+$G(TIULINK) D ^DIE
66 ; ---- If TIU Document, do post-filing action send signature alerts
67 I DIE="^TIU(8925," D
68 . N TIUREC,TIUPOST,DR,DIE,TYPE
69 . S TYPE=$S(+$$ISADDNDM^TIULC1(DA):+$G(^TIU(8925,+$P(^TIU(8925,DA,0),U,6),0)),1:+$G(^TIU(8925,DA,0)))
70 . S TIUPOST=$$POSTFILE^TIULC1(TYPE)
71 . S TIUREC("#")=DA
72 . I TIUPOST]"" X TIUPOST I 1
73 . D SEND^TIUALRT(DA)
74 S TIUFIX=$$FIXED(DIE,+DA,+DR)
75 I +$G(TIUFIX)'>0 K XQAKILL Q
76 S XQAKILL=0
77 ; ---- If field is fixed, evaluate whether whole event is resolved
78 D FLDRSLV(EVNTDA)
79 Q
80RECDISP(DIC,DA) ; ---- Call DIQ to display the existing record
81 ; TIU*1*81 moved from TIUPEVNT
82 N X,Y,DIQ,DR
83 I '+$$READ^TIUU("Y","Display ENTIRE existing record","NO") Q
84 W ! S DIC=$G(^DIC(DIC,0,"GL"))
85 D EN^DIQ
86 Q
87FIXED(DIC,DA,DR) ; ---- Evaluate whether the field has been filled in
88 ; TIU*1*81 moved from TIUPEVNT
89 N DIQ,X,Y,TIUY,TIUFIX S TIUY=0,DIQ="TIUFIX",DIQ(0)="IN"
90 I '$D(^TIU(8925,DA,0)) S TIUY=2 G FIXX
91 D EN^DIQ1 I $D(TIUFIX) S TIUY=1
92FIXX Q TIUY
93FLDRSLV(ERRDA) ; ---- Evaluate missing field errors; mark resolved
94 ; TIU*1*81 moved from TIUPEVNT
95 N TIUK,TIUFLD,RSLVED
96 S TIUK=0,RSLVED=1
97 ; ---- TIU*1*81 Mark resolved only if ALL missing fields are fixed
98 F S TIUK=$O(^TIU(8925.4,+ERRDA,1,TIUK)) Q:+TIUK'>0 Q:'RSLVED D
99 . N DIC,DIQ,DA,DR S DA=TIUK,DIC="^TIU(8925.4,"_+ERRDA_",1,"
100 . S DR=".01:.04",DIQ="TIUFLD(" D EN^DIQ1 Q:$D(TIUFLD)'>9
101 . I '$$FIXED(8925,+$G(TIUFLD(8925.42,DA,.02)),+$G(TIUFLD(8925.42,DA,.03)))=1 S RSLVED=0
102 Q:'RSLVED
103 N DIE,DR
104 S DA=+ERRDA,DIE=8925.4,DR=".06////1;.07////"_$$NOW^TIULC D ^DIE
105 Q
106 ;
107WHOGETS(TIUY,TIUTYP) ; ---- Who gets filing error/missing field alerts;
108 ; Get 8925.95 (document parameter) recipients.
109 ; ---- TIUTYP is title IFN in 8925.1 if valid title was uploaded, else
110 ; is IFN of entry from $HDR line: e.g. PROGRESS NOTES
111 ; Starts at initial TIUTYP; goes up hierarchy til it finds entry.
112 ; ---- TIU*1*81 Don't new TIUDAD HERE!
113 N TIUI,TIUJ
114 ; ---- TIU*1*81 TIUTITLE is killed before missing fld alerts are sent,
115 ; so don't use it here
116 Q:+$G(TIUTYP)'>0
117 S TIUI=$O(^TIU(8925.95,"B",+TIUTYP,0))
118 ; ---- If TIUTYP has docmt parameter, get recipients and don't look
119 ; further up:
120 I +TIUI D Q
121 . S TIUJ=0
122 . F S TIUJ=$O(^TIU(8925.95,+TIUI,4,+TIUJ)) Q:+TIUJ'>0 D
123 . . N TIUDUZ
124 . . S TIUDUZ=+$G(^TIU(8925.95,+TIUI,4,+TIUJ,0)) Q:+TIUDUZ'>0
125 . . S TIUY(TIUDUZ)=""
126 ; ---- If none found, try further up
127 S TIUDAD=$O(^TIU(8925.1,"AD",+TIUTYP,0))
128 I +TIUDAD D WHOGETS(.TIUY,TIUDAD)
129 Q
Note: See TracBrowser for help on using the repository browser.