source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUPUTC.m@ 1261

Last change on this file since 1261 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 6.1 KB
RevLine 
[613]1TIUPUTC ; SLC/JER - Document filer - captioned header ;5/20/05
2 ;;1.0;TEXT INTEGRATION UTILITIES;**3,21,81,100,113,112,173,184**;Jun 20, 1997
3 ;
4MAIN ; ---- Controls branching.
5 ; Attempts to file upload documents in the target file.
6 ; Requires DA = IEN of 8925.2 upload buffer entry.
7 N TIUDA,TIUBGN,TIUI,TIUHSIG,TIULIM,TIULCNT,TIULINE,TIUREC,TIUPOST
8 N TIUTYPE,TIUINST K ^TMP("TIUPUTC",$J)
9 I '$D(TIUPRM0)!'$D(TIUPRM1) D SETPARM^TIULE
10 S TIUHSIG=$P(TIUPRM0,U,10),TIUBGN=$P(TIUPRM0,U,12)
11 I TIUHSIG']"" D MAIN^TIUPEVNT(DA,1,1) Q
12 I TIUBGN']"" D MAIN^TIUPEVNT(DA,1,7) Q
13 ; ---- Strip controls when kermit:
14 I $P(TIUPRM0,U,17)="k" D PREPROC(DA)
15 S TIUI=0 F S TIUI=$O(^TIU(8925.2,+DA,"TEXT",TIUI)) Q:+TIUI'>0 D
16 . S TIULINE=$G(^TIU(8925.2,+DA,"TEXT",TIUI,0))
17 . I TIULINE[TIUHSIG D Q
18 . . ; ---- Hdr signal line. GETREC^TIUPUTC1 resets TIUI to $TXT line:
19 . . N TIUHDR,TIUFRST,TIUJ S TIUFRST=TIUI
20 . . ; ---- If after first hdr signal, finish previous docmt
21 . . ; before going on w/ current docmt:
22 . . I +$G(TIULCNT),$D(TIUREC("TROOT")),$D(@(TIUREC("TROOT")_"0)")) D FINISH
23 . . K TIUREC D GETREC^TIUPUTC1(TIULINE,.TIUREC,.TIUHDR)
24 . . I +$G(TIUREC("#"))'>0!($G(TIUREC("ROOT"))']"") Q
25 . . D STUFREC(.TIUHDR,.TIUREC)
26 . . S TIUREC("TROOT")=TIUREC("ROOT")_TIUREC("#")_","_TIUREC("TEXT")_","
27 . . S:'$D(@(TIUREC("TROOT")_"0)")) @(TIUREC("TROOT")_"0)")="^^^^^"
28 . . S TIULCNT=+$P(@(TIUREC("TROOT")_"0)"),U,4)
29 . . F TIUJ=TIUFRST:1:TIUI D
30 . . . ; ---- Delete header lines from buffer once filed;
31 . . . ; (TIUI was reset in GETREC^TIUPUTC1 to $TXT line):
32 . . . K ^TIU(8925.2,+DA,"TEXT",TIUJ,0)
33 . . I TIUREC("FILE")=8925,+$G(TIUREC("#")),+$G(TIUREC("BOILON")) D BOILRPLT(.TIUREC)
34 . I TIULINE'[TIUHSIG,(TIULINE'[TIUBGN),(+$G(TIUREC("FILE"))=8925),+$G(TIUREC("BOILON")) D
35 . . I TIULINE]"",$D(^TIU(8925.1,"B",$P(TIULINE,":"))) D I 1
36 . . . S TIULCNT=$$LOCATE(TIULINE,TIUREC("#"))
37 . . E S TIULCNT=+$G(TIULCNT)+.01
38 . . S ^TIU(8925,+TIUREC("#"),"TEMP",TIULCNT,0)=TIULINE
39 . . ; ---- Delete text line from buffer once xferred:
40 . . K ^TIU(8925.2,+DA,"TEXT",TIUI,0)
41 . I TIULINE'[TIUHSIG,(TIULINE'[TIUBGN),$D(TIUREC("TROOT")),$D(@(TIUREC("TROOT")_"0)")),(+$G(TIUREC("BOILON"))'>0) D
42 . . S TIULCNT=+$G(TIULCNT)+1,@(TIUREC("TROOT")_TIULCNT_",0)")=TIULINE
43 . . ; ---- Delete text line once xferred:
44 . . K ^TIU(8925.2,+DA,"TEXT",TIUI,0)
45 . . ; ---- Remove leading buffer garbage
46 . I TIULINE'[TIUHSIG,(TIULINE'[TIUBGN),'$D(TIUREC("TROOT")),($G(TIUREC("#"))'=-1) K ^TIU(8925.2,+DA,"TEXT",TIUI,0)
47 . I TIULINE[TIUBGN K ^TIU(8925.2,+DA,"TEXT",TIUI,0)
48 ; ---- Finish last docmt in buffer file:
49 I +$G(TIULCNT),$D(TIUREC("TROOT")),$D(@(TIUREC("TROOT")_"0)")) D FINISH
50 I '+$O(^TIU(8925.2,+DA,"TEXT",0)) D BUFPURGE(DA)
51 ; ---- Write upload results:
52 I '$D(ZTQUEUED),$D(^TMP("TIUPUTC",$J)) D
53 . W !!,"TOTALS FOR CURRENT BATCH:",!
54 . W !?14,"TOTAL Document(s) RECEIVED: ",$J((+$G(^TMP("TIUPUTC",$J,"SUCC"))+$G(^("MISS"))+$G(^("FAIL"))),5),!
55 . W !?18," Document(s) NOT FILED: ",$J(+$G(^TMP("TIUPUTC",$J,"FAIL")),5)
56 . W !?3,"Document(s) FILED with MISSING FIELDS: ",$J(+$G(^TMP("TIUPUTC",$J,"MISS")),5),!
57 K ^TMP("TIUPUTC",$J)
58 Q
59LOCATE(LINE,REC) ; ---- Locate line in boilerplate text
60 N TIUJ,HIT,BTXT S (TIUJ,HIT)=0
61 F Q:+HIT S TIUJ=$O(^TIU(8925,+REC,"TEMP",TIUJ)) Q:+TIUJ'>0!HIT D
62 . S BTXT=$G(^TIU(8925,+REC,"TEMP",TIUJ,0))
63 . I BTXT[$P(LINE,":")_":" S HIT=1
64 Q +$G(TIUJ)
65 ;
66STUFREC(HEADER,RECORD) ; ---- Stuffs record with known fixed fields;
67 ; Checks for missing fields.
68 N FDA,FDARR,IENS,FLAGS,TIUI,TIUMSG,TIUPC
69 S IENS=""""_+RECORD("#")_","""
70 S FDARR="FDA("_+RECORD("FILE")_","_IENS_")",FLAGS="KE"
71 ; ---- Set up FDA Array:
72 S TIUI=0
73 F S TIUI=$O(HEADER(TIUI)) Q:+TIUI'>0 D
74 . ; if field is Author/Dictator and title is OPERATION REPORT, ignore uploaded data *173
75 . I (TIUI=1202!(TIUI=1209)),TIUREC("TYPE")=$$CHKFILE^TIUADCL(8925.1,"OPERATION REPORT","I $P(^(0),U,4)=""DOC""") S @FDARR@(1303)="U" Q
76 . S:TIUI'=.001 @FDARR@(TIUI)=$$TRNSFRM^TIULX(.RECORD,TIUI,HEADER(TIUI))
77 I $D(FDA) D FILE^DIE(FLAGS,"FDA","TIUMSG")
78 I $D(TIUMSG) D
79 . ; ---- If FILE^DIC fails, log 8925.4 error w/ hdr info. Create new
80 . ; 8925.2 buffer entry with hdr, text, & 8925.4 log #.
81 . ; Kill most of old buffer. Send missing field alerts:
82 . D MAIN^TIUPEVNT(DA,2,"",$P($G(^TIU(8925.1,+RECORD("TYPE"),0)),U),.FDA,.TIUMSG)
83 . S ^TMP("TIUPUTC",$J,"MISS")=+$G(^TMP("TIUPUTC",$J,"MISS"))+1
84 I '$D(TIUMSG) D
85 . S ^TMP("TIUPUTC",$J,"SUCC")=+$G(^TMP("TIUPUTC",$J,"SUCC"))+1
86 Q
87BOILRPLT(TIUREC) ; ---- Execute/Interleave Boilerplates w/uploaded text
88 N TIU
89 D GETTIU^TIULD(.TIU,TIUREC("#"))
90 D LOADDFLT^TIUEDI4(TIUREC("#"),TIUREC("TYPE")) ;100
91 Q
92SETROOT(LINECNT,RECORD) ; ---- Sets root of WP field
93 S @(RECORD("TROOT")_"0)")="^^"_LINECNT_"^"_LINECNT_"^"_DT_"^^"
94 Q
95BUFPURGE(DA) ; ---- Call ^DIK to purge buffer record when all's well
96 N DIK S DIK="^TIU(8925.2," D ^DIK
97 Q
98PREPROC(DA) ; ---- Strip controls & white space from headers
99 N TIUI,TIUHLIN,X S (TIUI,TIUHLIN)=0
100 F S TIUI=$O(^TIU(8925.2,+DA,"TEXT",TIUI)) Q:+TIUI'>0 D
101 . S X=$G(^TIU(8925.2,+DA,"TEXT",TIUI,0))
102 . S:X[TIUHSIG TIUHLIN=1 S:X[TIUBGN TIUHLIN=0
103 . S:TIUHLIN ^TIU(8925.2,+DA,"TEXT",TIUI,0)=$$STRIP^TIUUPLD(X)
104 Q
105DADTYPE(DA) ; ---- Get type of original document for addenda
106 N TIUDAD,Y
107 S TIUDAD=$P($G(^TIU(8925,DA,0)),U,6)
108 S Y=+$G(^TIU(8925,+TIUDAD,0))
109 Q Y
110 ;
111FINISH ; ---- Finish document: feedback, postfile code, merge boil,
112 ; log file event
113 N ISADDNDM S ISADDNDM=0
114 D SETROOT(TIULCNT,.TIUREC)
115 S ISADDNDM=+$$ISADDNDM^TIULC1(TIUREC("#"))
116 S TIUTYPE=$S(ISADDNDM:+$$DADTYPE(TIUREC("#")),1:TIUREC("TYPE"))
117 I '$D(ZTQUEUED) W !,">>> ",$S(ISADDNDM:"Addendum",1:"Document")," Filed Successfully.",! ;TIU*1*81
118 ; ---- TIU*1*81 Tell error handler that retrying filer was successful:
119 S TIUDONE=1
120 S TIUTYPE=$S(+$$ISADDNDM^TIULC1(TIUREC("#")):+$$DADTYPE(TIUREC("#")),1:TIUREC("TYPE"))
121 S TIUPOST=$$POSTFILE^TIULC1(TIUTYPE)
122 I TIUPOST]"" X TIUPOST K ^TMP("TIUPRFUP",$J)
123 I TIUREC("FILE")=8925,+$G(TIUREC("BOILON")) D
124 . N TIU D GETTIU^TIULD(.TIU,TIUREC("#"))
125 . D MERGTEXT^TIUEDI1(TIUREC("#"),.TIU)
126 . K ^TIU(8925,+TIUREC("#"),"TEMP")
127 D MAIN^TIUPEVNT(DA,0,"",$P($G(^TIU(8925.1,+TIUREC("TYPE"),0)),U))
128 Q
129 ;
Note: See TracBrowser for help on using the repository browser.