Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIUSRVL

TIUSRVL.m

Go to the documentation of this file.
  1. TIUSRVL ; SLC/JER - Server functions for lists ;7/16/96 17:52
  1. ;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997
  1. NOTES(TIUY,DFN,STATUS,EARLY,LATE,ROOTFLAG) ; Gets list of Notes
  1. N QSTR S QSTR="APT"_U_DFN_U_$P($G(^DPT(+DFN,0)),U)
  1. I $S(+$G(DFN)'>0:1,'$D(^DPT(+$G(DFN),0)):1,1:0) Q
  1. S STATUS=$S($G(STATUS)]"":$G(STATUS),1:"ALL")
  1. D LIST(.TIUY,3,STATUS,QSTR,$G(EARLY),$G(LATE),$G(ROOTFLAG))
  1. Q
  1. SUMMARY(TIUY,DFN,STATUS,EARLY,LATE,ROOTFLAG) ; Gets list of Summaries
  1. N QSTR
  1. I $S(+$G(DFN)'>0:1,'$D(^DPT(+$G(DFN),0)):1,1:0) Q
  1. S QSTR="APT"_U_DFN_U_$P($G(^DPT(+DFN,0)),U)
  1. S STATUS=$S($G(STATUS)]"":$G(STATUS),1:"ALL")
  1. D LIST(.TIUY,1,STATUS,QSTR,$G(EARLY),$G(LATE),$G(ROOTFLAG))
  1. Q
  1. CONSULT(TIUY,DFN,STATUS,EARLY,LATE,ROOTFLAG) ; Gets list of Consults
  1. N QSTR
  1. I $S(+$G(DFN)'>0:1,'$D(^DPT(+$G(DFN),0)):1,1:0) Q
  1. S QSTR="APT"_U_DFN_U_$P($G(^DPT(+DFN,0)),U)
  1. S STATUS=$S($G(STATUS)]"":$G(STATUS),1:"ALL")
  1. D LIST(.TIUY,243,STATUS,QSTR,$G(EARLY),$G(LATE),$G(ROOTFLAG))
  1. Q
  1. LIST(TIUY,TYPE,STATUS,SCREEN,EARLY,LATE,ROOTFLAG) ; Build List
  1. N TIUCNT,TIUDT,TIUI,TIUJ,TIUK,TIUP,TIUQ,TIUIFN,TIUREC,TIUPRM0,TIUPRM1
  1. N TIUPRM3,TIUT,TIUTP,XREF,TIUS,TIUCONT,TIUSTAT,TIUTYPE,TYPES
  1. K ^TMP("TIULIST",$J),^TMP("TIUI",$J)
  1. I '$D(TIUPRM0) D SETPARM^TIULE
  1. D DOCTYPE(.TIUTYPE,TYPE)
  1. D CHECKADD(.TIUTYPE)
  1. I +$D(TIUTYPE)'>0 S TIUY=0 Q
  1. M TYPES=TIUTYPE
  1. D STATUS(.TIUSTAT,$$UP^XLFSTR(STATUS))
  1. I +$D(TIUSTAT)'>0 S TIUY=0 Q
  1. M STATUS=TIUSTAT
  1. S EARLY=9999999-+$G(EARLY),LATE=9999999-$S(+$G(LATE):+$G(LATE),1:3333333)
  1. F TIUK=1:1:$L(SCREEN,";") D
  1. . S XREF=$P($P(SCREEN,";",TIUK),U)
  1. . I XREF'="ASUB" S TIUI=$P($P(SCREEN,";",TIUK),U,2) D GATHER(TIUI,.TYPES,.STATUS)
  1. . I XREF="ASUB" D
  1. . . S TIUI=$O(^TIU(8925,XREF,$P($P(SCREEN,";",TIUK),U,2)),-1)
  1. . . F S TIUI=$O(^TIU(8925,XREF,TIUI)) Q:TIUI=""!(TIUI'[$P($P(SCREEN,";",TIUK),U,2)) D GATHER(TIUI,.TYPES,.STATUS)
  1. S TIUY=$NA(^TMP("TIULIST",$J))
  1. I +$O(^TMP("TIULIST",$J,0)) S (TIUI,TIUK)=0
  1. F S TIUI=$O(^TMP("TIULIST",$J,TIUI)) Q:+TIUI'>0 D
  1. . S TIUJ=0 F S TIUJ=$O(^TMP("TIULIST",$J,TIUI,TIUJ)) Q:+TIUJ'>0 D
  1. . . S TIUK=TIUK+1
  1. . . S ^TMP("TIULIST",$J,TIUK)=$G(^TMP("TIULIST",$J,TIUI,TIUJ))
  1. . . S ^TMP("TIULIDX",$J,TIUI,TIUJ)=TIUK K ^TMP("TIULIST",$J,TIUI,TIUJ)
  1. . . S:+$G(ROOTFLAG) $P(^TMP("TIULIST",$J),U)=TIUK
  1. . . S:TIUK=1&+$G(ROOTFLAG) $P(^TMP("TIULIST",$J),U,3)=(9999999-TIUI)
  1. . . S:+$G(ROOTFLAG) $P(^TMP("TIULIST",$J),U,2)=(9999999-TIUI)
  1. Q
  1. GATHER(TIUI,TYPES,STATUS) ; Find/sort records for the list
  1. N TIUT,TIUTP,TIUS,TIUSTAT
  1. S TIUT=0 F S TIUT=$O(TYPES(TIUT)) Q:+TIUT'>0 D
  1. . S TIUTP=+$G(TYPES(TIUT)) Q:TIUTP'>0
  1. . S TIUS=0 F S TIUS=$O(STATUS(TIUS)) Q:+TIUS'>0 D
  1. . . S TIUSTAT=+$G(STATUS(TIUS))
  1. . . Q:+TIUSTAT'>0
  1. . . S TIUJ=LATE F S TIUJ=$O(^TIU(8925,XREF,TIUI,TIUTP,TIUSTAT,TIUJ)) Q:+TIUJ'>0!(+TIUJ>EARLY) D
  1. . . . S TIUIFN=0
  1. . . . F S TIUIFN=$O(^TIU(8925,XREF,TIUI,TIUTP,TIUSTAT,TIUJ,TIUIFN)) Q:+TIUIFN'>0 D
  1. . . . . I TIUTP=81,(+TYPES>1),($P(TYPES(TIUT),U,3)="NOT PICKED"),'+$$DADINTYP(TIUIFN,.TYPES) Q
  1. . . . . ;I '$$CANDO^TIULP(TIUIFN,"VIEW") Q
  1. . . . . D ADDELMNT(TIUIFN,.TIUCNT)
  1. Q
  1. DADINTYP(TIUDA,TYPES) ; Evaluates whether addendum's parent belongs is among
  1. ; the selected types
  1. N TIUI,TIUDTYP,TIUY S (TIUI,TIUY)=0
  1. S TIUDTYP=+$G(^TIU(8925,+$P($G(^TIU(8925,+TIUDA,0)),U,6),0))
  1. F S TIUI=$O(TYPES(TIUI)) Q:+TIUI'>0!+TIUY D
  1. . I +$P(TYPES(TIUI),U)=TIUDTYP S TIUY=1
  1. Q TIUY
  1. ADDELMNT(DA,TIUCNT) ; Add each element to the list
  1. N DOC,LOC,PT,AUT,EDT,TIUPT,TIULST4,TIUREC,TIUR0,TIUR12,TIUR13
  1. N STATUS,EDTCNT,LOCTYP,TIUADT,TIUDDT
  1. S TIUR0=$G(^TIU(8925,+DA,0)),TIUR12=$G(^TIU(8925,+DA,12))
  1. S TIUR13=$G(^TIU(8925,+DA,13)),TIUPT=$G(^DPT(+$P(TIUR0,U,2),0))
  1. S DOC=$$PNAME^TIULC1(+TIUR0)
  1. I DOC="Addendum" S DOC=DOC_" to "_$$PNAME^TIULC1(+$G(^TIU(8925,+$P(TIUR0,U,6),0)))
  1. S STATUS=$$LOWER^TIULS($P(^TIU(8925.6,+$P(TIUR0,U,5),0),U))
  1. S LOC=$G(^SC(+$P(TIUR12,U,5),0)),LOCTYP=$P(LOC,U,3),LOC=$P(LOC,U)
  1. S TIUADT=$S(LOCTYP="W":"Adm: ",1:"Visit: ")_$$DATE^TIULS($P(TIUR0,U,7),"MM/DD/YY")
  1. S TIUDDT=$S(+$P(TIUR0,U,8):"Dis: ",1:"")_$$DATE^TIULS($P(TIUR0,U,8),"MM/DD/YY")
  1. S PT=$$NAME^TIULS($P(TIUPT,U),"LAST, FIRST MI")
  1. S TIULST4=$E($P(TIUPT,U,9),6,9)
  1. S TIULST4="("_$E(PT)_TIULST4_")"
  1. S AUT=$$SIGNAME^TIULS(+$P(TIUR12,U,2))
  1. S EDT=+TIUR13,EDTCNT=+$G(EDTCNT)+1
  1. F Q:+$D(^TMP("TIULIST",$J,9999999-EDT,EDTCNT))'>0 S EDTCNT=EDTCNT+1
  1. S TIUCNT=+$G(TIUCNT)+1
  1. S TIUREC=DA_U_DOC_U_EDT_U_PT_" "_TIULST4_U_AUT_U_LOC_U_STATUS_U_TIUADT_U_TIUDDT
  1. S ^TMP("TIULIST",$J,9999999-EDT,EDTCNT)=TIUREC
  1. ;S TIUY(TIUCNT)=TIUREC
  1. Q
  1. DOCTYPE(TIUY,DA,TYPE,TIUK) ; Get all descendent's of a given type
  1. N I,J,X,CURTYP,Y
  1. ; TIUK is STATIC
  1. S TIUK=+$G(TIUK)
  1. I $G(TYPE)']"" S TYPE="DOC"
  1. S CURTYP=$P(^TIU(8925.1,+DA,0),U,4)
  1. S TYPMATCH=$$TYPMATCH^TIULA1(TYPE,CURTYP)
  1. I +TYPMATCH S TIUK=+$G(TIUK)+1,TIUY(TIUK)=+DA_U_$$PNAME^TIULC1(+DA),TIUY=+$G(TIUY)+1
  1. S I=0 F S I=$O(^TIU(8925.1,+DA,10,I)) Q:+I'>0 D
  1. . N J
  1. . S J=+$G(^TIU(8925.1,+DA,10,+I,0)) Q:+J'>0
  1. . D DOCTYPE(.TIUY,+J,TYPE,.TIUK)
  1. Q
  1. CHECKADD(TYPES) ; Checks whether Addendum is included in the list of types
  1. N TIUI,HIT S (TIUI,HIT)=0
  1. F S TIUI=$O(TYPES(TIUI)) Q:+TIUI'>0!+HIT I $$UP^XLFSTR(TYPES(TIUI))="ADDENDUM" S HIT=1
  1. I +HIT'>0 S TYPES(TYPES+1)="81^Addendum^NOT PICKED",TYPES=TYPES+1
  1. Q
  1. STATUS(TIUY,STATUS,INCLDESC) ; Get statuses
  1. N TIUI,TIUS,TIUSTAT S STATUS=$G(STATUS,"ALL")
  1. I STATUS'="ALL" D Q
  1. . S TIUS=$O(^TIU(8925.6,"B",STATUS,0)) Q:+TIUS'>0
  1. . S TIUSTAT=$P($G(^TIU(8925.6,+TIUS,0)),U)
  1. . I $P(^TIU(8925.6,+TIUS,0),U,4)'="DEF" S TIUY(1)=TIUS_U_$$LOWER^TIULS(TIUSTAT)
  1. S STATUS=""
  1. F S STATUS=$O(^TIU(8925.6,"B",STATUS)) Q:STATUS']"" D
  1. . S TIUS=0
  1. . F S TIUS=$O(^TIU(8925.6,"B",STATUS,TIUS)) Q:+TIUS'>0 D
  1. . . S TIUI=+$G(TIUI)+1,TIUSTAT=$P($G(^TIU(8925.6,+TIUS,0)),U)
  1. . . I $P(^TIU(8925.6,+TIUS,0),U,4)'="DEF" D
  1. . . . S TIUY(TIUI)=TIUS_U_$$LOWER^TIULS(TIUSTAT)
  1. . . . I +$G(INCLDESC) D
  1. . . . . N TIUJ S TIUJ=0
  1. . . . . F S TIUJ=$O(^TIU(8925.6,+TIUS,1,TIUJ)) Q:+TIUJ'>0 D
  1. . . . . . S TIUY(TIUI,1,TIUJ)=$G(^TIU(8925.6,+TIUS,1,+TIUJ,0))
  1. Q