TIULS1 ; SLC/JER - Signature Block Procedures ;21-MAY-1999 15:30:59
;;1.0;TEXT INTEGRATION UTILITIES;**52**;Jun 20, 1997
EN(TIUY,DA) ; Get signature and cosignature blocks
N D0,DIC,DIQ,DIQ2,DR,TIUSIG
Q:'$D(^TIU(8925,DA,15))
S DIC=8925,DIQ="TIUSIG",DIQ(0)="IE",DR="1204;1208;1501:1505;1507:1511"
D EN^DIQ1 I '$D(TIUSIG) Q
D LOADSIG(.TIUY,"TIUSIG(8925,DA)")
Q
LOADSIG(TIUY,TIUARR) ; Load signature and cosignature blocks
N TIUL,TIUESIG1,TIUESIG2,TIUSIG1,TIUSIG2,TIUS1,TIUS2
N TIUSNM,TIUSTTL,TIUS1DT,TIUS2DT,TIUSDT
S TIUS1=$S(@TIUARR@(1505,"I")="E":"/es/ ",@TIUARR@(1505,"I")="C":"/s/ ",1:"")_$G(@TIUARR@(1503,"E"))
S TIUS2=$S(@TIUARR@(1511,"I")="E":"/es/ ",@TIUARR@(1511,"I")="C":"/s/ ",1:"")_$G(@TIUARR@(1509,"E"))
S TIUESIG1=$G(@TIUARR@(1204,"I"))
S TIUSIG1=$G(@TIUARR@(1502,"I"))
S TIUS1DT=$S(+$G(@TIUARR@(1501,"I")):"Signed: "_$$DATE^TIULS($G(@TIUARR@(1501,"I")),"MM/DD/CCYY HR:MIN"),1:"")
S TIUESIG2=$G(@TIUARR@(1208,"I"))
S:TIUESIG2']"" TIUESIG2=$G(@TIUARR@(1209,"I"))
S TIUS2DT=$S(+$G(@TIUARR@(1507,"I")):"Cosigned: "_$$DATE^TIULS($G(@TIUARR@(1507,"I")),"MM/DD/CCYY HR:MIN"),1:"")
S TIUSIG2=$G(@TIUARR@(1508,"I"))
S TIUSNM=$$SETSTR^VALM1(TIUS1,$G(TIUSNM),$S($G(TIUESIG1)=$G(TIUESIG2):40,1:1),35)
I $L(TIUS2) S TIUSNM=$$SETSTR^VALM1(TIUS2,$G(TIUSNM),40,35)
S TIUSTTL=$$SETSTR^VALM1(@TIUARR@(1504,"E"),$G(TIUSTTL),$S($G(TIUESIG1)=$G(TIUESIG2):40,1:1),35)
I $L(TIUS2) S TIUSTTL=$$SETSTR^VALM1(@TIUARR@(1510,"E"),$G(TIUSTTL),40,35)
S TIUSDT=$$SETSTR^VALM1(TIUS1DT,$G(TIUSDT),$S($G(TIUESIG1)=$G(TIUESIG2):40,1:1),35)
I $L(TIUS2) S TIUSDT=$$SETSTR^VALM1(TIUS2DT,$G(TIUSDT),40,35)
S TIUL=+$G(TIUL)+1,TIUY(TIUL)=TIUSNM
S TIUL=+$G(TIUL)+1,TIUY(TIUL)=TIUSTTL
S TIUL=+$G(TIUL)+1,TIUY(TIUL)=TIUSDT
I TIUSIG1']""!(TIUSIG2']"") D LOADWBLK(.TIUY,TIUSIG1,TIUESIG1,TIUSIG2,TIUESIG2,.TIUL)
I TIUSIG1]"",(TIUSIG1'=TIUESIG1) D LOADFOR(TIUSIG1,TIUESIG1,TIUSIG2,TIUESIG2,.TIUL) G LOADSIX
I TIUSIG2]"",(TIUSIG2'=TIUESIG2) D LOADFOR(TIUSIG1,TIUESIG1,TIUSIG2,TIUESIG2,.TIUL)
LOADSIX S TIUY=TIUL
Q
LOADWBLK(TIUY,TIUS1,TIUES1,TIUS2,TIUES2,TIUL) ; Load block for wet signature
N TIUESN1,TIUEST1,TIUESN2,TIUEST2,TIUBLKN,TIUBLKT
; If document is signed, and exp. signer = exp. cosigner then quit
I +TIUS1,(TIUES1=TIUES2) Q
I TIUS1']"" D
. S TIUESN1=$$SIGNAME^TIULS(TIUES1),TIUEST1=$$SIGTITL^TIULS(TIUES1)
. S TIUBLKN=$$SETSTR^VALM1(TIUESN1,$G(TIUBLKN),$S(TIUES1=TIUES2:40,1:1),35)
. S:TIUEST1]"" TIUBLKT=$$SETSTR^VALM1(TIUEST1,$G(TIUBLKT),$S(TIUES1=TIUES2:40,1:1),35)
I TIUS2']"" D
. S TIUESN2=$$SIGNAME^TIULS(TIUES2),TIUEST2=$$SIGTITL^TIULS(TIUES2)
. S TIUBLKN=$$SETSTR^VALM1(TIUESN2,$G(TIUBLKN),40,35)
. S:TIUEST2]"" TIUBLKT=$$SETSTR^VALM1(TIUEST2,$G(TIUBLKT),40,35)
S TIUL=+$G(TIUL)+1,TIUY(TIUL)=TIUBLKN
S:$G(TIUBLKT)]"" TIUL=+$G(TIUL)+1,TIUY(TIUL)=TIUBLKT
Q
LOADFOR(TIUS1,TIUES1,TIUS2,TIUES2,TIUL) ; Apply "for" block(s)
N TIUESN1,TIUEST1,TIUESN2,TIUEST2,TIUFORN,TIUFORT
S TIUESN1=$$SIGNAME^TIULS(TIUES1),TIUEST1=$$SIGTITL^TIULS(TIUES1)
S TIUESN2=$$SIGNAME^TIULS(TIUES2),TIUEST2=$$SIGTITL^TIULS(TIUES2)
I $G(TIUS1)'=$G(TIUES1) S TIUFORN=$$SETSTR^VALM1("for "_TIUESN1,$G(TIUFORN),1,35),TIUFORT=$$SETSTR^VALM1(TIUEST1,$G(TIUFORT),1,35)
I $G(TIUS2)'=$G(TIUES2) S TIUFORN=$$SETSTR^VALM1("for "_TIUESN2,$G(TIUFORN),40,35),TIUFORT=$$SETSTR^VALM1(TIUEST2,$G(TIUFORT),40,35)
S TIUL=+$G(TIUL)+1,TIUY(TIUL)=TIUFORN
S TIUL=+$G(TIUL)+1,TIUY(TIUL)=TIUFORT
Q
XTRASIG(TIUDA,TIUL) ; Load addtional signature blocks
N TIUI,DA,DR,DIC,DIQ,TIUXTRA S TIUI=0
S DIC="^TIU(8925.7,",DIQ="TIUXTRA"
S TIUL=+$G(TIUL)+1,TIUY(TIUL)=" "
S TIUL=+$G(TIUL)+1,TIUY(TIUL)="Concurrence signatures:"
F S TIUI=$O(^TIU(8925.7,"B",TIUDA,TIUI)) Q:+TIUI'>0 D
. N TIUX,TIUSGNR,TIUSDT
. S DA=TIUI,DR=".03:.08" D EN^DIQ1 Q:+$D(TIUXTRA)'>9
. S TIUL=+$G(TIUL)+1
. S TIUSGNR=$S($L($G(TIUXTRA(8925.7,DA,.06))):"/es/ "_$G(TIUXTRA(8925.7,DA,.06)),1:" "_$G(TIUXTRA(8925.7,DA,.03)))
. S TIUSDT=$S($L($G(TIUXTRA(8925.7,DA,.04))):$G(TIUXTRA(8925.7,DA,.04)),1:"* AWAITING SIGNATURE *")
. S TIUX=$$SETSTR^VALM1(TIUSDT,$G(TIUX),1,38)
. S TIUX=$$SETSTR^VALM1(TIUSGNR,$G(TIUX),30,49)
. S TIUY(TIUL)=TIUX,TIUX="",TIUL=+$G(TIUL)+1
. S TIUX=$$SETSTR^VALM1($G(TIUXTRA(8925.7,DA,.07)),$G(TIUX),35,44)
. S TIUY(TIUL)=TIUX
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIULS1 4290 printed Oct 16, 2024@18:43:04 Page 2
TIULS1 ; SLC/JER - Signature Block Procedures ;21-MAY-1999 15:30:59
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**52**;Jun 20, 1997
EN(TIUY,DA) ; Get signature and cosignature blocks
+1 NEW D0,DIC,DIQ,DIQ2,DR,TIUSIG
+2 if '$DATA(^TIU(8925,DA,15))
QUIT
+3 SET DIC=8925
SET DIQ="TIUSIG"
SET DIQ(0)="IE"
SET DR="1204;1208;1501:1505;1507:1511"
+4 DO EN^DIQ1
IF '$DATA(TIUSIG)
QUIT
+5 DO LOADSIG(.TIUY,"TIUSIG(8925,DA)")
+6 QUIT
LOADSIG(TIUY,TIUARR) ; Load signature and cosignature blocks
+1 NEW TIUL,TIUESIG1,TIUESIG2,TIUSIG1,TIUSIG2,TIUS1,TIUS2
+2 NEW TIUSNM,TIUSTTL,TIUS1DT,TIUS2DT,TIUSDT
+3 SET TIUS1=$SELECT(@TIUARR@(1505,"I")="E":"/es/ ",@TIUARR@(1505,"I")="C":"/s/ ",1:"")_$GET(@TIUARR@(1503,"E"))
+4 SET TIUS2=$SELECT(@TIUARR@(1511,"I")="E":"/es/ ",@TIUARR@(1511,"I")="C":"/s/ ",1:"")_$GET(@TIUARR@(1509,"E"))
+5 SET TIUESIG1=$GET(@TIUARR@(1204,"I"))
+6 SET TIUSIG1=$GET(@TIUARR@(1502,"I"))
+7 SET TIUS1DT=$SELECT(+$GET(@TIUARR@(1501,"I")):"Signed: "_$$DATE^TIULS($GET(@TIUARR@(1501,"I")),"MM/DD/CCYY HR:MIN"),1:"")
+8 SET TIUESIG2=$GET(@TIUARR@(1208,"I"))
+9 if TIUESIG2']""
SET TIUESIG2=$GET(@TIUARR@(1209,"I"))
+10 SET TIUS2DT=$SELECT(+$GET(@TIUARR@(1507,"I")):"Cosigned: "_$$DATE^TIULS($GET(@TIUARR@(1507,"I")),"MM/DD/CCYY HR:MIN"),1:"")
+11 SET TIUSIG2=$GET(@TIUARR@(1508,"I"))
+12 SET TIUSNM=$$SETSTR^VALM1(TIUS1,$GET(TIUSNM),$SELECT($GET(TIUESIG1)=$GET(TIUESIG2):40,1:1),35)
+13 IF $LENGTH(TIUS2)
SET TIUSNM=$$SETSTR^VALM1(TIUS2,$GET(TIUSNM),40,35)
+14 SET TIUSTTL=$$SETSTR^VALM1(@TIUARR@(1504,"E"),$GET(TIUSTTL),$SELECT($GET(TIUESIG1)=$GET(TIUESIG2):40,1:1),35)
+15 IF $LENGTH(TIUS2)
SET TIUSTTL=$$SETSTR^VALM1(@TIUARR@(1510,"E"),$GET(TIUSTTL),40,35)
+16 SET TIUSDT=$$SETSTR^VALM1(TIUS1DT,$GET(TIUSDT),$SELECT($GET(TIUESIG1)=$GET(TIUESIG2):40,1:1),35)
+17 IF $LENGTH(TIUS2)
SET TIUSDT=$$SETSTR^VALM1(TIUS2DT,$GET(TIUSDT),40,35)
+18 SET TIUL=+$GET(TIUL)+1
SET TIUY(TIUL)=TIUSNM
+19 SET TIUL=+$GET(TIUL)+1
SET TIUY(TIUL)=TIUSTTL
+20 SET TIUL=+$GET(TIUL)+1
SET TIUY(TIUL)=TIUSDT
+21 IF TIUSIG1']""!(TIUSIG2']"")
DO LOADWBLK(.TIUY,TIUSIG1,TIUESIG1,TIUSIG2,TIUESIG2,.TIUL)
+22 IF TIUSIG1]""
IF (TIUSIG1'=TIUESIG1)
DO LOADFOR(TIUSIG1,TIUESIG1,TIUSIG2,TIUESIG2,.TIUL)
GOTO LOADSIX
+23 IF TIUSIG2]""
IF (TIUSIG2'=TIUESIG2)
DO LOADFOR(TIUSIG1,TIUESIG1,TIUSIG2,TIUESIG2,.TIUL)
LOADSIX SET TIUY=TIUL
+1 QUIT
LOADWBLK(TIUY,TIUS1,TIUES1,TIUS2,TIUES2,TIUL) ; Load block for wet signature
+1 NEW TIUESN1,TIUEST1,TIUESN2,TIUEST2,TIUBLKN,TIUBLKT
+2 ; If document is signed, and exp. signer = exp. cosigner then quit
+3 IF +TIUS1
IF (TIUES1=TIUES2)
QUIT
+4 IF TIUS1']""
Begin DoDot:1
+5 SET TIUESN1=$$SIGNAME^TIULS(TIUES1)
SET TIUEST1=$$SIGTITL^TIULS(TIUES1)
+6 SET TIUBLKN=$$SETSTR^VALM1(TIUESN1,$GET(TIUBLKN),$SELECT(TIUES1=TIUES2:40,1:1),35)
+7 if TIUEST1]""
SET TIUBLKT=$$SETSTR^VALM1(TIUEST1,$GET(TIUBLKT),$SELECT(TIUES1=TIUES2:40,1:1),35)
End DoDot:1
+8 IF TIUS2']""
Begin DoDot:1
+9 SET TIUESN2=$$SIGNAME^TIULS(TIUES2)
SET TIUEST2=$$SIGTITL^TIULS(TIUES2)
+10 SET TIUBLKN=$$SETSTR^VALM1(TIUESN2,$GET(TIUBLKN),40,35)
+11 if TIUEST2]""
SET TIUBLKT=$$SETSTR^VALM1(TIUEST2,$GET(TIUBLKT),40,35)
End DoDot:1
+12 SET TIUL=+$GET(TIUL)+1
SET TIUY(TIUL)=TIUBLKN
+13 if $GET(TIUBLKT)]""
SET TIUL=+$GET(TIUL)+1
SET TIUY(TIUL)=TIUBLKT
+14 QUIT
LOADFOR(TIUS1,TIUES1,TIUS2,TIUES2,TIUL) ; Apply "for" block(s)
+1 NEW TIUESN1,TIUEST1,TIUESN2,TIUEST2,TIUFORN,TIUFORT
+2 SET TIUESN1=$$SIGNAME^TIULS(TIUES1)
SET TIUEST1=$$SIGTITL^TIULS(TIUES1)
+3 SET TIUESN2=$$SIGNAME^TIULS(TIUES2)
SET TIUEST2=$$SIGTITL^TIULS(TIUES2)
+4 IF $GET(TIUS1)'=$GET(TIUES1)
SET TIUFORN=$$SETSTR^VALM1("for "_TIUESN1,$GET(TIUFORN),1,35)
SET TIUFORT=$$SETSTR^VALM1(TIUEST1,$GET(TIUFORT),1,35)
+5 IF $GET(TIUS2)'=$GET(TIUES2)
SET TIUFORN=$$SETSTR^VALM1("for "_TIUESN2,$GET(TIUFORN),40,35)
SET TIUFORT=$$SETSTR^VALM1(TIUEST2,$GET(TIUFORT),40,35)
+6 SET TIUL=+$GET(TIUL)+1
SET TIUY(TIUL)=TIUFORN
+7 SET TIUL=+$GET(TIUL)+1
SET TIUY(TIUL)=TIUFORT
+8 QUIT
XTRASIG(TIUDA,TIUL) ; Load addtional signature blocks
+1 NEW TIUI,DA,DR,DIC,DIQ,TIUXTRA
SET TIUI=0
+2 SET DIC="^TIU(8925.7,"
SET DIQ="TIUXTRA"
+3 SET TIUL=+$GET(TIUL)+1
SET TIUY(TIUL)=" "
+4 SET TIUL=+$GET(TIUL)+1
SET TIUY(TIUL)="Concurrence signatures:"
+5 FOR
SET TIUI=$ORDER(^TIU(8925.7,"B",TIUDA,TIUI))
if +TIUI'>0
QUIT
Begin DoDot:1
+6 NEW TIUX,TIUSGNR,TIUSDT
+7 SET DA=TIUI
SET DR=".03:.08"
DO EN^DIQ1
if +$DATA(TIUXTRA)'>9
QUIT
+8 SET TIUL=+$GET(TIUL)+1
+9 SET TIUSGNR=$SELECT($LENGTH($GET(TIUXTRA(8925.7,DA,.06))):"/es/ "_$GET(TIUXTRA(8925.7,DA,.06)),1:" "_$GET(TIUXTRA(8925.7,DA,.03)))
+10 SET TIUSDT=$SELECT($LENGTH($GET(TIUXTRA(8925.7,DA,.04))):$GET(TIUXTRA(8925.7,DA,.04)),1:"* AWAITING SIGNATURE *")
+11 SET TIUX=$$SETSTR^VALM1(TIUSDT,$GET(TIUX),1,38)
+12 SET TIUX=$$SETSTR^VALM1(TIUSGNR,$GET(TIUX),30,49)
+13 SET TIUY(TIUL)=TIUX
SET TIUX=""
SET TIUL=+$GET(TIUL)+1
+14 SET TIUX=$$SETSTR^VALM1($GET(TIUXTRA(8925.7,DA,.07)),$GET(TIUX),35,44)
+15 SET TIUY(TIUL)=TIUX
End DoDot:1
+16 QUIT
