Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VALM0

VALM0.m

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