View source for ROUTINE VALM1,5,6,7

= FileMan Inquiry to ROUTINE FILE for entry VALM =
 NUMBER: 3872                            NAME: VALM
  TYPE: ROUTINE                         KIDS INSTALL DATE: MAY 20,2003@16:17:28
  SIZE (BYTES) (c): 4861

= ZTPP LISTING =
<pre>
VALM * *  126 LINES,  4861 BYTES,  RSUM: 8475059/24200749   Page 1
        UCI: EHR,EHR    Site: Central Regional Hospital MAY 11,2015@12:37
</pre>
== ^VALM ==
<pre>
  1 VALM   ;MJK/ALB - List Manager ;05/13/2003  12:09
  2 +1     ;;1.0;List Manager;**1,5,6,7**;Aug 13, 1993
VALM * *  126 LINES,  4861 BYTES,  RSUM: 8475059/24200749   Page 1
        UCI: EHR,EHR    Site: Example Hospital MAY 11,2015@12:37
</pre>
== VALM^VALM ==
<pre>
  1 VALM   ;MJK/ALB - List Manager ;05/13/2003  12:09
  2 +1     ;;1.0;List Manager;**1,5,6,7**;Aug 13, 1993
</pre>

== EN^VALM ==
=== CALLS ===
* [[ROUTINE VALM0|INIT^VALM0]] [[ROUTINE VALM#ASK| ASK^VALM]]
=== GLOBALS ===
* ^TMP("VALM DATA",$J,:,"INIT")
* ^TMP("VALM DATA",$J,:,"FNL")
=== CODE ===
<pre>
  3 EN(NAME,PARMS) --
            ; -- main entry point
  4 +1     ;  input:   NAME := free text name of list template or routine call
  5 +2     ;          PARMS := parameter list
  6 +3     I $G(PARMS)["T" K VALMEVL ; kill if 'T'op level
  7 +4     D INIT^VALM0(.NAME,$G(PARMS)) G ENQ:$D(VALMQUIT)
  8 +5     ; -- build list of items
  9 +6     I $G(^TMP("VALM DATA",$J,VALMEVL,"INIT"))]"" X ^("INIT") G ENQ:$D(VALMQUIT)
 10 +7     ; -- start event loop
 11 +8     S VALMBCK="R" D ASK
 12 +9     X:$G(^TMP("VALM DATA",$J,VALMEVL,"FNL"))]"" ^("FNL")
</pre>

== ENQ^VALM ==
<pre>
 13 ENQ    D POP^VALM0
 14 +1     Q
</pre>
== ASK^VALM ==
<pre>
 15 ASK    ; -- event loop
 16 +1     S X=VALM("PROTOCOL") D XQORM,EN^XQOR
 17 +2     I $D(VALMBCK),VALMBCK'="Q" G ASK
 18 +3     K XQORM,DTOUT,DIROUT,DUOUT
 19 +4     Q
</pre>
== COL^VALM ==
<pre>
 20 COL    ; -- set up column dd array
 21 +1     K VALMDDF
 22 +2     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)
 23 +3     Q
</pre>
== CAPTION^VALM ==
<pre>
 24 CAPTION() --
            ; -- set up caption line of header
 25 +1     N X,COL,FLD,CHR
 26 +2     S CHR=$S(VALMCC:" ",1:"-")
 27 +3     S $P(X,CHR,VALM("RM")+1)=""
 28 +4     S COL="" F  S COL=$O(VALMDDF(COL)) Q:COL=""  S FLD=VALMDDF(COL) D
 29 +5     . 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)))
 30 +6     Q X
</pre>
== CHGCAP^VALM ==
<pre>
 31 CHGCAP(FLD,LABEL) --
            ; -- change label on caption
 32 +1     ; input:  FLD := name of field
 33 +2     ;        LABEL := text for column header
 34 +3     S $P(VALMDDF(FLD),U,4)=LABEL,VALMCAP=$$CAPTION
 35 +4     Q
</pre>
== REFRESH^VALM ==
<pre>
 36 REFRESH ; -- refresh display
 37 +1     S VALMPGE=$$PAGE^VALM4(VALMBG,VALM("LINES"))
 38 +2     S X=0 X ^%ZOSF("RM")
 39 +3     D HDR:$G(VALMBCK)'["P",TBAR,LIST,LBAR
 40 +4     S VALMBCK=""
 41 +5     Q
</pre>
== HDR^VALM ==
<pre>
 42 HDR    ; -- prt/display header
 43 +1     N X,I
 44 +2     I '$D(VALMHDR) X:$G(VALM("HDR"))]"" VALM("HDR")
 45 +3     ; -- prt hdr line
 46 +4     W:'$D(VALMPG1) @IOF K VALMPG1
 47 +5     W:VALMCC $C(13)_IOUON_$C(13)_IOINHI_$C(13)       ; -- turn on undln/hi
 48 +6     I $E(IOST,1,2)="C-" D IOXY^VALM4(0,0)            ; -- position cursor
 49 +7     W $E(VALM("TITLE"),1,30)                         ; -- prt title
 50 +8     W:VALMCC IOINORM,IOUON                           ; -- turn off hi
 51 +9     W $J("",30-$L(VALM("TITLE")))                    ; -- fill in w/blanks
 52 +10    I $E(IOST,1,2)="C-" W $C(13) D IOXY^VALM4(30,0)  ; -- position cursor
 53 +11    W $J("",((VALMWD-80)/2)),$$HTE^XLFDT($H,1),$J("",10+((VALMWD-80)/2)),"Page: ",$J(VALMPGE,4)," of ",$J($$PAGE^VALM4(VALMC
            NT,VALM("LINES")),4)_$S($D(VALMORE):"+",1:" ") ; -- prt rest of hdr
 54 +12    W:VALMCC IOUOFF I $E(IOST,1,2)="C-" D IOXY^VALM4(0,0) ; -- turn off undln
 55 +13    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
 56 +14    Q
