TIUSRVL1 ; SLC/JER - Server functions for lists ;7/9/96 12:47
;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997
NOTES(TIUY,DFN,EARLY,LATE,ROOTFLAG) ; Gets list of Notes
I $S(+$G(DFN)'>0:1,'$D(^DPT(+$G(DFN),0)):1,1:0) Q
D LIST(.TIUY,DFN,3,$G(EARLY),$G(LATE),$G(ROOTFLAG))
Q
SUMMARY(TIUY,DFN,EARLY,LATE,ROOTFLAG) ; Gets list of Summaries
I $S(+$G(DFN)'>0:1,'$D(^DPT(+$G(DFN),0)):1,1:0) Q
D LIST(.TIUY,DFN,244,$G(EARLY),$G(LATE),$G(ROOTFLAG))
Q
CONSULT(TIUY,DFN,EARLY,LATE,ROOTFLAG) ; Gets list of Consults
I $S(+$G(DFN)'>0:1,'$D(^DPT(+$G(DFN),0)):1,1:0) Q
D LIST(.TIUY,DFN,243,$G(EARLY),$G(LATE),$G(ROOTFLAG))
Q
LIST(TIUY,DFN,TYPE,EARLY,LATE,ROOTFLAG) ; Build List
N TIUCNT,TIUDT,TIUI,TIUJ,TIUK,TIUP,TIUQ,TIUIFN,TIUREC,TIUPRM0,TIUPRM1
N TIUPRM3,TIUT,TIUTP,TIUS,TIUCONT
K ^TMP("TIULIST",$J),^TMP("TIUI",$J)
I '$D(TIUPRM0) D SETPARM^TIULE
I +$D(TYPE)'>0 S TIUY=0 Q
S EARLY=9999999-+$G(EARLY),LATE=9999999-$S(+$G(LATE):+$G(LATE),1:3333333)
S TIUI=0
F S TIUI=$O(^TIU(8925,"APTCL",DFN,TYPE,TIUI)) Q:TIUI'>0!(TIUI>EARLY) D
. D GATHER(TYPE,TIUI)
S TIUY=$NA(^TMP("TIULIST",$J))
I +$O(^TMP("TIULIST",$J,0)) S (TIUI,TIUK)=0
F S TIUI=$O(^TMP("TIULIST",$J,TIUI)) Q:+TIUI'>0 D
. S TIUJ=0 F S TIUJ=$O(^TMP("TIULIST",$J,TIUI,TIUJ)) Q:+TIUJ'>0 D
. . S TIUK=TIUK+1
. . S ^TMP("TIULIST",$J,TIUK)=$G(^TMP("TIULIST",$J,TIUI,TIUJ))
. . S ^TMP("TIULIDX",$J,TIUI,TIUJ)=TIUK K ^TMP("TIULIST",$J,TIUI,TIUJ)
. . S:+$G(ROOTFLAG) $P(^TMP("TIULIST",$J),U)=TIUK
. . S:TIUK=1&+$G(ROOTFLAG) $P(^TMP("TIULIST",$J),U,3)=(9999999-TIUI)
. . S:+$G(ROOTFLAG) $P(^TMP("TIULIST",$J),U,2)=(9999999-TIUI)
Q
GATHER(TYPE,TIUI) ; Find/sort records for the list
N TIUDA
S TIUDA=0
F S TIUDA=$O(^TIU(8925,"APTCL",DFN,TYPE,TIUI,TIUDA)) Q:+TIUDA'>0 D
. I +$$CANDO^TIULP(TIUDA,"VIEW")'>0 Q
. D ADDELMNT(TIUDA,.TIUCNT)
Q
ADDELMNT(DA,TIUCNT) ; Add each element to the list
N DOC,LOC,PT,AUT,EDT,TIUPT,TIULST4,TIUREC,TIUR0,TIUR12,TIUR13
N STATUS,EDTCNT,LOCTYP,TIUADT,TIUDDT
S TIUR0=$G(^TIU(8925,+DA,0)),TIUR12=$G(^TIU(8925,+DA,12))
S TIUR13=$G(^TIU(8925,+DA,13)),TIUPT=$G(^DPT(+$P(TIUR0,U,2),0))
S DOC=$$PNAME^TIULC1(+TIUR0)
I DOC="Addendum" S DOC=DOC_" to "_$$PNAME^TIULC1(+$G(^TIU(8925,+$P(TIUR0,U,6),0)))
S STATUS=$$LOWER^TIULS($P(^TIU(8925.6,+$P(TIUR0,U,5),0),U))
S LOC=$G(^SC(+$P(TIUR12,U,5),0)),LOCTYP=$P(LOC,U,3),LOC=$P(LOC,U)
S TIUADT=$S(LOCTYP="W":"Adm: ",1:"Visit: ")_$$DATE^TIULS($P(TIUR0,U,7),"MM/DD/YY")
S TIUDDT=$S(+$P(TIUR0,U,8):"Dis: ",1:"")_$$DATE^TIULS($P(TIUR0,U,8),"MM/DD/YY")
S PT=$$NAME^TIULS($P(TIUPT,U),"LAST, FIRST MI")
S TIULST4=$E($P(TIUPT,U,9),6,9)
S TIULST4="("_$E(PT)_TIULST4_")"
S AUT=$$SIGNAME^TIULS(+$P(TIUR12,U,2))
S EDT=+TIUR13,EDTCNT=+$G(EDTCNT)+1
F Q:+$D(^TMP("TIULIST",$J,9999999-EDT,EDTCNT))'>0 S EDTCNT=EDTCNT+1
S TIUCNT=+$G(TIUCNT)+1
S TIUREC=DA_U_DOC_U_EDT_U_PT_" "_TIULST4_U_AUT_U_LOC_U_STATUS_U_TIUADT_U_TIUDDT
S ^TMP("TIULIST",$J,9999999-EDT,EDTCNT)=TIUREC
;S TIUY(TIUCNT)=TIUREC
Q
DOCTYPE(TIUY,DA,TYPE,TIUK) ; Get all descendent's of a given type
N I,J,X,CURTYP,Y
; TIUK is STATIC
S TIUK=+$G(TIUK)
I $G(TYPE)']"" S TYPE="DOC"
S CURTYP=$P(^TIU(8925.1,+DA,0),U,4)
S TYPMATCH=$$TYPMATCH^TIULA1(TYPE,CURTYP)
I +TYPMATCH S TIUK=+$G(TIUK)+1,TIUY(TIUK)=+DA_U_$$PNAME^TIULC1(+DA)
S I=0 F S I=$O(^TIU(8925.1,+DA,10,I)) Q:+I'>0 D
. N J
. S J=+$G(^TIU(8925.1,+DA,10,+I,0)) Q:+J'>0
. D DOCTYPE(.TIUY,+J,TYPE,.TIUK)
Q
STATUS(TIUY,STATUS,INCLDESC) ; Get statuses
N TIUI,TIUS,TIUSTAT S STATUS=$G(STATUS,"ALL")
I STATUS'="ALL" D Q
. S TIUS=$O(^TIU(8925.6,"B",STATUS,0)) Q:+TIUS'>0
. S TIUSTAT=$P($G(^TIU(8925.6,+TIUS,0)),U)
. I $P(^TIU(8925.6,+TIUS,0),U,4)'="DEF" S TIUY(1)=TIUS_U_$$LOWER^TIULS(TIUSTAT)
S STATUS=""
F S STATUS=$O(^TIU(8925.6,"B",STATUS)) Q:STATUS']"" D
. S TIUS=0
. F S TIUS=$O(^TIU(8925.6,"B",STATUS,TIUS)) Q:+TIUS'>0 D
. . S TIUI=+$G(TIUI)+1,TIUSTAT=$P($G(^TIU(8925.6,+TIUS,0)),U)
. . I $P(^TIU(8925.6,+TIUS,0),U,4)'="DEF" D
. . . S TIUY(TIUI)=TIUS_U_$$LOWER^TIULS(TIUSTAT)
. . . I +$G(INCLDESC) D
. . . . N TIUJ S TIUJ=0
. . . . F S TIUJ=$O(^TIU(8925.6,+TIUS,1,TIUJ)) Q:+TIUJ'>0 D
. . . . . S TIUY(TIUI,1,TIUJ)=$G(^TIU(8925.6,+TIUS,1,+TIUJ,0))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUSRVL1 4237 printed Dec 13, 2024@02:45:49 Page 2
TIUSRVL1 ; SLC/JER - Server functions for lists ;7/9/96 12:47
+1 ;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997
NOTES(TIUY,DFN,EARLY,LATE,ROOTFLAG) ; Gets list of Notes
+1 IF $SELECT(+$GET(DFN)'>0:1,'$DATA(^DPT(+$GET(DFN),0)):1,1:0)
QUIT
+2 DO LIST(.TIUY,DFN,3,$GET(EARLY),$GET(LATE),$GET(ROOTFLAG))
+3 QUIT
SUMMARY(TIUY,DFN,EARLY,LATE,ROOTFLAG) ; Gets list of Summaries
+1 IF $SELECT(+$GET(DFN)'>0:1,'$DATA(^DPT(+$GET(DFN),0)):1,1:0)
QUIT
+2 DO LIST(.TIUY,DFN,244,$GET(EARLY),$GET(LATE),$GET(ROOTFLAG))
+3 QUIT
CONSULT(TIUY,DFN,EARLY,LATE,ROOTFLAG) ; Gets list of Consults
+1 IF $SELECT(+$GET(DFN)'>0:1,'$DATA(^DPT(+$GET(DFN),0)):1,1:0)
QUIT
+2 DO LIST(.TIUY,DFN,243,$GET(EARLY),$GET(LATE),$GET(ROOTFLAG))
+3 QUIT
LIST(TIUY,DFN,TYPE,EARLY,LATE,ROOTFLAG) ; Build List
+1 NEW TIUCNT,TIUDT,TIUI,TIUJ,TIUK,TIUP,TIUQ,TIUIFN,TIUREC,TIUPRM0,TIUPRM1
+2 NEW TIUPRM3,TIUT,TIUTP,TIUS,TIUCONT
+3 KILL ^TMP("TIULIST",$JOB),^TMP("TIUI",$JOB)
+4 IF '$DATA(TIUPRM0)
DO SETPARM^TIULE
+5 IF +$DATA(TYPE)'>0
SET TIUY=0
QUIT
+6 SET EARLY=9999999-+$GET(EARLY)
SET LATE=9999999-$SELECT(+$GET(LATE):+$GET(LATE),1:3333333)
+7 SET TIUI=0
+8 FOR
SET TIUI=$ORDER(^TIU(8925,"APTCL",DFN,TYPE,TIUI))
if TIUI'>0!(TIUI>EARLY)
QUIT
Begin DoDot:1
+9 DO GATHER(TYPE,TIUI)
End DoDot:1
+10 SET TIUY=$NAME(^TMP("TIULIST",$JOB))
+11 IF +$ORDER(^TMP("TIULIST",$JOB,0))
SET (TIUI,TIUK)=0
+12 FOR
SET TIUI=$ORDER(^TMP("TIULIST",$JOB,TIUI))
if +TIUI'>0
QUIT
Begin DoDot:1
+13 SET TIUJ=0
FOR
SET TIUJ=$ORDER(^TMP("TIULIST",$JOB,TIUI,TIUJ))
if +TIUJ'>0
QUIT
Begin DoDot:2
+14 SET TIUK=TIUK+1
+15 SET ^TMP("TIULIST",$JOB,TIUK)=$GET(^TMP("TIULIST",$JOB,TIUI,TIUJ))
+16 SET ^TMP("TIULIDX",$JOB,TIUI,TIUJ)=TIUK
KILL ^TMP("TIULIST",$JOB,TIUI,TIUJ)
+17 if +$GET(ROOTFLAG)
SET $PIECE(^TMP("TIULIST",$JOB),U)=TIUK
+18 if TIUK=1&+$GET(ROOTFLAG)
SET $PIECE(^TMP("TIULIST",$JOB),U,3)=(9999999-TIUI)
+19 if +$GET(ROOTFLAG)
SET $PIECE(^TMP("TIULIST",$JOB),U,2)=(9999999-TIUI)
End DoDot:2
End DoDot:1
+20 QUIT
GATHER(TYPE,TIUI) ; Find/sort records for the list
+1 NEW TIUDA
+2 SET TIUDA=0
+3 FOR
SET TIUDA=$ORDER(^TIU(8925,"APTCL",DFN,TYPE,TIUI,TIUDA))
if +TIUDA'>0
QUIT
Begin DoDot:1
+4 IF +$$CANDO^TIULP(TIUDA,"VIEW")'>0
QUIT
+5 DO ADDELMNT(TIUDA,.TIUCNT)
End DoDot:1
+6 QUIT
ADDELMNT(DA,TIUCNT) ; Add each element to the list
+1 NEW DOC,LOC,PT,AUT,EDT,TIUPT,TIULST4,TIUREC,TIUR0,TIUR12,TIUR13
+2 NEW STATUS,EDTCNT,LOCTYP,TIUADT,TIUDDT
+3 SET TIUR0=$GET(^TIU(8925,+DA,0))
SET TIUR12=$GET(^TIU(8925,+DA,12))
+4 SET TIUR13=$GET(^TIU(8925,+DA,13))
SET TIUPT=$GET(^DPT(+$PIECE(TIUR0,U,2),0))
+5 SET DOC=$$PNAME^TIULC1(+TIUR0)
+6 IF DOC="Addendum"
SET DOC=DOC_" to "_$$PNAME^TIULC1(+$GET(^TIU(8925,+$PIECE(TIUR0,U,6),0)))
+7 SET STATUS=$$LOWER^TIULS($PIECE(^TIU(8925.6,+$PIECE(TIUR0,U,5),0),U))
+8 SET LOC=$GET(^SC(+$PIECE(TIUR12,U,5),0))
SET LOCTYP=$PIECE(LOC,U,3)
SET LOC=$PIECE(LOC,U)
+9 SET TIUADT=$SELECT(LOCTYP="W":"Adm: ",1:"Visit: ")_$$DATE^TIULS($PIECE(TIUR0,U,7),"MM/DD/YY")
+10 SET TIUDDT=$SELECT(+$PIECE(TIUR0,U,8):"Dis: ",1:"")_$$DATE^TIULS($PIECE(TIUR0,U,8),"MM/DD/YY")
+11 SET PT=$$NAME^TIULS($PIECE(TIUPT,U),"LAST, FIRST MI")
+12 SET TIULST4=$EXTRACT($PIECE(TIUPT,U,9),6,9)
+13 SET TIULST4="("_$EXTRACT(PT)_TIULST4_")"
+14 SET AUT=$$SIGNAME^TIULS(+$PIECE(TIUR12,U,2))
+15 SET EDT=+TIUR13
SET EDTCNT=+$GET(EDTCNT)+1
+16 FOR
if +$DATA(^TMP("TIULIST",$JOB,9999999-EDT,EDTCNT))'>0
QUIT
SET EDTCNT=EDTCNT+1
+17 SET TIUCNT=+$GET(TIUCNT)+1
+18 SET TIUREC=DA_U_DOC_U_EDT_U_PT_" "_TIULST4_U_AUT_U_LOC_U_STATUS_U_TIUADT_U_TIUDDT
+19 SET ^TMP("TIULIST",$JOB,9999999-EDT,EDTCNT)=TIUREC
+20 ;S TIUY(TIUCNT)=TIUREC
+21 QUIT
DOCTYPE(TIUY,DA,TYPE,TIUK) ; Get all descendent's of a given type
+1 NEW I,J,X,CURTYP,Y
+2 ; TIUK is STATIC
+3 SET TIUK=+$GET(TIUK)
+4 IF $GET(TYPE)']""
SET TYPE="DOC"
+5 SET CURTYP=$PIECE(^TIU(8925.1,+DA,0),U,4)
+6 SET TYPMATCH=$$TYPMATCH^TIULA1(TYPE,CURTYP)
+7 IF +TYPMATCH
SET TIUK=+$GET(TIUK)+1
SET TIUY(TIUK)=+DA_U_$$PNAME^TIULC1(+DA)
+8 SET I=0
FOR
SET I=$ORDER(^TIU(8925.1,+DA,10,I))
if +I'>0
QUIT
Begin DoDot:1
+9 NEW J
+10 SET J=+$GET(^TIU(8925.1,+DA,10,+I,0))
if +J'>0
QUIT
+11 DO DOCTYPE(.TIUY,+J,TYPE,.TIUK)
End DoDot:1
+12 QUIT
STATUS(TIUY,STATUS,INCLDESC) ; Get statuses
+1 NEW TIUI,TIUS,TIUSTAT
SET STATUS=$GET(STATUS,"ALL")
+2 IF STATUS'="ALL"
Begin DoDot:1
+3 SET TIUS=$ORDER(^TIU(8925.6,"B",STATUS,0))
if +TIUS'>0
QUIT
+4 SET TIUSTAT=$PIECE($GET(^TIU(8925.6,+TIUS,0)),U)
+5 IF $PIECE(^TIU(8925.6,+TIUS,0),U,4)'="DEF"
SET TIUY(1)=TIUS_U_$$LOWER^TIULS(TIUSTAT)
End DoDot:1
QUIT
+6 SET STATUS=""
+7 FOR
SET STATUS=$ORDER(^TIU(8925.6,"B",STATUS))
if STATUS']""
QUIT
Begin DoDot:1
+8 SET TIUS=0
+9 FOR
SET TIUS=$ORDER(^TIU(8925.6,"B",STATUS,TIUS))
if +TIUS'>0
QUIT
Begin DoDot:2
+10 SET TIUI=+$GET(TIUI)+1
SET TIUSTAT=$PIECE($GET(^TIU(8925.6,+TIUS,0)),U)
+11 IF $PIECE(^TIU(8925.6,+TIUS,0),U,4)'="DEF"
Begin DoDot:3
+12 SET TIUY(TIUI)=TIUS_U_$$LOWER^TIULS(TIUSTAT)
+13 IF +$GET(INCLDESC)
Begin DoDot:4
+14 NEW TIUJ
SET TIUJ=0
+15 FOR
SET TIUJ=$ORDER(^TIU(8925.6,+TIUS,1,TIUJ))
if +TIUJ'>0
QUIT
Begin DoDot:5
+16 SET TIUY(TIUI,1,TIUJ)=$GET(^TIU(8925.6,+TIUS,1,+TIUJ,0))
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+17 QUIT
