TIUSRV1 ; SLC/JER - More silent server functions ; 07/31/2002 12:22
 ;;1.0;TEXT INTEGRATION UTILITIES;**61,100,112**;Jun 20, 1997
REASSIGN(TIUDA,REASSIGN,TIUL) ; Reassign Hx
 N TIUI,DR,DIC,DIQ,TIUREASS S TIUI=0
 I +$P(^TIU(8925,TIUDA,0),U,5)'=15,(+$G(REASSIGN)=0) Q
 S TIUL=TIUL+1 D BLANK^TIUSRV(TIUL) S TIUL=TIUL+1
 D SET^TIUSRV(TIUL,2," Reassignment History ",$G(IORVON),$G(IORVOFF))
 I '+$O(^TIU(8925.5,"AR",+TIUDA,0)) D
 . N TIUI
 . D SET^TIUSRV(TIUL,26,"Document Never Reassigned.")
 . F TIUI=(TIUL+1):1:16 S @VALMAR@(TIUI,0)=" "
 F  S TIUI=$O(^TIU(8925.5,"AR",TIUDA,TIUI)) Q:+TIUI'>0  D
 . N DA S DA=0
 . F  S DA=$O(^TIU(8925.5,"AR",TIUDA,TIUI,DA)) Q:+DA'>0  D
 . . S DR="1.01:1.12",DIC="^TIU(8925.5,",DIQ="TIUREASS"
 . . D EN^DIQ1 Q:$D(TIUREASS)'>9!($G(TIUREASS(8925.5,DA,1.01))']"")
 . . S TIUCNT=+$G(TIUCNT)+1 I TIUCNT>1 S TIUL=TIUL+1 D BLANK^TIUSRV(TIUL)
 . . S TIUL=TIUL+1
 . . D SET^TIUSRV(TIUL,2,"  Reassign Date: "_$G(TIUREASS(8925.5,DA,1.01)))
 . . D SET^TIUSRV(TIUL,44," Reassigned By: "_$G(TIUREASS(8925.5,DA,1.02)))
 . . S TIUL=TIUL+1
 . . D SET^TIUSRV(TIUL,2,"        Patient: "_$G(TIUREASS(8925.5,DA,1.03)))
 . . D SET^TIUSRV(TIUL,44," --->           "_$G(TIUREASS(8925.5,DA,1.04)))
 . . S TIUL=TIUL+1
 . . D SET^TIUSRV(TIUL,2,"Visit Date/time: "_$G(TIUREASS(8925.5,DA,1.05)))
 . . D SET^TIUSRV(TIUL,44," --->           "_$G(TIUREASS(8925.5,DA,1.06)))
 . . S TIUL=TIUL+1
 . . D SET^TIUSRV(TIUL,2,"  Hosp Location: "_$G(TIUREASS(8925.5,DA,1.07)))
 . . D SET^TIUSRV(TIUL,44," --->           "_$G(TIUREASS(8925.5,DA,1.08)))
 . . S TIUL=TIUL+1
 . . D SET^TIUSRV(TIUL,2,"     Visit Type: "_$$UP^XLFSTR($G(TIUREASS(8925.5,DA,1.09))))
 . . D SET^TIUSRV(TIUL,44," --->           "_$$UP^XLFSTR($G(TIUREASS(8925.5,DA,1.1))))
 Q
