Routine: ENPLS2

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

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 !

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")

 ;ENPLS2

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENPLS2   3315     printed  Mar 13, 2025@20:59:40                                                                                                                                                                                                      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

ENPLS2.m