- 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 Feb 19, 2025@00:11:03 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 ;