TIUFIX1 ; SLC/JER - Resolve Upload Filing Errors Library One ;05/06/2002
;;1.0;TEXT INTEGRATION UTILITIES;**131**;Jun 20, 1997
;
;MAKE is intended to be called by the filing error resolution
;code for various types of documents being uploaded into TIU.
;It is intended to be used in conjunction with a GETCHECK
;module written specifically for the particular type of
;document being uploaded. For examples of its use, see
;TIUPNFIX and TIUCNFIX.
;Since types of documents evolve and change, MAKE must be tested
;for each new type of document which uses it, and may require
;changes.
;MAKE takes a stub IEN or pt/visit/title info, locates or creates
;a TIU document, and attempts to complete the upload process
;for that document.
; **WARNING**
;MAKE calls FILE, which files ALL NODES of TIUFLDS which it
;receives. If data already exist for a given field, such filing
;OVERWRITES the existing value with a possibly erroneous,
;transcribed value. To prevent such overwriting of critical
;fields, MAKE kills certain nodes of TIUFLDS just before calling
;FILE. Nodes killed in MAKE include .01, .02, .07, and 1301,
;which were NOT previously killed when the header info was
;loaded into array TIUHDR. (LOADHDR^TIUFIX2 does NOT kill nodes,
;in contrast to LOADTIUX^TIUPEFIX.)
;Certain document types may NEED TO KILL ADDITIONAL NODES of
;TIUFLDS. For example, if a document type uploads into an
;existing stub which already HAS a Requesting Package value,
;that document type should also kill node 1405 of TIUFLDS to
;ensure that the existing Requesting Package data is not
;overwritten with possibly erroneous, transcribed Requesting
;Package data. Such nodes of TIUFLDS can be killed
;before calling MAKE.
MAKE(SUCCESS,TIUEVNT,TIUBUF,TIUTYPE,TIUFLDS,DFN,TITLDA,TIU,TIUPRM0,TIUSTUB) ; File
;new TIU Document or use stub docmt
; SUCCESS = (by ref) Returns TIU DOCUMENT # (PTR to 8925) or
; = 0^Explanatory message if no SUCCESS. Required.
; DFN = Patient (#2). Required if no stub.
; TITLDA = Pointer to TIU Document Definition (#8925.1). Required
; if no stub.
; TIU = Array of demographic and visit attributes. Required if
; no stub.
; TIUEVNT = Record number (ien) of event in TIU Upload Log
; file (#8925.4). Required.
; TIUTYPE = IEN of docmt def whose Filing Error Resolution Code
; is being invoked. Required.
; TIUFLDS = Array of field data from upload buffer. Required.
; MAKE kills certain nodes of TIUFLDS. Additional
; nodes may need to be killed before calling MAKE.
; See warning, above.
; TIUPRM0 = String of upload params like hdr signal. See
; SETPARM^TIULE. Required
; TIUSTUB = Valid Record number of stub document. Required
; if file is being uploaded into a stub
; document. MAKE assumes flds stuffed in
; STUFREC^TIUPEFIX already exist in stub. Assumes
; stub is NOT an addendum.
;
; -- first, get TIU Document record:
;
N TIUDA,LDT,NEWREC,TIUX,TIUTYP,TIUDPRM,TIUCLASS,TIUDTYP,TIUPOST
N TIUDFLT,TIUREC,TITL1,TIUADD
; -- If no docmt type or Upload event, or target file
; is not 8925, QUIT:
I '$G(TIUTYPE)!'$G(TIUEVNT) S SUCCESS="0^Document type and Upload Log Event Required." Q
I +$G(^TIU(8925.1,+TIUTYPE,1))'=8925 S SUCCESS="0^Target file not 8925." Q
; -- If stub IEN is not defined, create new record with user-
; supplied pt/visit/title info (or return an existing docmt):
I '$G(TIUSTUB) D Q:$P($G(SUCCESS),U)=0
. 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
. S TITL1=1_U_TITLDA
. D DOCPRM^TIULC1(TITLDA,.TIUDPRM)
. ; -- NOTE: If GETRECNW finds existing documents which have
. ; requesting packages (e.g. Consults), it ignores them
. ; and returns exclusively new documents.
. S TIUDA=$$GETRECNW^TIUEDI3(DFN,.TIU,TITL1,.NEWREC,.TIUDPRM)
. I +TIUDA'>0 S SUCCESS="0^Document could not be filed even though data appear complete and consistent."
; -- If stub IEN is defined, set docmt IEN = stub
I $G(TIUSTUB) D Q:$P($G(SUCCESS),U)=0
. I $D(^TIU(8925,TIUSTUB,0)) S TIUDA=TIUSTUB Q
. S SUCCESS="0^The stub document does not exist in TIU."
; -- Leave lock til later; check GUI - when does it lock? 4/21/02
; -- Lock Document:
;L +^TIU(8925,TIUDA):1
;E S SUCCESS="0^Document is being edited by another user; please try again later." Q
; -- If docmt is not new (new docmts leave GETRECNW already
; released) and is already released, create an addendum
; (addm does its own stuffing, filing, ... post filing):
I '$G(NEWREC),+$P(^TIU(8925,TIUDA,0),U,5)'<4 D Q:$P($G(SUCCESS),U)=0 G MAKEX
. D MAKEADD(.TIUADD,+TIUDA,TIUBUF,.TIUFLDS,TIUPRM0)
. S SUCCESS=TIUADD
. I SUCCESS S TIUDA=+TIUADD ;browse addm, not docmt
S SUCCESS=1
; -- Stuff visit-related data:
I '$G(TIUSTUB) D STUFREC^TIUPEFIX(TIUDA,$G(DFN),0,.TIU) ;0 parent
; -- Kill header array nodes that have already been filed
; in GETRECNW^TIUEDI3 or STUFREC^TIUPEFIX and which mustn't
; be overwritten with possibly erroneous, transcribed data:
K TIUFLDS(.01),TIUFLDS(.02),TIUFLDS(.03),TIUFLDS(.05),TIUFLDS(.07)
K TIUFLDS(.13),TIUFLDS(1205),TIUFLDS(1211),TIUFLDS(1301)
; -- File transcribed header fields (those not killed) in Document
; and create missing field errors:
D FILE(+TIUDA,.TIUFLDS,TITLDA)
; -- Load transcribed text into TIUX array and merge into TEMP array:
D LOADTEXT(.TIUX,TIUBUF,TIUPRM0)
K ^TIU(8925,+TIUDA,"TEMP")
M ^TIU(8925,+TIUDA,"TEMP")=TIUX("TEXT")
; -- File text in Document:
I '$D(TIU) D GETTIU^TIULD(.TIU,+TIUDA)
D MERGTEXT^TIUEDI1(+TIUDA,.TIU)
S TIUPOST=$$POSTFILE^TIULC1(TITLDA)
S TIUREC("#")=TIUDA
I TIUPOST]"" X TIUPOST
MAKEX D ALERTDEL^TIUPEVNT(+TIUBUF)
D RESOLVE^TIUPEVNT(TIUEVNT,1)
D BUFPURGE^TIUPUTC(+TIUBUF)
K ^TIU(8925,+TIUDA,"TEMP") W "Done."
;L -^TIU(8925,TIUDA)
I +$G(TIUDA),+$D(^TIU(8925,+$G(TIUDA),0)) D
. N TIU D GETTIU^TIULD(.TIU,+TIUDA)
. D EN^VALM("TIU BROWSE FOR MRT")
Q
LOADTEXT(TIUARR,TIUBUF,TIUPRM0) ; Load array TIUARR with text
N TIUI,TIUBGN,TIULINE
S TIUBGN=$P(TIUPRM0,U,12)
S TIUI=0 F S TIUI=$O(^TIU(8925.2,+TIUBUF,"TEXT",TIUI)) Q:+TIUI'>0 D
. S TIULINE=$G(^TIU(8925.2,+TIUBUF,"TEXT",TIUI,0))
. I TIULINE[TIUBGN D
. . N TIUJ S TIUJ=0
. . F D Q:+TIUI'>0
. . . S TIUI=$O(^TIU(8925.2,+TIUBUF,"TEXT",TIUI)) Q:+TIUI'>0
. . . S TIUJ=TIUJ+1
. . . S TIUARR("TEXT",TIUJ,0)=$G(^TIU(8925.2,+TIUBUF,"TEXT",TIUI,0))
Q
MAKEADD(TIUDADD,TIUDA,TIUBUF,TIUFLDS,TIUPRM0) ; Create an addendum record
; [TIUDADD] - passed back = IEN of addm to docmt TIUDA
N DIE,DR,DA,DIC,X,Y,DLAYGO,TIUATYP,TIUCAN,TIUFPRIV,TIU,TIUX S TIUFPRIV=1
N TIUDTTL,TIUPOST,TIUREC
S TIUDTTL=+$G(^TIU(8925,+TIUDA,0))
S TIUATYP=+$$WHATITLE^TIUPUTU("ADDENDUM")
S (DIC,DLAYGO)=8925,DIC(0)="L",X=""""_"`"_TIUATYP_""""
D ^DIC
S TIUDADD=+Y
I +Y'>0 S TIUDADD="0^Could not create addendum." Q
D GETTIU^TIULD(.TIU,TIUDA)
S TIU("DOCTYP")=TIUATYP_U_$$PNAME^TIULC1(TIUATYP)
D STUFREC^TIUPEFIX(TIUDADD,DFN,+TIUDA,.TIU)
; -- Kill header array nodes that have already been filed
; when addm created or in STUFREC^TIUPEFIX, and which mustn't
; be overwritten with possibly erroneous, transcribed data:
K TIUFLDS(.01),TIUFLDS(.02),TIUFLDS(.07),TIUFLDS(1301)
; -- File header fields in addendum record:
D FILE(+TIUDADD,.TIUFLDS,TIUATYP)
; -- Load text into TIUX array and merge into TEMP array:
D LOADTEXT(.TIUX,TIUBUF,TIUPRM0)
K ^TIU(8925,+TIUDADD,"TEMP")
M ^TIU(8925,+TIUDADD,"TEMP")=TIUX("TEXT")
; -- File text in addendum record:
D MERGTEXT^TIUEDI1(+TIUDADD,.TIU)
S TIUPOST=$$POSTFILE^TIULC1(TIUDTTL)
S TIUREC("#")=TIUDADD
I TIUPOST]"" X TIUPOST
Q
FILE(TIUDA,TIUFLDS,RTYPE) ; File header data; set missing field
;alerts for fields that fail to file
; [TIUDA] - IEN of 8925 document
; [TIUFLDS] - array of header data from upload buffer record.
; ALL nodes received by FILE will be filed. See
; warning for MAKE, concerning possible overwriting
; of good data with faulty data.
; [RTYPE] - Record type, i.e. IEN of 8925.1 title of docmt
N FDA,FDARR,IENS,FLAGS,TIUMSG,MSG,REQMSG
S IENS=""""_TIUDA_",""",FDARR="FDA(8925,"_IENS_")",FLAGS="KE"
M @FDARR=TIUFLDS
D FILE^DIE(FLAGS,"FDA","TIUMSG") ; File record
I $D(TIUMSG)>9 D
. D MAIN^TIUPEVNT(TIUBUF,2,"",$P($G(^TIU(8925.1,+RTYPE,0)),U),.FDA,.TIUMSG)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUFIX1 8631 printed Nov 22, 2024@17:50:53 Page 2
TIUFIX1 ; SLC/JER - Resolve Upload Filing Errors Library One ;05/06/2002
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**131**;Jun 20, 1997
+2 ;
+3 ;MAKE is intended to be called by the filing error resolution
+4 ;code for various types of documents being uploaded into TIU.
+5 ;It is intended to be used in conjunction with a GETCHECK
+6 ;module written specifically for the particular type of
+7 ;document being uploaded. For examples of its use, see
+8 ;TIUPNFIX and TIUCNFIX.
+9 ;Since types of documents evolve and change, MAKE must be tested
+10 ;for each new type of document which uses it, and may require
+11 ;changes.
+12 ;MAKE takes a stub IEN or pt/visit/title info, locates or creates
+13 ;a TIU document, and attempts to complete the upload process
+14 ;for that document.
+15 ; **WARNING**
+16 ;MAKE calls FILE, which files ALL NODES of TIUFLDS which it
+17 ;receives. If data already exist for a given field, such filing
+18 ;OVERWRITES the existing value with a possibly erroneous,
+19 ;transcribed value. To prevent such overwriting of critical
+20 ;fields, MAKE kills certain nodes of TIUFLDS just before calling
+21 ;FILE. Nodes killed in MAKE include .01, .02, .07, and 1301,
+22 ;which were NOT previously killed when the header info was
+23 ;loaded into array TIUHDR. (LOADHDR^TIUFIX2 does NOT kill nodes,
+24 ;in contrast to LOADTIUX^TIUPEFIX.)
+25 ;Certain document types may NEED TO KILL ADDITIONAL NODES of
+26 ;TIUFLDS. For example, if a document type uploads into an
+27 ;existing stub which already HAS a Requesting Package value,
+28 ;that document type should also kill node 1405 of TIUFLDS to
+29 ;ensure that the existing Requesting Package data is not
+30 ;overwritten with possibly erroneous, transcribed Requesting
+31 ;Package data. Such nodes of TIUFLDS can be killed
+32 ;before calling MAKE.
MAKE(SUCCESS,TIUEVNT,TIUBUF,TIUTYPE,TIUFLDS,DFN,TITLDA,TIU,TIUPRM0,TIUSTUB) ; File
+1 ;new TIU Document or use stub docmt
+2 ; SUCCESS = (by ref) Returns TIU DOCUMENT # (PTR to 8925) or
+3 ; = 0^Explanatory message if no SUCCESS. Required.
+4 ; DFN = Patient (#2). Required if no stub.
+5 ; TITLDA = Pointer to TIU Document Definition (#8925.1). Required
+6 ; if no stub.
+7 ; TIU = Array of demographic and visit attributes. Required if
+8 ; no stub.
+9 ; TIUEVNT = Record number (ien) of event in TIU Upload Log
+10 ; file (#8925.4). Required.
+11 ; TIUTYPE = IEN of docmt def whose Filing Error Resolution Code
+12 ; is being invoked. Required.
+13 ; TIUFLDS = Array of field data from upload buffer. Required.
+14 ; MAKE kills certain nodes of TIUFLDS. Additional
+15 ; nodes may need to be killed before calling MAKE.
+16 ; See warning, above.
+17 ; TIUPRM0 = String of upload params like hdr signal. See
+18 ; SETPARM^TIULE. Required
+19 ; TIUSTUB = Valid Record number of stub document. Required
+20 ; if file is being uploaded into a stub
+21 ; document. MAKE assumes flds stuffed in
+22 ; STUFREC^TIUPEFIX already exist in stub. Assumes
+23 ; stub is NOT an addendum.
+24 ;
+25 ; -- first, get TIU Document record:
+26 ;
+27 NEW TIUDA,LDT,NEWREC,TIUX,TIUTYP,TIUDPRM,TIUCLASS,TIUDTYP,TIUPOST
+28 NEW TIUDFLT,TIUREC,TITL1,TIUADD
+29 ; -- If no docmt type or Upload event, or target file
+30 ; is not 8925, QUIT:
+31 IF '$GET(TIUTYPE)!'$GET(TIUEVNT)
SET SUCCESS="0^Document type and Upload Log Event Required."
QUIT
+32 IF +$GET(^TIU(8925.1,+TIUTYPE,1))'=8925
SET SUCCESS="0^Target file not 8925."
QUIT
+33 ; -- If stub IEN is not defined, create new record with user-
+34 ; supplied pt/visit/title info (or return an existing docmt):
+35 IF '$GET(TIUSTUB)
Begin DoDot:1
+36 IF $SELECT($DATA(TIU)'>9:1,+$GET(DFN)'>0:1,+$GET(TITLDA)'>0:1,1:0)
SET SUCCESS="0^Invalid Patient, Visit, or Title."
QUIT
+37 SET TITL1=1_U_TITLDA
+38 DO DOCPRM^TIULC1(TITLDA,.TIUDPRM)
+39 ; -- NOTE: If GETRECNW finds existing documents which have
+40 ; requesting packages (e.g. Consults), it ignores them
+41 ; and returns exclusively new documents.
+42 SET TIUDA=$$GETRECNW^TIUEDI3(DFN,.TIU,TITL1,.NEWREC,.TIUDPRM)
+43 IF +TIUDA'>0
SET SUCCESS="0^Document could not be filed even though data appear complete and consistent."
End DoDot:1
if $PIECE($GET(SUCCESS),U)=0
QUIT
+44 ; -- If stub IEN is defined, set docmt IEN = stub
+45 IF $GET(TIUSTUB)
Begin DoDot:1
+46 IF $DATA(^TIU(8925,TIUSTUB,0))
SET TIUDA=TIUSTUB
QUIT
+47 SET SUCCESS="0^The stub document does not exist in TIU."
End DoDot:1
if $PIECE($GET(SUCCESS),U)=0
QUIT
+48 ; -- Leave lock til later; check GUI - when does it lock? 4/21/02
+49 ; -- Lock Document:
+50 ;L +^TIU(8925,TIUDA):1
+51 ;E S SUCCESS="0^Document is being edited by another user; please try again later." Q
+52 ; -- If docmt is not new (new docmts leave GETRECNW already
+53 ; released) and is already released, create an addendum
+54 ; (addm does its own stuffing, filing, ... post filing):
+55 IF '$GET(NEWREC)
IF +$PIECE(^TIU(8925,TIUDA,0),U,5)'<4
Begin DoDot:1
+56 DO MAKEADD(.TIUADD,+TIUDA,TIUBUF,.TIUFLDS,TIUPRM0)
+57 SET SUCCESS=TIUADD
+58 ;browse addm, not docmt
IF SUCCESS
SET TIUDA=+TIUADD
End DoDot:1
if $PIECE($GET(SUCCESS),U)=0
QUIT
GOTO MAKEX
+59 SET SUCCESS=1
+60 ; -- Stuff visit-related data:
+61 ;0 parent
IF '$GET(TIUSTUB)
DO STUFREC^TIUPEFIX(TIUDA,$GET(DFN),0,.TIU)
+62 ; -- Kill header array nodes that have already been filed
+63 ; in GETRECNW^TIUEDI3 or STUFREC^TIUPEFIX and which mustn't
+64 ; be overwritten with possibly erroneous, transcribed data:
+65 KILL TIUFLDS(.01),TIUFLDS(.02),TIUFLDS(.03),TIUFLDS(.05),TIUFLDS(.07)
+66 KILL TIUFLDS(.13),TIUFLDS(1205),TIUFLDS(1211),TIUFLDS(1301)
+67 ; -- File transcribed header fields (those not killed) in Document
+68 ; and create missing field errors:
+69 DO FILE(+TIUDA,.TIUFLDS,TITLDA)
+70 ; -- Load transcribed text into TIUX array and merge into TEMP array:
+71 DO LOADTEXT(.TIUX,TIUBUF,TIUPRM0)
+72 KILL ^TIU(8925,+TIUDA,"TEMP")
+73 MERGE ^TIU(8925,+TIUDA,"TEMP")=TIUX("TEXT")
+74 ; -- File text in Document:
+75 IF '$DATA(TIU)
DO GETTIU^TIULD(.TIU,+TIUDA)
+76 DO MERGTEXT^TIUEDI1(+TIUDA,.TIU)
+77 SET TIUPOST=$$POSTFILE^TIULC1(TITLDA)
+78 SET TIUREC("#")=TIUDA
+79 IF TIUPOST]""
XECUTE TIUPOST
MAKEX DO ALERTDEL^TIUPEVNT(+TIUBUF)
+1 DO RESOLVE^TIUPEVNT(TIUEVNT,1)
+2 DO BUFPURGE^TIUPUTC(+TIUBUF)
+3 KILL ^TIU(8925,+TIUDA,"TEMP")
WRITE "Done."
+4 ;L -^TIU(8925,TIUDA)
+5 IF +$GET(TIUDA)
IF +$DATA(^TIU(8925,+$GET(TIUDA),0))
Begin DoDot:1
+6 NEW TIU
DO GETTIU^TIULD(.TIU,+TIUDA)
+7 DO EN^VALM("TIU BROWSE FOR MRT")
End DoDot:1
+8 QUIT
LOADTEXT(TIUARR,TIUBUF,TIUPRM0) ; Load array TIUARR with text
+1 NEW TIUI,TIUBGN,TIULINE
+2 SET TIUBGN=$PIECE(TIUPRM0,U,12)
+3 SET TIUI=0
FOR
SET TIUI=$ORDER(^TIU(8925.2,+TIUBUF,"TEXT",TIUI))
if +TIUI'>0
QUIT
Begin DoDot:1
+4 SET TIULINE=$GET(^TIU(8925.2,+TIUBUF,"TEXT",TIUI,0))
+5 IF TIULINE[TIUBGN
Begin DoDot:2
+6 NEW TIUJ
SET TIUJ=0
+7 FOR
Begin DoDot:3
+8 SET TIUI=$ORDER(^TIU(8925.2,+TIUBUF,"TEXT",TIUI))
if +TIUI'>0
QUIT
+9 SET TIUJ=TIUJ+1
+10 SET TIUARR("TEXT",TIUJ,0)=$GET(^TIU(8925.2,+TIUBUF,"TEXT",TIUI,0))
End DoDot:3
if +TIUI'>0
QUIT
End DoDot:2
End DoDot:1
+11 QUIT
MAKEADD(TIUDADD,TIUDA,TIUBUF,TIUFLDS,TIUPRM0) ; Create an addendum record
+1 ; [TIUDADD] - passed back = IEN of addm to docmt TIUDA
+2 NEW DIE,DR,DA,DIC,X,Y,DLAYGO,TIUATYP,TIUCAN,TIUFPRIV,TIU,TIUX
SET TIUFPRIV=1
+3 NEW TIUDTTL,TIUPOST,TIUREC
+4 SET TIUDTTL=+$GET(^TIU(8925,+TIUDA,0))
+5 SET TIUATYP=+$$WHATITLE^TIUPUTU("ADDENDUM")
+6 SET (DIC,DLAYGO)=8925
SET DIC(0)="L"
SET X=""""_"`"_TIUATYP_""""
+7 DO ^DIC
+8 SET TIUDADD=+Y
+9 IF +Y'>0
SET TIUDADD="0^Could not create addendum."
QUIT
+10 DO GETTIU^TIULD(.TIU,TIUDA)
+11 SET TIU("DOCTYP")=TIUATYP_U_$$PNAME^TIULC1(TIUATYP)
+12 DO STUFREC^TIUPEFIX(TIUDADD,DFN,+TIUDA,.TIU)
+13 ; -- Kill header array nodes that have already been filed
+14 ; when addm created or in STUFREC^TIUPEFIX, and which mustn't
+15 ; be overwritten with possibly erroneous, transcribed data:
+16 KILL TIUFLDS(.01),TIUFLDS(.02),TIUFLDS(.07),TIUFLDS(1301)
+17 ; -- File header fields in addendum record:
+18 DO FILE(+TIUDADD,.TIUFLDS,TIUATYP)
+19 ; -- Load text into TIUX array and merge into TEMP array:
+20 DO LOADTEXT(.TIUX,TIUBUF,TIUPRM0)
+21 KILL ^TIU(8925,+TIUDADD,"TEMP")
+22 MERGE ^TIU(8925,+TIUDADD,"TEMP")=TIUX("TEXT")
+23 ; -- File text in addendum record:
+24 DO MERGTEXT^TIUEDI1(+TIUDADD,.TIU)
+25 SET TIUPOST=$$POSTFILE^TIULC1(TIUDTTL)
+26 SET TIUREC("#")=TIUDADD
+27 IF TIUPOST]""
XECUTE TIUPOST
+28 QUIT
FILE(TIUDA,TIUFLDS,RTYPE) ; File header data; set missing field
+1 ;alerts for fields that fail to file
+2 ; [TIUDA] - IEN of 8925 document
+3 ; [TIUFLDS] - array of header data from upload buffer record.
+4 ; ALL nodes received by FILE will be filed. See
+5 ; warning for MAKE, concerning possible overwriting
+6 ; of good data with faulty data.
+7 ; [RTYPE] - Record type, i.e. IEN of 8925.1 title of docmt
+8 NEW FDA,FDARR,IENS,FLAGS,TIUMSG,MSG,REQMSG
+9 SET IENS=""""_TIUDA_","""
SET FDARR="FDA(8925,"_IENS_")"
SET FLAGS="KE"
+10 MERGE @FDARR=TIUFLDS
+11 ; File record
DO FILE^DIE(FLAGS,"FDA","TIUMSG")
+12 IF $DATA(TIUMSG)>9
Begin DoDot:1
+13 DO MAIN^TIUPEVNT(TIUBUF,2,"",$PIECE($GET(^TIU(8925.1,+RTYPE,0)),U),.FDA,.TIUMSG)
End DoDot:1
+14 QUIT