TIUSRVPT ; SLC/JER - Set Methods for Documents ;03/02/10 09:59
;;1.0;TEXT INTEGRATION UTILITIES;**122,175,186,210,223,250**;Jun 20, 1997;Build 14
;
; ICR #10018 - DIE Routine & DIE, DR, & DA Local Vars
; #10103 - $$FMADD^XLFDT,$$NOW^XLFDT
;
SETTEXT(TIUY,TIUDA,TIUX,SUPPRESS) ; Save Text - use Buffered I/O
N PAGES,PAGE S TIUY=0,SUPPRESS=$G(SUPPRESS,0)
I $S(+$G(TIUDA)'>0:1,'$D(^TIU(8925,+TIUDA,0)):1,1:0) D Q
. S TIUY="0^0^0^Attempt to file data in a Nonexistent Entry."
. D ERROR(TIUY)
S PAGE=$P($G(TIUX("HDR")),U),PAGES=$P($G(TIUX("HDR")),U,2)
I $S('PAGE:1,'PAGES:1,1:0) D Q
. S TIUY="0^0^0^Invalid text block header"
. D ERROR(TIUY)
; I PAGE=1 D MERGTEMP^TIUEDI1(TIUDA) K ^TIU(8925,+TIUDA,"TEMP"),^("TEXT")
I PAGE=1 K ^TIU(8925,+TIUDA,"TEMP")
M ^TIU(8925,+TIUDA,"TEMP")=TIUX("TEXT")
;if done, commit changes
I 'SUPPRESS,(PAGE=PAGES),$D(^TIU(8925,TIUDA,"TEMP")) D
. N TIUC,TIUI,TIU,TIUD12,TIUAU,TIUEC S (TIUC,TIUI)=0
. F S TIUI=$O(^TIU(8925,TIUDA,"TEMP",TIUI)) Q:+TIUI'>0 D
. . S TIUC=TIUC+1
. I TIUC>0 S ^TIU(8925,TIUDA,"TEMP",0)="^^"_TIUC_U_TIUC_U_DT_"^^"
. D GETTIU^TIULD(.TIU,TIUDA)
. K ^TIU(8925,TIUDA,"TEXT")
. S TIUC=0 F S TIUC=$O(^TIU(8925,"DAD",TIUDA,TIUC)) Q:+TIUC'>0 D
. . I +$$ISADDNDM^TIULC1(+TIUC) Q
. . K ^TIU(8925,+TIUC,"TEXT")
. D MERGTEXT^TIUEDI1(+TIUDA,.TIU)
. K ^TIU(8925,TIUDA,"TEMP")
. ; If user is neither author or expected cosigner, file VBC Line count
. S TIUD12=$G(^TIU(8925,TIUDA,12)),TIUAU=$P(TIUD12,U,2),TIUEC=$P(TIUD12,U,8)
. I (TIUAU]""),(DUZ'=TIUAU) D
. . I (TIUEC]""),(DUZ=TIUEC) Q
. . D LINES(TIUDA)
; Acknowledge success / ask for next page
S TIUY=TIUDA_U_PAGE_U_PAGES
Q
LINES(DA) ; Compute/file VBC Line count
N DIE,DR S DIE="^TIU(8925,",DR=".1///"_$$LINECNT^TIULC(DA)_";1801///"_$$VBCLINES^TIULC(+DA)
D ^DIE
Q
ADMNCLOS(TIUY,TIUDA,MODE,PERSON) ; Post Administrative Closure Information
N TIUX,TIUI,TIUCLBY,TIUCLTTL,TIUCAPT
I '$D(^TIU(8925,TIUDA)) S TIUY="0^Attempt to file data in a Nonexistent Entry." Q
S MODE=$G(MODE,"S")
S TIUCAPT=$S("ES"[MODE:" Electronically Filed: ",1:"Administrative Closure: ")
S PERSON=$G(PERSON,DUZ)
S TIUCLBY=$$SIGNAME^TIULS(PERSON)
S TIUCLTTL=$$SIGTITL^TIULS(PERSON)
S TIUX(.05)=7
S TIUX(1606)=$G(DT)
S TIUX(1607)=TIUCLBY
S TIUX(1608)=TIUCLTTL
S TIUX(1613)=MODE
D FILE^TIUSRVP(.TIUY,TIUDA,.TIUX)
S TIUI=$P($G(^TIU(8925,TIUDA,"TEXT",0)),U,3)+1
;If scanned document set document body to informational text
I MODE="S" D
. S ^TIU(8925,+TIUDA,"TEXT",TIUI,0)=" ",TIUI=TIUI+1
. S ^TIU(8925,+TIUDA,"TEXT",TIUI,0)=" *** SCANNED DOCUMENT ***",TIUI=TIUI+1
. S ^TIU(8925,+TIUDA,"TEXT",TIUI,0)=" SIGNATURE NOT REQUIRED",TIUI=TIUI+1
. S ^TIU(8925,+TIUDA,"TEXT",TIUI,0)=" ",TIUI=TIUI+1
S ^TIU(8925,TIUDA,"TEXT",TIUI,0)=" ",TIUI=TIUI+1
S ^TIU(8925,TIUDA,"TEXT",TIUI,0)=TIUCAPT_$$DATE^TIULS(DT,"MM/DD/CCYY"),TIUI=TIUI+1
S ^TIU(8925,TIUDA,"TEXT",TIUI,0)=" by: "_TIUCLBY,TIUI=TIUI+1
S ^TIU(8925,TIUDA,"TEXT",TIUI,0)=" "_TIUCLTTL
S ^TIU(8925,+TIUDA,"TEXT",0)="^^"_TIUI_U_TIUI_U_DT_"^^"
D ALERTDEL^TIUALRT(TIUDA)
; post-signature action for administratively closed docs
N TIUCONS,TIUSTIS,TIUTTL,TIUPSIG,DA S TIUCONS=-1
D ISCNSLT^TIUCNSLT(.TIUCONS,+$G(^TIU(8925,TIUDA,0)))
S TIUSTIS=$P($G(^TIU(8925,TIUDA,0)),U,5)
S TIUTTL=+$G(^TIU(8925,+TIUDA,0)),TIUPSIG=$$POSTSIGN^TIULC1(TIUTTL)
I +$L(TIUPSIG) S DA=TIUDA X TIUPSIG
I TIUCONS,TIUSTIS=7,$$HASKIDS^TIUSRVLI(TIUDA) D
. N SEQUENCE,TIUKIDS,TIUINT,TIUK
. S SEQUENCE="D",TIUKIDS="TIUKIDS",TIUINT=0,TIUK=0
. D SETKIDS^TIUSRVLI(TIUKIDS,TIUDA,TIUINT)
. F S TIUK=$O(TIUKIDS(TIUK)) Q:'TIUK D
. . I $P(TIUKIDS(TIUK),U,7)="completed" X TIUPSIG
Q
ERROR(ECODE) ; Register AUTOSAVE Error
N ERRDT S ERRDT=+$$NOW^XLFDT
Q:+$G(^XTMP("TIUERR","COUNT"))'<100
I '$D(^XTMP("TIUERR",0)) D
. S ^XTMP("TIUERR",0)=$$FMADD^XLFDT(DT,90)_U_DT
S ^XTMP("TIUERR",ERRDT,"ECODE")=ECODE
S ^XTMP("TIUERR",ERRDT,"USER")=DUZ
S ^XTMP("TIUERR",ERRDT,"TIUDA")=$G(TIUDA,"UNDEFINED")
S ^XTMP("TIUERR",ERRDT,"TIUHDR")=$G(TIUX("HDR"))
S ^XTMP("TIUERR",ERRDT,"XWBHDR")=$G(XWBS1("HDR"))
S ^XTMP("TIUERR","COUNT")=$G(^XTMP("TIUERR","COUNT"))+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUSRVPT 4294 printed Dec 13, 2024@02:46:01 Page 2
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
+2 ;
+3 ; ICR #10018 - DIE Routine & DIE, DR, & DA Local Vars
+4 ; #10103 - $$FMADD^XLFDT,$$NOW^XLFDT
+5 ;
SETTEXT(TIUY,TIUDA,TIUX,SUPPRESS) ; Save Text - use Buffered I/O
+1 NEW PAGES,PAGE
SET TIUY=0
SET SUPPRESS=$GET(SUPPRESS,0)
+2 IF $SELECT(+$GET(TIUDA)'>0:1,'$DATA(^TIU(8925,+TIUDA,0)):1,1:0)
Begin DoDot:1
+3 SET TIUY="0^0^0^Attempt to file data in a Nonexistent Entry."
+4 DO ERROR(TIUY)
End DoDot:1
QUIT
+5 SET PAGE=$PIECE($GET(TIUX("HDR")),U)
SET PAGES=$PIECE($GET(TIUX("HDR")),U,2)
+6 IF $SELECT('PAGE:1,'PAGES:1,1:0)
Begin DoDot:1
+7 SET TIUY="0^0^0^Invalid text block header"
+8 DO ERROR(TIUY)
End DoDot:1
QUIT
+9 ; I PAGE=1 D MERGTEMP^TIUEDI1(TIUDA) K ^TIU(8925,+TIUDA,"TEMP"),^("TEXT")
+10 IF PAGE=1
KILL ^TIU(8925,+TIUDA,"TEMP")
+11 MERGE ^TIU(8925,+TIUDA,"TEMP")=TIUX("TEXT")
+12 ;if done, commit changes
+13 IF 'SUPPRESS
IF (PAGE=PAGES)
IF $DATA(^TIU(8925,TIUDA,"TEMP"))
Begin DoDot:1
+14 NEW TIUC,TIUI,TIU,TIUD12,TIUAU,TIUEC
SET (TIUC,TIUI)=0
+15 FOR
SET TIUI=$ORDER(^TIU(8925,TIUDA,"TEMP",TIUI))
if +TIUI'>0
QUIT
Begin DoDot:2
+16 SET TIUC=TIUC+1
End DoDot:2
+17 IF TIUC>0
SET ^TIU(8925,TIUDA,"TEMP",0)="^^"_TIUC_U_TIUC_U_DT_"^^"
+18 DO GETTIU^TIULD(.TIU,TIUDA)
+19 KILL ^TIU(8925,TIUDA,"TEXT")
+20 SET TIUC=0
FOR
SET TIUC=$ORDER(^TIU(8925,"DAD",TIUDA,TIUC))
if +TIUC'>0
QUIT
Begin DoDot:2
+21 IF +$$ISADDNDM^TIULC1(+TIUC)
QUIT
+22 KILL ^TIU(8925,+TIUC,"TEXT")
End DoDot:2
+23 DO MERGTEXT^TIUEDI1(+TIUDA,.TIU)
+24 KILL ^TIU(8925,TIUDA,"TEMP")
+25 ; If user is neither author or expected cosigner, file VBC Line count
+26 SET TIUD12=$GET(^TIU(8925,TIUDA,12))
SET TIUAU=$PIECE(TIUD12,U,2)
SET TIUEC=$PIECE(TIUD12,U,8)
+27 IF (TIUAU]"")
IF (DUZ'=TIUAU)
Begin DoDot:2
+28 IF (TIUEC]"")
IF (DUZ=TIUEC)
QUIT
+29 DO LINES(TIUDA)
End DoDot:2
End DoDot:1
+30 ; Acknowledge success / ask for next page
+31 SET TIUY=TIUDA_U_PAGE_U_PAGES
+32 QUIT
LINES(DA) ; Compute/file VBC Line count
+1 NEW DIE,DR
SET DIE="^TIU(8925,"
SET DR=".1///"_$$LINECNT^TIULC(DA)_";1801///"_$$VBCLINES^TIULC(+DA)
+2 DO ^DIE
+3 QUIT
ADMNCLOS(TIUY,TIUDA,MODE,PERSON) ; Post Administrative Closure Information
+1 NEW TIUX,TIUI,TIUCLBY,TIUCLTTL,TIUCAPT
+2 IF '$DATA(^TIU(8925,TIUDA))
SET TIUY="0^Attempt to file data in a Nonexistent Entry."
QUIT
+3 SET MODE=$GET(MODE,"S")
+4 SET TIUCAPT=$SELECT("ES"[MODE:" Electronically Filed: ",1:"Administrative Closure: ")
+5 SET PERSON=$GET(PERSON,DUZ)
+6 SET TIUCLBY=$$SIGNAME^TIULS(PERSON)
+7 SET TIUCLTTL=$$SIGTITL^TIULS(PERSON)
+8 SET TIUX(.05)=7
+9 SET TIUX(1606)=$GET(DT)
+10 SET TIUX(1607)=TIUCLBY
+11 SET TIUX(1608)=TIUCLTTL
+12 SET TIUX(1613)=MODE
+13 DO FILE^TIUSRVP(.TIUY,TIUDA,.TIUX)
+14 SET TIUI=$PIECE($GET(^TIU(8925,TIUDA,"TEXT",0)),U,3)+1
+15 ;If scanned document set document body to informational text
+16 IF MODE="S"
Begin DoDot:1
+17 SET ^TIU(8925,+TIUDA,"TEXT",TIUI,0)=" "
SET TIUI=TIUI+1
+18 SET ^TIU(8925,+TIUDA,"TEXT",TIUI,0)=" *** SCANNED DOCUMENT ***"
SET TIUI=TIUI+1
+19 SET ^TIU(8925,+TIUDA,"TEXT",TIUI,0)=" SIGNATURE NOT REQUIRED"
SET TIUI=TIUI+1
+20 SET ^TIU(8925,+TIUDA,"TEXT",TIUI,0)=" "
SET TIUI=TIUI+1
End DoDot:1
+21 SET ^TIU(8925,TIUDA,"TEXT",TIUI,0)=" "
SET TIUI=TIUI+1
+22 SET ^TIU(8925,TIUDA,"TEXT",TIUI,0)=TIUCAPT_$$DATE^TIULS(DT,"MM/DD/CCYY")
SET TIUI=TIUI+1
+23 SET ^TIU(8925,TIUDA,"TEXT",TIUI,0)=" by: "_TIUCLBY
SET TIUI=TIUI+1
+24 SET ^TIU(8925,TIUDA,"TEXT",TIUI,0)=" "_TIUCLTTL
+25 SET ^TIU(8925,+TIUDA,"TEXT",0)="^^"_TIUI_U_TIUI_U_DT_"^^"
+26 DO ALERTDEL^TIUALRT(TIUDA)
+27 ; post-signature action for administratively closed docs
+28 NEW TIUCONS,TIUSTIS,TIUTTL,TIUPSIG,DA
SET TIUCONS=-1
+29 DO ISCNSLT^TIUCNSLT(.TIUCONS,+$GET(^TIU(8925,TIUDA,0)))
+30 SET TIUSTIS=$PIECE($GET(^TIU(8925,TIUDA,0)),U,5)
+31 SET TIUTTL=+$GET(^TIU(8925,+TIUDA,0))
SET TIUPSIG=$$POSTSIGN^TIULC1(TIUTTL)
+32 IF +$LENGTH(TIUPSIG)
SET DA=TIUDA
XECUTE TIUPSIG
+33 IF TIUCONS
IF TIUSTIS=7
IF $$HASKIDS^TIUSRVLI(TIUDA)
Begin DoDot:1
+34 NEW SEQUENCE,TIUKIDS,TIUINT,TIUK
+35 SET SEQUENCE="D"
SET TIUKIDS="TIUKIDS"
SET TIUINT=0
SET TIUK=0
+36 DO SETKIDS^TIUSRVLI(TIUKIDS,TIUDA,TIUINT)
+37 FOR
SET TIUK=$ORDER(TIUKIDS(TIUK))
if 'TIUK
QUIT
Begin DoDot:2
+38 IF $PIECE(TIUKIDS(TIUK),U,7)="completed"
XECUTE TIUPSIG
End DoDot:2
End DoDot:1
+39 QUIT
ERROR(ECODE) ; Register AUTOSAVE Error
+1 NEW ERRDT
SET ERRDT=+$$NOW^XLFDT
+2 if +$GET(^XTMP("TIUERR","COUNT"))'<100
QUIT
+3 IF '$DATA(^XTMP("TIUERR",0))
Begin DoDot:1
+4 SET ^XTMP("TIUERR",0)=$$FMADD^XLFDT(DT,90)_U_DT
End DoDot:1
+5 SET ^XTMP("TIUERR",ERRDT,"ECODE")=ECODE
+6 SET ^XTMP("TIUERR",ERRDT,"USER")=DUZ
+7 SET ^XTMP("TIUERR",ERRDT,"TIUDA")=$GET(TIUDA,"UNDEFINED")
+8 SET ^XTMP("TIUERR",ERRDT,"TIUHDR")=$GET(TIUX("HDR"))
+9 SET ^XTMP("TIUERR",ERRDT,"XWBHDR")=$GET(XWBS1("HDR"))
+10 SET ^XTMP("TIUERR","COUNT")=$GET(^XTMP("TIUERR","COUNT"))+1
+11 QUIT
