TIUPUTC.m

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      ;