ENPRPAD ;(WIRMFO)/SAB-Project Actions Due Report ;1/29/1998
;;7.0;ENGINEERING;**28,49**;Aug 17, 1993
;
ASKDM ; ask due date (month/year)
S DIR(0)="D^::E",DIR("A")="Report Actions Due In"
S DIR("?")="Enter action due date (month and year)"
S DIR("B")=$$FMTE^XLFDT($E(DT,1,5)_"00")
D ^DIR K DIR G:$D(DIRUT) EXIT S ENDM=$E(Y,1,5)
I $E(ENDM,4,5)="00" W $C(7),!,"Month is required.",! G ASKDM
; ask project screen
S DIR(0)="Y",DIR("A")="Only include projects with MONTHLY UPDATES = YES"
S DIR("B")="YES"
D ^DIR K DIR G:$D(DIRUT) EXIT S ENONLYMU=Y
; ask device
S %ZIS="QM" D ^%ZIS G:POP EXIT
I $D(IO("Q")) D G EXIT
. S ZTRTN="QEN^ENPRPAD",ZTDESC="Project Actions Due Report"
. S ZTSAVE("ENDM")="",ZTSAVE("ENONLYMU")=""
. D ^%ZTLOAD,HOME^%ZIS K ZTSK
QEN ; queued entry
U IO
S (END,ENPG)=0 D NOW^%DTC S Y=% D DD^%DT S ENDT=Y
S ENL="",$P(ENL,"-",IOM)=""
; loop thru project file
K ^TMP($J)
S ENT=0
S ENDA=0 F S ENDA=$O(^ENG("PROJ",ENDA)) Q:'ENDA D Q:END
. I ENONLYMU,$$GET1^DIQ(6925,ENDA,2.5)'="YES" Q ; not monthly updates
. S ENPN=$$GET1^DIQ(6925,ENDA,.01)
. S ENPR=$$GET1^DIQ(6925,ENDA,155,"I")
. Q:"^MA^MI^MM^NR^SL^"'[(U_ENPR_U)
. ; build applicable milestone list for project
. S ENMSOK=$$MSL^ENPRUTL(ENDA)
. ; get milestone dates for project
. D MSD^ENPRUTL(ENDA)
. ; check milestones
. F ENI=1:1:22 D:$P(ENMSOK,U,ENI)
. . Q:ENMS("A",ENI)]"" ; have actual
. . S ENCPL=$S(ENMS("R",ENI)]"":ENMS("R",ENI),1:ENMS("P",ENI)) ; current planned
. . Q:ENCPL="" ; not planned
. . I $E(ENCPL,1,5)=ENDM S ^TMP($J,ENPR,ENPN,ENI)=ENCPL_U_"D"
. . I $E(ENCPL,1,5)<ENDM S ^TMP($J,ENPR,ENPN,ENI)=ENCPL_U_"O"
. I $D(^TMP($J,ENPR,ENPN))=10 S ^TMP($J,ENPR,ENPN)=ENDA
. K ENCPL,ENMS,ENMSOK
PRT ; print results
D HD
I '$D(^TMP($J)) W !!,"No Due or OverDue actions on projects" W:ENONLYMU " marked for MONTHLY UPDATE" W "."
S ENPR="" F S ENPR=$O(^TMP($J,ENPR)) Q:ENPR="" D Q:END
. W !!,"PROGRAM: ",$$EXTERNAL^DILFD(6925,155,"",ENPR)
. S ENPN="" F S ENPN=$O(^TMP($J,ENPR,ENPN)) Q:ENPN="" D Q:END
. . S ENDA=$P(^TMP($J,ENPR,ENPN),U)
. . W !!,ENPN,?15,$$GET1^DIQ(6925,ENDA,2)
. . S ENI="" F S ENI=$O(^TMP($J,ENPR,ENPN,ENI)) Q:ENI="" D Q:END
. . . S ENX=^TMP($J,ENPR,ENPN,ENI)
. . . I $Y+6>IOSL D HD Q:END D HDC
. . . W !,?5,$S($P(ENX,U,2)="D":"Due",1:"Overdue")
. . . W ?15,$$MS^ENPRUTL(ENI)," (",$$FMTE^XLFDT($P(ENX,U),2),") "
I 'END,$E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR
D ^%ZISC
EXIT I $D(ZTQUEUED) S ZTREQ="Q"
K DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
K END,ENDM,ENDT,ENL,ENPG
K EN,ENC,ENDA,ENI,ENL,ENONLYMU,ENPN,ENPR,ENT,ENX
Q
HD ; header
I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1,END=1 Q
I $E(IOST,1,2)="C-",ENPG S DIR(0)="E" D ^DIR K DIR I 'Y S END=1 Q
I $E(IOST,1,2)="C-"!ENPG W @IOF
S ENPG=ENPG+1
S $X=0
W "PROJECT ACTIONS DUE IN ",$$FMTE^XLFDT(ENDM),?48,ENDT,?72,"page ",ENPG
W !,"For ",$S(ENONLYMU:"projects with MONTHLY UPDATE = YES",1:"all projects"),"."
W !,ENL
Q
HDC ; header for continued project
W !,"PROGRAM: ",$$EXTERNAL^DILFD(6925,155,"",ENPR)," (continued)"
W !!,ENPN,?15,$$GET1^DIQ(6925,ENDA,2)," (continued)"
Q
;ENPRPAD
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENPRPAD 3176 printed Dec 13, 2024@01:55:26 Page 2
ENPRPAD ;(WIRMFO)/SAB-Project Actions Due Report ;1/29/1998
+1 ;;7.0;ENGINEERING;**28,49**;Aug 17, 1993
+2 ;
ASKDM ; ask due date (month/year)
+1 SET DIR(0)="D^::E"
SET DIR("A")="Report Actions Due In"
+2 SET DIR("?")="Enter action due date (month and year)"
+3 SET DIR("B")=$$FMTE^XLFDT($EXTRACT(DT,1,5)_"00")
+4 DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO EXIT
SET ENDM=$EXTRACT(Y,1,5)
+5 IF $EXTRACT(ENDM,4,5)="00"
WRITE $CHAR(7),!,"Month is required.",!
GOTO ASKDM
+6 ; ask project screen
+7 SET DIR(0)="Y"
SET DIR("A")="Only include projects with MONTHLY UPDATES = YES"
+8 SET DIR("B")="YES"
+9 DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO EXIT
SET ENONLYMU=Y
+10 ; ask device
+11 SET %ZIS="QM"
DO ^%ZIS
if POP
GOTO EXIT
+12 IF $DATA(IO("Q"))
Begin DoDot:1
+13 SET ZTRTN="QEN^ENPRPAD"
SET ZTDESC="Project Actions Due Report"
+14 SET ZTSAVE("ENDM")=""
SET ZTSAVE("ENONLYMU")=""
+15 DO ^%ZTLOAD
DO HOME^%ZIS
KILL ZTSK
End DoDot:1
GOTO EXIT
QEN ; queued entry
+1 USE IO
+2 SET (END,ENPG)=0
DO NOW^%DTC
SET Y=%
DO DD^%DT
SET ENDT=Y
+3 SET ENL=""
SET $PIECE(ENL,"-",IOM)=""
+4 ; loop thru project file
+5 KILL ^TMP($JOB)
+6 SET ENT=0
+7 SET ENDA=0
FOR
SET ENDA=$ORDER(^ENG("PROJ",ENDA))
if 'ENDA
QUIT
Begin DoDot:1
+8 ; not monthly updates
IF ENONLYMU
IF $$GET1^DIQ(6925,ENDA,2.5)'="YES"
QUIT
+9 SET ENPN=$$GET1^DIQ(6925,ENDA,.01)
+10 SET ENPR=$$GET1^DIQ(6925,ENDA,155,"I")
+11 if "^MA^MI^MM^NR^SL^"'[(U_ENPR_U)
QUIT
+12 ; build applicable milestone list for project
+13 SET ENMSOK=$$MSL^ENPRUTL(ENDA)
+14 ; get milestone dates for project
+15 DO MSD^ENPRUTL(ENDA)
+16 ; check milestones
+17 FOR ENI=1:1:22
if $PIECE(ENMSOK,U,ENI)
Begin DoDot:2
+18 ; have actual
if ENMS("A",ENI)]""
QUIT
+19 ; current planned
SET ENCPL=$SELECT(ENMS("R",ENI)]"":ENMS("R",ENI),1:ENMS("P",ENI))
+20 ; not planned
if ENCPL=""
QUIT
+21 IF $EXTRACT(ENCPL,1,5)=ENDM
SET ^TMP($JOB,ENPR,ENPN,ENI)=ENCPL_U_"D"
+22 IF $EXTRACT(ENCPL,1,5)<ENDM
SET ^TMP($JOB,ENPR,ENPN,ENI)=ENCPL_U_"O"
End DoDot:2
+23 IF $DATA(^TMP($JOB,ENPR,ENPN))=10
SET ^TMP($JOB,ENPR,ENPN)=ENDA
+24 KILL ENCPL,ENMS,ENMSOK
End DoDot:1
if END
QUIT
PRT ; print results
+1 DO HD
+2 IF '$DATA(^TMP($JOB))
WRITE !!,"No Due or OverDue actions on projects"
if ENONLYMU
WRITE " marked for MONTHLY UPDATE"
WRITE "."
+3 SET ENPR=""
FOR
SET ENPR=$ORDER(^TMP($JOB,ENPR))
if ENPR=""
QUIT
Begin DoDot:1
+4 WRITE !!,"PROGRAM: ",$$EXTERNAL^DILFD(6925,155,"",ENPR)
+5 SET ENPN=""
FOR
SET ENPN=$ORDER(^TMP($JOB,ENPR,ENPN))
if ENPN=""
QUIT
Begin DoDot:2
+6 SET ENDA=$PIECE(^TMP($JOB,ENPR,ENPN),U)
+7 WRITE !!,ENPN,?15,$$GET1^DIQ(6925,ENDA,2)
+8 SET ENI=""
FOR
SET ENI=$ORDER(^TMP($JOB,ENPR,ENPN,ENI))
if ENI=""
QUIT
Begin DoDot:3
+9 SET ENX=^TMP($JOB,ENPR,ENPN,ENI)
+10 IF $Y+6>IOSL
DO HD
if END
QUIT
DO HDC
+11 WRITE !,?5,$SELECT($PIECE(ENX,U,2)="D":"Due",1:"Overdue")
+12 WRITE ?15,$$MS^ENPRUTL(ENI)," (",$$FMTE^XLFDT($PIECE(ENX,U),2),") "
End DoDot:3
if END
QUIT
End DoDot:2
if END
QUIT
End DoDot:1
if END
QUIT
+13 IF 'END
IF $EXTRACT(IOST,1,2)="C-"
SET DIR(0)="E"
DO ^DIR
KILL DIR
+14 DO ^%ZISC
EXIT IF $DATA(ZTQUEUED)
SET ZTREQ="Q"
+1 KILL DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+2 KILL END,ENDM,ENDT,ENL,ENPG
+3 KILL EN,ENC,ENDA,ENI,ENL,ENONLYMU,ENPN,ENPR,ENT,ENX
+4 QUIT
HD ; header
+1 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET ZTSTOP=1
SET END=1
QUIT
+2 IF $EXTRACT(IOST,1,2)="C-"
IF ENPG
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF 'Y
SET END=1
QUIT
+3 IF $EXTRACT(IOST,1,2)="C-"!ENPG
WRITE @IOF
+4 SET ENPG=ENPG+1
+5 SET $X=0
+6 WRITE "PROJECT ACTIONS DUE IN ",$$FMTE^XLFDT(ENDM),?48,ENDT,?72,"page ",ENPG
+7 WRITE !,"For ",$SELECT(ENONLYMU:"projects with MONTHLY UPDATE = YES",1:"all projects"),"."
+8 WRITE !,ENL
+9 QUIT
HDC ; header for continued project
+1 WRITE !,"PROGRAM: ",$$EXTERNAL^DILFD(6925,155,"",ENPR)," (continued)"
+2 WRITE !!,ENPN,?15,$$GET1^DIQ(6925,ENDA,2)," (continued)"
+3 QUIT
+4 ;ENPRPAD
