source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDUL0.m@ 1590

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

initial load of FOIAVistA 6/30/08 version

File size: 3.4 KB
Line 
1SDUL0 ;MJK/ALB - List Manager (cont.); 12/1/91
2 ;;5.3;Scheduling;;Aug 13, 1993
3 ;
4INIT(NAME,PARMS) ;
5 D STACK
6 K SDULBCK,SDULQUIT,SDULHDR
7 S SDUL(0)=$G(PARMS)
8 I NAME["^",'$$SETUP(.NAME) S SDULQUIT="" G INITQ
9 I NAME'["^",'$$TEMP(.NAME) S SDULQUIT="" G INITQ
10 D TERM:'SDULEVL,CALC
11INITQ K SDX,X Q
12 ;
13TERM ; -- set up term characteristics
14 I '$D(IOST(0)) D HOME^%ZIS
15 S SDULWD=IOM,X=$$IO D ENDR^%ZISS
16 Q
17 ;
18IO() ; -- what device params
19 Q "IORVON;IORVOFF;IOIL;IOSTBM;IOSC;IORC;IOEDEOP;IOINHI;IOINORM;IOUON;IOUOFF"
20 ;
21STACK ; -- stack vars
22 S SDULEVL=$S($D(SDULEVL):SDULEVL+1,1:0)
23 I 'SDULEVL K SDUL,^TMP("SDUL DATA",$J,SDULEVL) G STACKQ
24 ;
25 ; -- stack'em
26 K ^TMP("SDUL STACK",$J,SDULEVL)
27 I $O(^TMP("SDUL STACK",$J,SDULEVL,"SDUL",""))="" S X="" F S X=$O(SDUL(X)) Q:X="" S ^(X)=SDUL(X)
28 I $O(^TMP("SDUL STACK",$J,SDULEVL,"OTHER VARS",""))="" F X="SDULMENU","SDULCAP","SDULAR","SDULCNT","SDULBG","SDULST","SDULCC" S ^(X)=$G(@X)
29 K SDULBG,SDUL
30STACKQ Q
31 ;
32POP ; -- clean up and unstack vars
33 K SDULMENU,SDULCAP,SDULHDR,SDULPGE,SDULUP,SDULDN,SDULDDF,SDULCC,SDULAR,SDULCNT,SDUL,SDULBG,SDULST,LN,^TMP("SDUL DATA",$J,SDULEVL)
34 I 'SDULEVL D G POPQ
35 .D CLEAR^SDUL1
36 .S Y=$$IO F I=1:1 S X=$P(Y,";",I) Q:X="" K @X
37 .K Y,X,I,SDULEVL,SDULWD,SDULFIND
38 ;
39 ; -- unstack'em
40 I $O(^TMP("SDUL STACK",$J,SDULEVL,"SDUL",""))]"" S X="" F S X=$O(^(X)) Q:X="" S SDUL(X)=^(X)
41 I $O(^TMP("SDUL STACK",$J,SDULEVL,"OTHER VARS",""))]"" S X="" F S X=$O(^(X)) Q:X="" S @X=^(X)
42 K ^TMP("SDUL STACK",$J,SDULEVL)
43 D COL^SDUL
44 S SDULEVL=$S(SDULEVL:SDULEVL-1,1:0),SDULBCK="R",(SDULUP,SDULDN)=""
45POPQ Q
46 ;
47SETUP(NAME) ; -- on-the-fly list
48 D @NAME
49 S Y=1 F X="ARRAY" I '$D(SDUL(X)) S Y=0 G SETUPQ
50 I $E(SDUL("ARRAY"))'="" S SDUL("ARRAY")=" "_SDUL("ARRAY")
51 S SDUL("IFN")=0
52 S:'$D(SDUL("TM")) SDUL("TM")=$S('$D(SDUL("HDR")):2,1:5)
53 S:'$D(SDUL("BM")) SDUL("BM")=$S('$D(SDUL("HDR")):16,1:14)
54 S:'$D(SDUL("TYPE")) SDUL("TYPE")=2 ; def to display
55 S:'$D(SDUL("TITLE")) SDUL("TITLE")="Standard List Display"
56 I '$G(SDUL("MAX")) S SDUL("MAX")=1
57 S:'$D(SDULCC) SDULCC=1
58SETUPQ Q Y
59 ;
60TEMP(NAME) ; -- use list template
61 N SDUL0,NODE
62 S SDUL=+$O(^SD(409.61,"B",NAME,0)),SDUL0=$G(^SD(409.61,SDUL,0))
63 G:SDUL0="" TEMPQ
64 ;
65 F NODE="ARRAY","HDR","EXP","HLP","INIT","FNL" S SDUL(NODE)=$G(^SD(409.61,SDUL,NODE))
66 S SDUL("IFN")=SDUL D COL^SDUL
67 S SDUL("TYPE")=$P(SDUL0,U,2)
68 S SDUL("TM")=$P(SDUL0,U,5)
69 S SDUL("BM")=$P(SDUL0,U,6)
70 S SDULCC=+$P(SDUL0,U,8)
71 S SDUL("ENTITY")=$P(SDUL0,U,9)
72 S SDUL("PROTOCOL")=$P(SDUL0,U,10)
73 S SDUL("TITLE")=$S($P(SDUL0,U,11)]"":$P(SDUL0,U,11),1:$P(SDUL0,U))
74 S SDUL("MAX")=$S($P(SDUL0,U,12):$P(SDUL0,U,12),1:1)
75 S SDUL("DAYS")=$S($P(SDUL0,U,13):$P(SDUL0,U,13),1:30)
76TEMPQ Q SDUL0]""
77 ;
78CALC ; -- calculate derived parmeters
79 N NODE,X,I,X,Y
80 F NODE="DAYS","EXP","HLP","INIT","FNL" I $G(SDUL(NODE))]"" S ^TMP("SDUL DATA",$J,SDULEVL,NODE)=SDUL(NODE) K SDUL(NODE)
81 S SDULAR=$E(SDUL("ARRAY"),2,50) K SDUL("ARRAY")
82 S SDUL("LINES")=(SDUL("BM")-SDUL("TM"))+1
83 S:SDUL("TM")<3 SDUL("TITLE")=" "_SDUL("TITLE")
84 ; -- set up protocol
85 S X="SDUL DISPLAY" ; default protocol
86 I SDUL("TYPE")=1,SDUL("PROTOCOL")]"" S X=SDUL("PROTOCOL")
87 I SDUL("TYPE")=2,$D(^TMP("SDUL DATA",$J,SDULEVL,"EXP")) S X=X_" W/EXPAND"
88 S SDUL("PROTOCOL")=+$O(^ORD(101,"B",X,0))_";ORD(101,"
89 ;
90 S (SDULUP,SDULDN)=""
91 I SDULCC S Y=$$IO F I=1:1 S X=$P(Y,";",I) Q:X="" I $G(@X)="" S SDULCC=0 Q
92 S SDULCAP=$$CAPTION^SDUL
93 S:$G(^DISV($S($D(DUZ)#2:DUZ,1:0),"SDULMENU",SDUL("PROTOCOL")))="" ^(SDUL("PROTOCOL"))=1 S SDULMENU=^(SDUL("PROTOCOL"))
94 Q
95 ;
Note: See TracBrowser for help on using the repository browser.