IDLINK(TIUDA,TIUL) ; Show Attach/Detach Hx
 N TIUI S TIUI=0
 Q:'$$IDHX(TIUDA)
 S TIUL=TIUL+1 D BLANK^TIUSRV(TIUL) S TIUL=TIUL+1
 D SET^TIUSRV(TIUL,1," Interdisciplinary Linkage History ",$G(IORVON),$G(IORVOFF))
 S TIUL=TIUL+1 D BLANK^TIUSRV(TIUL) S TIUL=TIUL+1
 D SET^TIUSRV(TIUL,0,"Date/Time         "_$S(+$G(^TIU(8925,+TIUDA,21)):"ID Parent",1:"Entry #  ")_"   Title                     Action    By") S TIUL=TIUL+1
 D SET^TIUSRV(TIUL,0,"----------------  ----------  ------------------------  --------  -------------")
 ; First, get events for ID Parents
 F  S TIUI=$O(^TIU(8925.5,"AID",TIUDA,TIUI)) Q:+TIUI'>0  D
 . N TIUD0,TIUD3,TIUY,EVDT,ENTDA,ENTTL,ACTION,DOER
 . Q:'$L($G(^TIU(8925.5,TIUI,3)))
 . S TIUD0=$G(^TIU(8925.5,TIUI,0)),TIUD3=$G(^(3))
 . S ENTDA=+TIUD0
 . S ACTION=$P(TIUD3,U),ACTION=$S(ACTION="d":"detached",1:"attached")
 . S EVDT=$$DATE^TIULS($P(TIUD3,U,2),"MM/DD/CCYY HR:MIN")
 . S ENTTL=$$PNAME^TIULC1(+$G(^TIU(8925,ENTDA,0)))
 . S DOER=$$NAME^TIULS($$PERSNAME^TIULC1(+$P(TIUD3,U,3)),"LAST,FI")
 . S TIUY="" S TIUY=$$SETSTR^VALM1(EVDT,TIUY,1,16)
 . S TIUY=$$SETSTR^VALM1(ENTDA,TIUY,19,10)
 . S TIUY=$$SETSTR^VALM1(ENTTL,TIUY,31,24)
 . S TIUY=$$SETSTR^VALM1(ACTION,TIUY,57,8)
 . S TIUY=$$SETSTR^VALM1(DOER,TIUY,67,14)
 . S TIUL=TIUL+1 D SET^TIUSRV(TIUL,0,TIUY)
 ; Next, get hx for ID Entries
 F  S TIUI=$O(^TIU(8925.5,"B",TIUDA,TIUI)) Q:+TIUI'>0  D
 . N TIUD0,TIUD3,TIUY,EVDT,ENTDA,IDDAD,IDTTL,ACTION,DOER
 . Q:'$L($G(^TIU(8925.5,TIUI,3)))
 . S TIUD0=$G(^TIU(8925.5,TIUI,0)),TIUD3=$G(^(3))
 . S ENTDA=+TIUD0,IDDAD=$P(TIUD3,U,5)
 . S ACTION=$P(TIUD3,U),ACTION=$S(ACTION="d":"detached",1:"attached")
 . S EVDT=$$DATE^TIULS($P(TIUD3,U,2),"MM/DD/CCYY HR:MIN")
 . S IDTTL=$$PNAME^TIULC1(+$G(^TIU(8925,IDDAD,0)))
 . S DOER=$$NAME^TIULS($$PERSNAME^TIULC1(+$P(TIUD3,U,3)),"LAST,FI")
 . S TIUY="" S TIUY=$$SETSTR^VALM1(EVDT,TIUY,1,16)
 . S TIUY=$$SETSTR^VALM1(IDDAD,TIUY,19,10)
 . S TIUY=$$SETSTR^VALM1(IDTTL,TIUY,31,24)
 . S TIUY=$$SETSTR^VALM1(ACTION,TIUY,57,8)
 . S TIUY=$$SETSTR^VALM1(DOER,TIUY,67,14)
 . S TIUL=TIUL+1 D SET^TIUSRV(TIUL,0,TIUY)
 Q
IDHX(TIUDA) ; Boolean fn to evaluate whether ID history exists
 N TIUI,TIUY S TIUY=0
 S TIUI=0
 F  S TIUI=$O(^TIU(8925.5,"B",TIUDA,TIUI)) Q:+TIUI'>0  D  Q:+TIUY
 . S:$L($G(^TIU(8925.5,TIUI,3))) TIUY=1
 S TIUI=0
 F  S TIUI=$O(^TIU(8925.5,"AID",TIUDA,TIUI)) Q:+TIUI'>0  D  Q:+TIUY
 . S:$L($G(^TIU(8925.5,TIUI,3))) TIUY=1
IDHXX Q TIUY