source: FOIAVistA/tag/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUSRV.m@ 636

Last change on this file since 636 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 7.6 KB
Line 
1TIUSRV ; SLC/JER - Silent server functions ; 3/28/06 3:01pm
2 ;;1.0;TEXT INTEGRATION UTILITIES;**1,19,28,87,61,100,109,113,112,184,211**;Jun 20, 1997;Build 26
3RPC(TIUY,TIUDA,REASSIGN) ; RPC for DT
4 N VALMAR,TIUGDATA,TIUGWHOL K ^TMP("TIUAUDIT",$J)
5 S TIUY=$NA(^TMP("TIUAUDIT",$J))
6 D GET(TIUDA,1,+$G(REASSIGN))
7 K ^TMP("VALM VIDEO",$J)
8 Q
9GET(TIUDA,HUSH,REASSIGN) ; Build List
10 N TIUI,TIUL,TIUREC,TIUDADD,X,TIUCPF,ONBROWSE
11 S (TIUDADD,TIUI,VALMCNT)=0,HUSH=+$G(HUSH)
12 N DA,DIC,DIQ,DR,TIUNAME K ^TMP("TIUAUDIT",$J)
13 I '$D(TIUPRM0) D SETPARM^TIULE
14 I '$D(IOINORM) S X="IOINORM;IOIHI;IORVON;IORVOFF;IOUON;IOUOFF;IOBON;IOBOFF" D ENDR^%ZISS
15 S:'$D(VALMAR) VALMAR="^TMP(""TIUAUDIT"",$J)"
16 S VALMEVL=+$G(VALMEVL)
17 I '$D(^TIU(8925,+TIUDA,0)) S VALMQUIT=1 Q
18 ; if the document has an OnBrowse Event, execute it
19 S ONBROWSE=$$ONBROWSE^TIULC1(+$G(^TIU(8925,+TIUDA,0)))
20 I $L(ONBROWSE) D LOADSUPP(ONBROWSE,TIUDA,.VALMCNT)
21 ;Set a flag to indicate whether or not a Title is a member of the
22 ;Clinical Procedures Class (1=Yes and 0=No)
23 S TIUCPF=+$$ISA^TIULX(+$G(^TIU(8925,TIUDA,0)),+$$CLASS^TIUCP)
24 S DIC=8925,DIQ="TIUREC(",DA=TIUDA
25 S DR=".01;.02;.05;.07:.1;1201;1202;1204;1208;1212;1301;1302;1305;1306;1501;1502;1505;1507;1508;1511;1601:1602;1610:1612;1701;89261"
26 ;If the document is a member of the Clinical Procedures Class, include the
27 ;Procedure Summary Code field and the Date/Time Performed field
28 I TIUCPF S DR=DR_";70201;70202"
29 D EN^DIQ1
30 S TIUI="" F S TIUI=$O(TIUREC(8925,+TIUDA,TIUI)) Q:+TIUI'>0 D
31 . I $G(TIUREC(8925,+TIUDA,TIUI))']"" S TIUREC(8925,+TIUDA,TIUI)="None"
32 . E S TIUREC(8925,+TIUDA,TIUI)=$$UP^XLFSTR(TIUREC(8925,+TIUDA,TIUI))
33 I $D(TIUREC)>9 D
34 . D SOURCE(.TIUREC,HUSH,.VALMCNT,TIUCPF)
35 . I '+$G(REASSIGN) D PROBLEM(TIUDA,.VALMCNT) D:$$ISPRFDOC^TIUPRF(TIUDA) LKDETAIL^TIUPRF3(TIUDA,.VALMCNT) D EDIT(TIUDA,.VALMCNT)
36 . D REASSIGN^TIUSRV1(TIUDA,+$G(REASSIGN),.VALMCNT) Q:+$G(REASSIGN)
37 . D IDLINK^TIUSRV1(TIUDA,.VALMCNT)
38 . D SIGN(.TIUREC,.VALMCNT)
39 . I +$O(^TIU(8925.7,"B",TIUDA,0)) D XTRASIGN(TIUDA,.VALMCNT)
40 . I $D(^TIU(8925,+TIUDA,16)) D PRIVACY(.TIUREC,.VALMCNT)
41 . D BODY(TIUDA,.VALMCNT)
42 S:+$G(VALMCNT)<$G(VALM("LINES")) VALMCNT=$G(VALM("LINES"))
43 Q
44LOADSUPP(METHOD,TIUDA,TIUL) ; Execute OnBrowse/Load Supplementary data
45 N TIUY,TIUI S TIUI=0
46 X METHOD I '$D(@TIUY) Q
47 S TIUL=TIUL+1
48 D SET(TIUL,1,"Requesting Package Information ",$G(IORVON),$G(IORVOFF))
49 S TIUL=TIUL+1 D BLANK(TIUL)
50 F S TIUI=$O(@TIUY@(TIUI)) Q:+TIUI'>0 D
51 . S TIUL=+$G(TIUL)+1 D SET(TIUL,1,@TIUY@(TIUI))
52 S TIUL=TIUL+1 D BLANK(TIUL) S TIUL=TIUL+1
53 K @TIUY
54 Q
55SOURCE(TIUREC,HUSH,TIUL,TIUCPF) ; Source Info
56 W:'+$G(HUSH) !!,"Opening "_TIUREC(8925,+TIUDA,.01)_" record for review..."
57 S TIUL=TIUL+1
58 D SET(TIUL,1,"Source Information ",$G(IORVON),$G(IORVOFF))
59 D SET(TIUL+1,2," Standard Title: "_$G(TIUREC(8925,TIUDA,89261)))
60 D SET(TIUL+2,2," Reference Date: "_$G(TIUREC(8925,TIUDA,1301)))
61 D SET(TIUL+3,2," Entry Date: "_$G(TIUREC(8925,TIUDA,1201)))
62 D SET(TIUL+4,2,"Expected Signer: "_$G(TIUREC(8925,TIUDA,1204)))
63 D SET(TIUL+5,2," Urgency: "_$G(TIUREC(8925,TIUDA,.09)))
64 D SET(TIUL+6,2," Line Count: "_$G(TIUREC(8925,TIUDA,.1)))
65 D SET(TIUL+7,2," Division: "_$G(TIUREC(8925,TIUDA,1212)))
66 D SET(TIUL+8,2," Subject: "_$G(TIUREC(8925,TIUDA,1701)))
67 ;If the document is a member of the Clinical Procedures Class, include the
68 ;Procedure Summary Code field and the Date/Time Performed field
69 I $G(TIUCPF) D
70 . D BLANK(TIUL+9)
71 . D SET(TIUL+10,2,"Procedure Summary Code: "_$G(TIUREC(8925,TIUDA,70201)))
72 . D SET(TIUL+11,2," Date/Time Performed: "_$G(TIUREC(8925,TIUDA,70202)))
73 D SET(TIUL+1,40," Author: "_$G(TIUREC(8925,TIUDA,1202)))
74 D SET(TIUL+2,40," Entered By: "_$G(TIUREC(8925,TIUDA,1302)))
75 D SET(TIUL+3,40," Expected Cosigner: "_$G(TIUREC(8925,TIUDA,1208)))
76 D SET(TIUL+4,40," Document Status: "_$G(TIUREC(8925,TIUDA,.05)))
77 D SET(TIUL+5,40," TIU Document #: "_+$G(TIUDA))
78 S TIUL=$S(+$G(TIUCPF):TIUL+11,1:TIUL+8)
79 Q
80PROBLEM(TIUDA,TIUL) ; Problems
81 N TIUI,DR,DIC,DIQ,TIUPROB S TIUI=0
82 S TIUL=TIUL+1 D BLANK(TIUL) S TIUL=TIUL+1
83 D SET(TIUL,1,"Associated Problems ",$G(IORVON),$G(IORVOFF))
84 I '+$O(^TIU(8925.9,"B",+TIUDA,0)) D SET(TIUL,25,"No linked problems.")
85 F S TIUI=$O(^TIU(8925.9,"B",TIUDA,TIUI)) Q:+TIUI'>0 D
86 . S DA=TIUI,DR=".02;.05",DIC="^TIU(8925.9,",DIQ="TIUPROB"
87 . D EN^DIQ1 Q:$D(TIUPROB)'>9
88 . S TIUL=TIUL+1
89 . D SET(TIUL,19,$$MIXED^TIULS($G(TIUPROB(8925.9,TIUI,.05))))
90 . D SET(TIUL,60,$G(TIUPROB(8925.9,TIUI,.02)))
91 Q
92EDIT(TIUDA,TIUL) ; Edits
93 N TIUI,DR,DIC,DIQ,TIUED S TIUI=0
94 S TIUL=TIUL+1 D BLANK(TIUL) S TIUL=TIUL+1
95 D SET(TIUL,1,"Edit Information ",$G(IORVON),$G(IORVOFF))
96 I '+$O(^TIU(8925.5,"B",+TIUDA,0)) D SET(TIUL,22,"No edits since entry.")
97 F S TIUI=$O(^TIU(8925.5,"B",TIUDA,TIUI)) Q:+TIUI'>0 D
98 . S DA=TIUI,DR=".02:03",DIC="^TIU(8925.5,",DIQ="TIUED"
99 . D EN^DIQ1 Q:$D(TIUED)'>9!($G(TIUED(8925.5,TIUI,.02))']"")
100 . S TIUL=TIUL+1
101 . D SET(TIUL,2," Edit Date: "_$G(TIUED(8925.5,TIUI,.02)))
102 . D SET(TIUL,44," Edited By: "_$G(TIUED(8925.5,TIUI,.03)))
103 Q
104SIGN(TIUREC,TIUL) ; Signature
105 S TIUL=TIUL+1 D BLANK(TIUL) S TIUL=TIUL+1
106 D SET(TIUL,1,"Signature Information ",$G(IORVON),$G(IORVOFF))
107 D SET(TIUL+1,2," Signed Date: "_$G(TIUREC(8925,TIUDA,1501)))
108 D SET(TIUL+3,2," Cosigned Date: "_$G(TIUREC(8925,TIUDA,1507)))
109 D SET(TIUL+1,40," Signed By: "_$G(TIUREC(8925,TIUDA,1502)))
110 D SET(TIUL+2,40," Signature Mode: "_$G(TIUREC(8925,TIUDA,1505)))
111 D SET(TIUL+3,40," Cosigned By: "_$G(TIUREC(8925,TIUDA,1508)))
112 D SET(TIUL+4,40," Cosignature Mode: "_$G(TIUREC(8925,TIUDA,1511)))
113 S TIUL=TIUL+4
114 Q
115XTRASIGN(TIUDA,TIUL) ; Additional signers
116 N TIUI,DA,DR,DIC,DIQ,TIUXTRA
117 S TIUI=0
118 S TIUL=TIUL+1 D BLANK(TIUL) S TIUL=TIUL+1
119 D SET(TIUL,1,"Receipt Acknowledged By ",$G(IORVON),$G(IORVOFF))
120 F S TIUI=$O(^TIU(8925.7,"B",TIUDA,TIUI)) Q:+TIUI'>0 D
121 . S DA=TIUI,DR=".03:.08",DIC="^TIU(8925.7,",DIQ="TIUXTRA"
122 . D EN^DIQ1 Q:$D(TIUXTRA)'>9
123 . S TIUL=TIUL+1
124 . D SET(TIUL,2," Signed Date: "_$G(TIUXTRA(8925.7,DA,.04)))
125 . D SET(TIUL,40," Signed By: "_$G(TIUXTRA(8925.7,DA,.06)))
126 . S TIUL=TIUL+1
127 . D SET(TIUL,2,"Expected Signer: "_$G(TIUXTRA(8925.7,DA,.03)))
128 . D SET(TIUL,40," Signature Mode: "_$G(TIUXTRA(8925.7,DA,.08)))
129 Q
130PRIVACY(TIUREC,TIUL) ; Privacy Act
131 S TIUL=TIUL+1 D BLANK(TIUL) S TIUL=TIUL+1
132 D SET(TIUL,1,"Privacy Act Information ",$G(IORVON),$G(IORVOFF))
133 S TIUL=TIUL+1
134 D SET(TIUL,2," Amended Date: "_$G(TIUREC(8925,TIUDA,1601)))
135 D SET(TIUL,40," Amended By: "_$G(TIUREC(8925,TIUDA,1602)))
136 S TIUL=TIUL+1
137 D SET(TIUL,2," Deleted Date: "_$G(TIUREC(8925,TIUDA,1611)))
138 D SET(TIUL,40," Deleted By: "_$G(TIUREC(8925,TIUDA,1610)))
139 S TIUL=TIUL+1
140 D SET(TIUL,2," Reason: "_$G(TIUREC(8925,TIUDA,1612)))
141 Q
142BODY(TIUDA,TIUL) ; body of document
143 N CANSEE
144 S TIUL=TIUL+1 D BLANK(TIUL) S TIUL=TIUL+1
145 D SET(TIUL,1,"Document Body ",$G(IORVON),$G(IORVOFF))
146 S TIUL=TIUL+1 D BLANK(TIUL)
147 S CANSEE=$$CANDO^TIULP(TIUDA,"VIEW")
148 I '+CANSEE D NOSEE(CANSEE,.TIUL) Q
149 I '$D(TIUGDATA) S TIUGDATA=$$IDDATA^TIURECL1(TIUDA)
150 D LOADREC^TIUBR1(TIUDA,.TIUL,TIUGDATA,$G(TIUGWHOL))
151 K ^TMP("TIU ADDENDUM",$J)
152 Q
153ISCOMP(DA) ; Evaluate whether a given record is a component
154 N TIUY,TIUTYP
155 S TIUTYP=+$G(^TIU(8925,DA,0))
156 S TIUY=$S($P($G(^TIU(8925.1,+TIUTYP,0)),U,4)="CO":1,1:0)
157 Q TIUY
158NOSEE(CANSEE,TIUJ) ; When the user shouldn't see the data...
159 S TIUJ=+$G(TIUJ)+1
160 D SET(TIUJ,2,$P(CANSEE,U,2))
161 Q
162SET(TIULINE,TIUCOL,TIUTEXT,ON,OFF) ; set display info in array
163 D:'$D(@VALMAR@(TIULINE,0)) BLANK(.TIULINE)
164 D SET^VALM10(.TIULINE,$$SETSTR^VALM1(.TIUTEXT,@VALMAR@(TIULINE,0),.TIUCOL,$L(TIUTEXT)))
165 D:$G(ON)]""!($G(OFF)]"") CNTRL^VALM10(.TIULINE,.TIUCOL,$L(TIUTEXT),$G(ON),$G(OFF))
166 W:'(TIULINE#5)&'+$G(HUSH) "."
167 Q
168 ;
169BLANK(TIULINE) ; blank line
170 D SET^VALM10(.TIULINE,$J("",80))
171 Q
Note: See TracBrowser for help on using the repository browser.