- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUSRVL 6087 printed Jan 18, 2025@03:46:57 Page 2
- 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