Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIUPUTC

TIUPUTC.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. MAIN ; ---- Controls branching.
  1. ; Attempts to file upload documents in the target file.
  1. ; Requires DA = IEN of 8925.2 upload buffer entry.
  1. N TIUDA,TIUBGN,TIUI,TIUHSIG,TIULIM,TIULCNT,TIULINE,TIUREC,TIUPOST,TIUFDT
  1. N TIUDONE
  1. N TIUTYPE,TIUINST K ^TMP("TIUPUTC",$J)
  1. I '$D(TIUPRM0)!'$D(TIUPRM1) D SETPARM^TIULE
  1. S TIUHSIG=$P(TIUPRM0,U,10),TIUBGN=$P(TIUPRM0,U,12)
  1. I TIUHSIG']"" D MAIN^TIUPEVNT(DA,1,1) Q
  1. I TIUBGN']"" D MAIN^TIUPEVNT(DA,1,7) Q
  1. ; ---- Strip controls when kermit:
  1. I $P(TIUPRM0,U,17)="k" D PREPROC(DA)
  1. S TIUI=0,TIUFDT=0
  1. F S TIUI=$O(^TIU(8925.2,+DA,"TEXT",TIUI)) Q:+TIUI'>0 D
  1. . S TIULINE=$G(^TIU(8925.2,+DA,"TEXT",TIUI,0))
  1. . ; - Skip to next note if future DS dictation date found
  1. . I (TIUFDT=1),(TIULINE'[TIUHSIG) Q
  1. . S TIUFDT=0
  1. . I TIULINE[TIUHSIG D Q
  1. . . ; ---- Hdr signal line. GETREC^TIUPUTC1 resets TIUI to $TXT line:
  1. . . N TIUHDR,TIUFRST,TIUJ S TIUFRST=TIUI
  1. . . ; ---- If after first hdr signal, finish previous docmt
  1. . . ; before going on w/ current docmt:
  1. . . I +$G(TIULCNT),$D(TIUREC("TROOT")),$D(@(TIUREC("TROOT")_"0)")) D FINISH
  1. . . K TIUREC D GETREC^TIUPUTC1(TIULINE,.TIUREC,.TIUHDR) Q:TIUFDT=1
  1. . . I +$G(TIUREC("#"))'>0!($G(TIUREC("ROOT"))']"") Q
  1. . . D STUFREC(.TIUHDR,.TIUREC)
  1. . . S TIUREC("TROOT")=TIUREC("ROOT")_TIUREC("#")_","_TIUREC("TEXT")_","
  1. . . S:'$D(@(TIUREC("TROOT")_"0)")) @(TIUREC("TROOT")_"0)")="^^^^^"
  1. . . S TIULCNT=+$P(@(TIUREC("TROOT")_"0)"),U,4)
  1. . . F TIUJ=TIUFRST:1:TIUI D
  1. . . . ; ---- Delete header lines from buffer once filed;
  1. . . . ; (TIUI was reset in GETREC^TIUPUTC1 to $TXT line):
  1. . . . K ^TIU(8925.2,+DA,"TEXT",TIUJ,0)
  1. . . I TIUREC("FILE")=8925,+$G(TIUREC("#")),+$G(TIUREC("BOILON")) D BOILRPLT(.TIUREC)
  1. . Q:TIUFDT=1 I TIULINE'[TIUHSIG,(TIULINE'[TIUBGN),(+$G(TIUREC("FILE"))=8925),+$G(TIUREC("BOILON")) D
  1. . . I TIULINE]"",$D(^TIU(8925.1,"B",$P(TIULINE,":"))) D I 1
  1. . . . S TIULCNT=$$LOCATE(TIULINE,TIUREC("#"))
  1. . . E S TIULCNT=+$G(TIULCNT)+.01
  1. . . S ^TIU(8925,+TIUREC("#"),"TEMP",TIULCNT,0)=TIULINE
  1. . . ; ---- Delete text line from buffer once xferred:
  1. . . K ^TIU(8925.2,+DA,"TEXT",TIUI,0)
  1. . I TIULINE'[TIUHSIG,(TIULINE'[TIUBGN),$D(TIUREC("TROOT")),$D(@(TIUREC("TROOT")_"0)")),(+$G(TIUREC("BOILON"))'>0) D
  1. . . S TIULCNT=+$G(TIULCNT)+1,@(TIUREC("TROOT")_TIULCNT_",0)")=TIULINE
  1. . . ; ---- Delete text line once xferred:
  1. . . K ^TIU(8925.2,+DA,"TEXT",TIUI,0)
  1. . . ; ---- Remove leading buffer garbage
  1. . I TIULINE'[TIUHSIG,(TIULINE'[TIUBGN),'$D(TIUREC("TROOT")),($G(TIUREC("#"))'=-1) K ^TIU(8925.2,+DA,"TEXT",TIUI,0)
  1. . I TIULINE[TIUBGN K ^TIU(8925.2,+DA,"TEXT",TIUI,0)
  1. ; ---- Finish last docmt in buffer file:
  1. I +$G(TIULCNT),$D(TIUREC("TROOT")),$D(@(TIUREC("TROOT")_"0)")) D FINISH
  1. I '+$O(^TIU(8925.2,+DA,"TEXT",0)) D BUFPURGE(DA)
  1. ; ---- Write upload results:
  1. I '$D(ZTQUEUED),$D(^TMP("TIUPUTC",$J)) D
  1. . W !!,"TOTALS FOR CURRENT BATCH:",!
  1. . W !?14,"TOTAL Document(s) RECEIVED: ",$J((+$G(^TMP("TIUPUTC",$J,"SUCC"))+$G(^("MISS"))+$G(^("FAIL"))),5),!
  1. . W !?18," Document(s) NOT FILED: ",$J(+$G(^TMP("TIUPUTC",$J,"FAIL")),5)
  1. . W !?3,"Document(s) FILED with MISSING FIELDS: ",$J(+$G(^TMP("TIUPUTC",$J,"MISS")),5),!
  1. K ^TMP("TIUPUTC",$J)
  1. Q
  1. LOCATE(LINE,REC) ; ---- Locate line in boilerplate text
  1. N TIUJ,HIT,BTXT S (TIUJ,HIT)=0
  1. F Q:+HIT S TIUJ=$O(^TIU(8925,+REC,"TEMP",TIUJ)) Q:+TIUJ'>0!HIT D
  1. . S BTXT=$G(^TIU(8925,+REC,"TEMP",TIUJ,0))
  1. . I BTXT[$P(LINE,":")_":" S HIT=1
  1. Q +$G(TIUJ)
  1. ;
  1. STUFREC(HEADER,TIURECD) ; ---- Stuffs record with known fixed fields;
  1. ; Checks for missing fields.
  1. N TIUFDA,FDARR,IENS,FLAGS,TIUI,TIUMSG,TIUECMSG,TIUPC,NEWMISS
  1. S IENS=""""_+TIURECD("#")_","""
  1. S FDARR="TIUFDA("_+TIURECD("FILE")_","_IENS_")",FLAGS="KE"
  1. ; ---- Set up TIUFDA Array:
  1. S TIUI=0
  1. F S TIUI=$O(HEADER(TIUI)) Q:+TIUI'>0 D
  1. . ; if field is Author/Dictator and title is OPERATION REPORT, ignore uploaded data *173
  1. . ; *277 VMP/DJH Allow 1202/1209 to file if addendum
  1. . 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
  1. . S:TIUI'=.001 @FDARR@(TIUI)=$$TRNSFRM^TIULX(.TIURECD,TIUI,HEADER(TIUI))
  1. I $D(TIUFDA) D FILE^DIE(FLAGS,"TIUFDA","TIUMSG")
  1. S NEWMISS=0
  1. I $D(TIUMSG) D
  1. . ; ---- If FILE^DIC fails, log 8925.4 error w/ hdr info. Create new
  1. . ; 8925.2 buffer entry with hdr, text, & 8925.4 log #.
  1. . ; Kill most of old buffer. Send missing field alerts:
  1. . D MAIN^TIUPEVNT(DA,2,"",$P($G(^TIU(8925.1,+TIURECD("TYPE"),0)),U),.TIUFDA,.TIUMSG)
  1. . S ^TMP("TIUPUTC",$J,"MISS")=+$G(^TMP("TIUPUTC",$J,"MISS"))+1,NEWMISS=1
  1. D CKEXPCOS(NEWMISS)
  1. I '$D(TIUMSG),'$D(TIUECMSG) D
  1. . S ^TMP("TIUPUTC",$J,"SUCC")=+$G(^TMP("TIUPUTC",$J,"SUCC"))+1
  1. Q
  1. CKEXPCOS(NEWMISS) ; check if Exp Cos is a missing field. Requires some vars from STUFREC
  1. N TIUFDA,TIUTITL,TIUD0,TIU12,TIU13,TIUEC,TIUAUTH,TIUDTDIC,TIUI,HEADER,TIUDAD
  1. S TIUTITL=+^TIU(8925,TIURECD("#"),0)
  1. I +$$ISADDNDM^TIULC1(TIURECD("#")) S TIUTITL=+$$DADTYPE^TIUPUTC(TIURECD("#"))
  1. I TIUTITL=81 S TIUD0=^TIU(8925,TIURECD("#"),0),TIUDAD=$P(TIUD0,U,6),TIUTITL=+^TIU(8925,TIUDAD,0)
  1. S TIU12=$G(^TIU(8925,TIURECD("#"),12)),TIU13=$G(^TIU(8925,TIURECD("#"),13))
  1. S TIUEC=$P(TIU12,U,8),TIUAUTH=$P(TIU12,U,2),TIUDTDIC=$P(TIU13,U,7) I TIUEC>0!(TIUAUTH'>0)!(TIUDTDIC'>0) Q
  1. I '$$REQCOSIG^TIULP(TIUTITL,,TIUAUTH,$P(TIUDTDIC,".")) Q
  1. S TIUI=1208,HEADER(TIUI)="** EXPECTED COSIGNER MISSING FROM UPLOAD **"
  1. ; If EC not there or not valid, set miss fld error.
  1. S @FDARR@(TIUI)=$$TRNSFRM^TIULX(.TIURECD,TIUI,HEADER(TIUI))
  1. D FILE^DIE(FLAGS,"TIUFDA","TIUECMSG")
  1. I $D(TIUECMSG) D
  1. . D MAIN^TIUPEVNT(DA,2,"",$P($G(^TIU(8925.1,+TIURECD("TYPE"),0)),U),.TIUFDA,.TIUECMSG)
  1. . ; Don't raise # of missing-fld docmts if it has already been raised for this docmt:
  1. . I 'NEWMISS S ^TMP("TIUPUTC",$J,"MISS")=+$G(^TMP("TIUPUTC",$J,"MISS"))+1
  1. Q
  1. BOILRPLT(TIUREC) ; ---- Execute/Interleave Boilerplates w/uploaded text
  1. N TIU
  1. D GETTIU^TIULD(.TIU,TIUREC("#"))
  1. D LOADDFLT^TIUEDI4(TIUREC("#"),TIUREC("TYPE")) ;100
  1. Q
  1. SETROOT(LINECNT,RECORD) ; ---- Sets root of WP field
  1. S @(RECORD("TROOT")_"0)")="^^"_LINECNT_"^"_LINECNT_"^"_DT_"^^"
  1. Q
  1. BUFPURGE(DA) ; ---- Call ^DIK to purge buffer record when all's well
  1. N DIK S DIK="^TIU(8925.2," D ^DIK
  1. Q
  1. PREPROC(DA) ; ---- Strip controls & white space from headers
  1. N TIUI,TIUHLIN,X S (TIUI,TIUHLIN)=0
  1. F S TIUI=$O(^TIU(8925.2,+DA,"TEXT",TIUI)) Q:+TIUI'>0 D
  1. . S X=$G(^TIU(8925.2,+DA,"TEXT",TIUI,0))
  1. . S:X[TIUHSIG TIUHLIN=1 S:X[TIUBGN TIUHLIN=0
  1. . S:TIUHLIN ^TIU(8925.2,+DA,"TEXT",TIUI,0)=$$STRIP^TIUUPLD(X)
  1. Q
  1. DADTYPE(DA) ; ---- Get type of original document for addenda
  1. N TIUDAD,Y
  1. S TIUDAD=$P($G(^TIU(8925,DA,0)),U,6)
  1. S Y=+$G(^TIU(8925,+TIUDAD,0))
  1. Q Y
  1. ;
  1. FINISH ; ---- Finish document: feedback, postfile code, merge boil,
  1. ; log file event
  1. N ISADDNDM S ISADDNDM=0
  1. D SETROOT(TIULCNT,.TIUREC)
  1. S ISADDNDM=+$$ISADDNDM^TIULC1(TIUREC("#"))
  1. S TIUTYPE=$S(ISADDNDM:+$$DADTYPE(TIUREC("#")),1:TIUREC("TYPE"))
  1. I '$D(ZTQUEUED) W !,">>> ",$S(ISADDNDM:"Addendum",1:"Document")," Filed Successfully.",! ;TIU*1*81
  1. ; ---- TIU*1*81 Tell error handler that retrying filer was successful:
  1. S TIUDONE=1
  1. S TIUTYPE=$S(+$$ISADDNDM^TIULC1(TIUREC("#")):+$$DADTYPE(TIUREC("#")),1:TIUREC("TYPE"))
  1. S TIUPOST=$$POSTFILE^TIULC1(TIUTYPE)
  1. I TIUPOST]"" X TIUPOST K ^TMP("TIUPRFUP",$J)
  1. I TIUREC("FILE")=8925,+$G(TIUREC("BOILON")) D
  1. . N TIU D GETTIU^TIULD(.TIU,TIUREC("#"))
  1. . D MERGTEXT^TIUEDI1(TIUREC("#"),.TIU)
  1. . K ^TIU(8925,+TIUREC("#"),"TEMP")
  1. D MAIN^TIUPEVNT(DA,0,"",$P($G(^TIU(8925.1,+TIUREC("TYPE"),0)),U))
  1. Q
  1. ;