source: WorldVistAEHR/trunk/r/ENGINEERING-EN/ENPRPAD.m@ 701

Last change on this file since 701 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.0 KB
Line 
1ENPRPAD ;(WIRMFO)/SAB-Project Actions Due Report ;1/29/1998
2 ;;7.0;ENGINEERING;**28,49**;Aug 17, 1993
3 ;
4ASKDM ; ask due date (month/year)
5 S DIR(0)="D^::E",DIR("A")="Report Actions Due In"
6 S DIR("?")="Enter action due date (month and year)"
7 S DIR("B")=$$FMTE^XLFDT($E(DT,1,5)_"00")
8 D ^DIR K DIR G:$D(DIRUT) EXIT S ENDM=$E(Y,1,5)
9 I $E(ENDM,4,5)="00" W $C(7),!,"Month is required.",! G ASKDM
10 ; ask project screen
11 S DIR(0)="Y",DIR("A")="Only include projects with MONTHLY UPDATES = YES"
12 S DIR("B")="YES"
13 D ^DIR K DIR G:$D(DIRUT) EXIT S ENONLYMU=Y
14 ; ask device
15 S %ZIS="QM" D ^%ZIS G:POP EXIT
16 I $D(IO("Q")) D G EXIT
17 . S ZTRTN="QEN^ENPRPAD",ZTDESC="Project Actions Due Report"
18 . S ZTSAVE("ENDM")="",ZTSAVE("ENONLYMU")=""
19 . D ^%ZTLOAD,HOME^%ZIS K ZTSK
20QEN ; queued entry
21 U IO
22 S (END,ENPG)=0 D NOW^%DTC S Y=% D DD^%DT S ENDT=Y
23 S ENL="",$P(ENL,"-",IOM)=""
24 ; loop thru project file
25 K ^TMP($J)
26 S ENT=0
27 S ENDA=0 F S ENDA=$O(^ENG("PROJ",ENDA)) Q:'ENDA D Q:END
28 . I ENONLYMU,$$GET1^DIQ(6925,ENDA,2.5)'="YES" Q ; not monthly updates
29 . S ENPN=$$GET1^DIQ(6925,ENDA,.01)
30 . S ENPR=$$GET1^DIQ(6925,ENDA,155,"I")
31 . Q:"^MA^MI^MM^NR^SL^"'[(U_ENPR_U)
32 . ; build applicable milestone list for project
33 . S ENMSOK=$$MSL^ENPRUTL(ENDA)
34 . ; get milestone dates for project
35 . D MSD^ENPRUTL(ENDA)
36 . ; check milestones
37 . F ENI=1:1:22 D:$P(ENMSOK,U,ENI)
38 . . Q:ENMS("A",ENI)]"" ; have actual
39 . . S ENCPL=$S(ENMS("R",ENI)]"":ENMS("R",ENI),1:ENMS("P",ENI)) ; current planned
40 . . Q:ENCPL="" ; not planned
41 . . I $E(ENCPL,1,5)=ENDM S ^TMP($J,ENPR,ENPN,ENI)=ENCPL_U_"D"
42 . . I $E(ENCPL,1,5)<ENDM S ^TMP($J,ENPR,ENPN,ENI)=ENCPL_U_"O"
43 . I $D(^TMP($J,ENPR,ENPN))=10 S ^TMP($J,ENPR,ENPN)=ENDA
44 . K ENCPL,ENMS,ENMSOK
45PRT ; print results
46 D HD
47 I '$D(^TMP($J)) W !!,"No Due or OverDue actions on projects" W:ENONLYMU " marked for MONTHLY UPDATE" W "."
48 S ENPR="" F S ENPR=$O(^TMP($J,ENPR)) Q:ENPR="" D Q:END
49 . W !!,"PROGRAM: ",$$EXTERNAL^DILFD(6925,155,"",ENPR)
50 . S ENPN="" F S ENPN=$O(^TMP($J,ENPR,ENPN)) Q:ENPN="" D Q:END
51 . . S ENDA=$P(^TMP($J,ENPR,ENPN),U)
52 . . W !!,ENPN,?15,$$GET1^DIQ(6925,ENDA,2)
53 . . S ENI="" F S ENI=$O(^TMP($J,ENPR,ENPN,ENI)) Q:ENI="" D Q:END
54 . . . S ENX=^TMP($J,ENPR,ENPN,ENI)
55 . . . I $Y+6>IOSL D HD Q:END D HDC
56 . . . W !,?5,$S($P(ENX,U,2)="D":"Due",1:"Overdue")
57 . . . W ?15,$$MS^ENPRUTL(ENI)," (",$$FMTE^XLFDT($P(ENX,U),2),") "
58 I 'END,$E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR
59 D ^%ZISC
60EXIT I $D(ZTQUEUED) S ZTREQ="Q"
61 K DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
62 K END,ENDM,ENDT,ENL,ENPG
63 K EN,ENC,ENDA,ENI,ENL,ENONLYMU,ENPN,ENPR,ENT,ENX
64 Q
65HD ; header
66 I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1,END=1 Q
67 I $E(IOST,1,2)="C-",ENPG S DIR(0)="E" D ^DIR K DIR I 'Y S END=1 Q
68 I $E(IOST,1,2)="C-"!ENPG W @IOF
69 S ENPG=ENPG+1
70 S $X=0
71 W "PROJECT ACTIONS DUE IN ",$$FMTE^XLFDT(ENDM),?48,ENDT,?72,"page ",ENPG
72 W !,"For ",$S(ENONLYMU:"projects with MONTHLY UPDATE = YES",1:"all projects"),"."
73 W !,ENL
74 Q
75HDC ; header for continued project
76 W !,"PROGRAM: ",$$EXTERNAL^DILFD(6925,155,"",ENPR)," (continued)"
77 W !!,ENPN,?15,$$GET1^DIQ(6925,ENDA,2)," (continued)"
78 Q
79 ;ENPRPAD
Note: See TracBrowser for help on using the repository browser.