source: cprs/branches/tmg-cprs/m_files/TMGTRAN1.m@ 1694

Last change on this file since 1694 was 796, checked in by Kevin Toppenberg, 15 years ago

Initial upload
File size: 37.0 KB
RevLine 
[796]1TMGTRAN1 ;TMG/kst/TRANSCRIPTION REPORT FUNCTIONS -- UI ;03/25/06
2 ;;1.0;TMG-LIB;**1**;09/01/05
3
4 ;" TRANSCRIPTION REPORT FUNCTIONS
5
6 ;"=======================================================================
7 ;" API -- Public Functions.
8 ;"=======================================================================
9 ;"RPTCUR
10 ;"RPTASK
11 ;"RPTQUIET(OPTIONS)
12 ;"FREECUR
13 ;"FREEASK
14 ;"ScanSign(OPTIONS,SIGNED)
15 ;"PWDSNOOP(IEN)
16 ;"SHOWUNSIGNED
17 ;"SIGNDOC(DocIEN,OPTIONS)
18 ;"PRINT(DocArray) ; Prompt and print, or array
19
20
21
22 ;"=======================================================================
23 ;" Private Functions.
24 ;"=======================================================================
25 ;"AskDatesRPT(Options)
26 ;"FreeDocs(AuthorIEN,ShowDetails)
27
28 ;"=======================================================================
29RPTCUR
30 ;"SCOPE: PUBLIC
31 ;"Purpose: To report transcription productivity for the current user (DUZ)
32 ;"Input: none. User will be asked for start and end dates
33 ;"Output: Produces a report to choses output channel.
34
35 new Options
36
37 write !,"-- TRANSCRIPTION PRODUCTIVITY CREDIT REPORT -- ",!!
38 write "Showing credit for: ",$piece($get(^VA(200,DUZ,0)),"^",1),!!
39
40 set Options("TRANS")=DUZ
41 do AskDatesRPT(.Options)
42
43 quit
44
45RPTASK
46 ;"SCOPE: PUBLIC
47 ;"Purpose: To report transcription productivity for a chosen user
48 ;"Input: none. User will be asked for the user to report on, and also
49 ;" start and end dates
50 ;"Output: Produces a report to choses output channel.
51
52 new Options
53
54 ;"set TMGDEBUG=1 ;"TEMP!!!
55
56 write !,"-- TRANSCRIPTION PRODUCTIVITY CREDIT REPORT -- ",!!
57
58 set DIC=200 ;"NEW PERSON file
59 set DIC(0)="MAQE"
60 set DIC("A")="Enter name of transcriptionist (^ to abort): "
61 do ^DIC
62 if +Y=-1 do goto RADone
63 . write !,"No transcriptionist selected. Aborting report.",!
64
65 set Options("TRANS")=+Y
66
67 do AskDatesRPT(.Options)
68RADone
69 quit
70
71RPTCURA
72 ;"SCOPE: PUBLIC
73 ;"Purpose: To report current user's (DUZ) cost for all transcriptionists
74 ;"Input: none. User will be asked for start and end dates
75 ;"Output: Produces a report to choses output channel.
76
77 new Options
78
79 write !,"-- TRANSCRIPTION COST REPORT -- ",!!
80 write "Showing cost for: ",$piece($get(^VA(200,DUZ,0)),"^",1),!!
81
82 set Options("AUTHOR")=DUZ
83 do AskDatesRPT(.Options)
84
85 quit
86
87RPTASKA
88 ;"SCOPE: PUBLIC
89 ;"Purpose: To report transcription costs for a chosen user
90 ;"Input: none. User will be asked for the user to report on, and also
91 ;" start and end dates
92 ;"Output: Produces a report to choses output channel.
93
94 new Options
95
96 write !,"-- TRANSCRIPTION COST REPORT -- ",!!
97
98 set DIC=200 ;"NEW PERSON file
99 set DIC(0)="MAQE"
100 set DIC("A")="Enter name of author (^ to abort): "
101 do ^DIC
102 if +Y=-1 do goto RAADone
103 . write !,"No author selected. Aborting report.",!
104
105 set Options("AUTHOR")=+Y
106
107 do AskDatesRPT(.Options)
108RAADone
109 quit
110
111
112
113AskDatesRPT(Options)
114 ;"SCOPE: PUBLIC
115 ;"Purpose: to finish the interactive report process.
116 ;"Input: An array that should contain Options("TRANS")=IEN
117
118 write !!!
119 write "NOTE: Enter date range for note ENTRY into system, not date of service.",!
120 new %DT
121 set %DT="AEP"
122 set %DT("A")="Enter starting date (^ to abort): "
123 do ^%DT
124 if Y=-1 do goto ADRDone
125 . write "Invalid date. Aborting report.",!
126 set Options("START")=Y
127
128 set %DT("A")="Enter ending date (^ to abort): "
129 do ^%DT
130 if Y=-1 do goto ADRDone
131 . write "Invalid date. Aborting report.",!
132 set Options("END")=Y
133
134 new YN
135 read !,"Show Details? YES// ",YN:$get(DTIME,3600)
136 if YN="" set YN="Y"
137 set Options("DETAILS")=($$UP^XLFSTR(YN)["Y")
138 if YN="^" write "Aborting.",! goto ADRDone
139
140 set %ZIS("A")="Enter output printer or device (^ to abort): "
141 do ^%ZIS
142 if POP do goto ADRDone
143 . write !,"Error selecting output printer or device. Aborting report.",!
144
145 use IO
146 do RPTQUIET(.Options)
147 use IO(0)
148
149 do ^%ZISC
150
151ADRDone
152 quit
153
154
155RPTQUIET(OPTIONS)
156 ;"SCOPE: PUBLIC
157 ;"Purpose: To create a report on transcription productivity based on
158 ;" options specified in OPTIONS.
159 ;"Input: The following elements in OPTIONS should be defined
160 ;" 0PTIONS("TRANS") ;"the IEN of the transcriptionst (IEN from file 200)
161 ;" This term is to limit the search. If all transcriptionsts are
162 ;" wanted, then don't define OPTIONS("TRANS")
163 ;" If multiple transcriptionists need to be specified, use this format:
164 ;" OPTIONS("TRANS")="*"
165 ;" OPTIONS("TRANS",1)=IEN#1
166 ;" OPTIONS("TRANS",2)=IEN#2
167 ;" OPTIONS("TRANS",3)=IEN#3
168 ;" 0PTIONS("AUTHOR") ;"the IEN of the author (IEN from file 200)
169 ;" This term is to limit the search. If all authors are
170 ;" wanted, then don't define OPTIONS("AUTHOR")
171 ;" If multiple authors need to be specified, use this format:
172 ;" OPTIONS("AUTHOR")="*"
173 ;" OPTIONS("AUTHOR",1)=IEN#1
174 ;" OPTIONS("AUTHOR",2)=IEN#2
175 ;" OPTIONS("AUTHOR",3)=IEN#3
176 ;" OPTIONS("START") ;"Earliest date of documents, in Fileman internal format
177 ;" OPTIONS("END") ;"Latest date of documents, in Fileman internal format
178 ;" OPTIONS("DETAILS") ;"if 1, then each document showed
179 ;"Note: This will create a report by writing to the current device
180 ;" If the user wants output to go to a DEVICE, then they should call
181 ;" ^%ZIS prior to calling this function, and call ^%ZISC aftewards to close
182
183 if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"RPTQUIET^TMGTRANS1")
184
185 new index
186 new TransIEN,AuthorIEN
187 new TransArrayP set TransArrayP="OPTIONS(""TRANS"")"
188 new AuthorArrayP set AuthorArrayP="OPTIONS(""AUTHOR"")"
189 new ChrCt set ChrCt=0
190 new LineCt set LineCt=0
191 new StartDT,EndDT
192 new CtAuthor ;"An array to subdivide lines to each doctor's account
193 new CtTrans ;"An array to track transcriptionists lines and income
194 new AuthorInitials,TransInitials
195 new ShowDetails set ShowDetails=+$get(OPTIONS("DETAILS"))
196
197 set StartDT=+$get(OPTIONS("START"))
198 if (StartDT=0) do goto RQDone
199 . write "No start date specified. Aborting.",!
200 set EndDT=+$get(OPTIONS("END"))\1 ;" \1 removes time from date
201 if (EndDT=0) do goto RQDone
202 . write "No end date specified. Aborting.",!
203
204 new CharsPerLine set CharsPerLine=+$piece($get(^TIU(8925.99,1,0)),"^",3)
205 if CharsPerLine=0 set CharsPerLine=65
206
207 write !!," Visit;"
208 write $$RJ^XLFSTR("Entry Date;",15)
209 write $$RJ^XLFSTR("Lines@Rate=$Cost",23),"; "
210 write "Trn; Ath; Sgn; Patient",!
211 write "------------------------------------------------------------------------------",!
212 set index=$order(^TIU(8925,0))
213 for do quit:(index="")
214 . ;"write "."
215 . if index="" quit
216 . new k
217 . use IO(0) read *k:0 use IO
218 . if k=27 do quit
219 . . set index=""
220 . . write "Report aborted by ESC from user.",!
221 . new tDate set tDate=$piece($get(^TIU(8925,index,12)),"^",1)
222 . set tDate=tDate\1 ;"remove time from date
223 . ;"set mC=mC+1 set tC=tC+1 if tC>100 write mC," " set tC=0
224 . if (tDate'<StartDT)&(tDate'>EndDT) do
225 . . set TransIEN=+$piece($get(^TIU(8925,index,13)),"^",2) ;"field 1302
226 . . ;"write "index=",index," "
227 . . ;"write "TransIEN='"
228 . . ;"write TransIEN,"'"
229 . . if ($data(OPTIONS("TRANS"))=0)!($$InList^TMGMISC(TransIEN,TransArrayP)=1) do
230 . . . set AuthorIEN=$piece($get(^TIU(8925,index,12)),"^",2) ;field 1202
231 . . . if ($data(OPTIONS("AUTHOR"))=0)!($$InList^TMGMISC(AuthorIEN,AuthorArrayP)=1) do
232 . . . . new tCharCt,tLineCt,Date,DateS,Pt
233 . . . . new VDate,VDateSi
234 . . . . new pStatus
235 . . . . new Status set Status="N"
236 . . . . new Patient set Patient=""
237 . . . . set tCharCt=+$piece($get(^TIU(8925,index,"TMG")),"^",2);"field 22711=char count
238 . . . . set tLineCt=+$piece($get(^TIU(8925,index,0)),"^",10) ;"field .1 = line count
239 . . . . set pStatus=$piece($get(^TIU(8925,index,0)),"^",5) ;"field .05 is status file pointer
240 . . . . if +pStatus'=0 do
241 . . . . . set Status=$piece($get(^TIU(8925.6,pStatus,0)),"^",2) ;"8925.6=TIU Status. field .02=symbol
242 . . . . . if Status="c" set Status="Y"
243 . . . . . else set Status="N"
244 . . . . if (tLineCt=0)!(tCharCt=0) do
245 . . . . . if (tLineCt=0)&(tCharCt'=0) do
246 . . . . . . set tLineCt=(((tCharCt/CharsPerLine)*10)\1)/10
247 . . . . . else if (tCharCt=0)&(tLineCt'=0) do
248 . . . . . . set tCharCt=tLineCt*CharsPerLine
249 . . . . . else do
250 . . . . . . set tLineCt=$$DocLines^TMGMISC(index,.tCharCt)
251 . . . . . . if tLineCt=0 set tLineCt=(((tCharCt/CharsPerLine)*10)\1)/10
252 . . . . . set tLineCt=$$Round^TMGMISC(tLineCt)
253 . . . . . set tCharCt=$$Round^TMGMISC(tCharCt)
254 . . . . . ;"Store values, so next time we won't have to calculate it.
255 . . . . . set $piece(^TIU(8925,index,0),"^",10)=+tLineCt ;"field .1 = line count
256 . . . . . set $piece(^TIU(8925,index,"TMG"),"^",2)=tCharCt ;"field 22711 = char count
257 . . . . set Date=$piece($get(^TIU(8925,index,12)),"^",1) ;"field 1201 = Entry Date
258 . . . . ;"set DateS=$$FMTE^XLFDT(Date,"D")
259 . . . . set DateS=$$DTFormat^TMGMISC(Date,"ww mm/dd/yy")
260 . . . . set VDate=$piece($get(^TIU(8925,index,13)),"^",1) ;"field 1301=Ref/Visit Date
261 . . . . ;"set VDateS=$$FMTE^XLFDT(VDate,"D")
262 . . . . set VDateS=$$DTFormat^TMGMISC(VDate,"mm/dd/yy")
263 . . . . set AuthorInitials=$piece($get(^VA(200,AuthorIEN,0)),"^",2)
264 . . . . set TransInitials=$piece($get(^VA(200,TransIEN,0)),"^",2) ;"field 1 = initials
265 . . . . set CtAuthor(AuthorIEN,"LINES")=$get(CtAuthor(AuthorIEN,"LINES"))+tLineCt
266 . . . . set CtAuthor(AuthorIEN,"NOTES")=+$get(CtAuthor(AuthorIEN,"NOTES"))+1
267 . . . . set CtTrans(TransIEN,"LINES")=$get(CtTrans(TransIEN,"LINES"))+tLineCt
268 . . . . set CtTrans(TransIEN,"NOTES")=+$get(CtTrans(TransIEN,"NOTES"))+1
269 . . . . set Pt=+$piece($get(^TIU(8925,index,0)),"^",2) ;"field .02 = patient
270 . . . . if Pt'=0 set Patient=$piece($get(^DPT(Pt,0)),"^",1) ;"field .01 = name
271 . . . . new NoteBonus set NoteBonus=0
272 . . . . new PayRate set PayRate=$$PayRate(TransIEN,Date,.NoteBonus)
273 . . . . ;"new LineCost set LineCost=$$RoundDn^TMGMISC(tLineCt*PayRate)
274 . . . . ;"new LineCost set LineCost=(tLineCt*PayRate)
275 . . . . new LineCost set LineCost=(tLineCt*PayRate)+NoteBonus
276 . . . . set CtAuthor(AuthorIEN,"COST")=+$get(CtAuthor(AuthorIEN,"COST"))+LineCost
277 . . . . set CtAuthor(AuthorIEN,"BONUS")=+$get(CtAuthor(AuthorIEN,"BONUS"))+NoteBonus
278 . . . . set CtTrans(TransIEN,"COST")=+$get(CtTrans(TransIEN,"COST"))+LineCost
279 . . . . set CtTrans(TransIEN,"BONUS")=+$get(CtTrans(TransIEN,"BONUS"))+NoteBonus
280 . . . . if ShowDetails do
281 . . . . . write VDateS,"; "
282 . . . . . write $$RJ^XLFSTR(DateS,13),";"
283 . . . . . new tS set tS=tLineCt_" @"_PayRate
284 . . . . . if NoteBonus>0 set tS=tS_")+"_NoteBonus
285 . . . . . write $$RJ^XLFSTR(.tS,15)
286 . . . . . set tS=" =$"_LineCost_"; "
287 . . . . . write $$RJ^XLFSTR(.tS,10)
288 . . . . . write TransInitials,"; ",AuthorInitials,"; "
289 . . . . . write " ",Status,"; "
290 . . . . . write $$Clip^TMGSTUTL(Patient,15),!
291 . . . . set LineCt=LineCt+tLineCt
292 . set index=+$order(^TIU(8925,index))
293 . if index=0 set index=""
294
295 write !,"Transcriptionist breakdown",!
296 write "-----------------------------",!
297 set index=$order(CtTrans(""))
298 for do quit:(index="")
299 . new TransS,Lines,Notes
300 . if index="" quit
301 . set TransS=$piece($get(^VA(200,index,0)),"^",1)
302 . if TransS="" set TransS="(Unknown Transcriptionist)"
303 . set Lines=+$get(CtTrans(index,"LINES"))
304 . set Notes=+$get(CtTrans(index,"NOTES"))
305 . write " ",TransS,": ",Lines," lines in ",Notes," notes."
306 . write " $",$get(CtTrans(index,"COST"))
307 . write " (income)",!
308 . if +$get(CtTrans(index,"BONUS"))>0 do
309 . . new c set c=+$get(CtTrans(index,"COST"))
310 . . new b set b=$get(CtTrans(index,"BONUS"))
311 . . write ?15,"$",c," = $",(c-b)," + $",b," per-note bonus.",!
312 . set index=$order(CtTrans(index))
313
314 write !,"Author breakdown",!
315 write "--------------------",!
316 set index=$order(CtAuthor(""))
317 for do quit:(index="")
318 . new AuthorS,Lines,Notes
319 . if index="" quit
320 . set AuthorS=$piece($get(^VA(200,index,0)),"^",1)
321 . if AuthorS="" set AuthorS="(Unknown Author)"
322 . set Lines=+$get(CtAuthor(index,"LINES"))
323 . set Notes=+$get(CtAuthor(index,"NOTES"))
324 . write " ",AuthorS,": ",Lines," lines in ",Notes," notes."
325 . write " $",$get(CtAuthor(index,"COST"))," (expense)",!
326 . if +$get(CtAuthor(index,"BONUS"))>0 do
327 . . new c set c=+$get(CtAuthor(index,"COST"))
328 . . new b set b=$get(CtAuthor(index,"BONUS"))
329 . . write ?15,"$",c," = $",(c-b)," + $",b," per-note bonus.",!
330 . set index=$order(CtAuthor(index))
331
332 write !!,"Done.",!
333
334RQDone
335 if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"RPTQUIET^TMGTRANS1")
336 quit
337
338
339PayRateE(TransIEN,Date)
340 ;"Purpose: To provide a 'shell' for PayRate below, except external
341 ;" format of date alowed
342
343 new IDate
344
345 set X=$get(Date)
346 ;"set IDate=
347
348 ;"COMPLETE FUNCTION LATER...
349
350 quit
351
352
353PayRate(TransIEN,Date,NoteBonus)
354 ;"Purpose: Get payrate in effect at time of Date
355 ;"Input: TransIEN -- the record number in file 200
356 ;" Date: reference date to lookup, ** in internal fileman format **
357 ;" NoteBonus -- [OPTIONAL] This is an out parameter. See below.
358 ;"Result: The payrate found in file TMG TRANSCRIPTION PAYRATE file
359 ;" This is dollars/line
360 ;" If NoteBonus was passed by reference, then the value of the
361 ;" NOTE BONUS field (field #3) is returned, or 0 if not found.
362 ;" Note: a result of 0 is returned if TransIEN not found, or
363 ;" no date range covers Date
364
365 new result set result=0
366 new bonusresult set bonusresult=0
367 new RateIEN
368 new index
369
370 if (+$get(TransIEN)=0)!(+$get(Date)=0) goto PRDone
371 set Date=Date\1
372 set RateIEN=+$order(^TMG(22704,"B",TransIEN,""))
373 if RateIEN=0 goto PRDone
374 merge PayRates=^TMG(22704,RateIEN,1)
375 set index=$order(^TMG(22704,RateIEN,1,0))
376 for do quit:(index="")
377 . if index="" quit
378 . new Rate set Rate=$get(^TMG(22704,RateIEN,1,index,0))
379 . if Rate'="" do
380 . . new StartDate,EndDate
381 . . set StartDate=$piece(Rate,"^",2)
382 . . set EndDate=$piece(Rate,"^",3)
383 . . if Date<StartDate do quit
384 . . . ;"write "Date=",Date," StartDate=",StartDate,!
385 . . if (EndDate'="")&(Date>EndDate) do quit
386 . . . ;"write "Date=",Date," EndDate=",EndDate,!
387 . . set result=$piece(Rate,"^",1)
388 . . set bonusresult=$piece(Rate,"^",4) ;"field#3 (NOTE BONUS)
389 . if result'=0 set index="" quit
390 . set index=$order(^TMG(22704,RateIEN,1,index))
391
392 if result=0 do
393 . ;"write !,"TransIEN=",TransIEN," Date=",Date,!
394PRDone
395 set NoteBonus=bonusresult
396 quit result
397
398 ;"=======================================================================
399
400FREECUR
401 ;"Purpose: For current user, cycle through all alerts regarding
402 ;" documents needing to be signed, and automatically sign
403 ;" them, then print if user wants.
404 ;"Input: none. User will be asked for signature password,
405 ;" and if they want documents printed.
406 ;"Output: Produces a report to chosen output channel.
407
408 ;"write @IOF
409 write !!,"-- RELEASE UNSIGNED DOCUMENTS -- ",!!
410 write "Releasing transcription for: ",$piece($get(^VA(200,DUZ,0)),"^",1),!!
411
412 do FreeDocs(DUZ,1)
413
414 write !,"Goodbye.",!
415
416 quit
417
418
419FREEASK
420 ;"Purpose: Ask for chosen user, then cycle through all alerts
421 ;" regarding documents needing to be signed, and automatically
422 ;" sign them, then print if user wants.
423 ;"Input: none. User will be asked for signature password,
424 ;" and if they want documents printed.
425 ;"Output: Produces a report to choses output channel.
426
427 new Y,DIC,TransIEN,DocIEN
428 set TransIEN=-1
429
430 ;"write @IOF
431 write !!,"-- RELEASE UNSIGNED DOCUMENTS -- ",!!
432
433 set DIC=200 ;"NEW PERSON file
434 set DIC(0)="MAQE"
435 set DIC("A")="Enter name of author (^ to abort): "
436 do ^DIC
437 if +Y'>0 do goto RADone
438 . write !,"No author selected. Aborting report.",!
439 set DocIEN=+Y
440
441 write !!,"OPTIONAL-- Enter name of transcriptionist to screen for. If specified, ",!
442 write "only notes entered by this transcriptionist will be signed and released."
443 set DIC("A")="Enter name of transcriptionist (ENTER or ^ to skip): "
444 do ^DIC
445 write !!
446 if +Y'>0 set TransIEN=+Y
447
448 do FreeDocs(DocIEN,1,TransIEN)
449
450 write !,"Goodbye.",!
451
452FADone
453 quit
454
455
456FreeDocs(AuthorIEN,ShowDetails,TransIEN)
457 ;"Purpose: to finish the interactive release documents process.
458 ;" This separate entry point allows restriction of the author
459 ;" whose's documents are to be released.
460 ;"Input: AuthorIEN, the record number of the author in file 200
461 ;" ShowDetails: optional. Default is to show details (1)
462 ;" 0=don't show, 1=show
463 ;" TransIEN: OPTIONAL -- the IEN of the transcriptionist.
464 ;" IF specified, then ONLY those notes created by this
465 ;" transcriptionist will be finished/released
466
467 new Signed
468 new abort set abort=0
469 new Options
470 new PrintAfter
471 new YN
472 new SignAll
473
474 set Options("AUTHOR")=+$get(AuthorIEN)
475 set Options("SIG")=0
476 set Options("DETAILS")=$get(ShowDetails,1)
477 if +$get(TransIEN)>0 set Options("TRANS")=+TransIEN
478
479 do
480 . write "Enter 'your' (meaning author's) signature code below."
481 . new DUZ
482 . set DUZ=+$get(AuthorIEN)
483 . if DUZ=0 quit
484 . do SIG^XUSESIG
485 . write !
486 . if X1'="" set Options("SIG")=1
487 if Options("SIG")'=1 do goto FADDone
488 . write "Signature code incorrect. Aborting.",!
489
490 read "Sign all notes at once (^/Y/N): YES// ",SignAll:$get(DTIME,3600),!
491 if SignAll="" set SignAll="Y"
492 if SignAll="^" write "Aborting.",! goto ADRDone
493 set Options("SIGN ALL")=($$UP^XLFSTR(SignAll)["Y")
494
495 write !,"Print Notes after signing? (^/Y/N): YES// "
496 read YN:$get(DTIME,3600),!
497 if YN="^" write "Aborting.",! goto ADRDone
498 if YN="" set YN="Y"
499 set PrintAfter=($$UP^XLFSTR(YN)["Y")
500
501 do AlertSign(.Options,.Signed)
502
503 write "Now look at ALL documents to find any unsigned ones.",!
504 set Options("START")="0001111"
505 do NOW^%DTC
506 set Options("END")=X
507 do ScanSign(.Options,.Signed)
508
509 merge ^TMG("BATCH SIGNED DOCS",$J)=Signed
510
511 if PrintAfter do PRINT(.Signed)
512
513FADDone
514 quit
515
516
517ScanSign(OPTIONS,SIGNED)
518 ;"Purpose: To scan through all TIU DOCUMENTS, and release those
519 ;" that have a status of unsigned to completed
520 ;"Input: The following elements in OPTIONS should be defined
521 ;" 0PTIONS("AUTHOR") ;"the IEN of the user (IEN from file 200)
522 ;" OPTIONS("START") ;"Earliest date of documents, in Fileman internal format
523 ;" ;"Note if not specified, then all dates are matched
524 ;" OPTIONS("END") ;"Latest date of documents, in Fileman internal format
525 ;" ;"Note if not specified, then all dates are matched
526 ;" OPTIONS("DETAILS") ;"if 1, then each document is shown as signed (not quiet)
527 ;" OPTIONS("SIG") ;"1 if signature has been verified.
528 ;" -----------Optional OPTIONS below---------------
529 ;" OPTIONS("TRANS") ;"the IEN of note. If specified, then note will not be signed
530 ;" ;"unless the transcriptionist (i.e. ENTERED BY field) = this IEN
531 ;" -------------------------------------------------------
532 ;" SIGNED: OPTIONAL. This is an OUT PARAMETER -- must be passed by reference
533 ;" This will contain list of documents freed/signed, in this format:
534 ;" SIGNED(1234)=1234 with 1234 being IEN of document signed.
535 ;" SIGNED(1235)=1235 with 1235 being IEN of document signed.
536 ;" SIGNED(1236)=1236 with 1235 being IEN of document signed.
537
538 new index
539 new DocAuth,Status,EnteredBy
540 new User,initials
541 new NeedsCR set NeedsCR=1
542 new StartDT,EndDT
543 new ShowDetails set ShowDetails=+$get(OPTIONS("DETAILS"))
544
545 if +$get(OPTIONS("START"))=0 do
546 . new %DT
547 . set %DT="AEP"
548 . set %DT("A")="Enter starting date (^ to abort): "
549 . do ^%DT
550 . set OPTIONS("START")=Y
551 if $get(OPTIONS("START"))'>0 do goto SSDone
552 . if ShowDetails write "START date invalid. Aborting.",!
553
554 if +$get(OPTIONS("END"))=0 do
555 . set %DT("A")="Enter ending date (^ to abort): "
556 . do ^%DT
557 . set OPTIONS("END")=Y
558 if $get(OPTIONS("END"))'>0 do goto SSDone
559 . if ShowDetails write "END date invalid. Aborting.",!
560
561 set User=+$get(OPTIONS("AUTHOR"))
562 if User=0 do goto RQDone
563 . if $get(OPTIONS("DETAILS")) write "No author IEN supplied. Aborting.",!
564 set StartDT=+$get(OPTIONS("START"))
565 set EndDT=+$get(OPTIONS("END"))
566
567 if $get(OPTIONS("DETAILS")) do
568 . write !,"------------------------------------------------",!
569 . write "Starting scan of all documents. [ESC] will abort.",!
570 . write "------------------------------------------------",!
571
572 set initials=$piece($get(^VA(200,User,0)),"^",2) ;"field 1 = initials
573 new sUnsigned set sUnsigned=$order(^TIU(8925.6,"B","UNSIGNED",""))
574 new sUnverified set sUnverified=$order(^TIU(8925.6,"B","UNVERIFIED",""))
575
576 set index=$order(^TIU(8925,0))
577 for do quit:(index="")
578 . if index="" quit
579 . new k read *k:0
580 . if k=27 do quit
581 . . set index=""
582 . . if $get(OPTIONS("DETAILS")) write "Release aborted by ESC from user.",!
583 . set DocAuth=$piece($get(^TIU(8925,index,12)),"^",2) ;"field 1202 = Author
584 . set EnteredBy=$piece($get(^TIU(8925,index,13)),"^",2) ;"field 1302 = Entered By
585 . if (DocAuth=$get(OPTIONS("AUTHOR"))) do
586 . . if $data(OPTIONS("TRANS"))&($get(OPTIONS("TRANS"))'=EnteredBy) quit
587 . . set Status=$piece($get(^TIU(8925,index,0)),"^",5) ;"field .05 = Status
588 . . if (Status=sUnsigned)!(Status=sUnverified) do ;"*** What else should go here?!!
589 . . . new tDate
590 . . . set tDate=$piece($get(^TIU(8925,index,12)),"^",1)
591 . . . set tDate=tDate\1 ;"integer round down (removes time decimal amount)
592 . . . if (StartDT=0)!(EndDT=0)!((tDate'<StartDT)&(tDate'>EndDT)) do
593 . . . . if $$SIGNDOC(index,.OPTIONS) do
594 . . . . . set SIGNED(index)=index
595 . set index=+$order(^TIU(8925,index))
596 . if index=0 set index=""
597
598SSDone
599 if $get(OPTIONS("DETAILS")) write !,"Done scanning all documents.",!
600
601 quit
602
603
604AlertSign(OPTIONS,SIGNED)
605 ;"Purpose: To cycle through all alerts for AUTHOR, and release TIU DOCUMENTS
606 ;" needing signature.
607 ;"Input: The following elements in OPTIONS should be defined
608 ;" 0PTIONS("AUTHOR") ;"the IEN of the user (IEN from file 200)
609 ;" OPTIONS("DETAILS") ;"if 1, then each document is shown as signed (not quiet)
610 ;" OPTIONS("SIG") ;"1 if signature has been verified.
611 ;" OPTIONS("SIGN ALL");"if 1, then all are signed without asking each one.
612 ;" SIGNED: OPTIONAL. This is an OUT PARAMETER -- must be passed by reference
613 ;" This will contain list of documents freed/signed, in this format:
614 ;" SIGNED(1234)=1234 with 1234 being IEN of document signed.
615 ;" SIGNED(1235)=1235 with 1235 being IEN of document signed.
616 ;" SIGNED(1236)=1236 with 1235 being IEN of document signed.
617
618 new index
619 new Abort set Abort=0
620 new Alert
621 new DocIEN
622 new NumFound set NumFound=0
623 new SignAll set SignAll=+$get(OPTIONS("SIGN ALL"))
624
625 set User=+$get(OPTIONS("AUTHOR"))
626 if User=0 do goto RQDone
627 . if $get(OPTIONS("DETAILS")) write "No author IEN supplied. Aborting.",!
628
629 if $get(OPTIONS("DETAILS")) do
630 . write !,"-------------------------------------------------------",!
631 . write "Search for 'signature-needed' alerts. [ESC] will abort.",!
632 . write "-------------------------------------------------------",!
633
634 if SignAll'=1 do if NumFound=0 goto ASgn2
635 . write !!,"-------- List of Documents to be Signed --------",!
636 . set index=$order(^XTV(8992,User,"XQA",0))
637 . for do quit:(index="")
638 . . if index="" quit
639 . . new k read *k:0
640 . . if k=27 do quit
641 . . . set index=""
642 . . . if $get(OPTIONS("DETAILS")) write "List aborted by ESC from user.",!
643 . . set Alert=$get(^XTV(8992,User,"XQA",index,0))
644 . . if $piece(Alert,"^",3)["available for SIGNATURE" do
645 . . . write $piece(Alert,"^",3),!
646 . . . set NumFound=NumFound+1
647 . . set index=$order(^XTV(8992,User,"XQA",index))
648 . write "-----------------------------------------------",!
649 . write !,NumFound," documents needing signature.",!!
650 . if NumFound=0 do quit
651 . . write "No alerts for a missing signature found.!",!
652
653 ;"WRITE "STARTING SIGN LOOP",!
654 set NumFound=0
655 set index=$order(^XTV(8992,User,"XQA",0))
656 for do quit:(index="")!(Abort=1)
657 . new Title,YN
658 . if index="" quit
659 . set Alert=$get(^XTV(8992,User,"XQA",index,0))
660 . set Title=$piece(Alert,"^",3)
661 . if Title["available for SIGNATURE" do
662 . . set NumFound=NumFound+1
663 . . if SignAll'=1 do
664 . . . write "Sign: ",$piece(Title," ",1),"? (Y/N/ALL): ALL// "
665 . . . read YN:$get(DTIME,3600),!
666 . . . set YN=$$UP^XLFSTR(YN)
667 . . else set YN="Y"
668 . . if YN="" set YN="ALL" write "ALL",!
669 . . if YN="ALL" set SignAll=1 set YN="Y"
670 . . else if YN["^" write !,"Aborting.",! set Abort=1 quit
671 . . if YN["Y" do
672 . . . set DocIEN=+$get(^XTV(8992,User,"XQA",index,1))
673 . . . if DocIEN'=0 do
674 . . . . if $$SIGNDOC(DocIEN,.OPTIONS) do
675 . . . . . set SIGNED(DocIEN)=DocIEN
676 . set index=$order(^XTV(8992,User,"XQA",index))
677
678 if $get(OPTIONS("DETAILS")) do
679 . write !!,"Done searching for 'needed-signature' alerts.",!
680
681ASgn2
682 if (1=0) do ;"if (NumFound=0) do
683 . if $get(OPTIONS("DETAILS")) do
684 . . write "No alert indicating a signature is needed was found....",!
685 . . write "...So starting a scan of all documents to look for unsigned documents.",!
686 . set OPTIONS("START")="0001111"
687 . do NOW^%DTC
688 . set OPTIONS("END")=X
689 . do ScanSign(.OPTIONS,.Signed)
690
691ASgnDone
692 quit
693
694
695SIGNDOC(DocIEN,OPTIONS)
696 ;"Purpose: To sign one document
697 ;"Input: DocIEN -- the record number of the document to sign
698 ;" OPTIONS -- An array with input values. The following are used:
699 ;" 0PTIONS("AUTHOR") ;"the IEN of the user (IEN from file 200)
700 ;" OPTIONS("DETAILS") ;"if 1, then each document showed
701 ;" OPTIONS("SIG") ;"1 if signature has been verified.
702 ;"Results: 1 = successful sign. 0 = failure
703
704 new result set result=0 ;"default to failure
705 new Node0
706 new sCompleted set sCompleted=$order(^TIU(8925.6,"B","COMPLETED",""))
707 new NewStatus
708 if $get(OPTIONS("SIG"))'=1 goto SDCDone
709 if +$get(OPTIONS("AUTHOR"))'>0 goto SDCDone
710 if $get(DocIEN)="" goto SDCDone
711
712 new SignerS
713 set SignerS=1_"^"_$piece($get(^VA(200,+OPTIONS("AUTHOR"),20)),"^",2,3)
714 if $data(^TIU(8925,DocIEN,0))=0 do goto SDCDone
715 . write "Unable to sign document #",DocIEN," because it doesn't seem to exist.",!
716 do ES^TIURS(DocIEN,SignerS)
717 ;"Note: alert(s) r.e. "Note available for signature" are automatically removed
718
719SDLoop
720 set Node0=$get(^TIU(8925,DocIEN,0))
721 set NewStatus=$piece(Node0,"^",5) ;"field .05 = Status
722
723 new Date,DateS,Pt
724 set Date=$piece(Node0,"^",7) ;"field .07 = Episode begin date/time
725 set DateS=$$FMTE^XLFDT(Date,"D")
726 set Pt=+$piece(Node0,"^",2) ;"field .02 = patient
727 if Pt'=0 set Patient=$piece($get(^DPT(Pt,0)),"^",1) ;"field .01 = name
728 if OPTIONS("DETAILS")=1 do
729 . write DateS," -- ",Patient
730
731 if NewStatus'=sCompleted do goto SDLoop
732 . if OPTIONS("DETAILS")=1 do
733 . . new s
734 . . set s=$piece($get(^TIU(8925.6,NewStatus,0)),"^",1)
735 . . write " NOT completed. Status=",s
736 . . write !," TRYING AGAIN. (utilizing a lower-level signature method.)",!
737 . . set $piece(^TIU(8925,DocIEN,0),"^",5)=sCompleted
738
739 if OPTIONS("DETAILS")=1 do
740 . write " Released (auto-'signed')",!
741
742 set result=1 ;"success
743
744SDCDone
745 quit result
746
747
748PRINT(DocArray) ; Prompt and print, or array
749 ;"This function was copied from PRINT^TIUEPRNT, to allow modification
750 ;"Function modification: changed to allow array input.
751 ;" DocArray: This will contain list of documents to print, in this format:
752 ;" DocArray(1234)=1234 with 1234 being IEN of document to be printed.
753 ;" DocArray(1235)=1235 with 1235 being IEN of document to be printed.
754 ;" DocArray(1236)=1236 with 1235 being IEN of document to be printed.
755 ;" Note: Is appears that DocArray(IEN)="" is the needed format.
756
757 New TIUDEV,TIUTYP,DFN,TIUPMTHD,TIUD0,TIUMSG,TIUPR,TIUDARR,TIUDPRM
758 new TIUFLAG set TIUFLAG="x"
759 New TIUPGRP,TIUPFHDR,TIUPFNBR
760
761 new index set index=$order(DocArray(""))
762 if index="" goto PRINT1X
763 for do quit:(index="")
764 . set DocIEN=index
765 . ;
766 . If +$$ISADDNDM^TIULC1(DocIEN) Set DocIEN=$Piece($Get(^TIU(8925,+DocIEN,0)),U,6)
767 . If $Get(^TIU(8925,DocIEN,21)) Set DocIEN=^TIU(8925,DocIEN,21)
768 . Set TIUD0=$Get(^TIU(8925,DocIEN,0))
769 . Set TIUTYP=$Piece(TIUD0,U)
770 . Set DFN=$Piece(TIUD0,U,2)
771 . If +TIUTYP'>0 Quit
772 . ;
773 . Set TIUPMTHD=$$PRNTMTHD^TIULG(+TIUTYP)
774 . Set TIUPGRP=$$PRNTGRP^TIULG(+TIUTYP)
775 . Set TIUPFHDR=$$PRNTHDR^TIULG(+TIUTYP)
776 . Set TIUPFNBR=$$PRNTNBR^TIULG(+TIUTYP)
777 . ;
778 . Do DOCPRM^TIULC1(+TIUTYP,.TIUDPRM,DocIEN)
779 . ;
780 . If +$Piece($Get(TIUDPRM(0)),U,9) do
781 . . if TIUFLAG="x" Set TIUFLAG=$$FLAG^TIUPRPN3 ;"Asks Chart vs. Work Copy? only ONCE
782 . If ($Get(TIUPMTHD)]"")&(+$Get(TIUPGRP))&($Get(TIUPFHDR)]"")&($Get(TIUPFNBR)]"") do
783 . . Set TIUDARR(TIUPMTHD,$Get(TIUPGRP)_"$"_TIUPFHDR_";"_DFN,1,DocIEN)=TIUPFNBR
784 . Else Set TIUDARR(TIUPMTHD,DFN,1,DocIEN)=""
785 . ;
786 . If $Get(TIUPMTHD)']"" do ;"Goto PRINT1X
787 . . if OPTIONS("DETAILS")=1 do
788 . . . Write !,$Char(7),"No Print Method Defined for "
789 . . . write $Piece($Get(^TIU(8925.1,+TIUTYP,0)),U)
790 . . ;"Hang 2
791 . ;
792 . set index=$order(DocArray(index))
793
794 Set TIUDEV=$$DEVICE^TIUDEV(.IO) ; Get Device/allow queueing
795 If ($Get(IO)']"")!(TIUDEV']"") Do ^%ZISC Quit
796 If $Data(IO("Q")) Do QUE^TIUDEV("PRINTQ^TIUEPRNT",TIUDEV) Goto PRINT1X
797 Do PRINTQ^TIUEPRNT
798 Do ^%ZISC
799
800PRINT1X ; Exit single document print
801 Quit
802
803
804SHOWUNSIGNED
805 ;"Purpose: to scan through all documents and show any that are unsigned
806
807 new index
808 new DocAuth,Status,Patient,PtName
809 new TransIEN,TransInit
810 new User,initials,AuthName
811 new NeedsCR set NeedsCR=1
812 new StartDT,EndDT
813
814 write !,"----------------------------------------------",!
815 write "Starting scan of documents. [ESC] will abort.",!
816 write "----------------------------------------------",!
817
818 new sUnsigned set sUnsigned=$order(^TIU(8925.6,"B","UNSIGNED",""))
819 new sCompleted set sCompleted=$order(^TIU(8925.6,"B","COMPLETED",""))
820
821 set index=$order(^TIU(8925,0))
822 for do quit:(index="")
823 . if index="" quit
824 . new k read *k:0
825 . if k=27 do quit
826 . . set index=""
827 . . if $get(OPTIONS("DETAILS")) write "Scan aborted by ESC from user.",!
828 . set Status=$piece($get(^TIU(8925,index,0)),"^",5) ;"field .05 = Status
829 . if (Status'=sCompleted) do
830 . . ;"write !
831 . . new tDate
832 . . set tDate=$piece($get(^TIU(8925,index,12)),"^",1)
833 . . set DocAuth=$piece($get(^TIU(8925,index,12)),"^",2) ;"field 1202 = Author
834 . . set initials=$piece($get(^VA(200,DocAuth,0)),"^",2) ;"field .02 = initials
835 . . set AuthName=$piece($get(^VA(200,DocAuth,0)),"^",1) ;"field .01 = Name
836 . . set Patient=$piece($get(^TIU(8925,index,0)),"^",2) ;"field .02 = patient IEN
837 . . set TransIEN=$piece($get(^TIU(8925,index,13)),"^",2) ;"field 1302 = Entered by IEN
838 . . if +TransIEN'=0 set TransInit=$piece($get(^VA(200,TransIEN,0)),"^",2) ;" field .02 = initials
839 . . else set TransInit="???"
840 . . if +Patient'=0 set PtName=$piece($get(^DPT(Patient,0)),"^",1) ;"field .01 is patient name
841 . . else set Patient="Name Unknown(?)"
842 . . set DateS=$$DTFormat^TMGMISC(tDate,"ww mm/dd/yy")
843 . . write "NOT COMPLETED. "
844 . . write $$RJ^XLFSTR(AuthName_"; ",20)
845 . . write $$RJ^XLFSTR(DateS_"; ",15)
846 . . write $$RJ^XLFSTR(TransInit_"; ",5)
847 . . write $$Clip^TMGSTUTL(PtName,20),!
848 . ;"else write "."
849 . set index=+$order(^TIU(8925,index))
850 . if index=0 set index=""
851
852 write !,"Done scanning documents.",!
853
854 quit
855
856
857
858PWDSNOOP(IEN)
859 ;"Purpose: To show private info for a given user
860 ;"NOTICE: This function MUST be used responsibly
861 ;"Input: IEN -- [OPTIONAL] the record number of the user to snoop on
862
863 write !!,"------------------------------------------------------------------",!
864 write "Notice: This function will unmask private password codes.",!
865 write "These codes can be used spoof this EMR system. Note",!
866 write "that impersonating another user can be a CRIME.",!,!
867
868 if $data(IEN) goto IS2
869
870 set DIC=200 ;"NEW PERSON file
871 set DIC(0)="MAQE"
872 set DIC("A")="Enter name of user to unmask codes for (^ to abort): "
873 do ^DIC
874 if +Y=-1 do goto ISPDone
875 . write !,"No user selected. Aborting report.",!
876
877 write !,!
878 set IEN=+Y
879
880IS2
881 new VerHash,AccHash,ESig
882 if '$data(IEN) goto ISPDone
883
884 set VerHash=$piece($get(^VA(200,IEN,.1)),"^",2)
885 set AccHash=$piece($get(^VA(200,IEN,0)),"^",3)
886 set ESig=$piece($get(^VA(200,IEN,20)),"^",4)
887
888 write "Access Code=",$$UN^XUSHSH(AccHash),!
889 write "Verify Code=",$$UN^XUSHSH(VerHash),!
890 write "Electronic Signature=",ESig,!!
891
892 write "Remember, you are morally, ethically, and LEGALLY required to use",!
893 write "this information only in an appropriate manner.",!
894 write "------------------------------------------------------------------",!
895 write "Goodbye.",!!
896
897ISPDone
898 quit
899
900
901
902
903
Note: See TracBrowser for help on using the repository browser.