source: FOIAVistA/tag/r/LIST_MANAGER-VALM/VALM0.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.2 KB
Line 
1VALM0 ;MJK/ALB - List Manager (cont.);08:19 PM 17 Jan 1993
2 ;;1;List Manager;;Aug 13, 1993
3 ;
4INIT(NAME,PARMS) ;
5 D STACK
6 K VALMBCK,VALMQUIT,VALMHDR
7 S VALM(0)=$G(PARMS)
8 I NAME["^",'$$SETUP^VALM00(.NAME) S VALMQUIT="" G INITQ
9 I NAME'["^",'$$TEMP(.NAME) S VALMQUIT="" G INITQ
10 D TERM:'VALMEVL,CALC
11INITQ K VALMX,X Q
12 ;
13TERM ; -- set up term characteristics
14 D HOME^%ZIS
15 S VALMWD=IOM,X=$$IO_";IOBON;IOBOFF;IOSGR0" D ENDR^%ZISS
16 S VALMSGR=$S($G(IOSGR0)]"":IOSGR0,1:$G(IOINORM))
17 ; -- cursor off/on to avoid bouncing
18 S (VALMCON,VALMCOFF)=""
19 I $E(IOST,1,4)="C-VT" S VALMCOFF=$C(13,27,91)_"?25l"_$C(13),VALMCON=$C(13,27,91)_"?25h"_$C(13)
20 S X="XQORM6" X ^%ZOSF("TEST") D:$T INIT^XQORM6
21 S VALMIOXY=^%ZOSF("XY")
22 Q
23 ;
24IO() ; -- what device params
25 Q "IORVON;IORVOFF;IOIL;IOSTBM;IOSC;IORC;IOEDEOP;IOINHI;IOINORM;IOUON;IOUOFF"
26 ;
27STACK ; -- stack vars
28 I $D(VALMEVL) D
29 .K ^TMP("VALM STACK",$J,VALMEVL)
30 .; -- stack'em
31 .I $O(^TMP("VALM STACK",$J,VALMEVL,"VALM",""))="" S X="" F S X=$O(VALM(X)) Q:X="" S ^(X)=VALM(X)
32 .I $O(^TMP("VALM STACK",$J,VALMEVL,"OTHER VARS",""))="" F X="VALMMENU","VALMCAP","VALMAR","VALMCNT","VALMBG","VALMLST","VALMCC","VALMLFT" S ^(X)=$G(@X)
33 .K VALMBG,VALM,VALMLFT
34 ;
35 S VALMEVL=$S($D(VALMEVL):VALMEVL+1,1:0)
36 I 'VALMEVL D
37 .F X="VALM DATA","VALM VIDEO","VALM VIDEO SAVE","VALMAR" K ^TMP(X,$J)
38 .K VALMBG,VALM,VALMLFT
39STACKQ Q
40 ;
41POP ; -- clean up and unstack vars
42 K VALMLFT,VALMMENU,VALMCAP,VALMHDR,VALMPGE,VALMUP,VALMDN,VALMDDF,VALMCC,VALMAR,VALMCNT,VALM,VALMBG,VALMLST,LN
43 K ^TMP("VALM DATA",$J,VALMEVL) D KILL^VALM10()
44 ;
45 ; -- final clean up
46 I 'VALMEVL D G POPQ
47 .D CLEAR^VALM1
48 .S X=VALMWD X ^%ZOSF("RM")
49 .S Y=$$IO F I=1:1 S X=$P(Y,";",I) Q:X="" K @X
50 .K IOBON,IOBOFF,IOSGR0,VALMSGR
51 .K Y,X,I,VALMEVL,VALMWD,VALMFIND,VALMIOXY,VALMKEY,VALMCON,VALMCOFF,VALMQUIT
52 .S X="XQORM6" X ^%ZOSF("TEST") D:$T EXIT^XQORM6
53 ;
54 ; -- unstack'em
55 S VALMEVL=$S(VALMEVL:VALMEVL-1,1:0)
56 I $O(^TMP("VALM STACK",$J,VALMEVL,"VALM",""))]"" S X="" F S X=$O(^(X)) Q:X="" S VALM(X)=^(X)
57 I $O(^TMP("VALM STACK",$J,VALMEVL,"OTHER VARS",""))]"" S X="" F S X=$O(^(X)) Q:X="" S @X=^(X)
58 K ^TMP("VALM STACK",$J,VALMEVL)
59 D COL^VALM
60 I $G(^TMP("VALM DATA",$J,VALMEVL,"HIDDEN"))'=$P($G(VALMKEY),U,2) D KEYS^VALM00($G(^("HIDDEN")),1)
61 S VALMBCK="R",(VALMUP,VALMDN)=""
62POPQ Q
63 ;
64TEMP(NAME) ; -- use list template
65 N VALM0,VALM1,NODE
66 S VALM=+$O(^SD(409.61,"B",NAME,0)),VALM0=$G(^SD(409.61,VALM,0)),VALM1=$G(^(1))
67 G:VALM0="" TEMPQ
68 ;
69 F NODE="ARRAY","HDR","EXP","HLP","INIT","FNL" S VALM(NODE)=$G(^SD(409.61,VALM,NODE))
70 S VALM("IFN")=VALM D COL^VALM
71 S VALM("TYPE")=$P(VALM0,U,2)
72 S VALM("TM")=$P(VALM0,U,5)
73 S VALM("BM")=$P(VALM0,U,6)
74 S VALM("FIXED")=$S($G(^SD(409.61,VALM("IFN"),"COL",+$O(^SD(409.61,VALM("IFN"),"COL","AIDENT",1,0)),0))]"":$P(^(0),U,2)+$P(^(0),U,3),1:0)
75 S VALM("RM")=$S($P(VALM0,U,4):$P(VALM0,U,4),1:80)
76 S VALMCC=+$P(VALM0,U,8)
77 S VALM("ENTITY")=$P(VALM0,U,9)
78 S VALM("PROTOCOL")=$P(VALM0,U,10)
79 S VALM("PRT")=$P(VALM1,U)
80 S VALM("TITLE")=$S($P(VALM0,U,11)]"":$P(VALM0,U,11),1:$P(VALM0,U))
81 S VALM("MAX")=$S($P(VALM0,U,12):$P(VALM0,U,12),1:1)
82 S VALM("DAYS")=$S($P(VALM0,U,13):$P(VALM0,U,13),1:30)
83 S VALM("DEFS")=$S($P(VALM0,U,14)=0:0,1:1)
84 S VALM("HIDDEN")=$P(VALM1,U,2)
85 I VALM("HIDDEN")="",VALM("TYPE")=2 S VALM("HIDDEN")="VALM HIDDEN ACTIONS"
86TEMPQ Q VALM0]""
87 ;
88CALC ; -- calculate derived parmeters
89 N NODE,X,I,X,Y
90 F NODE="HIDDEN","DAYS","EXP","HLP","INIT","FNL" I $G(VALM(NODE))]"" S ^TMP("VALM DATA",$J,VALMEVL,NODE)=VALM(NODE) K VALM(NODE)
91 S VALMAR=$E(VALM("ARRAY"),2,50) K VALM("ARRAY")
92 S:VALMAR="" VALMAR="^TMP(""VALMAR"",$J,VALMEVL)"
93 S VALM("LINES")=(VALM("BM")-VALM("TM"))+1
94 S:VALM("TM")<3 VALM("TITLE")=" "_VALM("TITLE")
95 S:VALM("TYPE")=2 VALM("DEFS")=1
96 ; -- set up protocol
97 S X="VALM DISPLAY" ; default protocol
98 I VALM("TYPE")=1,VALM("PROTOCOL")]"" S X=VALM("PROTOCOL")
99 I VALM("TYPE")=2,$D(^TMP("VALM DATA",$J,VALMEVL,"EXP")) S X=X_" W/EXPAND"
100 S VALM("PROTOCOL")=+$O(^ORD(101,"B",X,0))_";ORD(101,"
101 ;
102 S (VALMUP,VALMDN)=""
103 I VALMCC S Y=$$IO F I=1:1 S X=$P(Y,";",I) Q:X="" I $G(@X)="" S VALMCC=0 Q
104 S VALMCAP=$$CAPTION^VALM D ATR^VALM00
105 I $G(^TMP("VALM DATA",$J,VALMEVL,"HIDDEN"))'=$P($G(VALMKEY),U,2) D KEYS^VALM00($G(^("HIDDEN")),1)
106 S:$G(^DISV($S($D(DUZ)#2:DUZ,1:0),"VALMMENU",VALM("PROTOCOL")))="" ^(VALM("PROTOCOL"))=1 S VALMMENU=^(VALM("PROTOCOL"))
107 Q
108 ;
Note: See TracBrowser for help on using the repository browser.