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

TIUP149.m

Go to the documentation of this file. 
  1. TIUP149 ;SLC/RMO - Post-Install for TIU*1*149 ;10/28/02@09:51:20
  1.  ;;1.0;Text Integration Utilities;**149**;Jun 20, 1997
  1.  ;
  1. EN ;Entry point to queue a job to clean up certain documents
  1.  ;linked to a different patient's visit
  1.  N ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK
  1.  ;
  1.  W !!,"PATCH TIU*1*149"
  1.  W !!,"Search ALL entries in the TIU Document file (#8925) to link or"
  1.  W !,"unlink documents associated with a different patient's visit that"
  1.  W !,"meet the following criteria:"
  1.  W !!,"- Addenda or components where the parent points to the correct visit will"
  1.  W !,"  be linked, otherwise the addenda or components will be unlinked if they"
  1.  W !,"  are associated with an incorrect visit different than the parent."
  1.  W !!,"- Documents where the capture method is converted and a visit"
  1.  W !,"  exists will be linked, otherwise the document will be unlinked"
  1.  W !,"  from the incorrect visit."
  1.  W !!,"- Documents where the reference date is prior to 10/1/98 will"
  1.  W !,"  be unlinked from the incorrect visit."
  1.  W !!,"- Documents that are Discharge Summaries will be unlinked"
  1.  W !,"  from the incorrect visit."
  1.  W !
  1.  ;
  1.  ;Set variables
  1.  S ZTRTN="CLNUP^TIUP149",ZTIO="",ZTSAVE("DUZ")=""
  1.  S ZTDESC="Clean up TIU Documents Different Patient's Visit - Patch 149"
  1.  D ^%ZTLOAD
  1.  I $G(ZTSK) D
  1.  . W !!,"A task has been queued in the background and a bulletin will be sent"
  1.  . W !,"to you upon completion of the task or if the task is stopped."
  1.  . W !!,"The task number is "_$G(ZTSK)_"."
  1.  Q
  1.  ;
  1. CLNUP ;Entry point to clean up documents pointing to a different patient's
  1.  ;visit
  1.  ; Input  -- None
  1.  ; Output -- ^XTMP("TIUP149", Global
  1.  N NDBIF,TIUDA,TIUS,TIURSTDA
  1.  ;
  1.  ;Initialize re-start if check point exists
  1.  I +$G(^XTMP("TIUP149","CHKPT")) D
  1.  . S TIURSTDA=+$G(^XTMP("TIUP149","CHKPT"))
  1.  ELSE  D
  1.  . ;Clean up ^XTMP("TIUP149")
  1.  . K ^XTMP("TIUP149"),^XTMP("TIU/PXAPI")
  1.  . ;Initialize ^XTMP("TIUP149" if not re-start
  1.  . S ^XTMP("TIUP149",0)=$$FMADD^XLFDT(DT,90)_U_DT
  1.  . S ^XTMP("TIUP149","CNT","EX")=0 F TIUS=1:1:3 S ^XTMP("TIUP149","CNT","EX",TIUS)=0
  1.  . S ^XTMP("TIUP149","CNT","LNK")=0
  1.  . S ^XTMP("TIUP149","CNT","TOT")=0
  1.  . S ^XTMP("TIUP149","CHKPT")=""
  1.  K ^XTMP("TIUP149","STOP")
  1.  S ^XTMP("TIUP149","T0")=$$NOW^XLFDT
  1.  ;
  1.  ;Set integrated facility NDBI flag
  1.  S NDBIF=$$CHKINF
  1.  ;
  1.  ;Loop through documents
  1.  S TIUDA=$S($G(TIURSTDA):TIURSTDA,1:0)
  1.  F  S TIUDA=$O(^TIU(8925,TIUDA)) Q:+TIUDA'>0!($G(ZTSTOP))  I $D(^(TIUDA,0)) D
  1.  . ;Clean up visit for one document
  1.  . D CLNONE(TIUDA,$G(NDBIF))
  1.  . ;
  1.  . ;Set check point for Document IEN
  1.  . S ^XTMP("TIUP149","CHKPT")=TIUDA
  1.  . ;
  1.  . ;Check if user requested to stop task
  1.  . I $$S^%ZTLOAD S ZTSTOP=1
  1.  ;
  1.  ;Send bulletin, re-set check point and clean up variables
  1.  I $G(ZTSTOP) S ^XTMP("TIUP149","STOP")=$$NOW^XLFDT
  1.  S ^XTMP("TIUP149","T1")=$$NOW^XLFDT
  1.  ;
  1.  D MAIL^TIUP149P
  1.  ;
  1.  I '$G(ZTSTOP) S ^XTMP("TIUP149","CHKPT")=""
  1.  K TIURSTDA
  1.  Q
  1.  ;
  1. CHKINF() ;Check if Integrated Facility
  1.  ; Input  -- TIUDA    TIU Document file (#8925) IEN
  1.  ; Output -- 1=Yes and 0=No
  1.  N Y
  1.  S Y=0
  1.  I $$VERSION^XPDUTL("NDBI PRIMARY SYSTEM") S Y=1
  1.  Q +$G(Y)
  1.  ;
  1. CLNONE(TIUDA,NDBIF) ;Entry point to clean up visit for one document
  1.  ; Input  -- TIUDA    TIU Document file (#8925) IEN
  1.  ;           NDBIF    Integrated Facility Flag  (Optional)
  1.  ; Output -- None
  1.  N TIUD0,TIUDFN,TIUMVSTF,TIUVSIT,VSIT
  1.  ;
  1.  ;Set variables
  1.  S TIUD0=$G(^TIU(8925,TIUDA,0))
  1.  S TIUDFN=$P(TIUD0,U,2)
  1.  S TIUVSIT=$P(TIUD0,U,3)
  1.  ;
  1.  ;Check if document linked to a different patient's visit can be
  1.  ;cleaned up
  1.  I TIUVSIT>0,TIUDFN>0,+$G(^AUPNVSIT(+TIUVSIT,0)),$P(^(0),U,5)'=TIUDFN,$$CHKDOC(TIUDA,+$P(TIUD0,U,6),+TIUD0) D
  1.  . ;Exclude NDBI records
  1.  . I TIUVSIT=1,$G(NDBIF) D SETXTMP(TIUDA,3) Q
  1.  . ;Get correct visit to associate with document
  1.  . D GETVST(TIUDA,TIUDFN,+$P(TIUD0,U,6),.VSIT,.TIUMVSTF)
  1.  . ;If only one visit update the document with the visit
  1.  . I $G(VSIT)>0,'$G(TIUMVSTF) D
  1.  . . I $G(VSIT),$$UPDVST^TIUPXAP2(TIUDA,VSIT) D
  1.  . . . ;Document linked to visit
  1.  . . . D SETXTMP(TIUDA,,VSIT)
  1.  . . . ;Update kids that are addenda or components
  1.  . . . D UPDKIDS(TIUDA,VSIT)
  1.  . . ELSE  D
  1.  . . . ;Unable to correct - entry in use
  1.  . . . D SETXTMP(TIUDA,1)
  1.  . ELSE  D
  1.  . . ;Unlink document from visit
  1.  . . I $$DELVST(TIUDA) D
  1.  . . . D SETXTMP(TIUDA,2)
  1.  . . . ;Update kids that are addenda or components
  1.  . . . D UPDKIDS(TIUDA)
  1.  . . ELSE  D
  1.  . . . ;Unable to correct - entry in use
  1.  . . . D SETXTMP(TIUDA,1)
  1.  S ^XTMP("TIUP149","CNT","TOT")=+$G(^XTMP("TIUP149","CNT","TOT"))+1
  1.  Q
  1.  ;
  1. CHKDOC(TIUDA,TIUDAD,TITLE) ;Check if document can be cleaned up
  1.  ; Input  -- TIUDA    TIU Document file (#8925) IEN
  1.  ;           TIUDAD   TIU document file (#8925) Parent's IEN
  1.  ;           TITLE    TIU Document Definition file (#8925.1) IEN
  1.  ; Output -- 1=Can be cleaned up and 0=Cannot be cleaned up
  1.  N TIUD13,Y
  1.  ;
  1.  ;Set variables
  1.  S Y=0
  1.  S TIUD13=$G(^TIU(8925,TIUDA,13))
  1.  ;
  1.  ;If document is an addendum or component and the parent and child visit fields
  1.  ;are different, set clean-up flag to yes
  1.  I +$$ISADDNDM^TIULC1(TIUDA)!(+$$ISCOMP^TIUBR(TIUDA)) D  G CHKDOCQ
  1.  . I $P($G(^TIU(8925,+TIUDAD,0)),U,3)'=$P($G(^TIU(8925,TIUDA,0)),U,3) S Y=1
  1.  ;
  1.  ;If capture method is converted or reference date is before 10/1/98 or
  1.  ;document is a discharge summary, set clean up flag to yes
  1.  I ("^C^")[(U_$P(TIUD13,U,3)_U)!(+TIUD13&(+TIUD13<2981001))!(+$$ISDS^TIULX(TITLE)) S Y=1
  1.  ;
  1. CHKDOCQ Q +$G(Y)
  1.  ;
  1. GETVST(TIUDA,TIUDFN,TIUDAD,VSIT,TIUMVSTF) ;Get visit to associate with document
  1.  ; Input  -- TIUDA    TIU Document file (#8925) IEN
  1.  ;           TIUDFN   Patient file (#2) IEN
  1.  ;           TIUDAD   TIU document file (#8925) Parent's IEN
  1.  ; Output -- VSIT     Visit file (#9000010) IEN
  1.  ;           TIUMVSTF Multiple Visit Flag
  1.  ;           1=Multiple Visits
  1.  ;
  1.  N TIUD13,TIUDTM,TIUHL,VSITS
  1.  ;
  1.  ;Set variables
  1.  S TIUD13=$G(^TIU(8925,TIUDA,13))
  1.  S TIUHL=$P($G(^TIU(8925,TIUDA,12)),U,11)
  1.  ;
  1.  ;Check if document is an addendum or component, if it is use visit of parent
  1.  I +$$ISADDNDM^TIULC1(TIUDA)!(+$$ISCOMP^TIUBR(TIUDA)) D  G GETVSTQ
  1.  . I $D(^TIU(8925,+TIUDAD,0)),$P(^(0),U,3)>0 S VSIT=$P(^(0),U,3) D
  1.  . . I $P($G(^AUPNVSIT(+VSIT,0)),U,5)'=TIUDFN S VSIT=""
  1.  ;
  1.  ;If document is converted, check PCE for a visit
  1.  I (("^C^")[(U_$P(TIUD13,U,3)_U)) D
  1.  . ;For DS use patient movement date/time, otherwise use reference date/time
  1.  . I +$$ISDS^TIULX(+$G(^TIU(8925,TIUDA,0))) D
  1.  . . I +$G(^TIU(8925,TIUDA,14))>0,+$G(^DGPM(+^(14),0))>0 S TIUDTM=+^(0)
  1.  . ELSE  D
  1.  . . I +TIUD13>0 S TIUDTM=+TIUD13
  1.  . ;Check PCE for a visit
  1.  . I $G(TIUDTM) D
  1.  . . S VSITS=$$GETENC^PXAPI(TIUDFN,TIUDTM,TIUHL)
  1.  . . I VSITS>0 S VSIT=+VSITS
  1.  . . ;Set a flag if multiple visits
  1.  . . I $P(VSITS,U,2)'="" S TIUMVSTF=1
  1. GETVSTQ Q
  1.  ;
  1. SETXTMP(TIUDA,TIUEX,VSIT) ;Set ^XTMP for entries processed
  1.  ; Input  -- TIUDA    TIU Document file (#8925) IEN
  1.  ;           TIUEX    Unable to correct Exception types:  (Optional)
  1.  ;                    1=Entry in Use
  1.  ;                    2=Unlink Visit
  1.  ;                    3=NDBI Fix Needed
  1.  ;           VSIT     Visit file (#9000010) IEN  (Optional)
  1.  ; Output -- Set ^XTMP("TIUP149","LNK",TIUDA)=
  1.  ;               1st piece= 1=Linked and 0=Not Linked
  1.  ;               2nd piece= Exception type if not linked
  1.  ;               3rd piece= Visit file (#9000010) IEN if linked
  1.  I $G(TIUEX) D
  1.  . S ^XTMP("TIUP149","LNK",TIUDA)=0_U_$G(TIUEX)
  1.  . S ^XTMP("TIUP149","CNT","EX",TIUEX)=+$G(^XTMP("TIUP149","CNT","EX",TIUEX))+1
  1.  . S ^XTMP("TIUP149","CNT","EX")=+$G(^XTMP("TIUP149","CNT","EX"))+1
  1.  ELSE  D
  1.  . S ^XTMP("TIUP149","LNK",TIUDA)=1_U_U_$G(VSIT)
  1.  . S ^XTMP("TIUP149","CNT","LNK")=+$G(^XTMP("TIUP149","CNT","LNK"))+1
  1.  Q
  1.  ;
  1. DELVST(TIUDA,ERROR) ;Delete Visit in TIU Document file #8925
  1.  ; Input  -- TIUDA    TIU Document file (#8925) IEN
  1.  ; Output -- 1=Successful and 0=Failure
  1.  ;           ERROR    Error Message  (Optional)
  1.  N DIERR,OKF,TIUFDA
  1.  ;
  1.  ;Update document with visit
  1.  S TIUFDA(8925,TIUDA_",",.03)="@"
  1.  L +^TIU(8925,TIUDA):1 I $T D
  1.  . D FILE^DIE("","TIUFDA","") L -^TIU(8925,TIUDA)
  1.  . S ERROR=$G(DIERR)
  1.  . S OKF=$S(+$G(ERROR):0,1:1)
  1.  ELSE  D
  1.  . S OKF=0
  1. DELVSTQ Q +$G(OKF)
  1.  ;
  1. UPDKIDS(TIUDA,VSIT) ;Update Visit for kids that are addenda or components
  1.  ; Input  -- TIUDA    TIU Document file (#8925) IEN
  1.  ;           VSIT     Visit file (#9000010) IEN  (Optional)
  1.  ; Output -- None
  1.  N TIUKID
  1.  S TIUKID=0
  1.  F  S TIUKID=$O(^TIU(8925,"DAD",TIUDA,TIUKID)) Q:'TIUKID  D
  1.  . ;If document is an addendum or component and visit of parent is different than visit of kid
  1.  . I (+$$ISADDNDM^TIULC1(TIUKID)!(+$$ISCOMP^TIUBR(TIUKID))),$G(VSIT)'=$P($G(^TIU(8925,TIUKID,0)),U,3) D
  1.  . . ;Link kid to visit
  1.  . . I $G(VSIT)>0 D
  1.  . . . I $$UPDVST^TIUPXAP2(TIUKID,VSIT) D
  1.  . . . . D SETXTMP(TIUKID,,VSIT)
  1.  . . . ELSE  D
  1.  . . . . D SETXTMP(TIUKID,1)
  1.  . . ELSE  D
  1.  . . . ;Unlink kid from visit
  1.  . . . I $$DELVST(TIUKID) D
  1.  . . . . D SETXTMP(TIUKID,2)
  1.  . . . ELSE  D
  1.  . . . . D SETXTMP(TIUKID,1)
  1.  Q