Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIUTSK

TIUTSK.m

Go to the documentation of this file. 
  1. TIUTSK ; SLC/JER - TIU's Nightly Daemon ;4/18/03 [10/18/04 10:34am]
  1.  ;;1.0;TEXT INTEGRATION UTILITIES;**7,53,100,113,157,210,221**;Jun 20, 1997;Build 2
  1. MAIN ; All records are read. DC date updated, Record purged, Alerts are 
  1.  ; generated if appropriate
  1.  N TIUDA,TIUPRM0,TIUPRM1,TIUDATE,TIUENTDT,TIUPDT,TIUODT
  1.  N TIUSTART,TIUEND,TIUADDL
  1.  D SETPARM^TIULE
  1.  S TIUSTART=$$TSKPARM(1),TIUEND=$$TSKPARM(2)
  1.  ; Traverse "FIX" X-ref to fix temporary reference dates & back-fill
  1.  ; Discharge Dates
  1.  S TIUDA="" F  S TIUDA=$O(^TIU(8925,"FIX",1,TIUDA)) Q:TIUDA'>0  D
  1.  . D UPDDCDT(TIUDA) ;Ref Date fixed/DC Date updated if missing
  1.  ; Traverse "F" X-ref to identify records for which the grace period
  1.  ; for purge has expired
  1.  S TIUPDT=$$FMADD^XLFDT(DT,-$P(TIUPRM0,U,4))
  1.  S TIUODT=$$FMADD^XLFDT(DT,-$P(TIUPRM0,U,5))
  1.  ; Traverse "F" X-ref to identify records overdue for signature or purge
  1.  ; NOTE: Following VHA Directive 10-92-077, the purge is disabled until
  1.  ;       further notice **53**
  1.  ;VMP/ELR PATCH 221  SET UP TIUADDL IS OVERDUE ONLY BECAUSE OF ADDITIONAL SIGNER TO STOP AMENDMENT ALERT
  1.  S TIUADDL=0
  1.  S TIUENTDT=($$TSKPARM(3)-1)+.999999
  1.  F  S TIUENTDT=$O(^TIU(8925,"F",TIUENTDT)) Q:+TIUENTDT'>0!(TIUENTDT>TIUODT)  D
  1.  . S TIUDA=0 F  S TIUDA=$O(^TIU(8925,"F",+TIUENTDT,TIUDA)) Q:+TIUDA'>0  D
  1.  . . ; I (TIUPDT<$$FMADD^XLFDT(DT,-90)),+$$PURGE^TIULC(TIUDA) D PURGE(TIUDA) Purges old records (see NOTE above) **53**
  1.  . . I +$$OVERDUE(TIUDA,TIUSTART,TIUEND) D SEND^TIUALRT(TIUDA,1) S TIUADDL=0     ;Alert for overdue
  1.  ; If upload buffer rec older than 30 days, delete it & its alerts
  1.  S TIUDA=0 F  S TIUDA=$O(^TIU(8925.2,TIUDA)) Q:TIUDA'>0  D
  1.  . N TIUDATE
  1.  . S TIUDATE=$P($G(^TIU(8925.2,TIUDA,0)),U,3)
  1.  . Q:+TIUDATE'>0
  1.  . I $$FMDIFF^XLFDT(DT,TIUDATE)>30 D
  1.  . . N TIUEI S TIUEI=0
  1.  . . ; JOEL, 12/21/00:
  1.  . . F  S TIUEI=$O(^TIU(8925.2,TIUDA,"ERR",TIUEI)) Q:+TIUEI'>0  D
  1.  . . . N TIUEDA
  1.  . . . S TIUEDA=+$G(^TIU(8925.2,TIUDA,"ERR",TIUEI,0)) Q:+TIUEDA'>0
  1.  . . . D ALERTDEL^TIUPEVNT(TIUEDA)
  1.  . . D BUFPURGE^TIUPUTC(TIUDA)
  1.  Q
  1. UPDDCDT(TIUDA) ; If missing DC date & Patient Movement file has DC date,
  1.  ;         DC date updated.
  1.  N DFN,DIE,DR,TIU,TIUDAD,TIUDDT,TIUD0,TIUD14,TIUDGPM
  1.  S TIUD0=$G(^TIU(8925,+TIUDA,0)),TIUD14=$G(^TIU(8925,+TIUDA,14))
  1.  S TIUDGPM=+$P(TIUD14,U)
  1.  I +$P($G(^DGPM(+TIUDGPM,0)),U,17)'>0 D  Q
  1.  . I +$P(TIUD0,U,12)>0 Q
  1.  . S DIE=8925,DR=".12////1",DA=TIUDA D ^DIE
  1.  I TIUD0'="",'+$P(TIUD0,U,6),(($P(TIUD0,U,8)="")!(+$P(TIUD0,U,12)>0)) D
  1.  . D GETTIU^TIULD(.TIU,TIUDA)
  1.  . I +$G(TIU("LDT"))>0 D
  1.  . . S TIUDAD=$P(TIUD0,U,6)
  1.  . . D FIXDC(TIUDA,TIUDAD,DFN,.TIU)
  1.  Q
  1. PURGE(DA) ; When purge criteria met, document and addenda purged
  1.  N DR,DIE,TIUTYP,TIUDA,X,Y S TIUDA=0
  1.  F  S TIUDA=+$O(^TIU(8925,"DAD",+DA,TIUDA)) Q:+TIUDA'>0  D
  1.  . I +$$ISADDNDM^TIULC1(TIUDA) D PURGE(TIUDA) I 1
  1.  . E  D DIK^TIURB2(TIUDA) ; Remove components entirely. 1/3/01 updated DIK^TIURB to DIK^TIURB2 - Margy
  1.  S DIE=8925,DR=".05///PURGED;1609////"_$$NOW^TIULC_";2///@" D ^DIE
  1.  S ^TIU(8925,+DA,"TEXT",0)="^^"_2_U_2_U_DT_"^^"
  1.  S ^TIU(8925,+DA,"TEXT",1,0)=" "
  1.  S ^TIU(8925,+DA,"TEXT",2,0)="  Document Purged on "_$$DATE^TIULS(DT,"MM/DD/YY")_"."
  1.  Q
  1. FIXDC(DA,PARENT,DFN,TIU) ; Stuff fixed field data
  1.  N FDA,FDARR,IENS,FLAGS,TIUMSG
  1.  S IENS=""""_DA_",""",FDARR="FDA(8925,"_IENS_")",FLAGS="K"
  1.  I +$G(PARENT)'>0 D
  1.  . S @FDARR@(.08)=$P(TIU("LDT"),U)
  1.  . S @FDARR@(1402)=$P($G(TIU("TS")),U)
  1.  I +$G(PARENT)>0 D
  1.  . S @FDARR@(.08)=$P(TIU("LDT"),U)
  1.  . S @FDARR@(1401)=$P(^TIU(8925,+PARENT,14),U)
  1.  . S @FDARR@(1402)=$P(^TIU(8925,+PARENT,14),U,2)
  1.  S @FDARR@(1205)=$P($G(TIU("LOC")),U)
  1.  S @FDARR@(1212)=$P($G(TIU("INST")),U)
  1.  S @FDARR@(.12)="@"
  1.  S @FDARR@(1301)=+$G(TIU("LDT"))
  1.  D FILE^DIE(FLAGS,"FDA","TIUMSG") ; File record
  1.  Q
  1. OVERDUE(TIUDA,TIUSTART,TIUEND) ;Checks whether or not a given document is overdue
  1.  ;This is the same as OVERDUE^TIULC exept for the following items:
  1.  ;    TIUPRM0 must be defined before calling
  1.  ;    also checks for additional signatures overdue
  1.  N TIUD0,TIUDATE,TIUY,TIUDPRM,TIUXTRA S TIUY=0,TIUD0=$G(^TIU(8925,TIUDA,0)),TIUXTRA=0
  1.  D DOCPRM^TIULC1(+TIUD0,.TIUDPRM,TIUDA)
  1.  I '$D(TIUDPRM) G OVERX
  1.  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))
  1.  G:+TIUDATE'>0 OVERX
  1.  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
  1.  F  S TIUXTRA=$O(^TIU(8925.7,"B",TIUDA,TIUXTRA)) Q:'TIUXTRA  D
  1.  . I TIUDATE<$G(TIUSTART)!(TIUDATE>$G(TIUEND)) Q
  1.  . I '$$TSKPARM^TIUTSK(1) Q
  1.  . I $$FMDIFF^XLFDT(DT,TIUDATE)>$P(TIUPRM0,U,5),('$P($G(^TIU(8925.7,TIUXTRA,0)),U,4)) S TIUY=1,TIUADDL=1
  1. OVERX Q TIUY
  1. TSKPARM(TIUDA) ;Calculate a tiu parameter for the nightly task
  1.  ; TIUDA = 1 then return NIGHTLY TASK START computation
  1.  ; TIUDA = 2 then return NIGHTLY TASK END computation
  1.  N TIUDIV,TIUPARM,TIUY,TIUVAL
  1.  S TIUY=0
  1.  I TIUDA=2 S TIUY=DT
  1.  I TIUDA=3 D DT^DILF("P","T-12M",.TIUY)
  1.  I '$D(TIUPRM0) D SETPARM^TIULE
  1.  I '$G(TIUPRM0) Q TIUY
  1.  S TIUDIV=$P(TIUPRM0,U,1)
  1.  I '$G(TIUDIV) Q TIUY
  1.  S TIUPARM=$O(^TIU(8925.99,"B",TIUDIV,""))
  1.  I '$G(TIUPARM) Q TIUY
  1.  S TIUVAL=$P($G(^TIU(8925.99,TIUPARM,3)),U,TIUDA)
  1.  I '$G(TIUVAL) Q TIUY
  1.  D DT^DILF("P","T-"_TIUVAL,.TIUY)
  1.  Q TIUY