TIUSRVL ; SLC/JER - Server functions for lists ;7/16/96 17:52
;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997
NOTES(TIUY,DFN,STATUS,EARLY,LATE,ROOTFLAG) ; Gets list of Notes
N QSTR S QSTR="APT"_U_DFN_U_$P($G(^DPT(+DFN,0)),U)
I $S(+$G(DFN)'>0:1,'$D(^DPT(+$G(DFN),0)):1,1:0) Q
S STATUS=$S($G(STATUS)]"":$G(STATUS),1:"ALL")
D LIST(.TIUY,3,STATUS,QSTR,$G(EARLY),$G(LATE),$G(ROOTFLAG))
Q
SUMMARY(TIUY,DFN,STATUS,EARLY,LATE,ROOTFLAG) ; Gets list of Summaries
N QSTR
I $S(+$G(DFN)'>0:1,'$D(^DPT(+$G(DFN),0)):1,1:0) Q
S QSTR="APT"_U_DFN_U_$P($G(^DPT(+DFN,0)),U)
S STATUS=$S($G(STATUS)]"":$G(STATUS),1:"ALL")
D LIST(.TIUY,1,STATUS,QSTR,$G(EARLY),$G(LATE),$G(ROOTFLAG))
Q
CONSULT(TIUY,DFN,STATUS,EARLY,LATE,ROOTFLAG) ; Gets list of Consults
N QSTR
I $S(+$G(DFN)'>0:1,'$D(^DPT(+$G(DFN),0)):1,1:0) Q
S QSTR="APT"_U_DFN_U_$P($G(^DPT(+DFN,0)),U)
S STATUS=$S($G(STATUS)]"":$G(STATUS),1:"ALL")
D LIST(.TIUY,243,STATUS,QSTR,$G(EARLY),$G(LATE),$G(ROOTFLAG))
Q
LIST(TIUY,TYPE,STATUS,SCREEN,EARLY,LATE,ROOTFLAG) ; Build List
N TIUCNT,TIUDT,TIUI,TIUJ,TIUK,TIUP,TIUQ,TIUIFN,TIUREC,TIUPRM0,TIUPRM1
N TIUPRM3,TIUT,TIUTP,XREF,TIUS,TIUCONT,TIUSTAT,TIUTYPE,TYPES
K ^TMP("TIULIST",$J),^TMP("TIUI",$J)
I '$D(TIUPRM0) D SETPARM^TIULE
D DOCTYPE(.TIUTYPE,TYPE)
D CHECKADD(.TIUTYPE)
I +$D(TIUTYPE)'>0 S TIUY=0 Q
M TYPES=TIUTYPE
D STATUS(.TIUSTAT,$$UP^XLFSTR(STATUS))
I +$D(TIUSTAT)'>0 S TIUY=0 Q
M STATUS=TIUSTAT
S EARLY=9999999-+$G(EARLY),LATE=9999999-$S(+$G(LATE):+$G(LATE),1:3333333)
F TIUK=1:1:$L(SCREEN,";") D
. S XREF=$P($P(SCREEN,";",TIUK),U)
. I XREF'="ASUB" S TIUI=$P($P(SCREEN,";",TIUK),U,2) D GATHER(TIUI,.TYPES,.STATUS)
. I XREF="ASUB" D
. . S TIUI=$O(^TIU(8925,XREF,$P($P(SCREEN,";",TIUK),U,2)),-1)
. . F S TIUI=$O(^TIU(8925,XREF,TIUI)) Q:TIUI=""!(TIUI'[$P($P(SCREEN,";",TIUK),U,2)) D GATHER(TIUI,.TYPES,.STATUS)
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(TIUI,TYPES,STATUS) ; Find/sort records for the list
N TIUT,TIUTP,TIUS,TIUSTAT
S TIUT=0 F S TIUT=$O(TYPES(TIUT)) Q:+TIUT'>0 D
. S TIUTP=+$G(TYPES(TIUT)) Q:TIUTP'>0
. S TIUS=0 F S TIUS=$O(STATUS(TIUS)) Q:+TIUS'>0 D
. . S TIUSTAT=+$G(STATUS(TIUS))
. . Q:+TIUSTAT'>0
. . S TIUJ=LATE F S TIUJ=$O(^TIU(8925,XREF,TIUI,TIUTP,TIUSTAT,TIUJ)) Q:+TIUJ'>0!(+TIUJ>EARLY) D
. . . S TIUIFN=0
. . . F S TIUIFN=$O(^TIU(8925,XREF,TIUI,TIUTP,TIUSTAT,TIUJ,TIUIFN)) Q:+TIUIFN'>0 D
. . . . I TIUTP=81,(+TYPES>1),($P(TYPES(TIUT),U,3)="NOT PICKED"),'+$$DADINTYP(TIUIFN,.TYPES) Q
. . . . ;I '$$CANDO^TIULP(TIUIFN,"VIEW") Q
. . . . D ADDELMNT(TIUIFN,.TIUCNT)
Q
DADINTYP(TIUDA,TYPES) ; Evaluates whether addendum's parent belongs is among
; the selected types
N TIUI,TIUDTYP,TIUY S (TIUI,TIUY)=0
S TIUDTYP=+$G(^TIU(8925,+$P($G(^TIU(8925,+TIUDA,0)),U,6),0))
F S TIUI=$O(TYPES(TIUI)) Q:+TIUI'>0!+TIUY D
. I +$P(TYPES(TIUI),U)=TIUDTYP S TIUY=1
Q TIUY
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),TIUY=+$G(TIUY)+1
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
CHECKADD(TYPES) ; Checks whether Addendum is included in the list of types
N TIUI,HIT S (TIUI,HIT)=0
F S TIUI=$O(TYPES(TIUI)) Q:+TIUI'>0!+HIT I $$UP^XLFSTR(TYPES(TIUI))="ADDENDUM" S HIT=1
I +HIT'>0 S TYPES(TYPES+1)="81^Addendum^NOT PICKED",TYPES=TYPES+1
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
TIUSRVL ; SLC/JER - Server functions for lists ;7/16/96 17:52
+1 ;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997
NOTES(TIUY,DFN,STATUS,EARLY,LATE,ROOTFLAG) ; Gets list of Notes
+1 NEW QSTR
SET QSTR="APT"_U_DFN_U_$PIECE($GET(^DPT(+DFN,0)),U)
+2 IF $SELECT(+$GET(DFN)'>0:1,'$DATA(^DPT(+$GET(DFN),0)):1,1:0)
QUIT
+3 SET STATUS=$SELECT($GET(STATUS)]"":$GET(STATUS),1:"ALL")
+4 DO LIST(.TIUY,3,STATUS,QSTR,$GET(EARLY),$GET(LATE),$GET(ROOTFLAG))
+5 QUIT
SUMMARY(TIUY,DFN,STATUS,EARLY,LATE,ROOTFLAG) ; Gets list of Summaries
+1 NEW QSTR
+2 IF $SELECT(+$GET(DFN)'>0:1,'$DATA(^DPT(+$GET(DFN),0)):1,1:0)
QUIT
+3 SET QSTR="APT"_U_DFN_U_$PIECE($GET(^DPT(+DFN,0)),U)
+4 SET STATUS=$SELECT($GET(STATUS)]"":$GET(STATUS),1:"ALL")
+5 DO LIST(.TIUY,1,STATUS,QSTR,$GET(EARLY),$GET(LATE),$GET(ROOTFLAG))
+6 QUIT
CONSULT(TIUY,DFN,STATUS,EARLY,LATE,ROOTFLAG) ; Gets list of Consults
+1 NEW QSTR
+2 IF $SELECT(+$GET(DFN)'>0:1,'$DATA(^DPT(+$GET(DFN),0)):1,1:0)
QUIT
+3 SET QSTR="APT"_U_DFN_U_$PIECE($GET(^DPT(+DFN,0)),U)
+4 SET STATUS=$SELECT($GET(STATUS)]"":$GET(STATUS),1:"ALL")
+5 DO LIST(.TIUY,243,STATUS,QSTR,$GET(EARLY),$GET(LATE),$GET(ROOTFLAG))
+6 QUIT
LIST(TIUY,TYPE,STATUS,SCREEN,EARLY,LATE,ROOTFLAG) ; Build List
+1 NEW TIUCNT,TIUDT,TIUI,TIUJ,TIUK,TIUP,TIUQ,TIUIFN,TIUREC,TIUPRM0,TIUPRM1
+2 NEW TIUPRM3,TIUT,TIUTP,XREF,TIUS,TIUCONT,TIUSTAT,TIUTYPE,TYPES
+3 KILL ^TMP("TIULIST",$JOB),^TMP("TIUI",$JOB)
+4 IF '$DATA(TIUPRM0)
DO SETPARM^TIULE
+5 DO DOCTYPE(.TIUTYPE,TYPE)
+6 DO CHECKADD(.TIUTYPE)
+7 IF +$DATA(TIUTYPE)'>0
SET TIUY=0
QUIT
+8 MERGE TYPES=TIUTYPE
+9 DO STATUS(.TIUSTAT,$$UP^XLFSTR(STATUS))
+10 IF +$DATA(TIUSTAT)'>0
SET TIUY=0
QUIT
+11 MERGE STATUS=TIUSTAT
+12 SET EARLY=9999999-+$GET(EARLY)
SET LATE=9999999-$SELECT(+$GET(LATE):+$GET(LATE),1:3333333)
+13 FOR TIUK=1:1:$LENGTH(SCREEN,";")
Begin DoDot:1
+14 SET XREF=$PIECE($PIECE(SCREEN,";",TIUK),U)
+15 IF XREF'="ASUB"
SET TIUI=$PIECE($PIECE(SCREEN,";",TIUK),U,2)
DO GATHER(TIUI,.TYPES,.STATUS)
+16 IF XREF="ASUB"
Begin DoDot:2
+17 SET TIUI=$ORDER(^TIU(8925,XREF,$PIECE($PIECE(SCREEN,";",TIUK),U,2)),-1)
+18 FOR
SET TIUI=$ORDER(^TIU(8925,XREF,TIUI))
IF TIUI=""!(TIUI'[$PIECE($PIECE(SCREEN,";",TIUK),U,2))
QUIT
DO GATHER(TIUI,.TYPES,.STATUS)
End DoDot:2
End DoDot:1
+19 SET TIUY=$NAME(^TMP("TIULIST",$JOB))
+20 IF +$ORDER(^TMP("TIULIST",$JOB,0))
SET (TIUI,TIUK)=0
+21 FOR
SET TIUI=$ORDER(^TMP("TIULIST",$JOB,TIUI))
IF +TIUI'>0
QUIT
Begin DoDot:1
+22 SET TIUJ=0
FOR
SET TIUJ=$ORDER(^TMP("TIULIST",$JOB,TIUI,TIUJ))
IF +TIUJ'>0
QUIT
Begin DoDot:2
+23 SET TIUK=TIUK+1
+24 SET ^TMP("TIULIST",$JOB,TIUK)=$GET(^TMP("TIULIST",$JOB,TIUI,TIUJ))
+25 SET ^TMP("TIULIDX",$JOB,TIUI,TIUJ)=TIUK
KILL ^TMP("TIULIST",$JOB,TIUI,TIUJ)
+26 IF +$GET(ROOTFLAG)
SET $PIECE(^TMP("TIULIST",$JOB),U)=TIUK
+27 IF TIUK=1&+$GET(ROOTFLAG)
SET $PIECE(^TMP("TIULIST",$JOB),U,3)=(9999999-TIUI)
+28 IF +$GET(ROOTFLAG)
SET $PIECE(^TMP("TIULIST",$JOB),U,2)=(9999999-TIUI)
End DoDot:2
End DoDot:1
+29 QUIT
GATHER(TIUI,TYPES,STATUS) ; Find/sort records for the list
+1 NEW TIUT,TIUTP,TIUS,TIUSTAT
+2 SET TIUT=0
FOR
SET TIUT=$ORDER(TYPES(TIUT))
IF +TIUT'>0
QUIT
Begin DoDot:1
+3 SET TIUTP=+$GET(TYPES(TIUT))
IF TIUTP'>0
QUIT
+4 SET TIUS=0
FOR
SET TIUS=$ORDER(STATUS(TIUS))
IF +TIUS'>0
QUIT
Begin DoDot:2
+5 SET TIUSTAT=+$GET(STATUS(TIUS))
+6 IF +TIUSTAT'>0
QUIT
+7 SET TIUJ=LATE
FOR
SET TIUJ=$ORDER(^TIU(8925,XREF,TIUI,TIUTP,TIUSTAT,TIUJ))
IF +TIUJ'>0!(+TIUJ>EARLY)
QUIT
Begin DoDot:3
+8 SET TIUIFN=0
+9 FOR
SET TIUIFN=$ORDER(^TIU(8925,XREF,TIUI,TIUTP,TIUSTAT,TIUJ,TIUIFN))
IF +TIUIFN'>0
QUIT
Begin DoDot:4
+10 IF TIUTP=81
IF (+TYPES>1)
IF ($PIECE(TYPES(TIUT),U,3)="NOT PICKED")
IF '+$$DADINTYP(TIUIFN,.TYPES)
QUIT
+11 ;I '$$CANDO^TIULP(TIUIFN,"VIEW") Q
+12 DO ADDELMNT(TIUIFN,.TIUCNT)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+13 QUIT
DADINTYP(TIUDA,TYPES) ; Evaluates whether addendum's parent belongs is among
+1 ; the selected types
+2 NEW TIUI,TIUDTYP,TIUY
SET (TIUI,TIUY)=0
+3 SET TIUDTYP=+$GET(^TIU(8925,+$PIECE($GET(^TIU(8925,+TIUDA,0)),U,6),0))
+4 FOR
SET TIUI=$ORDER(TYPES(TIUI))
IF +TIUI'>0!+TIUY
QUIT
Begin DoDot:1
+5 IF +$PIECE(TYPES(TIUI),U)=TIUDTYP
SET TIUY=1
End DoDot:1
+6 QUIT TIUY
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)
SET TIUY=+$GET(TIUY)+1
+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
CHECKADD(TYPES) ; Checks whether Addendum is included in the list of types
+1 NEW TIUI,HIT
SET (TIUI,HIT)=0
+2 FOR
SET TIUI=$ORDER(TYPES(TIUI))
IF +TIUI'>0!+HIT
QUIT
IF $$UP^XLFSTR(TYPES(TIUI))="ADDENDUM"
SET HIT=1
+3 IF +HIT'>0
SET TYPES(TYPES+1)="81^Addendum^NOT PICKED"
SET TYPES=TYPES+1
+4 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
