| 1 | SDUL ;MJK/ALB - List Manager; 12/1/91
|
|---|
| 2 | ;;5.3;Scheduling;;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | EN(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")
|
|---|
| 12 | ENQ D POP^SDUL0
|
|---|
| 13 | Q
|
|---|
| 14 | ;
|
|---|
| 15 | BLD ; -- 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"))
|
|---|
| 19 | BLDQ Q
|
|---|
| 20 | ;
|
|---|
| 21 | LIST ; -- 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 | ;
|
|---|
| 33 | ASK ; -- 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
|
|---|
| 40 | ASKQ K XQORM,DTOUT,DIROUT,DUOUT Q
|
|---|
| 41 | ;
|
|---|
| 42 | COL ;
|
|---|
| 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 | ;
|
|---|
| 47 | CAPTION() ; -- 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 | ;
|
|---|
| 54 | CHGCAP(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 | ;
|
|---|
| 60 | HDR ; -- 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 | ;
|
|---|
| 81 | REFRESH ;
|
|---|
| 82 | S SDULPGE=$$PAGE^SDUL4(SDULBG,SDUL("LINES")) D HDR
|
|---|
| 83 | S SDULBCK="" D LIST
|
|---|
| 84 | Q
|
|---|
| 85 | ;
|
|---|
| 86 | SHOW ; -- 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 | ;
|
|---|
| 92 | WP1(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 | ;
|
|---|
| 98 | WP(SDULREF,SDULWPTL) ; -- quick entry to List Manager (c)
|
|---|
| 99 | D EN("WP1^SDUL(SDULREF)")
|
|---|
| 100 | Q
|
|---|
