source: WorldVistAEHR/trunk/r/LIST_MANAGER-VALM/VALM0.m@ 1064

VALM0 ;MJK/ALB - List Manager (cont.);08:19 PM  17 Jan 1993
 ;;1;List Manager;;Aug 13, 1993
 ;
INIT(NAME,PARMS) ;
 D STACK
 K VALMBCK,VALMQUIT,VALMHDR
 S VALM(0)=$G(PARMS)
 I NAME["^",'$$SETUP^VALM00(.NAME) S VALMQUIT="" G INITQ
 I NAME'["^",'$$TEMP(.NAME) S VALMQUIT="" G INITQ
 D TERM:'VALMEVL,CALC
INITQ K VALMX,X Q
 ;
TERM ; -- set up term characteristics
 D HOME^%ZIS
 S VALMWD=IOM,X=$$IO_";IOBON;IOBOFF;IOSGR0" D ENDR^%ZISS
 S VALMSGR=$S($G(IOSGR0)]"":IOSGR0,1:$G(IOINORM))
 ; -- cursor off/on to avoid bouncing
 S (VALMCON,VALMCOFF)=""
 I $E(IOST,1,4)="C-VT" S VALMCOFF=$C(13,27,91)_"?25l"_$C(13),VALMCON=$C(13,27,91)_"?25h"_$C(13)
 S X="XQORM6" X ^%ZOSF("TEST") D:$T INIT^XQORM6
 S VALMIOXY=^%ZOSF("XY")
 Q
 ;
IO() ; -- what device params
 Q "IORVON;IORVOFF;IOIL;IOSTBM;IOSC;IORC;IOEDEOP;IOINHI;IOINORM;IOUON;IOUOFF"
 ;
STACK ; -- stack vars
 I $D(VALMEVL) D
 .K ^TMP("VALM STACK",$J,VALMEVL)
 .; -- stack'em
 .I $O(^TMP("VALM STACK",$J,VALMEVL,"VALM",""))="" S X="" F  S X=$O(VALM(X)) Q:X=""  S ^(X)=VALM(X)
 .I $O(^TMP("VALM STACK",$J,VALMEVL,"OTHER VARS",""))="" F X="VALMMENU","VALMCAP","VALMAR","VALMCNT","VALMBG","VALMLST","VALMCC","VALMLFT" S ^(X)=$G(@X)
 .K VALMBG,VALM,VALMLFT
 ;
 S VALMEVL=$S($D(VALMEVL):VALMEVL+1,1:0)
 I 'VALMEVL D
 .F X="VALM DATA","VALM VIDEO","VALM VIDEO SAVE","VALMAR" K ^TMP(X,$J)
 .K VALMBG,VALM,VALMLFT
STACKQ Q
 ;
POP ; -- clean up and unstack vars
 K VALMLFT,VALMMENU,VALMCAP,VALMHDR,VALMPGE,VALMUP,VALMDN,VALMDDF,VALMCC,VALMAR,VALMCNT,VALM,VALMBG,VALMLST,LN
 K ^TMP("VALM DATA",$J,VALMEVL) D KILL^VALM10()
 ;
 ; -- final clean up
 I 'VALMEVL D  G POPQ
 .D CLEAR^VALM1
 .S X=VALMWD X ^%ZOSF("RM")
 .S Y=$$IO F I=1:1 S X=$P(Y,";",I) Q:X=""  K @X
 .K IOBON,IOBOFF,IOSGR0,VALMSGR
 .K Y,X,I,VALMEVL,VALMWD,VALMFIND,VALMIOXY,VALMKEY,VALMCON,VALMCOFF,VALMQUIT
 .S X="XQORM6" X ^%ZOSF("TEST") D:$T EXIT^XQORM6
 ;
 ; -- unstack'em
 S VALMEVL=$S(VALMEVL:VALMEVL-1,1:0)
 I $O(^TMP("VALM STACK",$J,VALMEVL,"VALM",""))]"" S X="" F  S X=$O(^(X)) Q:X=""  S VALM(X)=^(X)
 I $O(^TMP("VALM STACK",$J,VALMEVL,"OTHER VARS",""))]"" S X="" F  S X=$O(^(X)) Q:X=""  S @X=^(X)
 K ^TMP("VALM STACK",$J,VALMEVL)
 D COL^VALM
 I $G(^TMP("VALM DATA",$J,VALMEVL,"HIDDEN"))'=$P($G(VALMKEY),U,2) D KEYS^VALM00($G(^("HIDDEN")),1)
 S VALMBCK="R",(VALMUP,VALMDN)=""
