Changeset 623 for WorldVistAEHR/trunk/r/ENGINEERING-EN/ENPLS2.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/ENGINEERING-EN/ENPLS2.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ENGINEERING-EN/ENPLS2.m
r613 r623 1 ENPLS2 ;WISC/SAB - Select Items from List ;12/4/07 13:24 2 ;;7.0;ENGINEERING;**23,87**;Aug 17, 1993;Build 16 3 EN ; 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 28 BLD ; 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) 38 ACT ; 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) 45 EXIT ; 46 W:'$G(ENGNOFF) @IOF 47 K DX,DY 48 Q 49 EN2(ENGNOFF) ;Entry point to suppress Form Feed at end 50 G EN 51 SHD ; Screen Header 52 W @IOF 53 W ENF("HD"),?65,"Screen ",ENF("S")," of ",ENF("SM"),!! 54 W "ID#" 55 F ENI=1:1:ENF("CM") W ?ENF("C"_ENI,"X"),ENF("C"_ENI,"HD") 56 W ! 57 W "---" 58 F ENI=1:1:ENF("CM") W ?ENF("C"_ENI,"X"),$E(ENF("DASH"),1,ENF("C"_ENI,"L")) 59 W ! 60 Q 61 PYLIST ; Progam and Year list of project applications 62 N ENACL,ENC,ENDA,ENI,ENIDX,ENJ,ENK,ENPN,ENPR,ENY,ENY0,ENYR 63 K ^TMP($J,"R") 64 S DIR(0)="S^MA:MAJOR;MI:MINOR;MM:MINOR MISC;NR:NRM" 65 S DIR("?")="Enter program that listed projects must match." 66 D ^DIR K DIR Q:$D(DIRUT) 67 S ENPR=Y 68 S DIR(0)="N^1993:2099:0",DIR("A")="YEAR" 69 S DIR("?",1)="Enter a 4-digit year that listed projects must have as" 70 S DIR("?")="the A/E or Construction funding year." 71 S DIR("B")=$E(17000000+DT,1,4)+$S($E(DT,4,7)>0600:2,1:1) 72 D ^DIR K DIR Q:$D(DIRUT) 73 S ENYR=Y 74 F ENIDX="F","G" D 75 . S ENDA=0 F S ENDA=$O(^ENG("PROJ",ENIDX,ENYR,ENDA)) Q:'ENDA D 76 . . S ENY0=$G(^ENG("PROJ",ENDA,0)) Q:$P(ENY0,U)=""!($P(ENY0,U,6)'=ENPR) 77 . . S ^TMP($J,"R",$P(ENY0,U))=$P(ENY0,U)_U_$P(ENY0,U,3)_U_ENDA 78 I '$D(^TMP($J,"R")) W !!,"No Projects matched selection criteria!",! Q 79 S ENI=0,ENPN="" F S ENPN=$O(^TMP($J,"R",ENPN)) Q:ENPN="" S ENI=ENI+1,^TMP($J,"SCR",ENI)=^(ENPN) 80 S ^TMP($J,"SCR")=ENI_U_"PROGRAM ("_ENPR_") PROJECTS WITH FUNDING YEAR "_ENYR 81 S ^TMP($J,"SCR",0)="5;11;PROJECT #^19;50;TITLE" 82 D ^ENPLS2 83 ; save selected projects (if any) 84 S ENC=0,ENJ="" F S ENJ=$O(ENACL(ENJ)) Q:ENJ="" D 85 . F ENK=1:1 S ENI=$P(ENACL(ENJ),",",ENK) Q:ENI="" D 86 . . S ENY=^TMP($J,"SCR",ENI),^TMP($J,"L",$P(ENY,U))=$P(ENY,U,3),ENC=ENC+1 87 S:ENC ^TMP($J,"L")=ENC_$S(ENTY="F":U_ENFY,1:"") 88 K ^TMP($J,"R"),^TMP($J,"SCR") 89 Q 90 ;ENPLS2 1 ENPLS2 ;WISC/SAB - Select Items from List ;7/21/95 2 ;;7.0;ENGINEERING;**23**;Aug 17, 1993 3 EN ; 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 28 BLD ; 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) 38 ACT ; 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) 45 EXIT ; 46 W @IOF 47 K DX,DY 48 Q 49 SHD ; 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 59 PYLIST ; 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 TracChangeset
for help on using the changeset viewer.
