source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUPS104.m@ 1801

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

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1TIUPS104 ; SLC/JER - Post-install TIU*1*104 ;20-SEP-2000 14:22:20
2 ;;1.0;TEXT INTEGRATION UTILITIES;**104**;Jun 20, 1997
3MAIN ; Control unit
4 D CLEANUP
5 Q
6CLEANUP ; Correct PARENT DOCUMENT CLASS field for records that were filed with bad values
7 N TIUEDT,TIUDA,TIUCNT S TIUCNT=0
8 S TIUEDT=$$GETSTART Q:+TIUEDT'>0
9 S ^XTMP("TIUPS104",0)=$$FMADD^XLFDT(DT,90)_U_DT
10 S ^XTMP("TIUPS104","T0")=$$NOW^XLFDT
11 D BMES^XPDUTL("** CLEANING UP DOCUMENTS WITH BAD DOCUMENT CLASS VALUES **")
12 F S TIUEDT=$O(^TIU(8925,"F",TIUEDT)) Q:+TIUEDT'>0 D
13 . N TIUDA S TIUDA=0
14 . F S TIUDA=$O(^TIU(8925,"F",TIUEDT,TIUDA)) Q:+TIUDA'>0 D
15 . . N TIUD0,TIUDCLS,TIUCDCLS
16 . . S TIUD0=$G(^TIU(8925,TIUDA,0)),TIUDCLS=$P(TIUD0,U,4)
17 . . S TIUCDCLS=$$DOCCLASS^TIULC1(+TIUD0)
18 . . ; Don't process records where Document Class is correct
19 . . Q:TIUCDCLS=TIUDCLS
20 . . D FIXIT(TIUDA,TIUCDCLS,TIUDCLS)
21 . . S ^XTMP("TIUPS104","CHKPNT")=TIUEDT_U_TIUDA
22 S ^XTMP("TIUPS104","T1")=$$NOW^XLFDT
23 I TIUCNT=0 D BMES^XPDUTL("No aberrant documents found...")
24 Q
25GETSTART() ; Get the starting date
26 N TIUY
27 S TIUY=+$G(^XTMP("TIUPS104","CHKPNT"))
28 I +TIUY>0 G GETSTX
29 S TIUY=$$FMADD^XLFDT(DT,-180)
30GETSTX Q TIUY
31FIXIT(DA,TIUCDCLS,TIUDCLS) ; file the corrected document class
32 N DIE,DR
33 S DIE=8925
34 S DR=".04////^S X=TIUCDCLS"
35 D ^DIE
36 S TIUCNT=TIUCNT+1
37 S ^XTMP("TIUPS104",DA)=TIUDCLS_U_TIUCDCLS
38 S ^XTMP("TIUPS104","COUNT")=TIUCNT
39 I $S(TIUCNT=1:1,'(TIUCNT#50):1,1:0) D MES^XPDUTL($$GETMSG(TIUCNT\50))
40 Q
41GETMSG(LINE) ; Get a message of encouragement...
42 Q $P($T(MSG+$S(LINE'>10:LINE,1:$R(10))),";",3)
43MSG ; List of messages
44 ;;Hang in there, this won't take too much longer...
45 ;;Boy, you've got a lot of these!
46 ;;What were you expecting, animated .gif's or something?
47 ;;"I like New York in June, how about you?"
48 ;;"I like a Gershwin tune, how about you?"
49 ;;Aren't you glad that I didn't ask "IS EVERYTHING OK?"
50 ;;DILBERT RULES!
51 ;;Don't worry, I'll be done LONG before we have a mass transit subsidy...
52 ;;You will be assimilated...
53 ;;Resistence is futile...
Note: See TracBrowser for help on using the repository browser.