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

TIUSRVPT.m

Go to the documentation of this file.
  1. TIUSRVPT ; SLC/JER - Set Methods for Documents ;03/02/10 09:59
  1. ;;1.0;TEXT INTEGRATION UTILITIES;**122,175,186,210,223,250**;Jun 20, 1997;Build 14
  1. ;
  1. ; ICR #10018 - DIE Routine & DIE, DR, & DA Local Vars
  1. ; #10103 - $$FMADD^XLFDT,$$NOW^XLFDT
  1. ;
  1. SETTEXT(TIUY,TIUDA,TIUX,SUPPRESS) ; Save Text - use Buffered I/O
  1. N PAGES,PAGE S TIUY=0,SUPPRESS=$G(SUPPRESS,0)
  1. I $S(+$G(TIUDA)'>0:1,'$D(^TIU(8925,+TIUDA,0)):1,1:0) D Q
  1. . S TIUY="0^0^0^Attempt to file data in a Nonexistent Entry."
  1. . D ERROR(TIUY)
  1. S PAGE=$P($G(TIUX("HDR")),U),PAGES=$P($G(TIUX("HDR")),U,2)
  1. I $S('PAGE:1,'PAGES:1,1:0) D Q
  1. . S TIUY="0^0^0^Invalid text block header"
  1. . D ERROR(TIUY)
  1. ; I PAGE=1 D MERGTEMP^TIUEDI1(TIUDA) K ^TIU(8925,+TIUDA,"TEMP"),^("TEXT")
  1. I PAGE=1 K ^TIU(8925,+TIUDA,"TEMP")
  1. M ^TIU(8925,+TIUDA,"TEMP")=TIUX("TEXT")
  1. ;if done, commit changes
  1. I 'SUPPRESS,(PAGE=PAGES),$D(^TIU(8925,TIUDA,"TEMP")) D
  1. . N TIUC,TIUI,TIU,TIUD12,TIUAU,TIUEC S (TIUC,TIUI)=0
  1. . F S TIUI=$O(^TIU(8925,TIUDA,"TEMP",TIUI)) Q:+TIUI'>0 D
  1. . . S TIUC=TIUC+1
  1. . I TIUC>0 S ^TIU(8925,TIUDA,"TEMP",0)="^^"_TIUC_U_TIUC_U_DT_"^^"
  1. . D GETTIU^TIULD(.TIU,TIUDA)
  1. . K ^TIU(8925,TIUDA,"TEXT")
  1. . S TIUC=0 F S TIUC=$O(^TIU(8925,"DAD",TIUDA,TIUC)) Q:+TIUC'>0 D
  1. . . I +$$ISADDNDM^TIULC1(+TIUC) Q
  1. . . K ^TIU(8925,+TIUC,"TEXT")
  1. . D MERGTEXT^TIUEDI1(+TIUDA,.TIU)
  1. . K ^TIU(8925,TIUDA,"TEMP")
  1. . ; If user is neither author or expected cosigner, file VBC Line count
  1. . S TIUD12=$G(^TIU(8925,TIUDA,12)),TIUAU=$P(TIUD12,U,2),TIUEC=$P(TIUD12,U,8)
  1. . I (TIUAU]""),(DUZ'=TIUAU) D
  1. . . I (TIUEC]""),(DUZ=TIUEC) Q
  1. . . D LINES(TIUDA)
  1. ; Acknowledge success / ask for next page
  1. S TIUY=TIUDA_U_PAGE_U_PAGES
  1. Q
  1. LINES(DA) ; Compute/file VBC Line count
  1. N DIE,DR S DIE="^TIU(8925,",DR=".1///"_$$LINECNT^TIULC(DA)_";1801///"_$$VBCLINES^TIULC(+DA)
  1. D ^DIE
  1. Q
  1. ADMNCLOS(TIUY,TIUDA,MODE,PERSON) ; Post Administrative Closure Information
  1. N TIUX,TIUI,TIUCLBY,TIUCLTTL,TIUCAPT
  1. I '$D(^TIU(8925,TIUDA)) S TIUY="0^Attempt to file data in a Nonexistent Entry." Q
  1. S MODE=$G(MODE,"S")
  1. S TIUCAPT=$S("ES"[MODE:" Electronically Filed: ",1:"Administrative Closure: ")
  1. S PERSON=$G(PERSON,DUZ)
  1. S TIUCLBY=$$SIGNAME^TIULS(PERSON)
  1. S TIUCLTTL=$$SIGTITL^TIULS(PERSON)
  1. S TIUX(.05)=7
  1. S TIUX(1606)=$G(DT)
  1. S TIUX(1607)=TIUCLBY
  1. S TIUX(1608)=TIUCLTTL
  1. S TIUX(1613)=MODE
  1. D FILE^TIUSRVP(.TIUY,TIUDA,.TIUX)
  1. S TIUI=$P($G(^TIU(8925,TIUDA,"TEXT",0)),U,3)+1
  1. ;If scanned document set document body to informational text
  1. I MODE="S" D
  1. . S ^TIU(8925,+TIUDA,"TEXT",TIUI,0)=" ",TIUI=TIUI+1
  1. . S ^TIU(8925,+TIUDA,"TEXT",TIUI,0)=" *** SCANNED DOCUMENT ***",TIUI=TIUI+1
  1. . S ^TIU(8925,+TIUDA,"TEXT",TIUI,0)=" SIGNATURE NOT REQUIRED",TIUI=TIUI+1
  1. . S ^TIU(8925,+TIUDA,"TEXT",TIUI,0)=" ",TIUI=TIUI+1
  1. S ^TIU(8925,TIUDA,"TEXT",TIUI,0)=" ",TIUI=TIUI+1
  1. S ^TIU(8925,TIUDA,"TEXT",TIUI,0)=TIUCAPT_$$DATE^TIULS(DT,"MM/DD/CCYY"),TIUI=TIUI+1
  1. S ^TIU(8925,TIUDA,"TEXT",TIUI,0)=" by: "_TIUCLBY,TIUI=TIUI+1
  1. S ^TIU(8925,TIUDA,"TEXT",TIUI,0)=" "_TIUCLTTL
  1. S ^TIU(8925,+TIUDA,"TEXT",0)="^^"_TIUI_U_TIUI_U_DT_"^^"
  1. D ALERTDEL^TIUALRT(TIUDA)
  1. ; post-signature action for administratively closed docs
  1. N TIUCONS,TIUSTIS,TIUTTL,TIUPSIG,DA S TIUCONS=-1
  1. D ISCNSLT^TIUCNSLT(.TIUCONS,+$G(^TIU(8925,TIUDA,0)))
  1. S TIUSTIS=$P($G(^TIU(8925,TIUDA,0)),U,5)
  1. S TIUTTL=+$G(^TIU(8925,+TIUDA,0)),TIUPSIG=$$POSTSIGN^TIULC1(TIUTTL)
  1. I +$L(TIUPSIG) S DA=TIUDA X TIUPSIG
  1. I TIUCONS,TIUSTIS=7,$$HASKIDS^TIUSRVLI(TIUDA) D
  1. . N SEQUENCE,TIUKIDS,TIUINT,TIUK
  1. . S SEQUENCE="D",TIUKIDS="TIUKIDS",TIUINT=0,TIUK=0
  1. . D SETKIDS^TIUSRVLI(TIUKIDS,TIUDA,TIUINT)
  1. . F S TIUK=$O(TIUKIDS(TIUK)) Q:'TIUK D
  1. . . I $P(TIUKIDS(TIUK),U,7)="completed" X TIUPSIG
  1. Q
  1. ERROR(ECODE) ; Register AUTOSAVE Error
  1. N ERRDT S ERRDT=+$$NOW^XLFDT
  1. Q:+$G(^XTMP("TIUERR","COUNT"))'<100
  1. I '$D(^XTMP("TIUERR",0)) D
  1. . S ^XTMP("TIUERR",0)=$$FMADD^XLFDT(DT,90)_U_DT
  1. S ^XTMP("TIUERR",ERRDT,"ECODE")=ECODE
  1. S ^XTMP("TIUERR",ERRDT,"USER")=DUZ
  1. S ^XTMP("TIUERR",ERRDT,"TIUDA")=$G(TIUDA,"UNDEFINED")
  1. S ^XTMP("TIUERR",ERRDT,"TIUHDR")=$G(TIUX("HDR"))
  1. S ^XTMP("TIUERR",ERRDT,"XWBHDR")=$G(XWBS1("HDR"))
  1. S ^XTMP("TIUERR","COUNT")=$G(^XTMP("TIUERR","COUNT"))+1
  1. Q