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

SDUL.m

Go to the documentation of this file.
  1. SDUL ;MJK/ALB - List Manager; 12/1/91
  1. ;;5.3;Scheduling;;Aug 13, 1993
  1. ;
  1. EN(NAME,PARMS) ; -- main entry point
  1. ; input: NAME := free text name of list template or routine call
  1. ; PARMS := parameter list
  1. ;
  1. D INIT^SDUL0(.NAME,$G(PARMS)) G ENQ:$D(SDULQUIT)
  1. D BLD G ENQ:$D(SDULQUIT)
  1. D REFRESH,ASK
  1. X:$G(^TMP("SDUL DATA",$J,SDULEVL,"FNL"))]"" ^("FNL")
  1. ENQ D POP^SDUL0
  1. Q
  1. ;
  1. BLD ; -- build list of items
  1. I $G(^TMP("SDUL DATA",$J,SDULEVL,"INIT"))]"" X ^("INIT") G BLDQ:$D(SDULQUIT)
  1. S:'$D(SDULBG) SDULBG=1
  1. S SDULPGE=$$PAGE^SDUL4(SDULBG,SDUL("LINES"))
  1. BLDQ Q
  1. ;
  1. LIST ; -- list items
  1. S:'$D(SDULBG) SDULBG=1
  1. S SDULST=0,SDULPGE=$$PAGE^SDUL4(SDULBG,SDUL("LINES"))
  1. I $E(IOST,1,2)="C-" W ! S DX=0,DY=SDUL("TM")-2 X IOXY,^%ZOSF("XY")
  1. S I=SDULBG F LN=1:1:SDUL("LINES") S X=$G(@SDULAR@($$GET^SDUL4(I),0)) S SDULST=I W !,X S I=I+1
  1. S:SDULST>SDULCNT SDULST=SDULCNT
  1. K X S $P(X,$S(SDULCC:" ",1:"-"),SDULWD+1)=""
  1. S SDULDN=(SDULST<SDULCNT) S:SDULDN X="+"_$E(X,2,SDULWD+1)
  1. S:SDULCC X=IOUON_$C(13)_X_$C(13)_IOUOFF
  1. W !,X W:$E(IOST,1,2)="C-" !
  1. Q
  1. ;
  1. ASK ; -- prompt user
  1. I SDULCC D RESET^SDUL4
  1. S X=SDUL("PROTOCOL"),XQORM(0)=SDUL("MAX")_"A\"
  1. S:$G(^TMP("SDUL DATA",$J,SDULEVL,"HLP"))]"" XQORM("??")=^("HLP")
  1. K SDULBCK,DTOUT,DIROUT,DUOUT
  1. D EN^XQOR
  1. I $D(SDULBCK),SDULBCK'="Q" D REFRESH:SDULBCK="R" G ASK
  1. ASKQ K XQORM,DTOUT,DIROUT,DUOUT Q
  1. ;
  1. COL ;
  1. K SDULDDF
  1. S I=0 F S I=$O(^SD(409.61,SDUL("IFN"),"COL",I)) Q:'I I $D(^(I,0)) S SDULDDF($P(^(0),U))=^(0)
  1. Q
  1. ;
  1. CAPTION() ; -- set up caption line of header
  1. N X,COL,FLD
  1. S $P(X,$S(SDULCC:" ",1:"-"),SDULWD+1)=""
  1. S COL="" F S COL=$O(SDULDDF(COL)) Q:COL="" S FLD=SDULDDF(COL) D
  1. .S X=$$SETSTR^SDUL1($P(FLD,U,4),X,+$P(FLD,U,2),$S($L($P(FLD,U,4))<$P(FLD,U,3):$L($P(FLD,U,4)),1:+$P(FLD,U,3)))
  1. Q X
  1. ;
  1. CHGCAP(FLD,LABEL) ; -- change label on caption
  1. ; input: FLD := name of field
  1. ; LABEL := text for column header
  1. S $P(SDULDDF(FLD),U,4)=LABEL,SDULCAP=$$CAPTION
  1. Q
  1. ;
  1. HDR ; -- prt/display header
  1. N X,I
  1. I '$D(SDULHDR) X:$G(SDUL("HDR"))]"" SDUL("HDR")
  1. ; -- prt hdr line
  1. W @IOF
  1. W:SDULCC IOUON,IOINHI
  1. I $E(IOST,1,2)="C-" S DX=0,DY=0 X IOXY
  1. W $E(SDUL("TITLE"),1,30)
  1. W:SDULCC IOINORM,IOUON
  1. W $J("",30-$L(SDUL("TITLE")))
  1. I $E(IOST,1,2)="C-" W $C(13) S DX=30,DY=0 X IOXY
  1. W $$LOWER^SDUL1($$NOW^SDUL1)," Page: ",$J(SDULPGE,3)," of ",$J($$PAGE^SDUL4(SDULCNT,SDUL("LINES")),3)
  1. W:SDULCC IOUOFF,$C(13)
  1. ;
  1. F I=1:1:SDUL("TM")-3 W !,$G(SDULHDR(I))
  1. S SDULUP=(SDULBG>1) S SDULCAP=$S(SDULUP:"+",'SDULCC:"-",1:" ")_$E(SDULCAP,2,SDULWD)
  1. I SDUL("TM")>2 D
  1. .W:SDULCC !,IOUON,$C(13),SDULCAP,$C(13),IOUOFF
  1. .W:'SDULCC !,SDULCAP
  1. Q
  1. ;
  1. REFRESH ;
  1. S SDULPGE=$$PAGE^SDUL4(SDULBG,SDUL("LINES")) D HDR
  1. S SDULBCK="" D LIST
  1. Q
  1. ;
  1. SHOW ; -- show items to user
  1. S DX=0,DY=SDUL("BM")-SDULMENU X IOXY
  1. I SDULMENU D
  1. .S X="?" D DISP^XQORM1
  1. Q
  1. ;
  1. WP1(SDULREF) ; -- quick setup
  1. S SDULCNT=+$P(@SDULREF@(0),U,4)
  1. S SDUL("ARRAY")=SDULREF
  1. S:$D(SDULWPTL) SDUL("TITLE")=SDULWPTL
  1. Q
  1. ;
  1. WP(SDULREF,SDULWPTL) ; -- quick entry to List Manager (c)
  1. D EN("WP1^SDUL(SDULREF)")
  1. Q