source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIULS1.m@ 1259

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