TIUPUTC ; SLC/JER - Document filer - captioned header ;5/20/05
;;1.0;TEXT INTEGRATION UTILITIES;**3,21,81,100,113,112,173,184**;Jun 20, 1997
;
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
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 F S TIUI=$O(^TIU(8925.2,+DA,"TEXT",TIUI)) Q:+TIUI'>0 D
. S TIULINE=$G(^TIU(8925.2,+DA,"TEXT",TIUI,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)
. . 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)
. 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,RECORD) ; ---- Stuffs record with known fixed fields;
; Checks for missing fields.
N FDA,FDARR,IENS,FLAGS,TIUI,TIUMSG,TIUPC
S IENS=""""_+RECORD("#")_","""
S FDARR="FDA("_+RECORD("FILE")_","_IENS_")",FLAGS="KE"
; ---- Set up FDA 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
. I (TIUI=1202!(TIUI=1209)),TIUREC("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(.RECORD,TIUI,HEADER(TIUI))
I $D(FDA) D FILE^DIE(FLAGS,"FDA","TIUMSG")
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,+RECORD("TYPE"),0)),U),.FDA,.TIUMSG)
. S ^TMP("TIUPUTC",$J,"MISS")=+$G(^TMP("TIUPUTC",$J,"MISS"))+1
I '$D(TIUMSG) D
. S ^TMP("TIUPUTC",$J,"SUCC")=+$G(^TMP("TIUPUTC",$J,"SUCC"))+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
;
TIUPUTC ; SLC/JER - Document filer - captioned header ;5/20/05
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**3,21,81,100,113,112,173,184**;Jun 20, 1997
+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
+4 NEW TIUTYPE,TIUINST
KILL ^TMP("TIUPUTC",$JOB)
+5 IF '$DATA(TIUPRM0)!'$DATA(TIUPRM1)
DO SETPARM^TIULE
+6 SET TIUHSIG=$PIECE(TIUPRM0,U,10)
SET TIUBGN=$PIECE(TIUPRM0,U,12)
+7 IF TIUHSIG']""
DO MAIN^TIUPEVNT(DA,1,1)
QUIT
+8 IF TIUBGN']""
DO MAIN^TIUPEVNT(DA,1,7)
QUIT
+9 ; ---- Strip controls when kermit:
+10 IF $PIECE(TIUPRM0,U,17)="k"
DO PREPROC(DA)
+11 SET TIUI=0
FOR
SET TIUI=$ORDER(^TIU(8925.2,+DA,"TEXT",TIUI))
IF +TIUI'>0
QUIT
Begin DoDot:1
+12 SET TIULINE=$GET(^TIU(8925.2,+DA,"TEXT",TIUI,0))
+13 IF TIULINE[TIUHSIG
Begin DoDot:2
+14 ; ---- Hdr signal line. GETREC^TIUPUTC1 resets TIUI to $TXT line:
+15 NEW TIUHDR,TIUFRST,TIUJ
SET TIUFRST=TIUI
+16 ; ---- If after first hdr signal, finish previous docmt
+17 ; before going on w/ current docmt:
+18 IF +$GET(TIULCNT)
IF $DATA(TIUREC("TROOT"))
IF $DATA(@(TIUREC("TROOT")_"0)"))
DO FINISH
+19 KILL TIUREC
DO GETREC^TIUPUTC1(TIULINE,.TIUREC,.TIUHDR)
+20 IF +$GET(TIUREC("#"))'>0!($GET(TIUREC("ROOT"))']"")
QUIT
+21 DO STUFREC(.TIUHDR,.TIUREC)
+22 SET TIUREC("TROOT")=TIUREC("ROOT")_TIUREC("#")_","_TIUREC("TEXT")_","
+23 IF '$DATA(@(TIUREC("TROOT")_"0)"))
SET @(TIUREC("TROOT")_"0)")="^^^^^"
+24 SET TIULCNT=+$PIECE(@(TIUREC("TROOT")_"0)"),U,4)
+25 FOR TIUJ=TIUFRST:1:TIUI
Begin DoDot:3
+26 ; ---- Delete header lines from buffer once filed;
+27 ; (TIUI was reset in GETREC^TIUPUTC1 to $TXT line):
+28 KILL ^TIU(8925.2,+DA,"TEXT",TIUJ,0)
End DoDot:3
+29 IF TIUREC("FILE")=8925
IF +$GET(TIUREC("#"))
IF +$GET(TIUREC("BOILON"))
DO BOILRPLT(.TIUREC)
End DoDot:2
QUIT
+30 IF TIULINE'[TIUHSIG
IF (TIULINE'[TIUBGN)
IF (+$GET(TIUREC("FILE"))=8925)
IF +$GET(TIUREC("BOILON"))
Begin DoDot:2
+31 IF TIULINE]""
IF $DATA(^TIU(8925.1,"B",$PIECE(TIULINE,":")))
Begin DoDot:3
+32 SET TIULCNT=$$LOCATE(TIULINE,TIUREC("#"))
End DoDot:3
IF 1
+33 IF '$TEST
SET TIULCNT=+$GET(TIULCNT)+.01
+34 SET ^TIU(8925,+TIUREC("#"),"TEMP",TIULCNT,0)=TIULINE
+35 ; ---- Delete text line from buffer once xferred:
+36 KILL ^TIU(8925.2,+DA,"TEXT",TIUI,0)
End DoDot:2
+37 IF TIULINE'[TIUHSIG
IF (TIULINE'[TIUBGN)
IF $DATA(TIUREC("TROOT"))
IF $DATA(@(TIUREC("TROOT")_"0)"))
IF (+$GET(TIUREC("BOILON"))'>0)
Begin DoDot:2
+38 SET TIULCNT=+$GET(TIULCNT)+1
SET @(TIUREC("TROOT")_TIULCNT_",0)")=TIULINE
+39 ; ---- Delete text line once xferred:
+40 KILL ^TIU(8925.2,+DA,"TEXT",TIUI,0)
+41 ; ---- Remove leading buffer garbage
End DoDot:2
+42 IF TIULINE'[TIUHSIG
IF (TIULINE'[TIUBGN)
IF '$DATA(TIUREC("TROOT"))
IF ($GET(TIUREC("#"))'=-1)
KILL ^TIU(8925.2,+DA,"TEXT",TIUI,0)
+43 IF TIULINE[TIUBGN
KILL ^TIU(8925.2,+DA,"TEXT",TIUI,0)
End DoDot:1
+44 ; ---- Finish last docmt in buffer file:
+45 IF +$GET(TIULCNT)
IF $DATA(TIUREC("TROOT"))
IF $DATA(@(TIUREC("TROOT")_"0)"))
DO FINISH
+46 IF '+$ORDER(^TIU(8925.2,+DA,"TEXT",0))
DO BUFPURGE(DA)
+47 ; ---- Write upload results:
+48 IF '$DATA(ZTQUEUED)
IF $DATA(^TMP("TIUPUTC",$JOB))
Begin DoDot:1
+49 WRITE !!,"TOTALS FOR CURRENT BATCH:",!
+50 WRITE !?14,"TOTAL Document(s) RECEIVED: ",$JUSTIFY((+$GET(^TMP("TIUPUTC",$JOB,"SUCC"))+$GET(^("MISS"))+$GET(^("FAIL"))),5),!
+51 WRITE !?18," Document(s) NOT FILED: ",$JUSTIFY(+$GET(^TMP("TIUPUTC",$JOB,"FAIL")),5)
+52 WRITE !?3,"Document(s) FILED with MISSING FIELDS: ",$JUSTIFY(+$GET(^TMP("TIUPUTC",$JOB,"MISS")),5),!
End DoDot:1
+53 KILL ^TMP("TIUPUTC",$JOB)
+54 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,RECORD) ; ---- Stuffs record with known fixed fields;
+1 ; Checks for missing fields.
+2 NEW FDA,FDARR,IENS,FLAGS,TIUI,TIUMSG,TIUPC
+3 SET IENS=""""_+RECORD("#")_","""
+4 SET FDARR="FDA("_+RECORD("FILE")_","_IENS_")"
SET FLAGS="KE"
+5 ; ---- Set up FDA 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 IF (TIUI=1202!(TIUI=1209))
IF TIUREC("TYPE")=$$CHKFILE^TIUADCL(8925.1,"OPERATION REPORT","I $P(^(0),U,4)=""DOC""")
SET @FDARR@(1303)="U"
QUIT
+10 IF TIUI'=.001
SET @FDARR@(TIUI)=$$TRNSFRM^TIULX(.RECORD,TIUI,HEADER(TIUI))
End DoDot:1
+11 IF $DATA(FDA)
DO FILE^DIE(FLAGS,"FDA","TIUMSG")
+12 IF $DATA(TIUMSG)
Begin DoDot:1
+13 ; ---- If FILE^DIC fails, log 8925.4 error w/ hdr info. Create new
+14 ; 8925.2 buffer entry with hdr, text, & 8925.4 log #.
+15 ; Kill most of old buffer. Send missing field alerts:
+16 DO MAIN^TIUPEVNT(DA,2,"",$PIECE($GET(^TIU(8925.1,+RECORD("TYPE"),0)),U),.FDA,.TIUMSG)
+17 SET ^TMP("TIUPUTC",$JOB,"MISS")=+$GET(^TMP("TIUPUTC",$JOB,"MISS"))+1
End DoDot:1
+18 IF '$DATA(TIUMSG)
Begin DoDot:1
+19 SET ^TMP("TIUPUTC",$JOB,"SUCC")=+$GET(^TMP("TIUPUTC",$JOB,"SUCC"))+1
End DoDot:1
+20 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 ;