</pre>
== TBAR^VALM ==
<pre>
 57 TBAR   ; -- print caption/top bar
 58 +1     N X
 59 +2     D CRT(0,VALM("TM")-3)
 60 +3     S VALMUP=(VALMBG>1),VALMCAP=$S(VALMUP:"+",VALMCC:" ",1:"-")_$E(VALMCAP,2,VALM("RM"))
 61 +4     S X=$E(VALMCAP,1,VALM("FIXED"))_$E(VALMCAP,VALMLFT,VALMLFT+VALMWD-1-VALM("FIXED"))
 62 +5     I VALM("TM")>2 D
 63 +6     . S:VALMCC X=IOUON_$C(13)_X_$C(13)_IOUOFF_$C(13)
 64 +7     . W !,X
 65 +8     Q
</pre>
== LIST^VALM ==
<pre>
 66 LIST   ; -- list items
 67 +1     N I,LN,DY,DX
 68 +2     S DY=0
 69 +3     I $E(IOST,1,2)="C-" W ! S DX=0,DY=VALM("TM")-2 X IOXY
 70 +4     S I=VALMBG,VALMLST=I+VALM("LINES")-1 S:VALMLST>VALMCNT VALMLST=VALMCNT
 71 +5     F LN=1:1:VALM("LINES") D WRITE^VALM4(I,1,1,DY+LN) S I=I+1
 72 +6     Q
</pre>
== LBAR^VALM ==
<pre>
 73 LBAR   ; -- print low bar
 74 +1     N CHR,X
 75 +2     D CRT(0,VALM("BM")-1)
 76 +3     S CHR=$S(VALMCC:" ",1:"-")
 77 +4     K X S $P(X,CHR,VALMWD+1)=""
 78 +5     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
 79 +6     S VALMDN=(VALMLST<VALMCNT)
 80 +7     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)
 81 +8     S:VALMCC X=$C(13)_IORVON_$C(13)_X_$C(13)_IORVOFF_$C(13)
 82 +9     W !,X
 83 +10    I $E(IOST,1,2)="C-" W !
 84 +11    Q
</pre>
== MSG^VALM ==
<pre>
 85 MSG()  ;
 86 +1     Q "Enter ?? for more actions"
</pre>
== CRT^VALM ==
<pre>
 87 CRT(DX,DY) --
            ;
 88 +1     I DX'<0,DY'<0,$E(IOST,1,2)="C-" W $C(13) D IOXY^VALM4(.DX,.DY)
 89 +2     Q
</pre>
== SHOW^VALM ==
<pre>
 90 SHOW   ; -- show items to user / main call back
 91 +1     W VALMCOFF
 92 +2     N DX,DY
 93 +3     S:'$D(VALMBG) VALMBG=1
 94 +4     S:'$D(VALMLFT) VALMLFT=VALM("FIXED")+1
 95 +5     S VALMPGE=$$PAGE^VALM4(VALMBG,VALM("LINES"))
 96 +6     I $G(VALMBCK)="R" D REFRESH
 97 +7     I $D(VALMSG) D MSG^VALM10(VALMSG) K VALMSG
 98 +8     I '$D(XQORM("B")),VALM("DEFS") S XQORM("B")=$S(VALMLST<VALMCNT:"Next Screen",1:"Quit")
 99 +9     I VALMCC D RESET^VALM4
100 +10    S DX=0,DY=VALM("BM")-$S(VALM("TYPE")=2:0,1:VALMMENU) X IOXY
101 +11    I VALMMENU D
102 +12    . S X="?" D DISP^XQORM1
103 +13    . W:VALMCC IOEDEOP
104 +14    W VALMCON
105 +15    D XQORM,KEYS K VALMBCK,VALMDY
106 +16    Q
</pre>
== WP1^VALM ==
<pre>
107 WP1(VALMREF) --
            ; -- quick setup
108 +1     S VALMCNT=+$P(@VALMREF@(0),U,4)
109 +2     S VALM("ARRAY")=VALMREF
110 +3     S:$D(VALMWPTL) VALM("TITLE")=VALMWPTL
111 +4     Q
</pre>
== WP^VALM ==
<pre>
112 WP(VALMREF,VALMWPTL) --
            ; -- quick entry to List Manager (c)
113 +1     D EN("WP1^VALM(VALMREF)")
114 +2     Q
</pre>
== XQORM^VALM ==
<pre>
115 XQORM  ; -- set XQOR init vars
116 +1     S XQORM(0)=VALM("MAX")_"AR\"
117 +2     S XQORM("??")="D HELP^VALM2"
118 +3     K DTOUT,DIROUT,DUOUT
119 +4     Q
</pre>
== KEYS^VALM ==
<pre>
120 KEYS   ; -- set XQOR auto-protocols
121 +1     N I S I=0
122 +2     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"
123 +3     S XQORM("XLATE","LEFT")="<=1",XQORM("XLATE","RIGHT")=">=1"
124 +4     S XQORM("XLATE","FIND")="SE",XQORM("XLATE","HELP")="??"
125 +5     S XQORM("XLATE","DOWN")="DN",XQORM("XLATE","UP")="UP"
126 +6     Q
</pre>