- 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 Mar 13, 2025@21:00:06 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
