ENPLS2 ;WISC/SAB - Select Items from List ;12/4/07 13:24
;;7.0;ENGINEERING;**23,87**;Aug 17, 1993;Build 16
EN ; entry point
; input global
; ^TMP($J,"SCR)=number of entries in list^screen title
; ^TMP($J,"SCR",0)=col 1 x pos;col 1 hdr^...^col n x pos;col n hdr
; ^TMP($J,"SCR",id)=col 1 value^col 2 value^...^col n value
; output
; optional ENACL( selected items
;
; initialize variables
N ENI,ENID,ENF,ENI,ENS,ENX,ENY
K ENACL
S $P(ENF("DASH"),"-",80)=""
; get screen info
S ENX=^TMP($J,"SCR")
S ENF("IDM")=$P(ENX,U)
S ENF("HD")=$P(ENX,U,2)
; get column info
S ENX=^TMP($J,"SCR",0),ENF("CM")=0
F ENI=1:1 S ENY=$P(ENX,U,ENI) Q:ENY="" D
. S ENF("CM")=ENF("CM")+1
. S ENF("C"_ENI,"X")=$P(ENY,";",1)
. S ENF("C"_ENI,"L")=$P(ENY,";",2)
. S ENF("C"_ENI,"HD")=$P(ENY,";",3)
S ENF("SM")=(ENF("IDM")-1)\15+1
S ENF("S")=1
BLD ; build screen
K ENS
S ENS("IDL")=1+(ENF("S")-1*15)
S ENS("IDM")=$S(15+(ENF("S")-1*15)>ENF("IDM"):ENF("IDM"),1:15+(ENF("S")-1*15))
; display screen
D SHD
F ENID=ENS("IDL"):1:ENS("IDM") D W !
. S ENX=^TMP($J,"SCR",ENID)
. W $J(ENID,3)
. F ENI=1:1:ENF("CM") W ?ENF("C"_ENI,"X"),$P(ENX,U,ENI)
ACT ; prompt for selection
W !
S DIR("A")="Enter a list or range to select (1-"_ENF("IDM")_"): "_$S(ENF("S")<ENF("SM"):"Next Screen",1:"Quit")_"//"
S DIR(0)="LOA^1:"_ENF("IDM")
D ^DIR K DIR G:$D(DTOUT)!$D(DUOUT) EXIT
I X="",ENF("S")<ENF("SM") S ENF("S")=ENF("S")+1 G BLD
K ENACL S ENI="" F S ENI=$O(Y(ENI)) Q:ENI="" S ENACL(ENI)=Y(ENI)
EXIT ;
W:'$G(ENGNOFF) @IOF
K DX,DY
Q
EN2(ENGNOFF) ;Entry point to suppress Form Feed at end
G EN
SHD ; Screen Header
W @IOF
W ENF("HD"),?65,"Screen ",ENF("S")," of ",ENF("SM"),!!
W "ID#"
F ENI=1:1:ENF("CM") W ?ENF("C"_ENI,"X"),ENF("C"_ENI,"HD")
W !
W "---"
F ENI=1:1:ENF("CM") W ?ENF("C"_ENI,"X"),$E(ENF("DASH"),1,ENF("C"_ENI,"L"))
W !
Q
PYLIST ; Progam and Year list of project applications
N ENACL,ENC,ENDA,ENI,ENIDX,ENJ,ENK,ENPN,ENPR,ENY,ENY0,ENYR
K ^TMP($J,"R")
S DIR(0)="S^MA:MAJOR;MI:MINOR;MM:MINOR MISC;NR:NRM"
S DIR("?")="Enter program that listed projects must match."
D ^DIR K DIR Q:$D(DIRUT)
S ENPR=Y
S DIR(0)="N^1993:2099:0",DIR("A")="YEAR"
S DIR("?",1)="Enter a 4-digit year that listed projects must have as"
S DIR("?")="the A/E or Construction funding year."
S DIR("B")=$E(17000000+DT,1,4)+$S($E(DT,4,7)>0600:2,1:1)
D ^DIR K DIR Q:$D(DIRUT)
S ENYR=Y
F ENIDX="F","G" D
. S ENDA=0 F S ENDA=$O(^ENG("PROJ",ENIDX,ENYR,ENDA)) Q:'ENDA D
. . S ENY0=$G(^ENG("PROJ",ENDA,0)) Q:$P(ENY0,U)=""!($P(ENY0,U,6)'=ENPR)
. . S ^TMP($J,"R",$P(ENY0,U))=$P(ENY0,U)_U_$P(ENY0,U,3)_U_ENDA
I '$D(^TMP($J,"R")) W !!,"No Projects matched selection criteria!",! Q
S ENI=0,ENPN="" F S ENPN=$O(^TMP($J,"R",ENPN)) Q:ENPN="" S ENI=ENI+1,^TMP($J,"SCR",ENI)=^(ENPN)
S ^TMP($J,"SCR")=ENI_U_"PROGRAM ("_ENPR_") PROJECTS WITH FUNDING YEAR "_ENYR
S ^TMP($J,"SCR",0)="5;11;PROJECT #^19;50;TITLE"
D ^ENPLS2
; save selected projects (if any)
S ENC=0,ENJ="" F S ENJ=$O(ENACL(ENJ)) Q:ENJ="" D
. F ENK=1:1 S ENI=$P(ENACL(ENJ),",",ENK) Q:ENI="" D
. . S ENY=^TMP($J,"SCR",ENI),^TMP($J,"L",$P(ENY,U))=$P(ENY,U,3),ENC=ENC+1
S:ENC ^TMP($J,"L")=ENC_$S(ENTY="F":U_ENFY,1:"")
K ^TMP($J,"R"),^TMP($J,"SCR")
Q
;ENPLS2
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENPLS2 3315 printed Nov 22, 2024@17:05:09 Page 2
ENPLS2 ;WISC/SAB - Select Items from List ;12/4/07 13:24
+1 ;;7.0;ENGINEERING;**23,87**;Aug 17, 1993;Build 16
EN ; entry point
+1 ; input global
+2 ; ^TMP($J,"SCR)=number of entries in list^screen title
+3 ; ^TMP($J,"SCR",0)=col 1 x pos;col 1 hdr^...^col n x pos;col n hdr
+4 ; ^TMP($J,"SCR",id)=col 1 value^col 2 value^...^col n value
+5 ; output
+6 ; optional ENACL( selected items
+7 ;
+8 ; initialize variables
+9 NEW ENI,ENID,ENF,ENI,ENS,ENX,ENY
+10 KILL ENACL
+11 SET $PIECE(ENF("DASH"),"-",80)=""
+12 ; get screen info
+13 SET ENX=^TMP($JOB,"SCR")
+14 SET ENF("IDM")=$PIECE(ENX,U)
+15 SET ENF("HD")=$PIECE(ENX,U,2)
+16 ; get column info
+17 SET ENX=^TMP($JOB,"SCR",0)
SET ENF("CM")=0
+18 FOR ENI=1:1
SET ENY=$PIECE(ENX,U,ENI)
if ENY=""
QUIT
Begin DoDot:1
+19 SET ENF("CM")=ENF("CM")+1
+20 SET ENF("C"_ENI,"X")=$PIECE(ENY,";",1)
+21 SET ENF("C"_ENI,"L")=$PIECE(ENY,";",2)
+22 SET ENF("C"_ENI,"HD")=$PIECE(ENY,";",3)
End DoDot:1
+23 SET ENF("SM")=(ENF("IDM")-1)\15+1
+24 SET ENF("S")=1
BLD ; build screen
+1 KILL ENS
+2 SET ENS("IDL")=1+(ENF("S")-1*15)
+3 SET ENS("IDM")=$SELECT(15+(ENF("S")-1*15)>ENF("IDM"):ENF("IDM"),1:15+(ENF("S")-1*15))
+4 ; display screen
+5 DO SHD
+6 FOR ENID=ENS("IDL"):1:ENS("IDM")
Begin DoDot:1
+7 SET ENX=^TMP($JOB,"SCR",ENID)
+8 WRITE $JUSTIFY(ENID,3)
+9 FOR ENI=1:1:ENF("CM")
WRITE ?ENF("C"_ENI,"X"),$PIECE(ENX,U,ENI)
End DoDot:1
WRITE !
ACT ; prompt for selection
+1 WRITE !
+2 SET DIR("A")="Enter a list or range to select (1-"_ENF("IDM")_"): "_$SELECT(ENF("S")<ENF("SM"):"Next Screen",1:"Quit")_"//"
+3 SET DIR(0)="LOA^1:"_ENF("IDM")
+4 DO ^DIR
KILL DIR
if $DATA(DTOUT)!$DATA(DUOUT)
GOTO EXIT
+5 IF X=""
IF ENF("S")<ENF("SM")
SET ENF("S")=ENF("S")+1
GOTO BLD
+6 KILL ENACL
SET ENI=""
FOR
SET ENI=$ORDER(Y(ENI))
if ENI=""
QUIT
SET ENACL(ENI)=Y(ENI)
EXIT ;
+1 if '$GET(ENGNOFF)
WRITE @IOF
+2 KILL DX,DY
+3 QUIT
EN2(ENGNOFF) ;Entry point to suppress Form Feed at end
+1 GOTO EN
SHD ; Screen Header
+1 WRITE @IOF
+2 WRITE ENF("HD"),?65,"Screen ",ENF("S")," of ",ENF("SM"),!!
+3 WRITE "ID#"
+4 FOR ENI=1:1:ENF("CM")
WRITE ?ENF("C"_ENI,"X"),ENF("C"_ENI,"HD")
+5 WRITE !
+6 WRITE "---"
+7 FOR ENI=1:1:ENF("CM")
WRITE ?ENF("C"_ENI,"X"),$EXTRACT(ENF("DASH"),1,ENF("C"_ENI,"L"))
+8 WRITE !
+9 QUIT
PYLIST ; Progam and Year list of project applications
+1 NEW ENACL,ENC,ENDA,ENI,ENIDX,ENJ,ENK,ENPN,ENPR,ENY,ENY0,ENYR
+2 KILL ^TMP($JOB,"R")
+3 SET DIR(0)="S^MA:MAJOR;MI:MINOR;MM:MINOR MISC;NR:NRM"
+4 SET DIR("?")="Enter program that listed projects must match."
+5 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+6 SET ENPR=Y
+7 SET DIR(0)="N^1993:2099:0"
SET DIR("A")="YEAR"
+8 SET DIR("?",1)="Enter a 4-digit year that listed projects must have as"
+9 SET DIR("?")="the A/E or Construction funding year."
+10 SET DIR("B")=$EXTRACT(17000000+DT,1,4)+$SELECT($EXTRACT(DT,4,7)>0600:2,1:1)
+11 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+12 SET ENYR=Y
+13 FOR ENIDX="F","G"
Begin DoDot:1
+14 SET ENDA=0
FOR
SET ENDA=$ORDER(^ENG("PROJ",ENIDX,ENYR,ENDA))
if 'ENDA
QUIT
Begin DoDot:2
+15 SET ENY0=$GET(^ENG("PROJ",ENDA,0))
if $PIECE(ENY0,U)=""!($PIECE(ENY0,U,6)'=ENPR)
QUIT
+16 SET ^TMP($JOB,"R",$PIECE(ENY0,U))=$PIECE(ENY0,U)_U_$PIECE(ENY0,U,3)_U_ENDA
End DoDot:2
End DoDot:1
+17 IF '$DATA(^TMP($JOB,"R"))
WRITE !!,"No Projects matched selection criteria!",!
QUIT
+18 SET ENI=0
SET ENPN=""
FOR
SET ENPN=$ORDER(^TMP($JOB,"R",ENPN))
if ENPN=""
QUIT
SET ENI=ENI+1
SET ^TMP($JOB,"SCR",ENI)=^(ENPN)
+19 SET ^TMP($JOB,"SCR")=ENI_U_"PROGRAM ("_ENPR_") PROJECTS WITH FUNDING YEAR "_ENYR
+20 SET ^TMP($JOB,"SCR",0)="5;11;PROJECT #^19;50;TITLE"
+21 DO ^ENPLS2
+22 ; save selected projects (if any)
+23 SET ENC=0
SET ENJ=""
FOR
SET ENJ=$ORDER(ENACL(ENJ))
if ENJ=""
QUIT
Begin DoDot:1
+24 FOR ENK=1:1
SET ENI=$PIECE(ENACL(ENJ),",",ENK)
if ENI=""
QUIT
Begin DoDot:2
+25 SET ENY=^TMP($JOB,"SCR",ENI)
SET ^TMP($JOB,"L",$PIECE(ENY,U))=$PIECE(ENY,U,3)
SET ENC=ENC+1
End DoDot:2
End DoDot:1
+26 if ENC
SET ^TMP($JOB,"L")=ENC_$SELECT(ENTY="F":U_ENFY,1:"")
+27 KILL ^TMP($JOB,"R"),^TMP($JOB,"SCR")
+28 QUIT
+29 ;ENPLS2
