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

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.1 KB
RevLine 
[613]1TIULS1 ; SLC/JER - Signature Block Procedures ;21-MAY-1999 15:30:59
2 ;;1.0;TEXT INTEGRATION UTILITIES;**52**;Jun 20, 1997
3EN(TIUY,DA) ; Get signature and cosignature blocks
4 N D0,DIC,DIQ,DIQ2,DR,TIUSIG
5 Q:'$D(^TIU(8925,DA,15))
6 S DIC=8925,DIQ="TIUSIG",DIQ(0)="IE",DR="1204;1208;1501:1505;1507:1511"
7 D EN^DIQ1 I '$D(TIUSIG) Q
8 D LOADSIG(.TIUY,"TIUSIG(8925,DA)")
9 Q
10LOADSIG(TIUY,TIUARR) ; Load signature and cosignature blocks
11 N TIUL,TIUESIG1,TIUESIG2,TIUSIG1,TIUSIG2,TIUS1,TIUS2
12 N TIUSNM,TIUSTTL,TIUS1DT,TIUS2DT,TIUSDT
13 S TIUS1=$S(@TIUARR@(1505,"I")="E":"/es/ ",@TIUARR@(1505,"I")="C":"/s/ ",1:"")_$G(@TIUARR@(1503,"E"))
14 S TIUS2=$S(@TIUARR@(1511,"I")="E":"/es/ ",@TIUARR@(1511,"I")="C":"/s/ ",1:"")_$G(@TIUARR@(1509,"E"))
15 S TIUESIG1=$G(@TIUARR@(1204,"I"))
16 S TIUSIG1=$G(@TIUARR@(1502,"I"))
17 S TIUS1DT=$S(+$G(@TIUARR@(1501,"I")):"Signed: "_$$DATE^TIULS($G(@TIUARR@(1501,"I")),"MM/DD/CCYY HR:MIN"),1:"")
18 S TIUESIG2=$G(@TIUARR@(1208,"I"))
19 S:TIUESIG2']"" TIUESIG2=$G(@TIUARR@(1209,"I"))
20 S TIUS2DT=$S(+$G(@TIUARR@(1507,"I")):"Cosigned: "_$$DATE^TIULS($G(@TIUARR@(1507,"I")),"MM/DD/CCYY HR:MIN"),1:"")
21 S TIUSIG2=$G(@TIUARR@(1508,"I"))
22 S TIUSNM=$$SETSTR^VALM1(TIUS1,$G(TIUSNM),$S($G(TIUESIG1)=$G(TIUESIG2):40,1:1),35)
23 I $L(TIUS2) S TIUSNM=$$SETSTR^VALM1(TIUS2,$G(TIUSNM),40,35)
24 S TIUSTTL=$$SETSTR^VALM1(@TIUARR@(1504,"E"),$G(TIUSTTL),$S($G(TIUESIG1)=$G(TIUESIG2):40,1:1),35)
25 I $L(TIUS2) S TIUSTTL=$$SETSTR^VALM1(@TIUARR@(1510,"E"),$G(TIUSTTL),40,35)
26 S TIUSDT=$$SETSTR^VALM1(TIUS1DT,$G(TIUSDT),$S($G(TIUESIG1)=$G(TIUESIG2):40,1:1),35)
27 I $L(TIUS2) S TIUSDT=$$SETSTR^VALM1(TIUS2DT,$G(TIUSDT),40,35)
28 S TIUL=+$G(TIUL)+1,TIUY(TIUL)=TIUSNM
29 S TIUL=+$G(TIUL)+1,TIUY(TIUL)=TIUSTTL
30 S TIUL=+$G(TIUL)+1,TIUY(TIUL)=TIUSDT
31 I TIUSIG1']""!(TIUSIG2']"") D LOADWBLK(.TIUY,TIUSIG1,TIUESIG1,TIUSIG2,TIUESIG2,.TIUL)
32 I TIUSIG1]"",(TIUSIG1'=TIUESIG1) D LOADFOR(TIUSIG1,TIUESIG1,TIUSIG2,TIUESIG2,.TIUL) G LOADSIX
33 I TIUSIG2]"",(TIUSIG2'=TIUESIG2) D LOADFOR(TIUSIG1,TIUESIG1,TIUSIG2,TIUESIG2,.TIUL)
34LOADSIX S TIUY=TIUL
35 Q
36LOADWBLK(TIUY,TIUS1,TIUES1,TIUS2,TIUES2,TIUL) ; Load block for wet signature
37 N TIUESN1,TIUEST1,TIUESN2,TIUEST2,TIUBLKN,TIUBLKT
38 ; If document is signed, and exp. signer = exp. cosigner then quit
39 I +TIUS1,(TIUES1=TIUES2) Q
40 I TIUS1']"" D
41 . S TIUESN1=$$SIGNAME^TIULS(TIUES1),TIUEST1=$$SIGTITL^TIULS(TIUES1)
42 . S TIUBLKN=$$SETSTR^VALM1(TIUESN1,$G(TIUBLKN),$S(TIUES1=TIUES2:40,1:1),35)
43 . S:TIUEST1]"" TIUBLKT=$$SETSTR^VALM1(TIUEST1,$G(TIUBLKT),$S(TIUES1=TIUES2:40,1:1),35)
44 I TIUS2']"" D
45 . S TIUESN2=$$SIGNAME^TIULS(TIUES2),TIUEST2=$$SIGTITL^TIULS(TIUES2)
46 . S TIUBLKN=$$SETSTR^VALM1(TIUESN2,$G(TIUBLKN),40,35)
47 . S:TIUEST2]"" TIUBLKT=$$SETSTR^VALM1(TIUEST2,$G(TIUBLKT),40,35)
48 S TIUL=+$G(TIUL)+1,TIUY(TIUL)=TIUBLKN
49 S:$G(TIUBLKT)]"" TIUL=+$G(TIUL)+1,TIUY(TIUL)=TIUBLKT
50 Q
51LOADFOR(TIUS1,TIUES1,TIUS2,TIUES2,TIUL) ; Apply "for" block(s)
52 N TIUESN1,TIUEST1,TIUESN2,TIUEST2,TIUFORN,TIUFORT
53 S TIUESN1=$$SIGNAME^TIULS(TIUES1),TIUEST1=$$SIGTITL^TIULS(TIUES1)
54 S TIUESN2=$$SIGNAME^TIULS(TIUES2),TIUEST2=$$SIGTITL^TIULS(TIUES2)
55 I $G(TIUS1)'=$G(TIUES1) S TIUFORN=$$SETSTR^VALM1("for "_TIUESN1,$G(TIUFORN),1,35),TIUFORT=$$SETSTR^VALM1(TIUEST1,$G(TIUFORT),1,35)
56 I $G(TIUS2)'=$G(TIUES2) S TIUFORN=$$SETSTR^VALM1("for "_TIUESN2,$G(TIUFORN),40,35),TIUFORT=$$SETSTR^VALM1(TIUEST2,$G(TIUFORT),40,35)
57 S TIUL=+$G(TIUL)+1,TIUY(TIUL)=TIUFORN
58 S TIUL=+$G(TIUL)+1,TIUY(TIUL)=TIUFORT
59 Q
60XTRASIG(TIUDA,TIUL) ; Load addtional signature blocks
61 N TIUI,DA,DR,DIC,DIQ,TIUXTRA S TIUI=0
62 S DIC="^TIU(8925.7,",DIQ="TIUXTRA"
63 S TIUL=+$G(TIUL)+1,TIUY(TIUL)=" "
64 S TIUL=+$G(TIUL)+1,TIUY(TIUL)="Concurrence signatures:"
65 F S TIUI=$O(^TIU(8925.7,"B",TIUDA,TIUI)) Q:+TIUI'>0 D
66 . N TIUX,TIUSGNR,TIUSDT
67 . S DA=TIUI,DR=".03:.08" D EN^DIQ1 Q:+$D(TIUXTRA)'>9
68 . S TIUL=+$G(TIUL)+1
69 . S TIUSGNR=$S($L($G(TIUXTRA(8925.7,DA,.06))):"/es/ "_$G(TIUXTRA(8925.7,DA,.06)),1:" "_$G(TIUXTRA(8925.7,DA,.03)))
70 . S TIUSDT=$S($L($G(TIUXTRA(8925.7,DA,.04))):$G(TIUXTRA(8925.7,DA,.04)),1:"* AWAITING SIGNATURE *")
71 . S TIUX=$$SETSTR^VALM1(TIUSDT,$G(TIUX),1,38)
72 . S TIUX=$$SETSTR^VALM1(TIUSGNR,$G(TIUX),30,49)
73 . S TIUY(TIUL)=TIUX,TIUX="",TIUL=+$G(TIUL)+1
74 . S TIUX=$$SETSTR^VALM1($G(TIUXTRA(8925.7,DA,.07)),$G(TIUX),35,44)
75 . S TIUY(TIUL)=TIUX
76 Q
Note: See TracBrowser for help on using the repository browser.