source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUTSK.m@ 691

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

initial load of WorldVistAEHR
File size: 5.1 KB
RevLine 
[613]1TIUTSK ; SLC/JER - TIU's Nightly Daemon ;4/18/03 [10/18/04 10:34am]
2 ;;1.0;TEXT INTEGRATION UTILITIES;**7,53,100,113,157,210,221**;Jun 20, 1997;Build 2
3MAIN ; All records are read. DC date updated, Record purged, Alerts are
4 ; generated if appropriate
5 N TIUDA,TIUPRM0,TIUPRM1,TIUDATE,TIUENTDT,TIUPDT,TIUODT
6 N TIUSTART,TIUEND,TIUADDL
7 D SETPARM^TIULE
8 S TIUSTART=$$TSKPARM(1),TIUEND=$$TSKPARM(2)
9 ; Traverse "FIX" X-ref to fix temporary reference dates & back-fill
10 ; Discharge Dates
11 S TIUDA="" F S TIUDA=$O(^TIU(8925,"FIX",1,TIUDA)) Q:TIUDA'>0 D
12 . D UPDDCDT(TIUDA) ;Ref Date fixed/DC Date updated if missing
13 ; Traverse "F" X-ref to identify records for which the grace period
14 ; for purge has expired
15 S TIUPDT=$$FMADD^XLFDT(DT,-$P(TIUPRM0,U,4))
16 S TIUODT=$$FMADD^XLFDT(DT,-$P(TIUPRM0,U,5))
17 ; Traverse "F" X-ref to identify records overdue for signature or purge
18 ; NOTE: Following VHA Directive 10-92-077, the purge is disabled until
19 ; further notice **53**
20 ;VMP/ELR PATCH 221 SET UP TIUADDL IS OVERDUE ONLY BECAUSE OF ADDITIONAL SIGNER TO STOP AMENDMENT ALERT
21 S TIUADDL=0
22 S TIUENTDT=($$TSKPARM(3)-1)+.999999
23 F S TIUENTDT=$O(^TIU(8925,"F",TIUENTDT)) Q:+TIUENTDT'>0!(TIUENTDT>TIUODT) D
24 . S TIUDA=0 F S TIUDA=$O(^TIU(8925,"F",+TIUENTDT,TIUDA)) Q:+TIUDA'>0 D
25 . . ; I (TIUPDT<$$FMADD^XLFDT(DT,-90)),+$$PURGE^TIULC(TIUDA) D PURGE(TIUDA) Purges old records (see NOTE above) **53**
26 . . I +$$OVERDUE(TIUDA,TIUSTART,TIUEND) D SEND^TIUALRT(TIUDA,1) S TIUADDL=0 ;Alert for overdue
27 ; If upload buffer rec older than 30 days, delete it & its alerts
28 S TIUDA=0 F S TIUDA=$O(^TIU(8925.2,TIUDA)) Q:TIUDA'>0 D
29 . N TIUDATE
30 . S TIUDATE=$P($G(^TIU(8925.2,TIUDA,0)),U,3)
31 . Q:+TIUDATE'>0
32 . I $$FMDIFF^XLFDT(DT,TIUDATE)>30 D
33 . . N TIUEI S TIUEI=0
34 . . ; JOEL, 12/21/00:
35 . . F S TIUEI=$O(^TIU(8925.2,TIUDA,"ERR",TIUEI)) Q:+TIUEI'>0 D
36 . . . N TIUEDA
37 . . . S TIUEDA=+$G(^TIU(8925.2,TIUDA,"ERR",TIUEI,0)) Q:+TIUEDA'>0
38 . . . D ALERTDEL^TIUPEVNT(TIUEDA)
39 . . D BUFPURGE^TIUPUTC(TIUDA)
40 Q
41UPDDCDT(TIUDA) ; If missing DC date & Patient Movement file has DC date,
42 ; DC date updated.
43 N DFN,DIE,DR,TIU,TIUDAD,TIUDDT,TIUD0,TIUD14,TIUDGPM
44 S TIUD0=$G(^TIU(8925,+TIUDA,0)),TIUD14=$G(^TIU(8925,+TIUDA,14))
45 S TIUDGPM=+$P(TIUD14,U)
46 I +$P($G(^DGPM(+TIUDGPM,0)),U,17)'>0 D Q
47 . I +$P(TIUD0,U,12)>0 Q
48 . S DIE=8925,DR=".12////1",DA=TIUDA D ^DIE
49 I TIUD0'="",'+$P(TIUD0,U,6),(($P(TIUD0,U,8)="")!(+$P(TIUD0,U,12)>0)) D
50 . D GETTIU^TIULD(.TIU,TIUDA)
51 . I +$G(TIU("LDT"))>0 D
52 . . S TIUDAD=$P(TIUD0,U,6)
53 . . D FIXDC(TIUDA,TIUDAD,DFN,.TIU)
54 Q
55PURGE(DA) ; When purge criteria met, document and addenda purged
56 N DR,DIE,TIUTYP,TIUDA,X,Y S TIUDA=0
57 F S TIUDA=+$O(^TIU(8925,"DAD",+DA,TIUDA)) Q:+TIUDA'>0 D
58 . I +$$ISADDNDM^TIULC1(TIUDA) D PURGE(TIUDA) I 1
59 . E D DIK^TIURB2(TIUDA) ; Remove components entirely. 1/3/01 updated DIK^TIURB to DIK^TIURB2 - Margy
60 S DIE=8925,DR=".05///PURGED;1609////"_$$NOW^TIULC_";2///@" D ^DIE
61 S ^TIU(8925,+DA,"TEXT",0)="^^"_2_U_2_U_DT_"^^"
62 S ^TIU(8925,+DA,"TEXT",1,0)=" "
63 S ^TIU(8925,+DA,"TEXT",2,0)=" Document Purged on "_$$DATE^TIULS(DT,"MM/DD/YY")_"."
64 Q
65FIXDC(DA,PARENT,DFN,TIU) ; Stuff fixed field data
66 N FDA,FDARR,IENS,FLAGS,TIUMSG
67 S IENS=""""_DA_",""",FDARR="FDA(8925,"_IENS_")",FLAGS="K"
68 I +$G(PARENT)'>0 D
69 . S @FDARR@(.08)=$P(TIU("LDT"),U)
70 . S @FDARR@(1402)=$P($G(TIU("TS")),U)
71 I +$G(PARENT)>0 D
72 . S @FDARR@(.08)=$P(TIU("LDT"),U)
73 . S @FDARR@(1401)=$P(^TIU(8925,+PARENT,14),U)
74 . S @FDARR@(1402)=$P(^TIU(8925,+PARENT,14),U,2)
75 S @FDARR@(1205)=$P($G(TIU("LOC")),U)
76 S @FDARR@(1212)=$P($G(TIU("INST")),U)
77 S @FDARR@(.12)="@"
78 S @FDARR@(1301)=+$G(TIU("LDT"))
79 D FILE^DIE(FLAGS,"FDA","TIUMSG") ; File record
80 Q
81OVERDUE(TIUDA,TIUSTART,TIUEND) ;Checks whether or not a given document is overdue
82 ;This is the same as OVERDUE^TIULC exept for the following items:
83 ; TIUPRM0 must be defined before calling
84 ; also checks for additional signatures overdue
85 N TIUD0,TIUDATE,TIUY,TIUDPRM,TIUXTRA S TIUY=0,TIUD0=$G(^TIU(8925,TIUDA,0)),TIUXTRA=0
86 D DOCPRM^TIULC1(+TIUD0,.TIUDPRM,TIUDA)
87 I '$D(TIUDPRM) G OVERX
88 S TIUDATE=$S($$REQVER^TIULC(TIUDA,+$P(TIUDPRM(0),U,3)):$P($G(^TIU(8925,+TIUDA,13)),U,5),$P(TIUDPRM(0),U,2):$P($G(^TIU(8925,+TIUDA,13)),U,4),1:$P($G(^TIU(8925,+TIUDA,12)),U))
89 G:+TIUDATE'>0 OVERX
90 I $$FMDIFF^XLFDT(DT,TIUDATE)>$P(TIUPRM0,U,5),(+$P($G(^TIU(8925,+TIUDA,0)),U,5)>4),(+$P($G(^TIU(8925,+TIUDA,0)),U,5)<7) S TIUY=1 G OVERX
91 F S TIUXTRA=$O(^TIU(8925.7,"B",TIUDA,TIUXTRA)) Q:'TIUXTRA D
92 . I TIUDATE<$G(TIUSTART)!(TIUDATE>$G(TIUEND)) Q
93 . I '$$TSKPARM^TIUTSK(1) Q
94 . I $$FMDIFF^XLFDT(DT,TIUDATE)>$P(TIUPRM0,U,5),('$P($G(^TIU(8925.7,TIUXTRA,0)),U,4)) S TIUY=1,TIUADDL=1
95OVERX Q TIUY
96TSKPARM(TIUDA) ;Calculate a tiu parameter for the nightly task
97 ; TIUDA = 1 then return NIGHTLY TASK START computation
98 ; TIUDA = 2 then return NIGHTLY TASK END computation
99 N TIUDIV,TIUPARM,TIUY,TIUVAL
100 S TIUY=0
101 I TIUDA=2 S TIUY=DT
102 I TIUDA=3 D DT^DILF("P","T-12M",.TIUY)
103 I '$D(TIUPRM0) D SETPARM^TIULE
104 I '$G(TIUPRM0) Q TIUY
105 S TIUDIV=$P(TIUPRM0,U,1)
106 I '$G(TIUDIV) Q TIUY
107 S TIUPARM=$O(^TIU(8925.99,"B",TIUDIV,""))
108 I '$G(TIUPARM) Q TIUY
109 S TIUVAL=$P($G(^TIU(8925.99,TIUPARM,3)),U,TIUDA)
110 I '$G(TIUVAL) Q TIUY
111 D DT^DILF("P","T-"_TIUVAL,.TIUY)
112 Q TIUY
Note: See TracBrowser for help on using the repository browser.