TIUSRVLC ; SLC/JER - Server functions for lists ;06/19/97 16:22
;;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,3,DFN,$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,244,DFN,$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,243,STATUS,QSTR,$G(EARLY),$G(LATE),$G(ROOTFLAG))
Q
LIST(TIUY,CLASS,DFN,EARLY,LATE,ROOTFLAG) ; Build List
N TIUCNT,TIUDT,TIUI,TIUJ,TIUK,TIUP,TIUQ,TIUREC,TIUPRM0,TIUPRM1
N TIUPRM3,TIUT,TIUTP,XREF,TIUS,TIUCONT,TIUSTAT,TIUTYPE
K ^TMP("TIULIST",$J),^TMP("TIUI",$J)
I '$D(TIUPRM0) D SETPARM^TIULE
S EARLY=9999999-+$G(EARLY)
S (TIUI,LATE)=9999999-$S(+$G(LATE):+$G(LATE),1:3333333)
F S TIUI=$O(^TIU(8925,"APTCL",DFN,CLASS,TIUI)) Q:+TIUI'>0!(+TIUI>EARLY) D GATHER(DFN,CLASS,TIUI,ROOTFLAG)
I +$O(^TMP("TIULIST",$J,0)) S TIUY=$NA(^TMP("TIULIST",$J)),(TIUI,TIUK)=0
Q
GATHER(DFN,CLASS,TIUI,ROOTFLAG) ; Find/sort records for the list
N TIUDA
I '$D(TIUDPRM0) D SETPARM^TIULE
S TIUDA=0
F S TIUDA=$O(^TIU(8925,"APTCL",DFN,CLASS,TIUI,TIUDA)) Q:+TIUDA'>0 D
. I ($P(TIUPRM0,U,6)="S"),(+$$CANDO^TIULP(TIUDA,"VIEW")'>0) Q
. D ADDELMNT(TIUDA,.TIUCNT,ROOTFLAG)
Q
ADDELMNT(DA,TIUCNT,ROOTFLAG) ; Add each element to the list
N DOC,LOC,PT,AUT,EDT,TIUPT,TIULST4,TIUREC,TIUR0,TIUR12,TIUR13
N STATUS,EDTCNT,LOCTYP,TIUADT,TIUDDT,TIUSUBJ
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 TIUSUBJ=$G(^TIU(8925,+DA,17))
I '+$P(TIUR0,U,7) D
. S $P(TIUR0,U,7)=+$G(^AUPNVSIT(+$P(TIUR0,U,3),0))
. I '+$P(TIUR0,U,7) S $P(TIUR0,U,7)=""
S DOC=$$PNAME^TIULC1(+TIUR0)
I DOC="Addendum" S DOC=DOC_" to "_$$PNAME^TIULC1(+$G(^TIU(8925,+$P(TIUR0,U,6),0)))
I +$$HASADDEN^TIULC1(+DA) S DOC="+ "_DOC
I +$$URGENCY^TIURM(+DA)=1 S DOC=$S(DOC["+":"*",1:"* ")_DOC
S STATUS=$$LOWER^TIULS($P($G(^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
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_U
I ($L(TIUREC)+$L(TIUSUBJ))>255 S TIUSUBJ=$E(TIUSUBJ,1,(255-$L(TIUREC)))
S TIUREC=TIUREC_TIUSUBJ
S ^TMP("TIULIST",$J,TIUCNT)=TIUREC
S:+$G(ROOTFLAG) $P(^TMP("TIULIST",$J),U)=TIUCNT
S:+$G(ROOTFLAG)&(TIUCNT=1) $P(^TMP("TIULIST",$J),U,3)=EDT
S:+$G(ROOTFLAG) $P(^TMP("TIULIST",$J),U,2)=EDT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUSRVLC 3021 printed Apr 09, 2024@21:48:10 Page 2
TIUSRVLC ; SLC/JER - Server functions for lists ;06/19/97 16:22
+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,3,DFN,$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,244,DFN,$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,243,STATUS,QSTR,$GET(EARLY),$GET(LATE),$GET(ROOTFLAG))
+3 QUIT
LIST(TIUY,CLASS,DFN,EARLY,LATE,ROOTFLAG) ; Build List
+1 NEW TIUCNT,TIUDT,TIUI,TIUJ,TIUK,TIUP,TIUQ,TIUREC,TIUPRM0,TIUPRM1
+2 NEW TIUPRM3,TIUT,TIUTP,XREF,TIUS,TIUCONT,TIUSTAT,TIUTYPE
+3 KILL ^TMP("TIULIST",$JOB),^TMP("TIUI",$JOB)
+4 IF '$DATA(TIUPRM0)
DO SETPARM^TIULE
+5 SET EARLY=9999999-+$GET(EARLY)
+6 SET (TIUI,LATE)=9999999-$SELECT(+$GET(LATE):+$GET(LATE),1:3333333)
+7 FOR
SET TIUI=$ORDER(^TIU(8925,"APTCL",DFN,CLASS,TIUI))
if +TIUI'>0!(+TIUI>EARLY)
QUIT
DO GATHER(DFN,CLASS,TIUI,ROOTFLAG)
+8 IF +$ORDER(^TMP("TIULIST",$JOB,0))
SET TIUY=$NAME(^TMP("TIULIST",$JOB))
SET (TIUI,TIUK)=0
+9 QUIT
GATHER(DFN,CLASS,TIUI,ROOTFLAG) ; Find/sort records for the list
+1 NEW TIUDA
+2 IF '$DATA(TIUDPRM0)
DO SETPARM^TIULE
+3 SET TIUDA=0
+4 FOR
SET TIUDA=$ORDER(^TIU(8925,"APTCL",DFN,CLASS,TIUI,TIUDA))
if +TIUDA'>0
QUIT
Begin DoDot:1
+5 IF ($PIECE(TIUPRM0,U,6)="S")
IF (+$$CANDO^TIULP(TIUDA,"VIEW")'>0)
QUIT
+6 DO ADDELMNT(TIUDA,.TIUCNT,ROOTFLAG)
End DoDot:1
+7 QUIT
ADDELMNT(DA,TIUCNT,ROOTFLAG) ; 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,TIUSUBJ
+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 TIUSUBJ=$GET(^TIU(8925,+DA,17))
+6 IF '+$PIECE(TIUR0,U,7)
Begin DoDot:1
+7 SET $PIECE(TIUR0,U,7)=+$GET(^AUPNVSIT(+$PIECE(TIUR0,U,3),0))
+8 IF '+$PIECE(TIUR0,U,7)
SET $PIECE(TIUR0,U,7)=""
End DoDot:1
+9 SET DOC=$$PNAME^TIULC1(+TIUR0)
+10 IF DOC="Addendum"
SET DOC=DOC_" to "_$$PNAME^TIULC1(+$GET(^TIU(8925,+$PIECE(TIUR0,U,6),0)))
+11 IF +$$HASADDEN^TIULC1(+DA)
SET DOC="+ "_DOC
+12 IF +$$URGENCY^TIURM(+DA)=1
SET DOC=$SELECT(DOC["+":"*",1:"* ")_DOC
+13 SET STATUS=$$LOWER^TIULS($PIECE($GET(^TIU(8925.6,+$PIECE(TIUR0,U,5),0)),U))
+14 SET LOC=$GET(^SC(+$PIECE(TIUR12,U,5),0))
SET LOCTYP=$PIECE(LOC,U,3)
SET LOC=$PIECE(LOC,U)
+15 SET TIUADT=$SELECT(LOCTYP="W":"Adm: ",1:"Visit: ")_$$DATE^TIULS($PIECE(TIUR0,U,7),"MM/DD/YY")
+16 SET TIUDDT=$SELECT(+$PIECE(TIUR0,U,8):"Dis: ",1:"")_$$DATE^TIULS($PIECE(TIUR0,U,8),"MM/DD/YY")
+17 SET PT=$$NAME^TIULS($PIECE(TIUPT,U),"LAST, FIRST MI")
+18 SET TIULST4=$EXTRACT($PIECE(TIUPT,U,9),6,9)
+19 SET TIULST4="("_$EXTRACT(PT)_TIULST4_")"
+20 SET AUT=$$SIGNAME^TIULS(+$PIECE(TIUR12,U,2))
+21 SET EDT=+TIUR13
+22 SET TIUCNT=+$GET(TIUCNT)+1
+23 SET TIUREC=DA_U_DOC_U_EDT_U_PT_" "_TIULST4_U_AUT_U_LOC_U_STATUS_U_TIUADT_U_TIUDDT_U
+24 IF ($LENGTH(TIUREC)+$LENGTH(TIUSUBJ))>255
SET TIUSUBJ=$EXTRACT(TIUSUBJ,1,(255-$LENGTH(TIUREC)))
+25 SET TIUREC=TIUREC_TIUSUBJ
+26 SET ^TMP("TIULIST",$JOB,TIUCNT)=TIUREC
+27 if +$GET(ROOTFLAG)
SET $PIECE(^TMP("TIULIST",$JOB),U)=TIUCNT
+28 if +$GET(ROOTFLAG)&(TIUCNT=1)
SET $PIECE(^TMP("TIULIST",$JOB),U,3)=EDT
+29 if +$GET(ROOTFLAG)
SET $PIECE(^TMP("TIULIST",$JOB),U,2)=EDT
+30 QUIT
