84 lines
4.0 KiB
Mathematica
84 lines
4.0 KiB
Mathematica
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
|