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

TIUPEVN1.m

Go to the documentation of this file.
  1. TIUPEVN1 ; SLC/JER - Event logger Cont'd ;05/20/10 14:09
  1. ;;1.0;TEXT INTEGRATION UTILITIES;**81,250**;Jun 20, 1997;Build 14
  1. ;
  1. ; ICR #10006 - ^DIC Routine & DIC, DLAYGO, X, & Y local vars
  1. ; #10018 - ^DIE Routine & DIE, DA, DR, DTOUT, & DUOUT local vars
  1. ; #10004 - EN^DIQ Routine & DIC, DA, X, & Y local vars
  1. ; #10015 - EN^DIQ1 Routine & DIC, DIQ, DA, & DR local vars
  1. ; #10081 - SETUP^XQALERT Routine & XQADATA, XQAID, XQAMSG, & XQAROU local vars
  1. ;
  1. FIELDS(EVNTDA,MSG) ; ---- Log missing/incorrect field errors for
  1. ; specific fields in UPLOAD LOG file (#8925.4),
  1. ; in multiple fl. TIU*1*81 moved from TIUPEVNT
  1. N TIUI S TIUI=0
  1. F S TIUI=$O(MSG("DIERR",TIUI)) Q:+TIUI'>0 D
  1. . N DA,DR,DIC,DIE,DLAYGO,X,Y S DIC="^TIU(8925.4,"_EVNTDA_",1,",DIC(0)="L"
  1. . I '$D(MSG("DIERR",TIUI,"PARAM","FILE")) Q
  1. . S ^TIU(8925.4,EVNTDA,1,0)="^8925.42^^",DA(1)=EVNTDA
  1. . S DLAYGO=8925.42,X=""""_MSG("DIERR",TIUI,"PARAM","FILE")_""""
  1. . D ^DIC Q:+Y'>0
  1. . S DIE=DIC,DA(1)=EVNTDA,DA=+Y
  1. . S DR=".02///"_+$G(MSG("DIERR",TIUI,"PARAM","IENS"))_";.03///"_$G(MSG("DIERR",TIUI,"PARAM","FIELD"))_";.04///"_$G(MSG("DIERR",TIUI,"PARAM",3))
  1. . D ^DIE,FLDALRT(EVNTDA,DA,$P($G(^TIU(8925.4,+EVNTDA,0)),U,4))
  1. Q
  1. FLDALRT(EVNTDA,EVNTDA1,ERRMSG) ; ---- Send alerts for missing field errors
  1. ; TIU*1*81 moved from TIUPEVNT
  1. N XQA,XQAID,XQADATA,XQAMSG,XQAKILL,XQAROU,TIUI,TIUSUB,TYPE,EVNTDA10
  1. N NOTEDA,NOTE0
  1. ; ---- TIU*1*81 If this is a TIU docmt, get its title for TYPE
  1. S EVNTDA10=$G(^TIU(8925.4,EVNTDA,1,EVNTDA1,0))
  1. I $P(EVNTDA10,U)=8925 D
  1. . S NOTEDA=$P(EVNTDA10,U,2),NOTE0=$G(^TIU(8925,NOTEDA,0)),TYPE=+NOTE0
  1. . ; ---- TIU*1*81 If note is addendum, get type of parent note instead
  1. . I +$$ISADDNDM^TIULC1(NOTEDA) S TYPE=+$$DADTYPE^TIUPUTC(NOTEDA)
  1. ; ---- else get TYPE from $HDR line, e.g. Progress Notes (3)
  1. I $G(TYPE)'>0 S TYPE=+$G(TIUREC("TYPE"))
  1. I TYPE D WHOGETS^TIUPEVN1(.XQA,TYPE)
  1. ; ---- If no docmt def param recipients found, try site recipients
  1. I $D(XQA)'>9 D
  1. . S TIUI=$O(^TIU(8925.99,"B",+$G(DUZ(2)),0)) S:+TIUI'>0 TIUI=+$O(^TIU(8925.99,0))
  1. . S TIUSUB=0 F S TIUSUB=$O(^TIU(8925.99,+TIUI,2,TIUSUB)) Q:TIUSUB'>0 D
  1. . . S XQA($G(^TIU(8925.99,+TIUI,2,TIUSUB,0)))=""
  1. Q:$D(XQA)'>9
  1. S XQAID="TIUERR"_","_EVNTDA_","_EVNTDA1
  1. S XQAMSG=ERRMSG
  1. W:'$D(ZTQUEUED) !!,XQAMSG
  1. S XQADATA=ERRMSG_";"_EVNTDA_";"_EVNTDA1
  1. S XQAROU="FLDISP^TIUPEVN1" ; TIU*1*81 moved from TIUPEVNT
  1. D SETUP^XQALERT
  1. Q
  1. FLDISP ; ---- Alert follow-up action for missing field errors
  1. ; TIU*1*81 moved from TIUPEVNT
  1. N DIE,DA,DR,EVNTDA,EVNTDA1,EVNTREC,TIUFIX,TIULINK S TIUFIX=0
  1. S EVNTDA=+$P(XQADATA,";",2),EVNTDA1=+$P(XQADATA,";",3)
  1. S EVNTREC=$G(^TIU(8925.4,EVNTDA,1,EVNTDA1,0)) Q:+EVNTREC'>0
  1. S DIE=$P(EVNTREC,U),DA=$P(EVNTREC,U,2)
  1. S DR=$P(EVNTREC,U,3)_"//"_$P(EVNTREC,U,4)
  1. S TIUFIX=$$FIXED(DIE,+DA,+DR)
  1. I +TIUFIX>0 D Q
  1. . W:TIUFIX=1 !!,"Missing field already filled in by another method..."
  1. . W:TIUFIX=2 !!,"Record #",DA," has been deleted by an authorized user..."
  1. . W !," Nothing left to resolve." H 3
  1. . S XQAKILL=0 D FLDRSLV(EVNTDA)
  1. W !!,"You may now enter the correct information:",!
  1. W !,$P(XQADATA,";"),!
  1. D RECDISP(DIE,DA)
  1. I DIE=8925,(+DR=1405) D
  1. . N TIUREASX,TIUDA
  1. . S TIUDA=+DA
  1. . S TIUREASX=$$REASSIGN^TIULC1(+$G(^TIU(8925,+TIUDA,0)))
  1. . I TIUREASX]"" X TIUREASX S TIULINK=1
  1. I '+$G(TIULINK) D ^DIE
  1. ; ---- If TIU Document, do post-filing action send signature alerts
  1. I DIE="^TIU(8925," D
  1. . N TIUREC,TIUPOST,DR,DIE,TYPE,TIUD12,TIUD13,TIUEBY,TIUAU,TIUEC
  1. . S TYPE=$S(+$$ISADDNDM^TIULC1(DA):+$G(^TIU(8925,+$P(^TIU(8925,DA,0),U,6),0)),1:+$G(^TIU(8925,DA,0)))
  1. . S TIUPOST=$$POSTFILE^TIULC1(TYPE)
  1. . S TIUREC("#")=DA
  1. . I TIUPOST]"" X TIUPOST I 1
  1. . ;if not entered by the author or expected cosigner record VBC Line Count
  1. . S TIUD12=$G(^TIU(8925,DA,12)),TIUD13=$G(^(13))
  1. . S TIUEBY=$P(TIUD13,U,2),TIUAU=$P(TIUD12,U,2),TIUEC=$P(TIUD13,U,8)
  1. . I ((+TIUEBY>0)&(+TIUAU>0))&((TIUEBY'=TIUAU)&(TIUEBY'=TIUEC)) D LINES^TIUSRVPT(DA)
  1. . D SEND^TIUALRT(DA)
  1. S TIUFIX=$$FIXED(DIE,+DA,+DR)
  1. I +$G(TIUFIX)'>0 K XQAKILL Q
  1. S XQAKILL=0
  1. ; ---- If field is fixed, evaluate whether whole event is resolved
  1. D FLDRSLV(EVNTDA)
  1. Q
  1. RECDISP(DIC,DA) ; ---- Call DIQ to display the existing record
  1. ; TIU*1*81 moved from TIUPEVNT
  1. N X,Y,DIQ,DR
  1. I '+$$READ^TIUU("Y","Display ENTIRE existing record","NO") Q
  1. W ! S DIC=$G(^DIC(DIC,0,"GL"))
  1. D EN^DIQ
  1. Q
  1. FIXED(DIC,DA,DR) ; ---- Evaluate whether the field has been filled in
  1. ; TIU*1*81 moved from TIUPEVNT
  1. N DIQ,X,Y,TIUY,TIUFIX S TIUY=0,DIQ="TIUFIX",DIQ(0)="IN"
  1. I '$D(^TIU(8925,DA,0)) S TIUY=2 G FIXX
  1. D EN^DIQ1 I $D(TIUFIX) S TIUY=1
  1. FIXX Q TIUY
  1. FLDRSLV(ERRDA) ; ---- Evaluate missing field errors; mark resolved
  1. ; TIU*1*81 moved from TIUPEVNT
  1. N TIUK,TIUFLD,RSLVED
  1. S TIUK=0,RSLVED=1
  1. ; ---- TIU*1*81 Mark resolved only if ALL missing fields are fixed
  1. F S TIUK=$O(^TIU(8925.4,+ERRDA,1,TIUK)) Q:+TIUK'>0 Q:'RSLVED D
  1. . N DIC,DIQ,DA,DR S DA=TIUK,DIC="^TIU(8925.4,"_+ERRDA_",1,"
  1. . S DR=".01:.04",DIQ="TIUFLD(" D EN^DIQ1 Q:$D(TIUFLD)'>9
  1. . I '$$FIXED(8925,+$G(TIUFLD(8925.42,DA,.02)),+$G(TIUFLD(8925.42,DA,.03)))=1 S RSLVED=0
  1. Q:'RSLVED
  1. N DIE,DR
  1. S DA=+ERRDA,DIE=8925.4,DR=".06////1;.07////"_$$NOW^TIULC D ^DIE
  1. Q
  1. ;
  1. WHOGETS(TIUY,TIUTYP) ; ---- Who gets filing error/missing field alerts;
  1. ; Get 8925.95 (document parameter) recipients.
  1. ; ---- TIUTYP is title IFN in 8925.1 if valid title was uploaded, else
  1. ; is IFN of entry from $HDR line: e.g. PROGRESS NOTES
  1. ; Starts at initial TIUTYP; goes up hierarchy til it finds entry.
  1. ; ---- TIU*1*81 Don't new TIUDAD HERE!
  1. N TIUI,TIUJ
  1. ; ---- TIU*1*81 TIUTITLE is killed before missing fld alerts are sent,
  1. ; so don't use it here
  1. Q:+$G(TIUTYP)'>0
  1. S TIUI=$O(^TIU(8925.95,"B",+TIUTYP,0))
  1. ; ---- If TIUTYP has docmt parameter, get recipients and don't look
  1. ; further up:
  1. I +TIUI D Q
  1. . S TIUJ=0
  1. . F S TIUJ=$O(^TIU(8925.95,+TIUI,4,+TIUJ)) Q:+TIUJ'>0 D
  1. . . N TIUDUZ
  1. . . S TIUDUZ=+$G(^TIU(8925.95,+TIUI,4,+TIUJ,0)) Q:+TIUDUZ'>0
  1. . . S TIUY(TIUDUZ)=""
  1. ; ---- If none found, try further up
  1. S TIUDAD=$O(^TIU(8925.1,"AD",+TIUTYP,0))
  1. I +TIUDAD D WHOGETS(.TIUY,TIUDAD)
  1. Q