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

VALM.m

Go to the documentation of this file. 
  1. VALM ;MJK/ALB - List Manager;02:00 PM  21 Jan 1993 [ 07/24/98  9:04 AM ]
  1.  ;;1;List Manager;**1,1002**;Aug 13, 1993
  1.  ;IHS/ANMC/LJF 3/11/97 IHS PATCH #1002
  1.  ;  -- force re-execute of header code
  1.  ;
  1.  ;
  1. EN(NAME,PARMS) ; -- main entry point
  1.  ;  input:   NAME := free text name of list template or routine call
  1.  ;          PARMS := parameter list
  1.  ;
  1.  I $G(PARMS)["T" K VALMEVL ; kill if 'T'op level
  1.  D INIT^VALM0(.NAME,$G(PARMS)) G ENQ:$D(VALMQUIT)
  1.  ; -- build list of items
  1.  I $G(^TMP("VALM DATA",$J,VALMEVL,"INIT"))]"" X ^("INIT") G ENQ:$D(VALMQUIT)
  1.  ; -- start event loop
  1.  S VALMBCK="R" D ASK
  1.  X:$G(^TMP("VALM DATA",$J,VALMEVL,"FNL"))]"" ^("FNL")
  1. ENQ D POP^VALM0
  1.  Q
  1.  ;
  1. ASK ; -- event loop
  1.  S X=VALM("PROTOCOL") D XQORM,EN^XQOR
  1.  I $D(VALMBCK),VALMBCK'="Q" G ASK
  1. ASKQ K XQORM,DTOUT,DIROUT,DUOUT Q
  1.  ;
  1. COL ; -- set up column dd array
  1.  K VALMDDF
  1.  S I=0 F  S I=$O(^SD(409.61,VALM("IFN"),"COL",I)) Q:'I  I $D(^(I,0)) S VALMDDF($P(^(0),U))=^(0)
  1.  Q
  1.  ;
  1. CAPTION() ; -- set up caption line of header
  1.  N X,COL,FLD
  1.  S $P(X,$S(VALMCC:" ",1:"-"),VALM("RM")+1)=""
  1.  S COL="" F  S COL=$O(VALMDDF(COL)) Q:COL=""  S FLD=VALMDDF(COL) D
  1.  .S X=$$SETSTR^VALM1($P(FLD,U,4),X,+$P(FLD,U,2),$S($L($P(FLD,U,4))<$P(FLD,U,3):$L($P(FLD,U,4)),1:+$P(FLD,U,3)))
  1.  Q X
  1.  ;
  1. CHGCAP(FLD,LABEL) ; -- change label on caption
  1.  ; input:  FLD := name of field
  1.  ;        LABEL := text for column header
  1.  S $P(VALMDDF(FLD),U,4)=LABEL,VALMCAP=$$CAPTION
  1.  Q
  1.  ;
  1. REFRESH ; -- refresh display
  1.  S VALMPGE=$$PAGE^VALM4(VALMBG,VALM("LINES"))
  1.  S X=0 X ^%ZOSF("RM")
  1.  D HDR:$G(VALMBCK)'["P",TBAR,LIST,LBAR
  1.  S VALMBCK=""
  1.  Q
  1.  ;
  1. HDR ; -- prt/display header
  1.  N X,I
  1.  ;I '$D(VALMHDR) X:$G(VALM("HDR"))]"" VALM("HDR") ;IHS PATCH #1002
  1.  X:$G(VALM("HDR"))]"" VALM("HDR") ;IHS PATCH #1002
  1.  ; -- prt hdr line
  1.  W @IOF
  1.  W:VALMCC $C(13)_IOUON_$C(13)_IOINHI_$C(13)       ; -- turn on undln/hi
  1.  I $E(IOST,1,2)="C-" D IOXY^VALM4(0,0)            ; -- position cursor
  1.  W $E(VALM("TITLE"),1,30)                         ; -- prt title
  1.  W:VALMCC IOINORM,IOUON                           ; -- turn off hi
  1.  W $J("",30-$L(VALM("TITLE")))                    ; -- fill in w/blanks
  1.  I $E(IOST,1,2)="C-" W $C(13) D IOXY^VALM4(30,0)  ; -- position cursor
  1.  W $J("",((VALMWD-80)/2)),$$LOWER^VALM1($$NOW^VALM1),$J("",10+((VALMWD-80)/2)),"Page: ",$J(VALMPGE,4)," of ",$J($$PAGE^VALM4(VALMCNT,VALM("LINES")),4)_$S($D(VALMORE):"+",1:" ") ; -- prt rest of hdr
  1.  W:VALMCC IOUOFF I $E(IOST,1,2)="C-" D IOXY^VALM4(0,0) ; -- turn off undln
  1.  F I=1:1:VALM("TM")-3 W !,$S('$D(VALMHDR(I)):"",$L(VALMHDR(I))>(VALMWD-1):$$EXTRACT^VALM4($G(VALMHDR(I))),1:VALMHDR(I)) ; -- prt hdr
  1.  Q
  1.  ;
  1. TBAR ; -- print caption/top bar
  1.  N X
  1.  D CRT(0,VALM("TM")-3)
  1.  S VALMUP=(VALMBG>1),VALMCAP=$S(VALMUP:"+",VALMCC:" ",1:"-")_$E(VALMCAP,2,VALM("RM"))
  1.  S X=$E(VALMCAP,1,VALM("FIXED"))_$E(VALMCAP,VALMLFT,VALMLFT+VALMWD-1-VALM("FIXED"))
  1.  I VALM("TM")>2 D
  1.  .S:VALMCC X=IOUON_$C(13)_X_$C(13)_IOUOFF_$C(13)
  1.  .W !,X
  1.  Q
  1.  ;
  1. LIST ; -- list items
  1.  N I,LN,DY,DX
  1.  S DY=0
  1.  I $E(IOST,1,2)="C-" W ! S DX=0,DY=VALM("TM")-2 X IOXY
  1.  S I=VALMBG,VALMLST=I+VALM("LINES")-1 S:VALMLST>VALMCNT VALMLST=VALMCNT
  1.  F LN=1:1:VALM("LINES") D WRITE^VALM4(I,1,1,DY+LN) S I=I+1
  1.  Q
  1.  ;
  1. LBAR ; -- print low bar
  1.  N CHR,X
  1.  D CRT(0,VALM("BM")-1)
  1.  S CHR=$S(VALMCC:" ",1:"-")
  1.  K X S $P(X,CHR,VALMWD+1)=""
  1.  S X=$E(X,1,10)_$E($E($S($G(VALMSG)="":$$MSG(),1:VALMSG),1,50)_$E(X,11,75),1,65)_$E(X,76,VALMWD) K VALMSG
  1.  S VALMDN=(VALMLST<VALMCNT)
  1.  S X=$S(VALMDN:"+",1:CHR)_CHR_$S(VALMLFT>(VALM("FIXED")+1):"<<<",1:CHR_CHR_CHR)_$E(X,6,VALMWD-3)_$S((VALMLFT+(VALMWD-VALM("FIXED")))<VALM("RM"):">>>",1:CHR_CHR_CHR)
  1.  S:VALMCC X=$C(13)_IORVON_$C(13)_X_$C(13)_IORVOFF_$C(13)
  1.  W !,X
  1.  I $E(IOST,1,2)="C-" W !
  1.  Q
  1.  ;
  1. MSG() ;
  1.  Q "Enter ?? for more actions"
  1.  ;
  1. CRT(DX,DY) ;
  1.  I DX'<0,DY'<0,$E(IOST,1,2)="C-" W $C(13) D IOXY^VALM4(.DX,.DY)
  1.  Q
  1.  ;
  1. SHOW ; -- show items to user / main call back
  1.  W VALMCOFF
  1.  N DX,DY
  1.  S:'$D(VALMBG) VALMBG=1
  1.  S:'$D(VALMLFT) VALMLFT=VALM("FIXED")+1
  1.  S VALMPGE=$$PAGE^VALM4(VALMBG,VALM("LINES"))
  1.  I $G(VALMBCK)="R" D REFRESH
  1.  I $D(VALMSG) D MSG^VALM10(VALMSG) K VALMSG
  1.  I '$D(XQORM("B")),VALM("DEFS") S XQORM("B")=$S(VALMLST<VALMCNT:"Next Screen",1:"Quit")
  1.  I VALMCC D RESET^VALM4
  1.  S DX=0,DY=VALM("BM")-$S(VALM("TYPE")=2:0,1:VALMMENU) X IOXY
  1.  I VALMMENU D
  1.  .S X="?" D DISP^XQORM1
  1.  .W:VALMCC IOEDEOP
  1.  W VALMCON
  1.  D XQORM,KEYS K VALMBCK,VALMDY
  1.  Q
  1.  ;
  1. WP1(VALMREF) ; -- quick setup
  1.  S VALMCNT=+$P(@VALMREF@(0),U,4)
  1.  S VALM("ARRAY")=VALMREF
  1.  S:$D(VALMWPTL) VALM("TITLE")=VALMWPTL
  1.  Q
  1.  ;
  1. WP(VALMREF,VALMWPTL) ; -- quick entry to List Manager (c)
  1.  D EN("WP1^VALM(VALMREF)")
  1.  Q
  1.  ;
  1. XQORM ; -- set XQOR init vars
  1.  S XQORM(0)=VALM("MAX")_"AR\"
  1.  S XQORM("??")="D HELP^VALM2"
  1.  K DTOUT,DIROUT,DUOUT
  1.  Q
  1.  ;
  1. KEYS ; -- set XQOR auto-protocols
  1.  N I S I=0
  1.  F  S I=$O(VALMKEY(I)) Q:'I  S X=VALMKEY(I) S:$P(X,U,2)]"" XQORM("KEY",$P(X,U,2))=+X_"^1"
  1.  S XQORM("XLATE","LEFT")="<=1",XQORM("XLATE","RIGHT")=">=1"
  1.  S XQORM("XLATE","FIND")="SE",XQORM("XLATE","HELP")="??"
  1.  S XQORM("XLATE","DOWN")="DN",XQORM("XLATE","UP")="UP"
  1.  Q