source: FOIAVistA/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUFIX1.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 8.3 KB
Line 
1TIUFIX1 ; SLC/JER - Resolve Upload Filing Errors Library One ;05/06/2002
2 ;;1.0;TEXT INTEGRATION UTILITIES;**131**;Jun 20, 1997
3 ;
4 ;MAKE is intended to be called by the filing error resolution
5 ;code for various types of documents being uploaded into TIU.
6 ;It is intended to be used in conjunction with a GETCHECK
7 ;module written specifically for the particular type of
8 ;document being uploaded. For examples of its use, see
9 ;TIUPNFIX and TIUCNFIX.
10 ;Since types of documents evolve and change, MAKE must be tested
11 ;for each new type of document which uses it, and may require
12 ;changes.
13 ;MAKE takes a stub IEN or pt/visit/title info, locates or creates
14 ;a TIU document, and attempts to complete the upload process
15 ;for that document.
16 ; **WARNING**
17 ;MAKE calls FILE, which files ALL NODES of TIUFLDS which it
18 ;receives. If data already exist for a given field, such filing
19 ;OVERWRITES the existing value with a possibly erroneous,
20 ;transcribed value. To prevent such overwriting of critical
21 ;fields, MAKE kills certain nodes of TIUFLDS just before calling
22 ;FILE. Nodes killed in MAKE include .01, .02, .07, and 1301,
23 ;which were NOT previously killed when the header info was
24 ;loaded into array TIUHDR. (LOADHDR^TIUFIX2 does NOT kill nodes,
25 ;in contrast to LOADTIUX^TIUPEFIX.)
26 ;Certain document types may NEED TO KILL ADDITIONAL NODES of
27 ;TIUFLDS. For example, if a document type uploads into an
28 ;existing stub which already HAS a Requesting Package value,
29 ;that document type should also kill node 1405 of TIUFLDS to
30 ;ensure that the existing Requesting Package data is not
31 ;overwritten with possibly erroneous, transcribed Requesting
32 ;Package data. Such nodes of TIUFLDS can be killed
33 ;before calling MAKE.
34MAKE(SUCCESS,TIUEVNT,TIUBUF,TIUTYPE,TIUFLDS,DFN,TITLDA,TIU,TIUPRM0,TIUSTUB) ; File
35 ;new TIU Document or use stub docmt
36 ; SUCCESS = (by ref) Returns TIU DOCUMENT # (PTR to 8925) or
37 ; = 0^Explanatory message if no SUCCESS. Required.
38 ; DFN = Patient (#2). Required if no stub.
39 ; TITLDA = Pointer to TIU Document Definition (#8925.1). Required
40 ; if no stub.
41 ; TIU = Array of demographic and visit attributes. Required if
42 ; no stub.
43 ; TIUEVNT = Record number (ien) of event in TIU Upload Log
44 ; file (#8925.4). Required.
45 ; TIUTYPE = IEN of docmt def whose Filing Error Resolution Code
46 ; is being invoked. Required.
47 ; TIUFLDS = Array of field data from upload buffer. Required.
48 ; MAKE kills certain nodes of TIUFLDS. Additional
49 ; nodes may need to be killed before calling MAKE.
50 ; See warning, above.
51 ; TIUPRM0 = String of upload params like hdr signal. See
52 ; SETPARM^TIULE. Required
53 ; TIUSTUB = Valid Record number of stub document. Required
54 ; if file is being uploaded into a stub
55 ; document. MAKE assumes flds stuffed in
56 ; STUFREC^TIUPEFIX already exist in stub. Assumes
57 ; stub is NOT an addendum.
58 ;
59 ; -- first, get TIU Document record:
60 ;
61 N TIUDA,LDT,NEWREC,TIUX,TIUTYP,TIUDPRM,TIUCLASS,TIUDTYP,TIUPOST
62 N TIUDFLT,TIUREC,TITL1,TIUADD
63 ; -- If no docmt type or Upload event, or target file
64 ; is not 8925, QUIT:
65 I '$G(TIUTYPE)!'$G(TIUEVNT) S SUCCESS="0^Document type and Upload Log Event Required." Q
66 I +$G(^TIU(8925.1,+TIUTYPE,1))'=8925 S SUCCESS="0^Target file not 8925." Q
67 ; -- If stub IEN is not defined, create new record with user-
68 ; supplied pt/visit/title info (or return an existing docmt):
69 I '$G(TIUSTUB) D Q:$P($G(SUCCESS),U)=0
70 . I $S($D(TIU)'>9:1,+$G(DFN)'>0:1,+$G(TITLDA)'>0:1,1:0) S SUCCESS="0^Invalid Patient, Visit, or Title." Q
71 . S TITL1=1_U_TITLDA
72 . D DOCPRM^TIULC1(TITLDA,.TIUDPRM)
73 . ; -- NOTE: If GETRECNW finds existing documents which have
74 . ; requesting packages (e.g. Consults), it ignores them
75 . ; and returns exclusively new documents.
76 . S TIUDA=$$GETRECNW^TIUEDI3(DFN,.TIU,TITL1,.NEWREC,.TIUDPRM)
77 . I +TIUDA'>0 S SUCCESS="0^Document could not be filed even though data appear complete and consistent."
78 ; -- If stub IEN is defined, set docmt IEN = stub
79 I $G(TIUSTUB) D Q:$P($G(SUCCESS),U)=0
80 . I $D(^TIU(8925,TIUSTUB,0)) S TIUDA=TIUSTUB Q
81 . S SUCCESS="0^The stub document does not exist in TIU."
82 ; -- Leave lock til later; check GUI - when does it lock? 4/21/02
83 ; -- Lock Document:
84 ;L +^TIU(8925,TIUDA):1
85 ;E S SUCCESS="0^Document is being edited by another user; please try again later." Q
86 ; -- If docmt is not new (new docmts leave GETRECNW already
87 ; released) and is already released, create an addendum
88 ; (addm does its own stuffing, filing, ... post filing):
89 I '$G(NEWREC),+$P(^TIU(8925,TIUDA,0),U,5)'<4 D Q:$P($G(SUCCESS),U)=0 G MAKEX
90 . D MAKEADD(.TIUADD,+TIUDA,TIUBUF,.TIUFLDS,TIUPRM0)
91 . S SUCCESS=TIUADD
92 . I SUCCESS S TIUDA=+TIUADD ;browse addm, not docmt
93 S SUCCESS=1
94 ; -- Stuff visit-related data:
95 I '$G(TIUSTUB) D STUFREC^TIUPEFIX(TIUDA,$G(DFN),0,.TIU) ;0 parent
96 ; -- Kill header array nodes that have already been filed
97 ; in GETRECNW^TIUEDI3 or STUFREC^TIUPEFIX and which mustn't
98 ; be overwritten with possibly erroneous, transcribed data:
99 K TIUFLDS(.01),TIUFLDS(.02),TIUFLDS(.03),TIUFLDS(.05),TIUFLDS(.07)
100 K TIUFLDS(.13),TIUFLDS(1205),TIUFLDS(1211),TIUFLDS(1301)
101 ; -- File transcribed header fields (those not killed) in Document
102 ; and create missing field errors:
103 D FILE(+TIUDA,.TIUFLDS,TITLDA)
104 ; -- Load transcribed text into TIUX array and merge into TEMP array:
105 D LOADTEXT(.TIUX,TIUBUF,TIUPRM0)
106 K ^TIU(8925,+TIUDA,"TEMP")
107 M ^TIU(8925,+TIUDA,"TEMP")=TIUX("TEXT")
108 ; -- File text in Document:
109 I '$D(TIU) D GETTIU^TIULD(.TIU,+TIUDA)
110 D MERGTEXT^TIUEDI1(+TIUDA,.TIU)
111 S TIUPOST=$$POSTFILE^TIULC1(TITLDA)
112 S TIUREC("#")=TIUDA
113 I TIUPOST]"" X TIUPOST
114MAKEX D ALERTDEL^TIUPEVNT(+TIUBUF)
115 D RESOLVE^TIUPEVNT(TIUEVNT,1)
116 D BUFPURGE^TIUPUTC(+TIUBUF)
117 K ^TIU(8925,+TIUDA,"TEMP") W "Done."
118 ;L -^TIU(8925,TIUDA)
119 I +$G(TIUDA),+$D(^TIU(8925,+$G(TIUDA),0)) D
120 . N TIU D GETTIU^TIULD(.TIU,+TIUDA)
121 . D EN^VALM("TIU BROWSE FOR MRT")
122 Q
123LOADTEXT(TIUARR,TIUBUF,TIUPRM0) ; Load array TIUARR with text
124 N TIUI,TIUBGN,TIULINE
125 S TIUBGN=$P(TIUPRM0,U,12)
126 S TIUI=0 F S TIUI=$O(^TIU(8925.2,+TIUBUF,"TEXT",TIUI)) Q:+TIUI'>0 D
127 . S TIULINE=$G(^TIU(8925.2,+TIUBUF,"TEXT",TIUI,0))
128 . I TIULINE[TIUBGN D
129 . . N TIUJ S TIUJ=0
130 . . F D Q:+TIUI'>0
131 . . . S TIUI=$O(^TIU(8925.2,+TIUBUF,"TEXT",TIUI)) Q:+TIUI'>0
132 . . . S TIUJ=TIUJ+1
133 . . . S TIUARR("TEXT",TIUJ,0)=$G(^TIU(8925.2,+TIUBUF,"TEXT",TIUI,0))
134 Q
135MAKEADD(TIUDADD,TIUDA,TIUBUF,TIUFLDS,TIUPRM0) ; Create an addendum record
136 ; [TIUDADD] - passed back = IEN of addm to docmt TIUDA
137 N DIE,DR,DA,DIC,X,Y,DLAYGO,TIUATYP,TIUCAN,TIUFPRIV,TIU,TIUX S TIUFPRIV=1
138 N TIUDTTL,TIUPOST,TIUREC
139 S TIUDTTL=+$G(^TIU(8925,+TIUDA,0))
140 S TIUATYP=+$$WHATITLE^TIUPUTU("ADDENDUM")
141 S (DIC,DLAYGO)=8925,DIC(0)="L",X=""""_"`"_TIUATYP_""""
142 D ^DIC
143 S TIUDADD=+Y
144 I +Y'>0 S TIUDADD="0^Could not create addendum." Q
145 D GETTIU^TIULD(.TIU,TIUDA)
146 S TIU("DOCTYP")=TIUATYP_U_$$PNAME^TIULC1(TIUATYP)
147 D STUFREC^TIUPEFIX(TIUDADD,DFN,+TIUDA,.TIU)
148 ; -- Kill header array nodes that have already been filed
149 ; when addm created or in STUFREC^TIUPEFIX, and which mustn't
150 ; be overwritten with possibly erroneous, transcribed data:
151 K TIUFLDS(.01),TIUFLDS(.02),TIUFLDS(.07),TIUFLDS(1301)
152 ; -- File header fields in addendum record:
153 D FILE(+TIUDADD,.TIUFLDS,TIUATYP)
154 ; -- Load text into TIUX array and merge into TEMP array:
155 D LOADTEXT(.TIUX,TIUBUF,TIUPRM0)
156 K ^TIU(8925,+TIUDADD,"TEMP")
157 M ^TIU(8925,+TIUDADD,"TEMP")=TIUX("TEXT")
158 ; -- File text in addendum record:
159 D MERGTEXT^TIUEDI1(+TIUDADD,.TIU)
160 S TIUPOST=$$POSTFILE^TIULC1(TIUDTTL)
161 S TIUREC("#")=TIUDADD
162 I TIUPOST]"" X TIUPOST
163 Q
164FILE(TIUDA,TIUFLDS,RTYPE) ; File header data; set missing field
165 ;alerts for fields that fail to file
166 ; [TIUDA] - IEN of 8925 document
167 ; [TIUFLDS] - array of header data from upload buffer record.
168 ; ALL nodes received by FILE will be filed. See
169 ; warning for MAKE, concerning possible overwriting
170 ; of good data with faulty data.
171 ; [RTYPE] - Record type, i.e. IEN of 8925.1 title of docmt
172 N FDA,FDARR,IENS,FLAGS,TIUMSG,MSG,REQMSG
173 S IENS=""""_TIUDA_",""",FDARR="FDA(8925,"_IENS_")",FLAGS="KE"
174 M @FDARR=TIUFLDS
175 D FILE^DIE(FLAGS,"FDA","TIUMSG") ; File record
176 I $D(TIUMSG)>9 D
177 . D MAIN^TIUPEVNT(TIUBUF,2,"",$P($G(^TIU(8925.1,+RTYPE,0)),U),.FDA,.TIUMSG)
178 Q
Note: See TracBrowser for help on using the repository browser.