TIULM ; SLC/JER - List Manager Library: RESIZE, REMOVE Elmt, PICK List Elmt ; 3/9/01
;;1.0;TEXT INTEGRATION UTILITIES;**100**;Jun 20, 1997
RESIZE(LONG,SHORT,SHRINK) ; Resizes list area
N TIUBM S TIUBM=$S(VALMMENU:SHORT,+$G(SHRINK):SHORT,1:LONG)
I VALM("BM")'=TIUBM S VALMBCK="R" D
. S VALM("BM")=TIUBM,VALM("LINES")=(TIUBM-VALM("TM"))+1
. I +$G(VALMCC) D RESET^VALM4
Q
PICK(TIUITEM) ; Highlight selected list elements, add to VALMY(ITEM) array
N TIUI,ITEM,LINE
; **100** 4/11/00:
F TIUI=1:1:$L(TIUITEM,",") S ITEM=$P(TIUITEM,",",TIUI) Q:+ITEM'>0 D
. S LINE=+$O(@VALMAR@("PICK",+ITEM,0)) I '+LINE S LINE=ITEM
. I '$D(VALMY(ITEM)) D I 1
. . D RESTORE^VALM10(LINE),CNTRL^VALM10(LINE,6,VALM("RM"),IORVON,IORVOFF)
. . D WRITE^VALM10(LINE)
. . S VALMY(ITEM)=""
. . ;**100**
. . I $G(TIUGLINK) D
. . . I $L(TIUITEM,",")>2 D
. . . . W !!,"You are now selecting ONE interdisciplinary parent note."
. . . . W !,"Acting on line ",+TIUITEM
. . . . W " as your parent note selection." H 5
. . . . S TIUITEM=+TIUITEM ; only want 1 ID parent
. . . D LKDAD^TIUGR2(TIUGLINK)
. . . K VALMY
. E D
. . D RESTORE^VALM10(LINE),WRITE^VALM10(LINE)
. . K VALMY(ITEM)
; D RE^VALM4 ; P100 took out, redundant
Q
FIXLST ; Restore video attributes to entire list
N TIUI S TIUI=0
Q:'$D(VALMAR)
F S TIUI=$O(^TMP("TIUR",$J,TIUI)) Q:+TIUI'>0 D
. I TIUI=$P($G(TIUGLINK),U,2) Q ; See TIURL
. D RESTORE(TIUI)
Q
FIXLSTNW ; Restore video attributes to entire list
; New: Don't bold the list #
N TIUI S TIUI=0
Q:'$D(VALMAR)
F S TIUI=$O(^TMP("TIUR",$J,TIUI)) Q:+TIUI'>0 D
. I TIUI=$P($G(TIUGLINK),U,2) Q ; See TIURL
. D RESTORE^VALM10(TIUI)
Q
RESTORE(ITEM) ; Restore video attributes for a single list element
D RESTORE^VALM10(ITEM),FLDCTRL^VALM10(ITEM,"NUMBER",IOINHI,IOINORM)
Q
RESTOREG(TIUGLINK) ; Update video attributes after changing view,
;for ID entry being attached, which probably moved to a different line.
N LINENO,NLINENO
Q:'$G(TIUGLINK)
S LINENO=$P(TIUGLINK,U,2)
S NLINENO=+$O(^TMP("TIUR",$J,"IEN",+TIUGLINK,0))
S $P(TIUGLINK,U,2)=NLINENO
I $D(^TMP("TIUR",$J,LINENO)) D RESTORE^VALM10(LINENO)
I $D(^TMP("TIUR",$J,NLINENO)) D
. D RESTORE^VALM10(NLINENO)
. D CNTRL^VALM10(NLINENO,6,VALM("RM"),IORVON,IORVOFF)
Q
;
REMOVE(ITEM) ; Remove an element from the list
; No longer used since patch 100
; Now called only by rtn TIUPPAC, an obsolete patient postings rtn.
N TIUREC S TIUREC=$G(^TMP("TIUR",$J,+ITEM,0))
S TIUREC=$$SETFLD^VALM1("deleted",TIUREC,"STATUS")
S ^TMP("TIUR",$J,+ITEM,0)=TIUREC
D RESTORE^VALM10(+ITEM),CNTRL^VALM10(+ITEM,6,VALM("RM"),IOINHI,IOINORM)
I $P(ITEM,U,2) D UPIDDATA^TIURL1($P(ITEM,U,2))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIULM 2726 printed Dec 13, 2024@02:42:14 Page 2
TIULM ; SLC/JER - List Manager Library: RESIZE, REMOVE Elmt, PICK List Elmt ; 3/9/01
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**100**;Jun 20, 1997
RESIZE(LONG,SHORT,SHRINK) ; Resizes list area
+1 NEW TIUBM
SET TIUBM=$SELECT(VALMMENU:SHORT,+$GET(SHRINK):SHORT,1:LONG)
+2 IF VALM("BM")'=TIUBM
SET VALMBCK="R"
Begin DoDot:1
+3 SET VALM("BM")=TIUBM
SET VALM("LINES")=(TIUBM-VALM("TM"))+1
+4 IF +$GET(VALMCC)
DO RESET^VALM4
End DoDot:1
+5 QUIT
PICK(TIUITEM) ; Highlight selected list elements, add to VALMY(ITEM) array
+1 NEW TIUI,ITEM,LINE
+2 ; **100** 4/11/00:
+3 FOR TIUI=1:1:$LENGTH(TIUITEM,",")
SET ITEM=$PIECE(TIUITEM,",",TIUI)
if +ITEM'>0
QUIT
Begin DoDot:1
+4 SET LINE=+$ORDER(@VALMAR@("PICK",+ITEM,0))
IF '+LINE
SET LINE=ITEM
+5 IF '$DATA(VALMY(ITEM))
Begin DoDot:2
+6 DO RESTORE^VALM10(LINE)
DO CNTRL^VALM10(LINE,6,VALM("RM"),IORVON,IORVOFF)
+7 DO WRITE^VALM10(LINE)
+8 SET VALMY(ITEM)=""
+9 ;**100**
+10 IF $GET(TIUGLINK)
Begin DoDot:3
+11 IF $LENGTH(TIUITEM,",")>2
Begin DoDot:4
+12 WRITE !!,"You are now selecting ONE interdisciplinary parent note."
+13 WRITE !,"Acting on line ",+TIUITEM
+14 WRITE " as your parent note selection."
HANG 5
+15 ; only want 1 ID parent
SET TIUITEM=+TIUITEM
End DoDot:4
+16 DO LKDAD^TIUGR2(TIUGLINK)
+17 KILL VALMY
End DoDot:3
End DoDot:2
IF 1
+18 IF '$TEST
Begin DoDot:2
+19 DO RESTORE^VALM10(LINE)
DO WRITE^VALM10(LINE)
+20 KILL VALMY(ITEM)
End DoDot:2
End DoDot:1
+21 ; D RE^VALM4 ; P100 took out, redundant
+22 QUIT
FIXLST ; Restore video attributes to entire list
+1 NEW TIUI
SET TIUI=0
+2 if '$DATA(VALMAR)
QUIT
+3 FOR
SET TIUI=$ORDER(^TMP("TIUR",$JOB,TIUI))
if +TIUI'>0
QUIT
Begin DoDot:1
+4 ; See TIURL
IF TIUI=$PIECE($GET(TIUGLINK),U,2)
QUIT
+5 DO RESTORE(TIUI)
End DoDot:1
+6 QUIT
FIXLSTNW ; Restore video attributes to entire list
+1 ; New: Don't bold the list #
+2 NEW TIUI
SET TIUI=0
+3 if '$DATA(VALMAR)
QUIT
+4 FOR
SET TIUI=$ORDER(^TMP("TIUR",$JOB,TIUI))
if +TIUI'>0
QUIT
Begin DoDot:1
+5 ; See TIURL
IF TIUI=$PIECE($GET(TIUGLINK),U,2)
QUIT
+6 DO RESTORE^VALM10(TIUI)
End DoDot:1
+7 QUIT
RESTORE(ITEM) ; Restore video attributes for a single list element
+1 DO RESTORE^VALM10(ITEM)
DO FLDCTRL^VALM10(ITEM,"NUMBER",IOINHI,IOINORM)
+2 QUIT
RESTOREG(TIUGLINK) ; Update video attributes after changing view,
+1 ;for ID entry being attached, which probably moved to a different line.
+2 NEW LINENO,NLINENO
+3 if '$GET(TIUGLINK)
QUIT
+4 SET LINENO=$PIECE(TIUGLINK,U,2)
+5 SET NLINENO=+$ORDER(^TMP("TIUR",$JOB,"IEN",+TIUGLINK,0))
+6 SET $PIECE(TIUGLINK,U,2)=NLINENO
+7 IF $DATA(^TMP("TIUR",$JOB,LINENO))
DO RESTORE^VALM10(LINENO)
+8 IF $DATA(^TMP("TIUR",$JOB,NLINENO))
Begin DoDot:1
+9 DO RESTORE^VALM10(NLINENO)
+10 DO CNTRL^VALM10(NLINENO,6,VALM("RM"),IORVON,IORVOFF)
End DoDot:1
+11 QUIT
+12 ;
REMOVE(ITEM) ; Remove an element from the list
+1 ; No longer used since patch 100
+2 ; Now called only by rtn TIUPPAC, an obsolete patient postings rtn.
+3 NEW TIUREC
SET TIUREC=$GET(^TMP("TIUR",$JOB,+ITEM,0))
+4 SET TIUREC=$$SETFLD^VALM1("deleted",TIUREC,"STATUS")
+5 SET ^TMP("TIUR",$JOB,+ITEM,0)=TIUREC
+6 DO RESTORE^VALM10(+ITEM)
DO CNTRL^VALM10(+ITEM,6,VALM("RM"),IOINHI,IOINORM)
+7 IF $PIECE(ITEM,U,2)
DO UPIDDATA^TIURL1($PIECE(ITEM,U,2))
+8 QUIT
