source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDUL.m@ 785

Last change on this file since 785 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.9 KB
Line 
1SDUL ;MJK/ALB - List Manager; 12/1/91
2 ;;5.3;Scheduling;;Aug 13, 1993
3 ;
4EN(NAME,PARMS) ; -- main entry point
5 ; input: NAME := free text name of list template or routine call
6 ; PARMS := parameter list
7 ;
8 D INIT^SDUL0(.NAME,$G(PARMS)) G ENQ:$D(SDULQUIT)
9 D BLD G ENQ:$D(SDULQUIT)
10 D REFRESH,ASK
11 X:$G(^TMP("SDUL DATA",$J,SDULEVL,"FNL"))]"" ^("FNL")
12ENQ D POP^SDUL0
13 Q
14 ;
15BLD ; -- build list of items
16 I $G(^TMP("SDUL DATA",$J,SDULEVL,"INIT"))]"" X ^("INIT") G BLDQ:$D(SDULQUIT)
17 S:'$D(SDULBG) SDULBG=1
18 S SDULPGE=$$PAGE^SDUL4(SDULBG,SDUL("LINES"))
19BLDQ Q
20 ;
21LIST ; -- list items
22 S:'$D(SDULBG) SDULBG=1
23 S SDULST=0,SDULPGE=$$PAGE^SDUL4(SDULBG,SDUL("LINES"))
24 I $E(IOST,1,2)="C-" W ! S DX=0,DY=SDUL("TM")-2 X IOXY,^%ZOSF("XY")
25 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
26 S:SDULST>SDULCNT SDULST=SDULCNT
27 K X S $P(X,$S(SDULCC:" ",1:"-"),SDULWD+1)=""
28 S SDULDN=(SDULST<SDULCNT) S:SDULDN X="+"_$E(X,2,SDULWD+1)
29 S:SDULCC X=IOUON_$C(13)_X_$C(13)_IOUOFF
30 W !,X W:$E(IOST,1,2)="C-" !
31 Q
32 ;
33ASK ; -- prompt user
34 I SDULCC D RESET^SDUL4
35 S X=SDUL("PROTOCOL"),XQORM(0)=SDUL("MAX")_"A\"
36 S:$G(^TMP("SDUL DATA",$J,SDULEVL,"HLP"))]"" XQORM("??")=^("HLP")
37 K SDULBCK,DTOUT,DIROUT,DUOUT
38 D EN^XQOR
39 I $D(SDULBCK),SDULBCK'="Q" D REFRESH:SDULBCK="R" G ASK
40ASKQ K XQORM,DTOUT,DIROUT,DUOUT Q
41 ;
42COL ;
43 K SDULDDF
44 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)
45 Q
46 ;
47CAPTION() ; -- set up caption line of header
48 N X,COL,FLD
49 S $P(X,$S(SDULCC:" ",1:"-"),SDULWD+1)=""
50 S COL="" F S COL=$O(SDULDDF(COL)) Q:COL="" S FLD=SDULDDF(COL) D
51 .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)))
52 Q X
53 ;
54CHGCAP(FLD,LABEL) ; -- change label on caption
55 ; input: FLD := name of field
56 ; LABEL := text for column header
57 S $P(SDULDDF(FLD),U,4)=LABEL,SDULCAP=$$CAPTION
58 Q
59 ;
60HDR ; -- prt/display header
61 N X,I
62 I '$D(SDULHDR) X:$G(SDUL("HDR"))]"" SDUL("HDR")
63 ; -- prt hdr line
64 W @IOF
65 W:SDULCC IOUON,IOINHI
66 I $E(IOST,1,2)="C-" S DX=0,DY=0 X IOXY
67 W $E(SDUL("TITLE"),1,30)
68 W:SDULCC IOINORM,IOUON
69 W $J("",30-$L(SDUL("TITLE")))
70 I $E(IOST,1,2)="C-" W $C(13) S DX=30,DY=0 X IOXY
71 W $$LOWER^SDUL1($$NOW^SDUL1)," Page: ",$J(SDULPGE,3)," of ",$J($$PAGE^SDUL4(SDULCNT,SDUL("LINES")),3)
72 W:SDULCC IOUOFF,$C(13)
73 ;
74 F I=1:1:SDUL("TM")-3 W !,$G(SDULHDR(I))
75 S SDULUP=(SDULBG>1) S SDULCAP=$S(SDULUP:"+",'SDULCC:"-",1:" ")_$E(SDULCAP,2,SDULWD)
76 I SDUL("TM")>2 D
77 .W:SDULCC !,IOUON,$C(13),SDULCAP,$C(13),IOUOFF
78 .W:'SDULCC !,SDULCAP
79 Q
80 ;
81REFRESH ;
82 S SDULPGE=$$PAGE^SDUL4(SDULBG,SDUL("LINES")) D HDR
83 S SDULBCK="" D LIST
84 Q
85 ;
86SHOW ; -- show items to user
87 S DX=0,DY=SDUL("BM")-SDULMENU X IOXY
88 I SDULMENU D
89 .S X="?" D DISP^XQORM1
90 Q
91 ;
92WP1(SDULREF) ; -- quick setup
93 S SDULCNT=+$P(@SDULREF@(0),U,4)
94 S SDUL("ARRAY")=SDULREF
95 S:$D(SDULWPTL) SDUL("TITLE")=SDULWPTL
96 Q
97 ;
98WP(SDULREF,SDULWPTL) ; -- quick entry to List Manager (c)
99 D EN("WP1^SDUL(SDULREF)")
100 Q
Note: See TracBrowser for help on using the repository browser.