- 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
- 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
