ENPLS ;WISC/SAB-SELECT PROJECTS ;8/17/95
;;7.0;ENGINEERING;**23**;Aug 17, 1993
EN(ENTY,ENLK) ; Entry Point
; input variables
; (optional) ENTY - type of projects (F,A,R)
; (optional) ENLK - true if selected projects should be locked
; output variables
; ^TMP($J,"L")=project count^current year of FYFP if ENTY="F"
; ^TMP($J,"L",project number)=ien
;
N ENC,ENDA,ENFY,ENPN,ENSEL,ENSN
K ^TMP($J,"L")
I "^F^A^R^"'[(U_$G(ENTY)_U) S ENTY="",ENSEL=1
S ENLK=$G(ENLK)
I ENTY]"" D G:$D(DIRUT) EXIT S ENSEL=Y
. S DIR("A")="Choose method of project selection"
. S DIR(0)="S^1:INDIVIDUAL PROJECTS"
. S:ENTY="F" DIR(0)=DIR(0)_";2:FROM LIST OF FYFP PROJECTS RETURNED TO SITE"
. S:ENTY="F" DIR(0)=DIR(0)_";3:ALL PROJECTS IN FIVE YEAR FACILITY PLAN"
. S:ENTY="A" DIR(0)=DIR(0)_";2:FROM LIST OF PROJECT APPLICATIONS RETURNED TO SITE"
. S:ENTY="A" DIR(0)=DIR(0)_";3:SELECTED PROJECTS FROM PROGRAM-YEAR LIST"
. S:ENTY="R" DIR(0)=DIR(0)_";2:ALL PROJECTS WITH MONTHLY UPDATES = YES"
. D ^DIR K DIR
; need year for FYFP
I ENTY="F" D G:$D(DIRUT) EXIT
. S DIR(0)="N^1993:2099:0",DIR("A")="Budget Year of 5-Yr Plan"
. S DIR("?")="Enter the 4-digit Budget Year of the Plan"
. 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 ENFY=Y-1
I ENSEL=1 D I $D(DTOUT)!$D(DUOUT) D:ENLK UNLOCK K ^TMP($J,"L") G EXIT
. ; individual projects chosen
. S ENC=0
. S DIC=6925,DIC(0)="AQEM",DIC("A")="Select PROJECT NUMBER: "
. F D ^DIC Q:Y'>0 S ENDA=+Y D
. . S ENPN=$P($G(^ENG("PROJ",ENDA,0)),U) Q:ENPN']""
. . I ENLK L +^ENG("PROJ",ENDA):10 I '$T W !,"Another user is editing this project. Can't select.",$C(7) Q
. . S ^TMP($J,"L",ENPN)=+Y,ENC=ENC+1
. K DIC
. S:ENC ^TMP($J,"L")=ENC_$S(ENTY="F":U_ENFY,1:"")
I ENTY="F",ENSEL=2 D RET,LOCK:ENLK ; returned FYFP projects
I ENTY="F",ENSEL=3 D G:$D(DIRUT)!$D(DTOUT)!$D(DUOUT) EXIT D:ENLK LOCK
. ; FYFP projects chosen
. S DIC="^DIC(4,",DIC(0)="AEMQ",DIC("B")=$P($G(^DIC(6910,1,0)),U,2)
. D ^DIC K DIC I Y<1!$D(DTOUT)!$D(DUOUT) Q
. S ENSN=$E($$GET1^DIQ(4,+Y_",",99),1,3)
. D FYFP^ENPLS1(ENSN,ENFY)
I ENTY="A",ENSEL=2 D RET,LOCK:ENLK ; returned project applications
I ENTY="A",ENSEL=3 D PYLIST^ENPLS2,LOCK:ENLK ; program,year project list
I ENTY="R",ENSEL=2 D D LOCK:ENLK
. ; monthly updates chosen
. S (ENC,ENDA)=0 F S ENDA=$O(^ENG("PROJ",ENDA)) Q:'ENDA D
. . S ENPN=$$GET1^DIQ(6925,ENDA_",",.01) Q:ENPN=""
. . I $$GET1^DIQ(6925,ENDA_",",2.5)="YES" S ^TMP($J,"L",ENPN)=ENDA,ENC=ENC+1
. S:ENC ^TMP($J,"L")=ENC
I '$D(^TMP($J,"L")) W !,"No projects selected!",$C(7) G EXIT
EXIT ; Exit
K DIC,DIR,DIRUT,DTOUT,DUOUT,DIROUT,X,Y
Q
RET ; Select from Returned projects
N ENACL,ENC,ENDA,ENFLD,ENI,ENJ,ENK,ENPN,ENPR,ENY,ENY0
K ^TMP($J,"R")
S ENFLD=$S(ENTY="F":181.1,ENTY="A":251,1:"")
; find,sort returned projects
S ENDA=0
F S ENDA=$O(^ENG("PROJ",ENDA)) Q:'ENDA D
. Q:$$GET1^DIQ(6925,ENDA_",",ENFLD)'="RETURNED TO SITE"
. S ENY0=$G(^ENG("PROJ",ENDA,0)) Q:$P(ENY0,U)=""!($P(ENY0,U,6)="")
. S ^TMP($J,"R",$P(ENY0,U,6),$P(ENY0,U))=$P(ENY0,U)_U_$P(ENY0,U,6)_U_$P(ENY0,U,3)_U_ENDA
I '$D(^TMP($J,"R")) W !!,"No 'Returned' Projects Found!",! G RETEX
S ENI=0,ENPR=""
F S ENPR=$O(^TMP($J,"R",ENPR)) Q:ENPR="" S ENPN="" F S ENPN=$O(^TMP($J,"R",ENPR,ENPN)) Q:ENPN="" S ENI=ENI+1,^TMP($J,"SCR",ENI)=^(ENPN)
S:ENTY="F" ^TMP($J,"SCR")=ENI_U_"RETURNED Five Year Plan Projects"
S:ENTY="A" ^TMP($J,"SCR")=ENI_U_"RETURNED Project Applications"
S ^TMP($J,"SCR",0)="5;11;PROJECT #^19;7;PROGRAM^29;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,4),ENC=ENC+1
S:ENC ^TMP($J,"L")=ENC_$S(ENTY="F":U_ENFY,1:"")
RETEX ; exit
K ^TMP($J,"R"),^TMP($J,"SCR")
Q
LOCK ; Lock List
N ENDA,ENDEL,ENPN
S ENDEL=0
S ENPN="" F S ENPN=$O(^TMP($J,"L",ENPN)) Q:ENPN="" D
. S ENDA=$P(^TMP($J,"L",ENPN),U)
. L +^ENG("PROJ",ENDA):10 I '$T S ENDEL=1 W !,"Project ",ENPN," is currently being edited!"
I ENDEL D UNLOCK K ^TMP($J,"L")
Q
UNLOCK ; Unlock List
N ENDA,ENPN
S ENPN="" F S ENPN=$O(^TMP($J,"L",ENPN)) Q:ENPN="" D
. S ENDA=$P(^TMP($J,"L",ENPN),U)
. L -^ENG("PROJ",ENDA)
Q
;ENPLS
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENPLS 4358 printed Oct 16, 2024@17:55:46 Page 2
ENPLS ;WISC/SAB-SELECT PROJECTS ;8/17/95
+1 ;;7.0;ENGINEERING;**23**;Aug 17, 1993
EN(ENTY,ENLK) ; Entry Point
+1 ; input variables
+2 ; (optional) ENTY - type of projects (F,A,R)
+3 ; (optional) ENLK - true if selected projects should be locked
+4 ; output variables
+5 ; ^TMP($J,"L")=project count^current year of FYFP if ENTY="F"
+6 ; ^TMP($J,"L",project number)=ien
+7 ;
+8 NEW ENC,ENDA,ENFY,ENPN,ENSEL,ENSN
+9 KILL ^TMP($JOB,"L")
+10 IF "^F^A^R^"'[(U_$GET(ENTY)_U)
SET ENTY=""
SET ENSEL=1
+11 SET ENLK=$GET(ENLK)
+12 IF ENTY]""
Begin DoDot:1
+13 SET DIR("A")="Choose method of project selection"
+14 SET DIR(0)="S^1:INDIVIDUAL PROJECTS"
+15 if ENTY="F"
SET DIR(0)=DIR(0)_";2:FROM LIST OF FYFP PROJECTS RETURNED TO SITE"
+16 if ENTY="F"
SET DIR(0)=DIR(0)_";3:ALL PROJECTS IN FIVE YEAR FACILITY PLAN"
+17 if ENTY="A"
SET DIR(0)=DIR(0)_";2:FROM LIST OF PROJECT APPLICATIONS RETURNED TO SITE"
+18 if ENTY="A"
SET DIR(0)=DIR(0)_";3:SELECTED PROJECTS FROM PROGRAM-YEAR LIST"
+19 if ENTY="R"
SET DIR(0)=DIR(0)_";2:ALL PROJECTS WITH MONTHLY UPDATES = YES"
+20 DO ^DIR
KILL DIR
End DoDot:1
if $DATA(DIRUT)
GOTO EXIT
SET ENSEL=Y
+21 ; need year for FYFP
+22 IF ENTY="F"
Begin DoDot:1
+23 SET DIR(0)="N^1993:2099:0"
SET DIR("A")="Budget Year of 5-Yr Plan"
+24 SET DIR("?")="Enter the 4-digit Budget Year of the Plan"
+25 SET DIR("B")=$EXTRACT(17000000+DT,1,4)+$SELECT($EXTRACT(DT,4,7)>0600:2,1:1)
+26 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+27 SET ENFY=Y-1
End DoDot:1
if $DATA(DIRUT)
GOTO EXIT
+28 IF ENSEL=1
Begin DoDot:1
+29 ; individual projects chosen
+30 SET ENC=0
+31 SET DIC=6925
SET DIC(0)="AQEM"
SET DIC("A")="Select PROJECT NUMBER: "
+32 FOR
DO ^DIC
if Y'>0
QUIT
SET ENDA=+Y
Begin DoDot:2
+33 SET ENPN=$PIECE($GET(^ENG("PROJ",ENDA,0)),U)
if ENPN']""
QUIT
+34 IF ENLK
LOCK +^ENG("PROJ",ENDA):10
IF '$TEST
WRITE !,"Another user is editing this project. Can't select.",$CHAR(7)
QUIT
+35 SET ^TMP($JOB,"L",ENPN)=+Y
SET ENC=ENC+1
End DoDot:2
+36 KILL DIC
+37 if ENC
SET ^TMP($JOB,"L")=ENC_$SELECT(ENTY="F":U_ENFY,1:"")
End DoDot:1
IF $DATA(DTOUT)!$DATA(DUOUT)
if ENLK
DO UNLOCK
KILL ^TMP($JOB,"L")
GOTO EXIT
+38 ; returned FYFP projects
IF ENTY="F"
IF ENSEL=2
DO RET
if ENLK
DO LOCK
+39 IF ENTY="F"
IF ENSEL=3
Begin DoDot:1
+40 ; FYFP projects chosen
+41 SET DIC="^DIC(4,"
SET DIC(0)="AEMQ"
SET DIC("B")=$PIECE($GET(^DIC(6910,1,0)),U,2)
+42 DO ^DIC
KILL DIC
IF Y<1!$DATA(DTOUT)!$DATA(DUOUT)
QUIT
+43 SET ENSN=$EXTRACT($$GET1^DIQ(4,+Y_",",99),1,3)
+44 DO FYFP^ENPLS1(ENSN,ENFY)
End DoDot:1
if $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)
GOTO EXIT
if ENLK
DO LOCK
+45 ; returned project applications
IF ENTY="A"
IF ENSEL=2
DO RET
if ENLK
DO LOCK
+46 ; program,year project list
IF ENTY="A"
IF ENSEL=3
DO PYLIST^ENPLS2
if ENLK
DO LOCK
+47 IF ENTY="R"
IF ENSEL=2
Begin DoDot:1
+48 ; monthly updates chosen
+49 SET (ENC,ENDA)=0
FOR
SET ENDA=$ORDER(^ENG("PROJ",ENDA))
if 'ENDA
QUIT
Begin DoDot:2
+50 SET ENPN=$$GET1^DIQ(6925,ENDA_",",.01)
if ENPN=""
QUIT
+51 IF $$GET1^DIQ(6925,ENDA_",",2.5)="YES"
SET ^TMP($JOB,"L",ENPN)=ENDA
SET ENC=ENC+1
End DoDot:2
+52 if ENC
SET ^TMP($JOB,"L")=ENC
End DoDot:1
if ENLK
DO LOCK
+53 IF '$DATA(^TMP($JOB,"L"))
WRITE !,"No projects selected!",$CHAR(7)
GOTO EXIT
EXIT ; Exit
+1 KILL DIC,DIR,DIRUT,DTOUT,DUOUT,DIROUT,X,Y
+2 QUIT
RET ; Select from Returned projects
+1 NEW ENACL,ENC,ENDA,ENFLD,ENI,ENJ,ENK,ENPN,ENPR,ENY,ENY0
+2 KILL ^TMP($JOB,"R")
+3 SET ENFLD=$SELECT(ENTY="F":181.1,ENTY="A":251,1:"")
+4 ; find,sort returned projects
+5 SET ENDA=0
+6 FOR
SET ENDA=$ORDER(^ENG("PROJ",ENDA))
if 'ENDA
QUIT
Begin DoDot:1
+7 if $$GET1^DIQ(6925,ENDA_",",ENFLD)'="RETURNED TO SITE"
QUIT
+8 SET ENY0=$GET(^ENG("PROJ",ENDA,0))
if $PIECE(ENY0,U)=""!($PIECE(ENY0,U,6)="")
QUIT
+9 SET ^TMP($JOB,"R",$PIECE(ENY0,U,6),$PIECE(ENY0,U))=$PIECE(ENY0,U)_U_$PIECE(ENY0,U,6)_U_$PIECE(ENY0,U,3)_U_ENDA
End DoDot:1
+10 IF '$DATA(^TMP($JOB,"R"))
WRITE !!,"No 'Returned' Projects Found!",!
GOTO RETEX
+11 SET ENI=0
SET ENPR=""
+12 FOR
SET ENPR=$ORDER(^TMP($JOB,"R",ENPR))
if ENPR=""
QUIT
SET ENPN=""
FOR
SET ENPN=$ORDER(^TMP($JOB,"R",ENPR,ENPN))
if ENPN=""
QUIT
SET ENI=ENI+1
SET ^TMP($JOB,"SCR",ENI)=^(ENPN)
+13 if ENTY="F"
SET ^TMP($JOB,"SCR")=ENI_U_"RETURNED Five Year Plan Projects"
+14 if ENTY="A"
SET ^TMP($JOB,"SCR")=ENI_U_"RETURNED Project Applications"
+15 SET ^TMP($JOB,"SCR",0)="5;11;PROJECT #^19;7;PROGRAM^29;50;TITLE"
+16 DO ^ENPLS2
+17 ; save selected projects (if any)
+18 SET ENC=0
SET ENJ=""
FOR
SET ENJ=$ORDER(ENACL(ENJ))
if ENJ=""
QUIT
Begin DoDot:1
+19 FOR ENK=1:1
SET ENI=$PIECE(ENACL(ENJ),",",ENK)
if ENI=""
QUIT
Begin DoDot:2
+20 SET ENY=^TMP($JOB,"SCR",ENI)
SET ^TMP($JOB,"L",$PIECE(ENY,U))=$PIECE(ENY,U,4)
SET ENC=ENC+1
End DoDot:2
End DoDot:1
+21 if ENC
SET ^TMP($JOB,"L")=ENC_$SELECT(ENTY="F":U_ENFY,1:"")
RETEX ; exit
+1 KILL ^TMP($JOB,"R"),^TMP($JOB,"SCR")
+2 QUIT
LOCK ; Lock List
+1 NEW ENDA,ENDEL,ENPN
+2 SET ENDEL=0
+3 SET ENPN=""
FOR
SET ENPN=$ORDER(^TMP($JOB,"L",ENPN))
if ENPN=""
QUIT
Begin DoDot:1
+4 SET ENDA=$PIECE(^TMP($JOB,"L",ENPN),U)
+5 LOCK +^ENG("PROJ",ENDA):10
IF '$TEST
SET ENDEL=1
WRITE !,"Project ",ENPN," is currently being edited!"
End DoDot:1
+6 IF ENDEL
DO UNLOCK
KILL ^TMP($JOB,"L")
+7 QUIT
UNLOCK ; Unlock List
+1 NEW ENDA,ENPN
+2 SET ENPN=""
FOR
SET ENPN=$ORDER(^TMP($JOB,"L",ENPN))
if ENPN=""
QUIT
Begin DoDot:1
+3 SET ENDA=$PIECE(^TMP($JOB,"L",ENPN),U)
+4 LOCK -^ENG("PROJ",ENDA)
End DoDot:1
+5 QUIT
+6 ;ENPLS