POPQ Q
 ;
TEMP(NAME) ; -- use list template
 N VALM0,VALM1,NODE
 S VALM=+$O(^SD(409.61,"B",NAME,0)),VALM0=$G(^SD(409.61,VALM,0)),VALM1=$G(^(1))
 G:VALM0="" TEMPQ
 ;
 F NODE="ARRAY","HDR","EXP","HLP","INIT","FNL" S VALM(NODE)=$G(^SD(409.61,VALM,NODE))
 S VALM("IFN")=VALM D COL^VALM
 S VALM("TYPE")=$P(VALM0,U,2)
 S VALM("TM")=$P(VALM0,U,5)
 S VALM("BM")=$P(VALM0,U,6)
 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)
 S VALM("RM")=$S($P(VALM0,U,4):$P(VALM0,U,4),1:80)
 S VALMCC=+$P(VALM0,U,8)
 S VALM("ENTITY")=$P(VALM0,U,9)
 S VALM("PROTOCOL")=$P(VALM0,U,10)
 S VALM("PRT")=$P(VALM1,U)
 S VALM("TITLE")=$S($P(VALM0,U,11)]"":$P(VALM0,U,11),1:$P(VALM0,U))
 S VALM("MAX")=$S($P(VALM0,U,12):$P(VALM0,U,12),1:1)
 S VALM("DAYS")=$S($P(VALM0,U,13):$P(VALM0,U,13),1:30)
 S VALM("DEFS")=$S($P(VALM0,U,14)=0:0,1:1)
 S VALM("HIDDEN")=$P(VALM1,U,2)
 I VALM("HIDDEN")="",VALM("TYPE")=2 S VALM("HIDDEN")="VALM HIDDEN ACTIONS"
TEMPQ Q VALM0]""
 ;
CALC ; -- calculate derived parmeters
 N NODE,X,I,X,Y
 F NODE="HIDDEN","DAYS","EXP","HLP","INIT","FNL" I $G(VALM(NODE))]"" S ^TMP("VALM DATA",$J,VALMEVL,NODE)=VALM(NODE) K VALM(NODE)
 S VALMAR=$E(VALM("ARRAY"),2,50) K VALM("ARRAY")
 S:VALMAR="" VALMAR="^TMP(""VALMAR"",$J,VALMEVL)"
 S VALM("LINES")=(VALM("BM")-VALM("TM"))+1
 S:VALM("TM")<3 VALM("TITLE")=" "_VALM("TITLE")
 S:VALM("TYPE")=2 VALM("DEFS")=1
 ; -- set up protocol
 S X="VALM DISPLAY" ; default protocol
 I VALM("TYPE")=1,VALM("PROTOCOL")]"" S X=VALM("PROTOCOL")
 I VALM("TYPE")=2,$D(^TMP("VALM DATA",$J,VALMEVL,"EXP")) S X=X_" W/EXPAND"
 S VALM("PROTOCOL")=+$O(^ORD(101,"B",X,0))_";ORD(101,"
 ;
 S (VALMUP,VALMDN)=""
 I VALMCC S Y=$$IO F I=1:1 S X=$P(Y,";",I) Q:X=""  I $G(@X)="" S VALMCC=0 Q
 S VALMCAP=$$CAPTION^VALM D ATR^VALM00
 I $G(^TMP("VALM DATA",$J,VALMEVL,"HIDDEN"))'=$P($G(VALMKEY),U,2) D KEYS^VALM00($G(^("HIDDEN")),1)
 S:$G(^DISV($S($D(DUZ)#2:DUZ,1:0),"VALMMENU",VALM("PROTOCOL")))="" ^(VALM("PROTOCOL"))=1 S VALMMENU=^(VALM("PROTOCOL"))
 Q
 ;