source: WorldVistAEHR/trunk/r/CAPACITY_MANAGEMENT_TOOLS-KMPD-KMPL/KMPDUT2.m@ 1361

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

initial load of WorldVistAEHR
File size: 8.2 KB
RevLine 
[613]1KMPDUT2 ;OAK/RAK - CM Tools Utility ;2/17/04 10:45
2 ;;2.0;CAPACITY MANAGEMENT TOOLS;;Mar 22, 2002
3 ;
4ID(KMPDIEN) ;--called from ^DD(8973.1,0,"ID","W")
5 ;-----------------------------------------------------------------------
6 ; KMPDIEN... Ien for file #8973.1 (CM HL7 DATA)
7 ;-----------------------------------------------------------------------
8 Q:'$G(KMPDIEN)
9 Q:'$D(^KMPD(8973.1,+KMPDIEN,0))
10 N DATA,TXT
11 S DATA=$G(^KMPD(8973.1,+KMPDIEN,0)),DATA(99.2)=$G(^(99.2)) Q:DATA=""
12 ; sent to national database
13 S TXT(1)=$S($P(DATA,U,2):"sent",1:"not sent")
14 S TXT(1)=TXT(1)_$J(" ",11-$L(TXT(1)))
15 ; namespace
16 S TXT(1)=TXT(1)_$P(DATA,U,3)
17 S TXT(1)=TXT(1)_$J(" ",18-$L(TXT(1)))
18 ; protocol
19 S TXT(1)=TXT(1)_$P(DATA,U,5)
20 S TXT(1)=TXT(1)_$J(" ",52-$L(TXT(1)))
21 ; synch/asynch
22 S TXT(1)=TXT(1)_$S($P(DATA,U,6)=1:"sync",1:"async")
23 ; other site number
24 I $P(DATA(99.2),U,12)'="" D
25 .S TXT(2)=$P(DATA(99.2),U,12)
26 .S TXT(2,"F")="!?41"
27 S TXT(1,"F")="?15"
28 D EN^DDIOL(.TXT)
29 Q
30 ;
31ID1(KMPDIEN) ;--called from ^DD(8973.2,0,"ID","W")
32 ;-----------------------------------------------------------------------
33 ; KMPDIEN... Ien for file #8973.2 (CM TIMING)
34 ;-----------------------------------------------------------------------
35 Q:'$G(KMPDIEN)
36 Q:'$D(^KMPD(8973.2,+KMPDIEN,0))
37 N DATA,TXT
38 S DATA=$G(^KMPD(8973.2,+KMPDIEN,0)) Q:DATA=""
39 S TXT(1)=""
40 ; date/time
41 S TXT(1)=TXT(1)_$$FMTE^XLFDT($P(DATA,U,3),2)
42 S TXT(1)=TXT(1)_$J(" ",18-$L(TXT(1)))
43 ; title
44 S TXT(1)=TXT(1)_$E($P(DATA,U,8),1,16)
45 ; client name
46 S TXT(2)=$E($P(DATA,U,6),1,30)
47 ; person
48 S TXT(3)=$P($G(^VA(200,+$P(DATA,U,5),0)),U)
49 ; sent to national database
50 S TXT(4)="weekly - "_$S($P(DATA,U,2):"sent",1:"not sent")
51 S TXT(5)="daily - "_$S($P(DATA,U,10):"sent",1:"not sent")
52 ;S TXT(1)=TXT(1)_$J(" ",11-$L(TXT(1)))
53 S TXT(1,"F")="?45"
54 S TXT(2,"F")="!?48"
55 S TXT(3,"F")="!?48"
56 S TXT(4,"F")="!?48"
57 S TXT(5,"F")="!?48"
58 D EN^DDIOL(.TXT)
59 Q
60 ;
61XREF(DA,X,KMPDTYPE) ;-set/kill 'APTDTNM' xref in file #8973.1
62 ;-----------------------------------------------------------------------
63 ; DA....... Ien for file #8973.1 (CM HL7 DATA)
64 ; X........ Value of field #.05 (PROTOCOL)
65 ; KMPDTYPE. 1 - set xref
66 ; 2 - kill xref
67 ;-----------------------------------------------------------------------
68 Q:'$G(DA)
69 Q:$G(X)=""
70 Q:'$G(KMPDTYPE)
71 N DATA,DATE,NM
72 S DATA=$G(^KMPD(8973.1,DA,0)) Q:DATA=""
73 S DATE=$P(DATA,U) Q:'DATE
74 S NM=$P(DATA,U,3) Q:NM=""
75 I KMPDTYPE=1 S ^KMPD(8973.1,"APTDTNM",X,DATE,NM,DA)=""
76 I KMPDTYPE=2 K ^KMPD(8973.1,"APTDTNM",X,DATE,NM,DA)
77 Q
78 ;
79XREF1(DA,X,KMPDTYPE) ;-set/kill 'ACSDTPRNM' xref in file #8973.1
80 ;-----------------------------------------------------------------------
81 ; DA....... Ien for file #8973.1 (CM HL7 DATA)
82 ; X........ Value of field #99.212 (CONTACTED SITE NAME)
83 ; KMPDTYPE. 1 - set xref
84 ; 2 - kill xref
85 ;
86 ; variables used:
87 ; DATE.. Internal value of field #.01 (DATE)
88 ; NM.... Internal value of field #.03 (NAMESPACE)
89 ; PR.... Internal value of field #.05 (PROTOCOL)
90 ;-----------------------------------------------------------------------
91 Q:'$G(DA)
92 Q:$G(X)=""
93 Q:'$G(KMPDTYPE)
94 N DATA,DATE,NM,PR
95 S DATA=$G(^KMPD(8973.1,DA,0)) Q:DATA=""
96 S DATE=$P(DATA,U) Q:'DATE
97 S NM=$P(DATA,U,3) Q:NM=""
98 S PR=$P(DATA,U,5) Q:PR=""
99 I KMPDTYPE=1 S ^KMPD(8973.1,"ACSDTPRNM",X,DATE,PR,NM,DA)=""
100 I KMPDTYPE=2 K ^KMPD(8973.1,"ACSDTPRNM",X,DATE,PR,NM,DA)
101 Q
102 ;
103XREF2(DA,X,KMPDTYPE) ;-set/kill 'ASYNC' xref in file #8973.1
104 ;-----------------------------------------------------------------------
105 ; DA....... Ien for file #8973.1 (CM HL7 DATA)
106 ; X........ Value of field #.06 (SYNC/ASYNC)
107 ; KMPDTYPE. 1 - set xref
108 ; 2 - kill xref
109 ;
110 ; variables used:
111 ; DATE.. Internal value of field #.01 (DATE)
112 ;-----------------------------------------------------------------------
113 Q:'$G(DA)
114 Q:$G(X)=""
115 Q:'$G(KMPDTYPE)
116 N DATA,DATE
117 S DATA=$G(^KMPD(8973.1,DA,0)) Q:DATA=""
118 S DATE=$P(DATA,U) Q:'DATE
119 I KMPDTYPE=1 S ^KMPD(8973.1,"ASYNC",DATE,X,DA)=""
120 I KMPDTYPE=2 K ^KMPD(8973.1,"ASYNC",DATE,X,DA)
121 Q
122 ;
123XREFT1(DA,X,KMPDTYPE) ;-set/kill 'ASVDTSS' xref in file #8973.2
124 ;-----------------------------------------------------------------------
125 ; DA....... Ien for file #8973.2 (CM TIMING)
126 ; X........ Value of field #.07 (SERVER SUBSCRIPT)
127 ; KMPDTYPE. 1 - set xref
128 ; 2 - kill xref
129 ;-----------------------------------------------------------------------
130 Q:'$G(DA)
131 Q:$G(X)=""
132 Q:'$G(KMPDTYPE)
133 N DATA,DATE
134 S DATA=$G(^KMPD(8973.2,DA,0)) Q:DATA=""
135 ; strip off time
136 S DATE=$P($P(DATA,U,3),".") Q:'DATE
137 I KMPDTYPE=1 S ^KMPD(8973.2,"ASVDTSS",X,DATE,DA)=""
138 I KMPDTYPE=2 K ^KMPD(8973.2,"ASVDTSS",X,DATE,DA)
139 Q
140 ;
141XREFT2(DA,X,KMPDTYPE) ;-set/kill 'ASSDTPT' xref in file #8973.2
142 ;-----------------------------------------------------------------------
143 ; DA....... Ien for file #8973.2 (CM TIMING)
144 ; X........ Value of field #.07 (SERVER SUBSCRIPT)
145 ; KMPDTYPE. 1 - set xref
146 ; 2 - kill xref
147 ;
148 ; ^KMPD(8973.2,"ASSDTPT",ServerSubscript,ServerStartDate,PrimeTime,DA)
149 ;-----------------------------------------------------------------------
150 Q:'$G(DA)
151 Q:$G(X)=""
152 Q:'$G(KMPDTYPE)
153 N DATA,DATE,PTNP
154 S DATA=$G(^KMPD(8973.2,DA,0)) Q:DATA=""
155 ; server start date/time
156 S DATE=$P(DATA,U,3) Q:'DATE
157 ; prime time / non-prime time
158 S PTNP=$$PTNP^KMPDHU03(DATE) Q:'PTNP
159 ; strip off time
160 S DATE=$P(DATE,".") Q:'DATE
161 I KMPDTYPE=1 S ^KMPD(8973.2,"ASSDTPT",X,DATE,PTNP,DA)=""
162 I KMPDTYPE=2 K ^KMPD(8973.2,"ASSDTPT",X,DATE,PTNP,DA)
163 Q
164 ;
165XREFT3(DA,X,KMPDTYPE) ;-set/kill 'ASSDTTM' xref in file #8973.2
166 ;-----------------------------------------------------------------------
167 ; DA....... Ien for file #8973.2 (CM TIMING)
168 ; X........ Value of field #.07 (SERVER SUBSCRIPT)
169 ; KMPDTYPE. 1 - set xref
170 ; 2 - kill xref
171 ;
172 ; ^KMPD(8973.2,"ASSDTTM",ServerSubscript,ServerStartDate,PrimeTime,DA)
173 ;-----------------------------------------------------------------------
174 Q:'$G(DA)
175 Q:$G(X)=""
176 Q:'$G(KMPDTYPE)
177 N DATA,DATE
178 S DATA=$G(^KMPD(8973.2,DA,0)) Q:DATA=""
179 ; server start date/time
180 S DATE=$P(DATA,U,3) Q:'DATE
181 I KMPDTYPE=1 S ^KMPD(8973.2,"ASSDTTM",X,DATE,DA)=""
182 I KMPDTYPE=2 K ^KMPD(8973.2,"ASSDTTM",X,DATE,DA)
183 Q
184 ;
185XREFT4(DA,X,KMPDTYPE) ;-set/kill 'ASSCLDTTM' xref in file #8973.2
186 ;-----------------------------------------------------------------------
187 ; DA....... Ien for file #8973.2 (CM TIMING)
188 ; X........ Value of field #.07 (KMPTMP SUBSCRIPT)
189 ; KMPDTYPE. 1 - set xref
190 ; 2 - kill xref
191 ;
192 ; ^KMPD(8973.2,"ASSCLDTTM",KmptmpSubscript,ClientName,ServerDateTime,DA)
193 ;-----------------------------------------------------------------------
194 Q:'$G(DA)
195 Q:$G(X)=""
196 Q:'$G(KMPDTYPE)
197 N CLNM,DATA,DATE
198 S DATA=$G(^KMPD(8973.2,DA,0)) Q:DATA=""
199 ; server start date/time
200 S DATE=$P(DATA,U,3) Q:'DATE
201 ; client name
202 S CLNM=$P(DATA,U,6) Q:CLNM=""
203 I KMPDTYPE=1 S ^KMPD(8973.2,"ASSCLDTTM",X,CLNM,DATE,DA)=""
204 I KMPDTYPE=2 K ^KMPD(8973.2,"ASSCLDTTM",X,CLNM,DATE,DA)
205 Q
206XREFT5(DA,X,KMPDTYPE) ;-set/kill 'ASSNPDTTM' xref in file #8973.2
207 ;-----------------------------------------------------------------------
208 ; DA....... Ien for file #8973.2 (CM TIMING)
209 ; X........ Value of field #.07 (KMPTMP SUBSCRIPT)
210 ; KMPDTYPE. 1 - set xref
211 ; 2 - kill xref
212 ;
213 ; ^KMPD(8973.2,"ASSNPDTTM",KmptmpSubscript,NewPerson,ServerDateTime,DA)
214 ;-----------------------------------------------------------------------
215 Q:'$G(DA)
216 Q:$G(X)=""
217 Q:'$G(KMPDTYPE)
218 N NP,DATA,DATE
219 S DATA=$G(^KMPD(8973.2,DA,0)) Q:DATA=""
220 ; server start date/time
221 S DATE=$P(DATA,U,3) Q:'DATE
222 ; new person
223 S NP=$P(DATA,U,5) Q:NP=""
224 I KMPDTYPE=1 S ^KMPD(8973.2,"ASSNPDTTM",X,NP,DATE,DA)=""
225 I KMPDTYPE=2 K ^KMPD(8973.2,"ASSNPDTTM",X,NP,DATE,DA)
226 Q
227 ;
228XREFT6(DA,X,KMPDTYPE) ;-set/kill 'ASSIPDTTM' xref in file #8973.2
229 ;-----------------------------------------------------------------------
230 ; DA....... Ien for file #8973.2 (CM TIMING)
231 ; X........ Value of field #.07 (KMPTMP SUBSCRIPT)
232 ; KMPDTYPE. 1 - set xref
233 ; 2 - kill xref
234 ;
235 ; ^KMPD(8973.2,"ASSIPDTTM",KmptmpSubscript,IpAddress,ServerDateTime,DA)
236 ;-----------------------------------------------------------------------
237 Q:'$G(DA)
238 Q:$G(X)=""
239 Q:'$G(KMPDTYPE)
240 N IP,DATA,DATE
241 S DATA=$G(^KMPD(8973.2,DA,0)) Q:DATA=""
242 ; server start date/time
243 S DATE=$P(DATA,U,3) Q:'DATE
244 ; ip address
245 S IP=$P(DATA,U,9) Q:IP=""
246 I KMPDTYPE=1 S ^KMPD(8973.2,"ASSIPDTTM",X,IP,DATE,DA)=""
247 I KMPDTYPE=2 K ^KMPD(8973.2,"ASSIPDTTM",X,IP,DATE,DA)
248 Q
Note: See TracBrowser for help on using the repository browser.