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

SDUL0.m

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