- 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 Mar 13, 2025@21:50:43 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
