source: FOIAVistA/tag/r/ENGINEERING-EN/ENAEMS.m@ 719

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

initial load of FOIAVistA 6/30/08 version

File size: 3.6 KB
Line 
1ENAEMS ;WOIFO/SU-AEMS/MERS WO PERFORMANCE EXTRACT ; 07/25/2002 03:30 PM
2 ;;7.0;ENGINEERING;**72**;August 17,1993
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5BEGIN ;
6 ;
7 NEW FY
8 W !!,"AEMS/MERS WORK ORDER PERFORMANCE EXTRACT",!!!
9 R "PLEASE ENTER FISCAL YEAR FOR PROCESSING: 2002//",FY:$S($D(DTIME):DTIME,1:60)
10 I FY="^" G EXIT
11 I FY="" S FY=2002
12 I FY'?4N W !!,"Please enter 4 digits Fiscal Year",!! G BEGIN
13 W !!,"Processing ... "
14POST ;
15 NEW I,J,K,X,Y,STA,OSTA,LC,FDT,TP,QT,AA,BB,A1,U,PMST
16 NEW X1,X2,XMSUB,XMTEXT,XMY,FYB,FYE,END,DIFROM
17 I $G(FY)="" NEW FY S FY=2002
18 K ^TMP("ENAEMS#10"),^TMP("ENAEMS#19")
19 ; get report period ( FY Begin/End date )
20 S U="^",FYB=FY-1701_1000,FYE=FY-1700_"0931"
21 ; get reporting site
22 S STA=$P(^DIC(6910,1,0),U,2),END=$$LEGACY^XUAF4(STA)
23 I END=1 G EXIT
24 I STA="" S STA="UNKNOWN"
25 ;
26MS10 ; measure #10
27 ;
28 S I=0 F S I=$O(^ENG(6914,I)) Q:'I D
29 . ; get owning station
30 . S OSTA=$P($G(^ENG(6914,I,9)),U,5) I OSTA="" S OSTA=STA
31 . S J=0 F S J=$O(^ENG(6914,I,6,J)) Q:'J D
32 .. S K=$G(^ENG(6914,I,6,J,0)),AA=+K
33 .. I AA<FYB!(AA>FYE) Q ;Quit if falls outside the range
34 .. S TP=$E($P(K,U,2),1,2) I TP="Y2" Q ; skip Y2K record
35 .. I TP'="PM" S TP="UNSCH"
36 .. I TP="PM" S PMST=$E($P(K,U,3)) S TP=$S(PMST="D":"PMDEF",1:"PMNDF")
37 .. S QT=$E(AA,4,5)+2\3+1 I QT>4 S QT=1 ; calculate quarter by month
38 .. ; get hour:p4, labor:p5, material:p6, vendor:p7
39 .. F A1=4:1:7 S BB(A1-2)=$P(K,U,A1)
40 .. S AA=$G(^TMP("ENAEMS#10",$J,OSTA,QT,TP)),BB(1)=1
41 .. ; increment each counter: count, hour, labor$, material$, vendor$
42 .. F A1=1:1:5 S $P(AA,",",A1)=$P(AA,",",A1)+BB(A1)
43 .. S ^TMP("ENAEMS#10",$J,OSTA,QT,TP)=AA
44 ;
45MS19 ; measure #19
46 S I=0 F S I=$O(^ENG(6920,I)) Q:'I D
47 . Q:'$D(^ENG(6920,I,0))
48 . ; exclude PM, Y2K work order
49 . S TP=$E(^ENG(6920,I,0),1,2) I TP="PM"!(TP="Y2") Q
50 . ; X1: date complete, X2: date request
51 . S X2=$P($P($G(^ENG(6920,I,0)),U,2),".")
52 . S X1=$P($P($G(^ENG(6920,I,5)),U,2),".")
53 . Q:X2="" ; if request date is null
54 . Q:X1<X2 ; date complete smaller than date request
55 . I X1<FYB!(X1>FYE) Q ; Quit if falls outside the range
56 . S QT=$E(X1,4,5)+2\3+1 I QT>4 S QT=1 ; calculate quarter by month
57 . D ^%DTC ; calculate total date spent by date X1 and X2
58 . S AA=$G(^TMP("ENAEMS#19",$J,QT)),AA(1)=1,AA(2)=X+1
59 . ; increment each counter: count, date spent
60 . F A1=1,2 S $P(AA,",",A1)=$P(AA,",",A1)+AA(A1)
61 . S ^TMP("ENAEMS#19",$J,QT)=AA
62 ;
63 D RPT
64EXIT ;
65 K ^TMP("ENAEMS#10"),^TMP("ENAEMS#19")
66 Q
67 ;
68RPT ;
69 ; Construct Email text file
70 S LC=1,X=","
71 S OSTA="" F S OSTA=$O(^TMP("ENAEMS#10",$J,OSTA)) Q:OSTA="" D
72 . S QT=0 F S QT=$O(^TMP("ENAEMS#10",$J,OSTA,QT)) Q:'QT D
73 .. S TP="" F S TP=$O(^TMP("ENAEMS#10",$J,OSTA,QT,TP)) Q:TP="" D
74 ... S AA=^TMP("ENAEMS#10",$J,OSTA,QT,TP)
75 ... S LC=LC+1,FDT(LC)=STA_X_OSTA_X_FY_"-"_QT_X_TP_X_AA
76 D MAIL(10)
77 S LC=1,QT=0 K FDT
78 F S QT=$O(^TMP("ENAEMS#19",$J,QT)) Q:'QT D
79 . S AA=^TMP("ENAEMS#19",$J,QT),$P(AA,X,2)=$J($P(AA,X,2)/AA,1,1)
80 . S LC=LC+1,FDT(LC)=STA_X_FY_"-"_QT_X_AA
81 D MAIL(19)
82 Q
83 ;
84MAIL(MN) ;
85 ; Send report to mail group member and patch installer
86 X ^%ZOSF("UCI") S J=^%ZOSF("PROD")
87 S:J'["," Y=$P(Y,",") S END=$$KSP^XUPARAM("WHERE")
88 ; send report to mail group for PRODUCTION UCI only
89 I Y=J,END'["FO-",END'["ISC-" F I=1:1 S J=$T(MAILGRP+I),J=$P(J,";;",2) Q:J="" S XMY(J)=""
90 ; mail to user who install this patch
91 I $G(DUZ),$D(^VA(200,DUZ)) S XMY(DUZ)=""
92 ; if no data extracted, send blank MSG anyway
93 I '$D(FDT) S FDT(LC)=""
94 S XMSUB="Measure #"_MN_", Site "_STA_", FY "_FY_", WO Performance Extract"
95 S XMTEXT="FDT("
96 D ^XMD
97 Q
98MAILGRP ;
99 ;;G.CoreFLS AEMS/MERS EXTRACT@FORUM.VA.GOV
100 ;;
101 Q
Note: See TracBrowser for help on using the repository browser.