source: WorldVistAEHR/trunk/r/ENGINEERING-EN/ENPLS2.m@ 1800

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

revised back to 6/30/08 version

File size: 3.1 KB
RevLine 
[623]1ENPLS2 ;WISC/SAB - Select Items from List ;7/21/95
2 ;;7.0;ENGINEERING;**23**;Aug 17, 1993
3EN ; entry point
4 ; input global
5 ; ^TMP($J,"SCR)=number of entries in list^screen title
6 ; ^TMP($J,"SCR",0)=col 1 x pos;col 1 hdr^...^col n x pos;col n hdr
7 ; ^TMP($J,"SCR",id)=col 1 value^col 2 value^...^col n value
8 ; output
9 ; optional ENACL( selected items
10 ;
11 ; initialize variables
12 N ENI,ENID,ENF,ENI,ENS,ENX,ENY
13 K ENACL
14 S $P(ENF("DASH"),"-",80)=""
15 ; get screen info
16 S ENX=^TMP($J,"SCR")
17 S ENF("IDM")=$P(ENX,U)
18 S ENF("HD")=$P(ENX,U,2)
19 ; get column info
20 S ENX=^TMP($J,"SCR",0),ENF("CM")=0
21 F ENI=1:1 S ENY=$P(ENX,U,ENI) Q:ENY="" D
22 . S ENF("CM")=ENF("CM")+1
23 . S ENF("C"_ENI,"X")=$P(ENY,";",1)
24 . S ENF("C"_ENI,"L")=$P(ENY,";",2)
25 . S ENF("C"_ENI,"HD")=$P(ENY,";",3)
26 S ENF("SM")=(ENF("IDM")-1)\15+1
27 S ENF("S")=1
28BLD ; build screen
29 K ENS
30 S ENS("IDL")=1+(ENF("S")-1*15)
31 S ENS("IDM")=$S(15+(ENF("S")-1*15)>ENF("IDM"):ENF("IDM"),1:15+(ENF("S")-1*15))
32 ; display screen
33 D SHD
34 F ENID=ENS("IDL"):1:ENS("IDM") D W !
35 . S ENX=^TMP($J,"SCR",ENID)
36 . W $J(ENID,3)
37 . F ENI=1:1:ENF("CM") W ?ENF("C"_ENI,"X"),$P(ENX,U,ENI)
38ACT ; prompt for selection
39 W !
40 S DIR("A")="Enter a list or range to select (1-"_ENF("IDM")_"): "_$S(ENF("S")<ENF("SM"):"Next Screen",1:"Quit")_"//"
41 S DIR(0)="LOA^1:"_ENF("IDM")
42 D ^DIR K DIR G:$D(DTOUT)!$D(DUOUT) EXIT
43 I X="",ENF("S")<ENF("SM") S ENF("S")=ENF("S")+1 G BLD
44 K ENACL S ENI="" F S ENI=$O(Y(ENI)) Q:ENI="" S ENACL(ENI)=Y(ENI)
45EXIT ;
46 W @IOF
47 K DX,DY
48 Q
49SHD ; Screen Header
50 W @IOF
51 W ENF("HD"),?65,"Screen ",ENF("S")," of ",ENF("SM"),!!
52 W "ID#"
53 F ENI=1:1:ENF("CM") W ?ENF("C"_ENI,"X"),ENF("C"_ENI,"HD")
54 W !
55 W "---"
56 F ENI=1:1:ENF("CM") W ?ENF("C"_ENI,"X"),$E(ENF("DASH"),1,ENF("C"_ENI,"L"))
57 W !
58 Q
59PYLIST ; Progam and Year list of project applications
60 N ENACL,ENC,ENDA,ENI,ENIDX,ENJ,ENK,ENPN,ENPR,ENY,ENY0,ENYR
61 K ^TMP($J,"R")
62 S DIR(0)="S^MA:MAJOR;MI:MINOR;MM:MINOR MISC;NR:NRM"
63 S DIR("?")="Enter program that listed projects must match."
64 D ^DIR K DIR Q:$D(DIRUT)
65 S ENPR=Y
66 S DIR(0)="N^1993:2099:0",DIR("A")="YEAR"
67 S DIR("?",1)="Enter a 4-digit year that listed projects must have as"
68 S DIR("?")="the A/E or Construction funding year."
69 S DIR("B")=$E(17000000+DT,1,4)+$S($E(DT,4,7)>0600:2,1:1)
70 D ^DIR K DIR Q:$D(DIRUT)
71 S ENYR=Y
72 F ENIDX="F","G" D
73 . S ENDA=0 F S ENDA=$O(^ENG("PROJ",ENIDX,ENYR,ENDA)) Q:'ENDA D
74 . . S ENY0=$G(^ENG("PROJ",ENDA,0)) Q:$P(ENY0,U)=""!($P(ENY0,U,6)'=ENPR)
75 . . S ^TMP($J,"R",$P(ENY0,U))=$P(ENY0,U)_U_$P(ENY0,U,3)_U_ENDA
76 I '$D(^TMP($J,"R")) W !!,"No Projects matched selection criteria!",! Q
77 S ENI=0,ENPN="" F S ENPN=$O(^TMP($J,"R",ENPN)) Q:ENPN="" S ENI=ENI+1,^TMP($J,"SCR",ENI)=^(ENPN)
78 S ^TMP($J,"SCR")=ENI_U_"PROGRAM ("_ENPR_") PROJECTS WITH FUNDING YEAR "_ENYR
79 S ^TMP($J,"SCR",0)="5;11;PROJECT #^19;50;TITLE"
80 D ^ENPLS2
81 ; save selected projects (if any)
82 S ENC=0,ENJ="" F S ENJ=$O(ENACL(ENJ)) Q:ENJ="" D
83 . F ENK=1:1 S ENI=$P(ENACL(ENJ),",",ENK) Q:ENI="" D
84 . . S ENY=^TMP($J,"SCR",ENI),^TMP($J,"L",$P(ENY,U))=$P(ENY,U,3),ENC=ENC+1
85 S:ENC ^TMP($J,"L")=ENC_$S(ENTY="F":U_ENFY,1:"")
86 K ^TMP($J,"R"),^TMP($J,"SCR")
87 Q
88 ;ENPLS2
Note: See TracBrowser for help on using the repository browser.