96 lines
3.4 KiB
Mathematica
96 lines
3.4 KiB
Mathematica
SDUL0 ;MJK/ALB - List Manager (cont.); 12/1/91
|
|
;;5.3;Scheduling;;Aug 13, 1993
|
|
;
|
|
INIT(NAME,PARMS) ;
|
|
D STACK
|
|
K SDULBCK,SDULQUIT,SDULHDR
|
|
S SDUL(0)=$G(PARMS)
|
|
I NAME["^",'$$SETUP(.NAME) S SDULQUIT="" G INITQ
|
|
I NAME'["^",'$$TEMP(.NAME) S SDULQUIT="" G INITQ
|
|
D TERM:'SDULEVL,CALC
|
|
INITQ K SDX,X Q
|
|
;
|
|
TERM ; -- set up term characteristics
|
|
I '$D(IOST(0)) D HOME^%ZIS
|
|
S SDULWD=IOM,X=$$IO D ENDR^%ZISS
|
|
Q
|
|
;
|
|
IO() ; -- what device params
|
|
Q "IORVON;IORVOFF;IOIL;IOSTBM;IOSC;IORC;IOEDEOP;IOINHI;IOINORM;IOUON;IOUOFF"
|
|
;
|
|
STACK ; -- stack vars
|
|
S SDULEVL=$S($D(SDULEVL):SDULEVL+1,1:0)
|
|
I 'SDULEVL K SDUL,^TMP("SDUL DATA",$J,SDULEVL) G STACKQ
|
|
;
|
|
; -- stack'em
|
|
K ^TMP("SDUL STACK",$J,SDULEVL)
|
|
I $O(^TMP("SDUL STACK",$J,SDULEVL,"SDUL",""))="" S X="" F S X=$O(SDUL(X)) Q:X="" S ^(X)=SDUL(X)
|
|
I $O(^TMP("SDUL STACK",$J,SDULEVL,"OTHER VARS",""))="" F X="SDULMENU","SDULCAP","SDULAR","SDULCNT","SDULBG","SDULST","SDULCC" S ^(X)=$G(@X)
|
|
K SDULBG,SDUL
|
|
STACKQ Q
|
|
;
|
|
POP ; -- clean up and unstack vars
|
|
K SDULMENU,SDULCAP,SDULHDR,SDULPGE,SDULUP,SDULDN,SDULDDF,SDULCC,SDULAR,SDULCNT,SDUL,SDULBG,SDULST,LN,^TMP("SDUL DATA",$J,SDULEVL)
|
|
I 'SDULEVL D G POPQ
|
|
.D CLEAR^SDUL1
|
|
.S Y=$$IO F I=1:1 S X=$P(Y,";",I) Q:X="" K @X
|
|
.K Y,X,I,SDULEVL,SDULWD,SDULFIND
|
|
;
|
|
; -- unstack'em
|
|
I $O(^TMP("SDUL STACK",$J,SDULEVL,"SDUL",""))]"" S X="" F S X=$O(^(X)) Q:X="" S SDUL(X)=^(X)
|
|
I $O(^TMP("SDUL STACK",$J,SDULEVL,"OTHER VARS",""))]"" S X="" F S X=$O(^(X)) Q:X="" S @X=^(X)
|
|
K ^TMP("SDUL STACK",$J,SDULEVL)
|
|
D COL^SDUL
|
|
S SDULEVL=$S(SDULEVL:SDULEVL-1,1:0),SDULBCK="R",(SDULUP,SDULDN)=""
|
|
POPQ Q
|
|
;
|
|
SETUP(NAME) ; -- on-the-fly list
|
|
D @NAME
|
|
S Y=1 F X="ARRAY" I '$D(SDUL(X)) S Y=0 G SETUPQ
|
|
I $E(SDUL("ARRAY"))'="" S SDUL("ARRAY")=" "_SDUL("ARRAY")
|
|
S SDUL("IFN")=0
|
|
S:'$D(SDUL("TM")) SDUL("TM")=$S('$D(SDUL("HDR")):2,1:5)
|
|
S:'$D(SDUL("BM")) SDUL("BM")=$S('$D(SDUL("HDR")):16,1:14)
|
|
S:'$D(SDUL("TYPE")) SDUL("TYPE")=2 ; def to display
|
|
S:'$D(SDUL("TITLE")) SDUL("TITLE")="Standard List Display"
|
|
I '$G(SDUL("MAX")) S SDUL("MAX")=1
|
|
S:'$D(SDULCC) SDULCC=1
|
|
SETUPQ Q Y
|
|
;
|
|
TEMP(NAME) ; -- use list template
|
|
N SDUL0,NODE
|
|
S SDUL=+$O(^SD(409.61,"B",NAME,0)),SDUL0=$G(^SD(409.61,SDUL,0))
|
|
G:SDUL0="" TEMPQ
|
|
;
|
|
F NODE="ARRAY","HDR","EXP","HLP","INIT","FNL" S SDUL(NODE)=$G(^SD(409.61,SDUL,NODE))
|
|
S SDUL("IFN")=SDUL D COL^SDUL
|
|
S SDUL("TYPE")=$P(SDUL0,U,2)
|
|
S SDUL("TM")=$P(SDUL0,U,5)
|
|
S SDUL("BM")=$P(SDUL0,U,6)
|
|
S SDULCC=+$P(SDUL0,U,8)
|
|
S SDUL("ENTITY")=$P(SDUL0,U,9)
|
|
S SDUL("PROTOCOL")=$P(SDUL0,U,10)
|
|
S SDUL("TITLE")=$S($P(SDUL0,U,11)]"":$P(SDUL0,U,11),1:$P(SDUL0,U))
|
|
S SDUL("MAX")=$S($P(SDUL0,U,12):$P(SDUL0,U,12),1:1)
|
|
S SDUL("DAYS")=$S($P(SDUL0,U,13):$P(SDUL0,U,13),1:30)
|
|
TEMPQ Q SDUL0]""
|
|
;
|
|
CALC ; -- calculate derived parmeters
|
|
N NODE,X,I,X,Y
|
|
F NODE="DAYS","EXP","HLP","INIT","FNL" I $G(SDUL(NODE))]"" S ^TMP("SDUL DATA",$J,SDULEVL,NODE)=SDUL(NODE) K SDUL(NODE)
|
|
S SDULAR=$E(SDUL("ARRAY"),2,50) K SDUL("ARRAY")
|
|
S SDUL("LINES")=(SDUL("BM")-SDUL("TM"))+1
|
|
S:SDUL("TM")<3 SDUL("TITLE")=" "_SDUL("TITLE")
|
|
; -- set up protocol
|
|
S X="SDUL DISPLAY" ; default protocol
|
|
I SDUL("TYPE")=1,SDUL("PROTOCOL")]"" S X=SDUL("PROTOCOL")
|
|
I SDUL("TYPE")=2,$D(^TMP("SDUL DATA",$J,SDULEVL,"EXP")) S X=X_" W/EXPAND"
|
|
S SDUL("PROTOCOL")=+$O(^ORD(101,"B",X,0))_";ORD(101,"
|
|
;
|
|
S (SDULUP,SDULDN)=""
|
|
I SDULCC S Y=$$IO F I=1:1 S X=$P(Y,";",I) Q:X="" I $G(@X)="" S SDULCC=0 Q
|
|
S SDULCAP=$$CAPTION^SDUL
|
|
S:$G(^DISV($S($D(DUZ)#2:DUZ,1:0),"SDULMENU",SDUL("PROTOCOL")))="" ^(SDUL("PROTOCOL"))=1 S SDULMENU=^(SDUL("PROTOCOL"))
|
|
Q
|
|
;
|