TIUPUTC ; SLC/JER - Document filer - captioned header ;07/12/16 13:04
;;1.0;TEXT INTEGRATION UTILITIES;**3,21,81,100,113,112,173,184,277,290**;Jun 20, 1997;Build 548
;
MAIN ; ---- Controls branching.
; Attempts to file upload documents in the target file.
; Requires DA = IEN of 8925.2 upload buffer entry.
N TIUDA,TIUBGN,TIUI,TIUHSIG,TIULIM,TIULCNT,TIULINE,TIUREC,TIUPOST,TIUFDT
N TIUDONE
N TIUTYPE,TIUINST K ^TMP("TIUPUTC",$J)
I '$D(TIUPRM0)!'$D(TIUPRM1) D SETPARM^TIULE
S TIUHSIG=$P(TIUPRM0,U,10),TIUBGN=$P(TIUPRM0,U,12)
I TIUHSIG']"" D MAIN^TIUPEVNT(DA,1,1) Q
I TIUBGN']"" D MAIN^TIUPEVNT(DA,1,7) Q
; ---- Strip controls when kermit:
I $P(TIUPRM0,U,17)="k" D PREPROC(DA)
S TIUI=0,TIUFDT=0
F S TIUI=$O(^TIU(8925.2,+DA,"TEXT",TIUI)) Q:+TIUI'>0 D
. S TIULINE=$G(^TIU(8925.2,+DA,"TEXT",TIUI,0))
. ; - Skip to next note if future DS dictation date found
. I (TIUFDT=1),(TIULINE'[TIUHSIG) Q
. S TIUFDT=0
. I TIULINE[TIUHSIG D Q
. . ; ---- Hdr signal line. GETREC^TIUPUTC1 resets TIUI to $TXT line:
. . N TIUHDR,TIUFRST,TIUJ S TIUFRST=TIUI
. . ; ---- If after first hdr signal, finish previous docmt
. . ; before going on w/ current docmt:
. . I +$G(TIULCNT),$D(TIUREC("TROOT")),$D(@(TIUREC("TROOT")_"0)")) D FINISH
. . K TIUREC D GETREC^TIUPUTC1(TIULINE,.TIUREC,.TIUHDR) Q:TIUFDT=1
. . I +$G(TIUREC("#"))'>0!($G(TIUREC("ROOT"))']"") Q
. . D STUFREC(.TIUHDR,.TIUREC)
. . S TIUREC("TROOT")=TIUREC("ROOT")_TIUREC("#")_","_TIUREC("TEXT")_","
. . S:'$D(@(TIUREC("TROOT")_"0)")) @(TIUREC("TROOT")_"0)")="^^^^^"
. . S TIULCNT=+$P(@(TIUREC("TROOT")_"0)"),U,4)
. . F TIUJ=TIUFRST:1:TIUI D
. . . ; ---- Delete header lines from buffer once filed;
. . . ; (TIUI was reset in GETREC^TIUPUTC1 to $TXT line):
. . . K ^TIU(8925.2,+DA,"TEXT",TIUJ,0)
. . I TIUREC("FILE")=8925,+$G(TIUREC("#")),+$G(TIUREC("BOILON")) D BOILRPLT(.TIUREC)
. Q:TIUFDT=1 I TIULINE'[TIUHSIG,(TIULINE'[TIUBGN),(+$G(TIUREC("FILE"))=8925),+$G(TIUREC("BOILON")) D
. . I TIULINE]"",$D(^TIU(8925.1,"B",$P(TIULINE,":"))) D I 1
. . . S TIULCNT=$$LOCATE(TIULINE,TIUREC("#"))
. . E S TIULCNT=+$G(TIULCNT)+.01
. . S ^TIU(8925,+TIUREC("#"),"TEMP",TIULCNT,0)=TIULINE
. . ; ---- Delete text line from buffer once xferred:
. . K ^TIU(8925.2,+DA,"TEXT",TIUI,0)
. I TIULINE'[TIUHSIG,(TIULINE'[TIUBGN),$D(TIUREC("TROOT")),$D(@(TIUREC("TROOT")_"0)")),(+$G(TIUREC("BOILON"))'>0) D
. . S TIULCNT=+$G(TIULCNT)+1,@(TIUREC("TROOT")_TIULCNT_",0)")=TIULINE
. . ; ---- Delete text line once xferred:
. . K ^TIU(8925.2,+DA,"TEXT",TIUI,0)
. . ; ---- Remove leading buffer garbage
. I TIULINE'[TIUHSIG,(TIULINE'[TIUBGN),'$D(TIUREC("TROOT")),($G(TIUREC("#"))'=-1) K ^TIU(8925.2,+DA,"TEXT",TIUI,0)
. I TIULINE[TIUBGN K ^TIU(8925.2,+DA,"TEXT",TIUI,0)
; ---- Finish last docmt in buffer file:
I +$G(TIULCNT),$D(TIUREC("TROOT")),$D(@(TIUREC("TROOT")_"0)")) D FINISH
I '+$O(^TIU(8925.2,+DA,"TEXT",0)) D BUFPURGE(DA)
; ---- Write upload results:
I '$D(ZTQUEUED),$D(^TMP("TIUPUTC",$J)) D
. W !!,"TOTALS FOR CURRENT BATCH:",!
. W !?14,"TOTAL Document(s) RECEIVED: ",$J((+$G(^TMP("TIUPUTC",$J,"SUCC"))+$G(^("MISS"))+$G(^("FAIL"))),5),!
. W !?18," Document(s) NOT FILED: ",$J(+$G(^TMP("TIUPUTC",$J,"FAIL")),5)
. W !?3,"Document(s) FILED with MISSING FIELDS: ",$J(+$G(^TMP("TIUPUTC",$J,"MISS")),5),!
K ^TMP("TIUPUTC",$J)
Q
LOCATE(LINE,REC) ; ---- Locate line in boilerplate text
N TIUJ,HIT,BTXT S (TIUJ,HIT)=0
F Q:+HIT S TIUJ=$O(^TIU(8925,+REC,"TEMP",TIUJ)) Q:+TIUJ'>0!HIT D
. S BTXT=$G(^TIU(8925,+REC,"TEMP",TIUJ,0))
. I BTXT[$P(LINE,":")_":" S HIT=1
Q +$G(TIUJ)
;
STUFREC(HEADER,TIURECD) ; ---- Stuffs record with known fixed fields;
; Checks for missing fields.
N TIUFDA,FDARR,IENS,FLAGS,TIUI,TIUMSG,TIUECMSG,TIUPC,NEWMISS
S IENS=""""_+TIURECD("#")_","""
S FDARR="TIUFDA("_+TIURECD("FILE")_","_IENS_")",FLAGS="KE"
; ---- Set up TIUFDA Array:
S TIUI=0
F S TIUI=$O(HEADER(TIUI)) Q:+TIUI'>0 D
. ; if field is Author/Dictator and title is OPERATION REPORT, ignore uploaded data *173
. ; *277 VMP/DJH Allow 1202/1209 to file if addendum
. I '+$$ISADDNDM^TIULC1(+TIURECD("#")),(TIUI=1202!(TIUI=1209)),TIURECD("TYPE")=$$CHKFILE^TIUADCL(8925.1,"OPERATION REPORT","I $P(^(0),U,4)=""DOC""") S @FDARR@(1303)="U" Q
. S:TIUI'=.001 @FDARR@(TIUI)=$$TRNSFRM^TIULX(.TIURECD,TIUI,HEADER(TIUI))
I $D(TIUFDA) D FILE^DIE(FLAGS,"TIUFDA","TIUMSG")
S NEWMISS=0
I $D(TIUMSG) D
. ; ---- If FILE^DIC fails, log 8925.4 error w/ hdr info. Create new
. ; 8925.2 buffer entry with hdr, text, & 8925.4 log #.
. ; Kill most of old buffer. Send missing field alerts:
. D MAIN^TIUPEVNT(DA,2,"",$P($G(^TIU(8925.1,+TIURECD("TYPE"),0)),U),.TIUFDA,.TIUMSG)
. S ^TMP("TIUPUTC",$J,"MISS")=+$G(^TMP("TIUPUTC",$J,"MISS"))+1,NEWMISS=1
D CKEXPCOS(NEWMISS)
I '$D(TIUMSG),'$D(TIUECMSG) D
. S ^TMP("TIUPUTC",$J,"SUCC")=+$G(^TMP("TIUPUTC",$J,"SUCC"))+1
Q
CKEXPCOS(NEWMISS) ; check if Exp Cos is a missing field. Requires some vars from STUFREC
N TIUFDA,TIUTITL,TIUD0,TIU12,TIU13,TIUEC,TIUAUTH,TIUDTDIC,TIUI,HEADER,TIUDAD
S TIUTITL=+^TIU(8925,TIURECD("#"),0)
I +$$ISADDNDM^TIULC1(TIURECD("#")) S TIUTITL=+$$DADTYPE^TIUPUTC(TIURECD("#"))
I TIUTITL=81 S TIUD0=^TIU(8925,TIURECD("#"),0),TIUDAD=$P(TIUD0,U,6),TIUTITL=+^TIU(8925,TIUDAD,0)
S TIU12=$G(^TIU(8925,TIURECD("#"),12)),TIU13=$G(^TIU(8925,TIURECD("#"),13))
S TIUEC=$P(TIU12,U,8),TIUAUTH=$P(TIU12,U,2),TIUDTDIC=$P(TIU13,U,7) I TIUEC>0!(TIUAUTH'>0)!(TIUDTDIC'>0) Q
I '$$REQCOSIG^TIULP(TIUTITL,,TIUAUTH,$P(TIUDTDIC,".")) Q
S TIUI=1208,HEADER(TIUI)="** EXPECTED COSIGNER MISSING FROM UPLOAD **"
; If EC not there or not valid, set miss fld error.
S @FDARR@(TIUI)=$$TRNSFRM^TIULX(.TIURECD,TIUI,HEADER(TIUI))
D FILE^DIE(FLAGS,"TIUFDA","TIUECMSG")
I $D(TIUECMSG) D
. D MAIN^TIUPEVNT(DA,2,"",$P($G(^TIU(8925.1,+TIURECD("TYPE"),0)),U),.TIUFDA,.TIUECMSG)
. ; Don't raise # of missing-fld docmts if it has already been raised for this docmt:
. I 'NEWMISS S ^TMP("TIUPUTC",$J,"MISS")=+$G(^TMP("TIUPUTC",$J,"MISS"))+1
Q
BOILRPLT(TIUREC) ; ---- Execute/Interleave Boilerplates w/uploaded text
N TIU
D GETTIU^TIULD(.TIU,TIUREC("#"))
D LOADDFLT^TIUEDI4(TIUREC("#"),TIUREC("TYPE")) ;100
Q
SETROOT(LINECNT,RECORD) ; ---- Sets root of WP field
S @(RECORD("TROOT")_"0)")="^^"_LINECNT_"^"_LINECNT_"^"_DT_"^^"
Q
BUFPURGE(DA) ; ---- Call ^DIK to purge buffer record when all's well
N DIK S DIK="^TIU(8925.2," D ^DIK
Q
PREPROC(DA) ; ---- Strip controls & white space from headers
N TIUI,TIUHLIN,X S (TIUI,TIUHLIN)=0
F S TIUI=$O(^TIU(8925.2,+DA,"TEXT",TIUI)) Q:+TIUI'>0 D
. S X=$G(^TIU(8925.2,+DA,"TEXT",TIUI,0))
. S:X[TIUHSIG TIUHLIN=1 S:X[TIUBGN TIUHLIN=0
. S:TIUHLIN ^TIU(8925.2,+DA,"TEXT",TIUI,0)=$$STRIP^TIUUPLD(X)
Q
DADTYPE(DA) ; ---- Get type of original document for addenda
N TIUDAD,Y
S TIUDAD=$P($G(^TIU(8925,DA,0)),U,6)
S Y=+$G(^TIU(8925,+TIUDAD,0))
Q Y
;
FINISH ; ---- Finish document: feedback, postfile code, merge boil,
; log file event
N ISADDNDM S ISADDNDM=0
D SETROOT(TIULCNT,.TIUREC)
S ISADDNDM=+$$ISADDNDM^TIULC1(TIUREC("#"))
S TIUTYPE=$S(ISADDNDM:+$$DADTYPE(TIUREC("#")),1:TIUREC("TYPE"))
I '$D(ZTQUEUED) W !,">>> ",$S(ISADDNDM:"Addendum",1:"Document")," Filed Successfully.",! ;TIU*1*81
; ---- TIU*1*81 Tell error handler that retrying filer was successful:
S TIUDONE=1
S TIUTYPE=$S(+$$ISADDNDM^TIULC1(TIUREC("#")):+$$DADTYPE(TIUREC("#")),1:TIUREC("TYPE"))
S TIUPOST=$$POSTFILE^TIULC1(TIUTYPE)
I TIUPOST]"" X TIUPOST K ^TMP("TIUPRFUP",$J)
I TIUREC("FILE")=8925,+$G(TIUREC("BOILON")) D
. N TIU D GETTIU^TIULD(.TIU,TIUREC("#"))
. D MERGTEXT^TIUEDI1(TIUREC("#"),.TIU)
. K ^TIU(8925,+TIUREC("#"),"TEMP")
D MAIN^TIUPEVNT(DA,0,"",$P($G(^TIU(8925.1,+TIUREC("TYPE"),0)),U))
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUPUTC 7859 printed Apr 09, 2024@21:43:17 Page 2
TIUPUTC ; SLC/JER - Document filer - captioned header ;07/12/16 13:04
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**3,21,81,100,113,112,173,184,277,290**;Jun 20, 1997;Build 548
+2 ;
MAIN ; ---- Controls branching.
+1 ; Attempts to file upload documents in the target file.
+2 ; Requires DA = IEN of 8925.2 upload buffer entry.
+3 NEW TIUDA,TIUBGN,TIUI,TIUHSIG,TIULIM,TIULCNT,TIULINE,TIUREC,TIUPOST,TIUFDT
+4 NEW TIUDONE
+5 NEW TIUTYPE,TIUINST
KILL ^TMP("TIUPUTC",$JOB)
+6 IF '$DATA(TIUPRM0)!'$DATA(TIUPRM1)
DO SETPARM^TIULE
+7 SET TIUHSIG=$PIECE(TIUPRM0,U,10)
SET TIUBGN=$PIECE(TIUPRM0,U,12)
+8 IF TIUHSIG']""
DO MAIN^TIUPEVNT(DA,1,1)
QUIT
+9 IF TIUBGN']""
DO MAIN^TIUPEVNT(DA,1,7)
QUIT
+10 ; ---- Strip controls when kermit:
+11 IF $PIECE(TIUPRM0,U,17)="k"
DO PREPROC(DA)
+12 SET TIUI=0
SET TIUFDT=0
+13 FOR
SET TIUI=$ORDER(^TIU(8925.2,+DA,"TEXT",TIUI))
if +TIUI'>0
QUIT
Begin DoDot:1
+14 SET TIULINE=$GET(^TIU(8925.2,+DA,"TEXT",TIUI,0))
+15 ; - Skip to next note if future DS dictation date found
+16 IF (TIUFDT=1)
IF (TIULINE'[TIUHSIG)
QUIT
+17 SET TIUFDT=0
+18 IF TIULINE[TIUHSIG
Begin DoDot:2
+19 ; ---- Hdr signal line. GETREC^TIUPUTC1 resets TIUI to $TXT line:
+20 NEW TIUHDR,TIUFRST,TIUJ
SET TIUFRST=TIUI
+21 ; ---- If after first hdr signal, finish previous docmt
+22 ; before going on w/ current docmt:
+23 IF +$GET(TIULCNT)
IF $DATA(TIUREC("TROOT"))
IF $DATA(@(TIUREC("TROOT")_"0)"))
DO FINISH
+24 KILL TIUREC
DO GETREC^TIUPUTC1(TIULINE,.TIUREC,.TIUHDR)
if TIUFDT=1
QUIT
+25 IF +$GET(TIUREC("#"))'>0!($GET(TIUREC("ROOT"))']"")
QUIT
+26 DO STUFREC(.TIUHDR,.TIUREC)
+27 SET TIUREC("TROOT")=TIUREC("ROOT")_TIUREC("#")_","_TIUREC("TEXT")_","
+28 if '$DATA(@(TIUREC("TROOT")_"0)"))
SET @(TIUREC("TROOT")_"0)")="^^^^^"
+29 SET TIULCNT=+$PIECE(@(TIUREC("TROOT")_"0)"),U,4)
+30 FOR TIUJ=TIUFRST:1:TIUI
Begin DoDot:3
+31 ; ---- Delete header lines from buffer once filed;
+32 ; (TIUI was reset in GETREC^TIUPUTC1 to $TXT line):
+33 KILL ^TIU(8925.2,+DA,"TEXT",TIUJ,0)
End DoDot:3
+34 IF TIUREC("FILE")=8925
IF +$GET(TIUREC("#"))
IF +$GET(TIUREC("BOILON"))
DO BOILRPLT(.TIUREC)
End DoDot:2
QUIT
+35 if TIUFDT=1
QUIT
IF TIULINE'[TIUHSIG
IF (TIULINE'[TIUBGN)
IF (+$GET(TIUREC("FILE"))=8925)
IF +$GET(TIUREC("BOILON"))
Begin DoDot:2
+36 IF TIULINE]""
IF $DATA(^TIU(8925.1,"B",$PIECE(TIULINE,":")))
Begin DoDot:3
+37 SET TIULCNT=$$LOCATE(TIULINE,TIUREC("#"))
End DoDot:3
IF 1
+38 IF '$TEST
SET TIULCNT=+$GET(TIULCNT)+.01
+39 SET ^TIU(8925,+TIUREC("#"),"TEMP",TIULCNT,0)=TIULINE
+40 ; ---- Delete text line from buffer once xferred:
+41 KILL ^TIU(8925.2,+DA,"TEXT",TIUI,0)
End DoDot:2
+42 IF TIULINE'[TIUHSIG
IF (TIULINE'[TIUBGN)
IF $DATA(TIUREC("TROOT"))
IF $DATA(@(TIUREC("TROOT")_"0)"))
IF (+$GET(TIUREC("BOILON"))'>0)
Begin DoDot:2
+43 SET TIULCNT=+$GET(TIULCNT)+1
SET @(TIUREC("TROOT")_TIULCNT_",0)")=TIULINE
+44 ; ---- Delete text line once xferred:
+45 KILL ^TIU(8925.2,+DA,"TEXT",TIUI,0)
+46 ; ---- Remove leading buffer garbage
End DoDot:2
+47 IF TIULINE'[TIUHSIG
IF (TIULINE'[TIUBGN)
IF '$DATA(TIUREC("TROOT"))
IF ($GET(TIUREC("#"))'=-1)
KILL ^TIU(8925.2,+DA,"TEXT",TIUI,0)
+48 IF TIULINE[TIUBGN
KILL ^TIU(8925.2,+DA,"TEXT",TIUI,0)
End DoDot:1
+49 ; ---- Finish last docmt in buffer file:
+50 IF +$GET(TIULCNT)
IF $DATA(TIUREC("TROOT"))
IF $DATA(@(TIUREC("TROOT")_"0)"))
DO FINISH
+51 IF '+$ORDER(^TIU(8925.2,+DA,"TEXT",0))
DO BUFPURGE(DA)
+52 ; ---- Write upload results:
+53 IF '$DATA(ZTQUEUED)
IF $DATA(^TMP("TIUPUTC",$JOB))
Begin DoDot:1
+54 WRITE !!,"TOTALS FOR CURRENT BATCH:",!
+55 WRITE !?14,"TOTAL Document(s) RECEIVED: ",$JUSTIFY((+$GET(^TMP("TIUPUTC",$JOB,"SUCC"))+$GET(^("MISS"))+$GET(^("FAIL"))),5),!
+56 WRITE !?18," Document(s) NOT FILED: ",$JUSTIFY(+$GET(^TMP("TIUPUTC",$JOB,"FAIL")),5)
+57 WRITE !?3,"Document(s) FILED with MISSING FIELDS: ",$JUSTIFY(+$GET(^TMP("TIUPUTC",$JOB,"MISS")),5),!
End DoDot:1
+58 KILL ^TMP("TIUPUTC",$JOB)
+59 QUIT
LOCATE(LINE,REC) ; ---- Locate line in boilerplate text
+1 NEW TIUJ,HIT,BTXT
SET (TIUJ,HIT)=0
+2 FOR
if +HIT
QUIT
SET TIUJ=$ORDER(^TIU(8925,+REC,"TEMP",TIUJ))
if +TIUJ'>0!HIT
QUIT
Begin DoDot:1
+3 SET BTXT=$GET(^TIU(8925,+REC,"TEMP",TIUJ,0))
+4 IF BTXT[$PIECE(LINE,":")_":"
SET HIT=1
End DoDot:1
+5 QUIT +$GET(TIUJ)
+6 ;
STUFREC(HEADER,TIURECD) ; ---- Stuffs record with known fixed fields;
+1 ; Checks for missing fields.
+2 NEW TIUFDA,FDARR,IENS,FLAGS,TIUI,TIUMSG,TIUECMSG,TIUPC,NEWMISS
+3 SET IENS=""""_+TIURECD("#")_","""
+4 SET FDARR="TIUFDA("_+TIURECD("FILE")_","_IENS_")"
SET FLAGS="KE"
+5 ; ---- Set up TIUFDA Array:
+6 SET TIUI=0
+7 FOR
SET TIUI=$ORDER(HEADER(TIUI))
if +TIUI'>0
QUIT
Begin DoDot:1
+8 ; if field is Author/Dictator and title is OPERATION REPORT, ignore uploaded data *173
+9 ; *277 VMP/DJH Allow 1202/1209 to file if addendum
+10 IF '+$$ISADDNDM^TIULC1(+TIURECD("#"))
IF (TIUI=1202!(TIUI=1209))
IF TIURECD("TYPE")=$$CHKFILE^TIUADCL(8925.1,"OPERATION REPORT","I $P(^(0),U,4)=""DOC""")
SET @FDARR@(1303)="U"
QUIT
+11 if TIUI'=.001
SET @FDARR@(TIUI)=$$TRNSFRM^TIULX(.TIURECD,TIUI,HEADER(TIUI))
End DoDot:1
+12 IF $DATA(TIUFDA)
DO FILE^DIE(FLAGS,"TIUFDA","TIUMSG")
+13 SET NEWMISS=0
+14 IF $DATA(TIUMSG)
Begin DoDot:1
+15 ; ---- If FILE^DIC fails, log 8925.4 error w/ hdr info. Create new
+16 ; 8925.2 buffer entry with hdr, text, & 8925.4 log #.
+17 ; Kill most of old buffer. Send missing field alerts:
+18 DO MAIN^TIUPEVNT(DA,2,"",$PIECE($GET(^TIU(8925.1,+TIURECD("TYPE"),0)),U),.TIUFDA,.TIUMSG)
+19 SET ^TMP("TIUPUTC",$JOB,"MISS")=+$GET(^TMP("TIUPUTC",$JOB,"MISS"))+1
SET NEWMISS=1
End DoDot:1
+20 DO CKEXPCOS(NEWMISS)
+21 IF '$DATA(TIUMSG)
IF '$DATA(TIUECMSG)
Begin DoDot:1
+22 SET ^TMP("TIUPUTC",$JOB,"SUCC")=+$GET(^TMP("TIUPUTC",$JOB,"SUCC"))+1
End DoDot:1
+23 QUIT
CKEXPCOS(NEWMISS) ; check if Exp Cos is a missing field. Requires some vars from STUFREC
+1 NEW TIUFDA,TIUTITL,TIUD0,TIU12,TIU13,TIUEC,TIUAUTH,TIUDTDIC,TIUI,HEADER,TIUDAD
+2 SET TIUTITL=+^TIU(8925,TIURECD("#"),0)
+3 IF +$$ISADDNDM^TIULC1(TIURECD("#"))
SET TIUTITL=+$$DADTYPE^TIUPUTC(TIURECD("#"))
+4 IF TIUTITL=81
SET TIUD0=^TIU(8925,TIURECD("#"),0)
SET TIUDAD=$PIECE(TIUD0,U,6)
SET TIUTITL=+^TIU(8925,TIUDAD,0)
+5 SET TIU12=$GET(^TIU(8925,TIURECD("#"),12))
SET TIU13=$GET(^TIU(8925,TIURECD("#"),13))
+6 SET TIUEC=$PIECE(TIU12,U,8)
SET TIUAUTH=$PIECE(TIU12,U,2)
SET TIUDTDIC=$PIECE(TIU13,U,7)
IF TIUEC>0!(TIUAUTH'>0)!(TIUDTDIC'>0)
QUIT
+7 IF '$$REQCOSIG^TIULP(TIUTITL,,TIUAUTH,$PIECE(TIUDTDIC,"."))
QUIT
+8 SET TIUI=1208
SET HEADER(TIUI)="** EXPECTED COSIGNER MISSING FROM UPLOAD **"
+9 ; If EC not there or not valid, set miss fld error.
+10 SET @FDARR@(TIUI)=$$TRNSFRM^TIULX(.TIURECD,TIUI,HEADER(TIUI))
+11 DO FILE^DIE(FLAGS,"TIUFDA","TIUECMSG")
+12 IF $DATA(TIUECMSG)
Begin DoDot:1
+13 DO MAIN^TIUPEVNT(DA,2,"",$PIECE($GET(^TIU(8925.1,+TIURECD("TYPE"),0)),U),.TIUFDA,.TIUECMSG)
+14 ; Don't raise # of missing-fld docmts if it has already been raised for this docmt:
+15 IF 'NEWMISS
SET ^TMP("TIUPUTC",$JOB,"MISS")=+$GET(^TMP("TIUPUTC",$JOB,"MISS"))+1
End DoDot:1
+16 QUIT
BOILRPLT(TIUREC) ; ---- Execute/Interleave Boilerplates w/uploaded text
+1 NEW TIU
+2 DO GETTIU^TIULD(.TIU,TIUREC("#"))
+3 ;100
DO LOADDFLT^TIUEDI4(TIUREC("#"),TIUREC("TYPE"))
+4 QUIT
SETROOT(LINECNT,RECORD) ; ---- Sets root of WP field
+1 SET @(RECORD("TROOT")_"0)")="^^"_LINECNT_"^"_LINECNT_"^"_DT_"^^"
+2 QUIT
BUFPURGE(DA) ; ---- Call ^DIK to purge buffer record when all's well
+1 NEW DIK
SET DIK="^TIU(8925.2,"
DO ^DIK
+2 QUIT
PREPROC(DA) ; ---- Strip controls & white space from headers
+1 NEW TIUI,TIUHLIN,X
SET (TIUI,TIUHLIN)=0
+2 FOR
SET TIUI=$ORDER(^TIU(8925.2,+DA,"TEXT",TIUI))
if +TIUI'>0
QUIT
Begin DoDot:1
+3 SET X=$GET(^TIU(8925.2,+DA,"TEXT",TIUI,0))
+4 if X[TIUHSIG
SET TIUHLIN=1
if X[TIUBGN
SET TIUHLIN=0
+5 if TIUHLIN
SET ^TIU(8925.2,+DA,"TEXT",TIUI,0)=$$STRIP^TIUUPLD(X)
End DoDot:1
+6 QUIT
DADTYPE(DA) ; ---- Get type of original document for addenda
+1 NEW TIUDAD,Y
+2 SET TIUDAD=$PIECE($GET(^TIU(8925,DA,0)),U,6)
+3 SET Y=+$GET(^TIU(8925,+TIUDAD,0))
+4 QUIT Y
+5 ;
FINISH ; ---- Finish document: feedback, postfile code, merge boil,
+1 ; log file event
+2 NEW ISADDNDM
SET ISADDNDM=0
+3 DO SETROOT(TIULCNT,.TIUREC)
+4 SET ISADDNDM=+$$ISADDNDM^TIULC1(TIUREC("#"))
+5 SET TIUTYPE=$SELECT(ISADDNDM:+$$DADTYPE(TIUREC("#")),1:TIUREC("TYPE"))
+6 ;TIU*1*81
IF '$DATA(ZTQUEUED)
WRITE !,">>> ",$SELECT(ISADDNDM:"Addendum",1:"Document")," Filed Successfully.",!
+7 ; ---- TIU*1*81 Tell error handler that retrying filer was successful:
+8 SET TIUDONE=1
+9 SET TIUTYPE=$SELECT(+$$ISADDNDM^TIULC1(TIUREC("#")):+$$DADTYPE(TIUREC("#")),1:TIUREC("TYPE"))
+10 SET TIUPOST=$$POSTFILE^TIULC1(TIUTYPE)
+11 IF TIUPOST]""
XECUTE TIUPOST
KILL ^TMP("TIUPRFUP",$JOB)
+12 IF TIUREC("FILE")=8925
IF +$GET(TIUREC("BOILON"))
Begin DoDot:1
+13 NEW TIU
DO GETTIU^TIULD(.TIU,TIUREC("#"))
+14 DO MERGTEXT^TIUEDI1(TIUREC("#"),.TIU)
+15 KILL ^TIU(8925,+TIUREC("#"),"TEMP")
End DoDot:1
+16 DO MAIN^TIUPEVNT(DA,0,"",$PIECE($GET(^TIU(8925.1,+TIUREC("TYPE"),0)),U))
+17 QUIT
+18 ;
