ROUTINE VALM*1,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 = VALM * * 126 LINES,  4861 BYTES,  RSUM: 8475059/24200749   Page 1 UCI: EHR,EHR   Site: Example Hospital MAY 11,2015@12:37

^VALM
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

VALM^VALM
1 VALM  ;MJK/ALB - List Manager ;05/13/2003  12:09 2 +1    ;;1.0;List Manager;**1,5,6,7**;Aug 13, 1993

CALLS

 * INIT^VALM0 ASK^VALM

GLOBALS

 * ^TMP("VALM DATA",$J,:,"INIT")
 * ^TMP("VALM DATA",$J,:,"FNL")

CODE
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")

ENQ^VALM
13 ENQ   D POP^VALM0 14 +1    Q

ASK^VALM
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

COL^VALM
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

CAPTION^VALM
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

CHGCAP^VALM
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

REFRESH^VALM
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

HDR^VALM
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

TBAR^VALM
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

LIST^VALM
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

LBAR^VALM
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(VALM("FIXED")+1):"<<<",1:CHR_CHR_CHR)_$E(X,6,VALMWD-3)_$S((VALMLFT+(VALMWD-VALM            ("FIXED")))>>",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

MSG^VALM
85 MSG ; 86 +1    Q "Enter ?? for more actions"

CRT^VALM
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

SHOW^VALM
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

WP1^VALM
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

WP^VALM
112 WP(VALMREF,VALMWPTL) -- ; -- quick entry to List Manager (c) 113 +1    D EN("WP1^VALM(VALMREF)") 114 +2    Q

XQORM^VALM
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

KEYS^VALM
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