Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIUFIX1

TIUFIX1.m

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