VALM10 ;MJK;09:29 PM 17 Jan 1993;
;;1;List Manager;;Aug 13, 1993
;
CNTRL(LINE,COL,WIDTH,ON,OFF,SAVE) ; -- set video control chars
; input: LINE := line number
; COL := column to start control
; WIDTH := how many characters should contrl be in effect
; ON := beginninng control code (ex. the value of IOINHI)
; OFF := ending control code (ex. the value of IOINORM)
; SAVE := 1 to save control code for later use
; otherwise 0 [optional]
;
S X="VALM VIDEO"_$S($G(SAVE):" SAVE",1:"")
S ^TMP(X,$J,VALMEVL,LINE,COL,WIDTH)=ON
S ^TMP(X,$J,VALMEVL,LINE,COL+WIDTH,0)=OFF
Q
;
KILL(LINE) ; -- kill off video cntrls for a line
; input: LINE := line number
;
K:'$D(LINE) ^TMP("VALM VIDEO",$J,VALMEVL),^TMP("VALM VIDEO SAVE",$J,VALMEVL)
K:$D(LINE) ^TMP("VALM VIDEO",$J,VALMEVL,LINE),^TMP("VALM VIDEO SAVE",$J,VALMEVL,LINE)
Q
;
SAVE(LINE) ; -- save video cntrls for a line
; input: LINE := line number
;
D SWAP("^TMP(""VALM VIDEO"",$J,VALMEVL,LINE)","^TMP(""VALM VIDEO SAVE"",$J,VALMEVL,LINE)")
Q
;
RESTORE(LINE) ; -- restore video cntrls for a line
; input: LINE := line number
;
D SWAP("^TMP(""VALM VIDEO SAVE"",$J,VALMEVL,LINE)","^TMP(""VALM VIDEO"",$J,VALMEVL,LINE)")
Q
;
SWAP(FR,TO,SAVE) ; -- swap video cntrl arrays
; [not a supported call]
;
K @TO
S COL=0
F S COL=$O(@FR@(COL)) Q:'COL D
.N WIDTH S WIDTH=""
.F S WIDTH=$O(@FR@(COL,WIDTH)) Q:WIDTH="" S @TO@(COL,WIDTH)=@FR@(COL,WIDTH)
K:'$G(SAVE) @FR
Q
;
SELECT(LINE,MODE) ; -- highlight/unhighlight a line
; input: LINE := line number
; MODE := 1 to highlight line
; 0 to unhighlight and restore to original state
;
I MODE D
.D SAVE(.LINE)
.D CNTRL(.LINE,1,VALM("RM"),.IOINHI,.IOINORM)
I 'MODE D RESTORE(.LINE)
D WRITE(.LINE)
Q
;
WRITE(LINE) ; -- re-write line to screen
; input: LINE := line number
;
N DY
W IOSC
S DY=LINE-VALMBG+VALM("TM")-1 D IOXY^VALM4(0,.DY)
D WRITE^VALM4(.LINE,0,1,.DY)
W IORC
Q
;
FLDTEXT(LINE,FLD,TEXT) ; -- set text for field in line
; input: LINE := line number
; FLD := caption field name
; TEXT := text to insert for field
;
S @VALMAR@(LINE,0)=$$SETFLD^VALM1(.TEXT,@VALMAR@(LINE,0),.FLD)
Q
;
FLDCTRL(LINE,FLD,ON,OFF,SAVE) ; -- set default video ctrls for line
; or just 1 field
; input: LINE := line number
; FLD := caption field name [optional]
; ON := beginninng control code (ex. the value of IOINHI)
; OFF := ending control code (ex. the value of IOINORM)
; SAVE := 1 to save control code for later use
; otherwise 0 [optional]
;
I $G(FLD)="" D SWAP("^TMP(""VALM VIDEO SAVE"",$J,VALMEVL,0)","^TMP(""VALM VIDEO"",$J,VALMEVL,LINE)",1) G FLDCTRLQ
; -- just a fld
N COL,WIDTH,X I '$D(ON) N ON,OFF
S X=VALMDDF(FLD),COL=$P(X,U,2),WIDTH=$P(X,U,3)
I '$D(ON) D
.S (ON,OFF)=""
.D ATRFLD^VALM00(.FLD,.ON,.OFF)
D:ON]"" CNTRL(LINE,COL,WIDTH,.ON,.OFF,$G(SAVE))
FLDCTRLQ Q
;
SET(LINE,TEXT,ENTRY) ; -- set text in array
; input: LINE := line number
; TEXT := text for line
; ENTRY := entry number assoicated with line [optional]
; >> if defined, then line will also be indexed
;
S @VALMAR@(LINE,0)=TEXT
S:$G(ENTRY) @VALMAR@("IDX",LINE,ENTRY)=""
Q
;
CLEAN ; -- kill off lines and video cntrls
K @VALMAR
K ^TMP("VALM VIDEO",$J,VALMEVL)
Q
;
MSG(VALMSG) ; -- post message immediately
I VALMCC D INSTR^VALM1(IORVON_$E($S(VALMSG]"":VALMSG,1:$$MSG^VALM())_$J("",50),1,50)_IORVOFF,11,VALM("BM")+1,50,0) S VALMSG="" G MSGQ
D LBAR^VALM
MSGQ Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVALM10 3775 printed Oct 16, 2024@18:10:47 Page 2
VALM10 ;MJK;09:29 PM 17 Jan 1993;
+1 ;;1;List Manager;;Aug 13, 1993
+2 ;
CNTRL(LINE,COL,WIDTH,ON,OFF,SAVE) ; -- set video control chars
+1 ; input: LINE := line number
+2 ; COL := column to start control
+3 ; WIDTH := how many characters should contrl be in effect
+4 ; ON := beginninng control code (ex. the value of IOINHI)
+5 ; OFF := ending control code (ex. the value of IOINORM)
+6 ; SAVE := 1 to save control code for later use
+7 ; otherwise 0 [optional]
+8 ;
+9 SET X="VALM VIDEO"_$SELECT($GET(SAVE):" SAVE",1:"")
+10 SET ^TMP(X,$JOB,VALMEVL,LINE,COL,WIDTH)=ON
+11 SET ^TMP(X,$JOB,VALMEVL,LINE,COL+WIDTH,0)=OFF
+12 QUIT
+13 ;
KILL(LINE) ; -- kill off video cntrls for a line
+1 ; input: LINE := line number
+2 ;
+3 if '$DATA(LINE)
KILL ^TMP("VALM VIDEO",$JOB,VALMEVL),^TMP("VALM VIDEO SAVE",$JOB,VALMEVL)
+4 if $DATA(LINE)
KILL ^TMP("VALM VIDEO",$JOB,VALMEVL,LINE),^TMP("VALM VIDEO SAVE",$JOB,VALMEVL,LINE)
+5 QUIT
+6 ;
SAVE(LINE) ; -- save video cntrls for a line
+1 ; input: LINE := line number
+2 ;
+3 DO SWAP("^TMP(""VALM VIDEO"",$J,VALMEVL,LINE)","^TMP(""VALM VIDEO SAVE"",$J,VALMEVL,LINE)")
+4 QUIT
+5 ;
RESTORE(LINE) ; -- restore video cntrls for a line
+1 ; input: LINE := line number
+2 ;
+3 DO SWAP("^TMP(""VALM VIDEO SAVE"",$J,VALMEVL,LINE)","^TMP(""VALM VIDEO"",$J,VALMEVL,LINE)")
+4 QUIT
+5 ;
SWAP(FR,TO,SAVE) ; -- swap video cntrl arrays
+1 ; [not a supported call]
+2 ;
+3 KILL @TO
+4 SET COL=0
+5 FOR
SET COL=$ORDER(@FR@(COL))
if 'COL
QUIT
Begin DoDot:1
+6 NEW WIDTH
SET WIDTH=""
+7 FOR
SET WIDTH=$ORDER(@FR@(COL,WIDTH))
if WIDTH=""
QUIT
SET @TO@(COL,WIDTH)=@FR@(COL,WIDTH)
End DoDot:1
+8 if '$GET(SAVE)
KILL @FR
+9 QUIT
+10 ;
SELECT(LINE,MODE) ; -- highlight/unhighlight a line
+1 ; input: LINE := line number
+2 ; MODE := 1 to highlight line
+3 ; 0 to unhighlight and restore to original state
+4 ;
+5 IF MODE
Begin DoDot:1
+6 DO SAVE(.LINE)
+7 DO CNTRL(.LINE,1,VALM("RM"),.IOINHI,.IOINORM)
End DoDot:1
+8 IF 'MODE
DO RESTORE(.LINE)
+9 DO WRITE(.LINE)
+10 QUIT
+11 ;
WRITE(LINE) ; -- re-write line to screen
+1 ; input: LINE := line number
+2 ;
+3 NEW DY
+4 WRITE IOSC
+5 SET DY=LINE-VALMBG+VALM("TM")-1
DO IOXY^VALM4(0,.DY)
+6 DO WRITE^VALM4(.LINE,0,1,.DY)
+7 WRITE IORC
+8 QUIT
+9 ;
FLDTEXT(LINE,FLD,TEXT) ; -- set text for field in line
+1 ; input: LINE := line number
+2 ; FLD := caption field name
+3 ; TEXT := text to insert for field
+4 ;
+5 SET @VALMAR@(LINE,0)=$$SETFLD^VALM1(.TEXT,@VALMAR@(LINE,0),.FLD)
+6 QUIT
+7 ;
FLDCTRL(LINE,FLD,ON,OFF,SAVE) ; -- set default video ctrls for line
+1 ; or just 1 field
+2 ; input: LINE := line number
+3 ; FLD := caption field name [optional]
+4 ; ON := beginninng control code (ex. the value of IOINHI)
+5 ; OFF := ending control code (ex. the value of IOINORM)
+6 ; SAVE := 1 to save control code for later use
+7 ; otherwise 0 [optional]
+8 ;
+9 IF $GET(FLD)=""
DO SWAP("^TMP(""VALM VIDEO SAVE"",$J,VALMEVL,0)","^TMP(""VALM VIDEO"",$J,VALMEVL,LINE)",1)
GOTO FLDCTRLQ
+10 ; -- just a fld
+11 NEW COL,WIDTH,X
IF '$DATA(ON)
NEW ON,OFF
+12 SET X=VALMDDF(FLD)
SET COL=$PIECE(X,U,2)
SET WIDTH=$PIECE(X,U,3)
+13 IF '$DATA(ON)
Begin DoDot:1
+14 SET (ON,OFF)=""
+15 DO ATRFLD^VALM00(.FLD,.ON,.OFF)
End DoDot:1
+16 if ON]""
DO CNTRL(LINE,COL,WIDTH,.ON,.OFF,$GET(SAVE))
FLDCTRLQ QUIT
+1 ;
SET(LINE,TEXT,ENTRY) ; -- set text in array
+1 ; input: LINE := line number
+2 ; TEXT := text for line
+3 ; ENTRY := entry number assoicated with line [optional]
+4 ; >> if defined, then line will also be indexed
+5 ;
+6 SET @VALMAR@(LINE,0)=TEXT
+7 if $GET(ENTRY)
SET @VALMAR@("IDX",LINE,ENTRY)=""
+8 QUIT
+9 ;
CLEAN ; -- kill off lines and video cntrls
+1 KILL @VALMAR
+2 KILL ^TMP("VALM VIDEO",$JOB,VALMEVL)
+3 QUIT
+4 ;
MSG(VALMSG) ; -- post message immediately
+1 IF VALMCC
DO INSTR^VALM1(IORVON_$EXTRACT($SELECT(VALMSG]"":VALMSG,1:$$MSG^VALM())_$JUSTIFY("",50),1,50)_IORVOFF,11,VALM("BM")+1,50,0)
SET VALMSG=""
GOTO MSGQ
+2 DO LBAR^VALM
MSGQ QUIT
