source: WorldVistAEHR/trunk/r/ENGINEERING-EN/ENPLX1.m@ 767

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

initial load of WorldVistAEHR
File size: 5.3 KB
RevLine 
[613]1ENPLX1 ;WISC/SAB; PROJECT TRANSMISSION (cont); 6/12/97
2 ;;7.0;ENGINEERING;**23,28**;Aug 17, 1993
3LOCK ; lock valid projects on list
4 S ENPN=""
5 F S ENPN=$O(^TMP($J,"L",ENPN)) Q:ENPN="" S ENX=^(ENPN) D
6 . S ENDA=$P(ENX,U)
7 . I $P(ENX,U,2)>1 L +^ENG("PROJ",ENDA):10 I '$T S END=1,$P(^TMP($J,"L",ENPN),U,3)=1
8 Q:'END
9 ;
10 S XMSUB="ERROR DURING QUEUED TRANSMISSION"
11 S XMDUZ="Engineering Package"
12 D XMZ^XMA2 I XMZ<1 Q
13 S ENX="Your queued transmission of "
14 S ENX=ENX_$S(ENTY="F":"Five Year Facility Plan Projects",ENTY="A":"Project Applications",ENTY="R":"Project Progress Reports",1:"")
15 S ENL=1,^XMB(3.9,XMZ,2,ENL,0)=ENX
16 S ENL=ENL+1,^XMB(3.9,XMZ,2,ENL,0)="was not performed because the asterisked projects were being edited."
17 S ENL=ENL+1,^XMB(3.9,XMZ,2,ENL,0)=" "
18 S ENPN=""
19 F S ENPN=$O(^TMP($J,"L",ENPN)) Q:ENPN="" S ENX=^(ENPN) D
20 . S ENDA=$P(ENX,U)
21 . I $P(ENX,U,2)>1 S ENL=ENL+1,^XMB(3.9,XMZ,2,ENL,0)=$S($P(ENX,U,3):"*",1:" ")_ENPN
22 S ^XMB(3.9,XMZ,2,0)="^3.92A^"_ENL_U_ENL_U_DT
23 S XMY(DUZ)=""
24 D ENT1^XMD
25 K XMZ
26 Q
27CREATE ; Create Mail Message
28 I $G(XMZ)'<1 D SEND
29 S ENC("MSG")=ENC("MSG")+1
30 S ENX="EN XMIT "_$P("^FYFP^APPL^REPT",U,$F("FAR",ENTY))_" "
31 S:ENT("PACK")=1!(ENT("PROJ")=1) ENX=ENX_ENPN
32 S:ENT("PACK")'=1&(ENT("PROJ")>1) ENX=ENX_$E(1000+$E($P($G(^DIC(6910,1,0)),U,2),1,3),2,4)_" SEQ "_ENC("MSG")_" OF "_ENT("MSG")
33 S XMSUB=ENX
34 S XMDUZ=DUZ
35 D XMZ^XMA2 I XMZ<1 S END=1 Q
36 D NOW^%DTC S ENDT=%\1,ENY=$P(%,".",2)
37 S ENCLDT=$$FDT^ENPLUTL(%)
38 S ENX="ENG^"_$E(1000+$E($P($G(^DIC(6910,1,0)),U,2),1,3),2,4)
39 S ENX=ENX_U_$P("^5YRP^1193^0051",U,$F("FAR",ENTY))
40 S ENX=ENX_U_(%+17000000\1)_U_ENY_$E("000000",1,6-$L(ENY))
41 S ENX=ENX_U_$$LTZ^ENPLUTL_$E(" ",1,3-$L($$LTZ^ENPLUTL))
42 S ENX=ENX_U_$E(1000+ENC("MSG"),2,4)_U_$E(1000+ENT("MSG"),2,4)
43 S ENX=ENX_U_$P("^004^004^002",U,$F("FAR",ENTY))
44 S ENX=ENX_"^|"
45 S ENL=1,^XMB(3.9,XMZ,2,ENL,0)=ENX
46 I ENC("MSG")=1,"FA"[ENTY D MG
47 Q
48SEND ; Send Mail Message
49 S ENL=ENL+1,^XMB(3.9,XMZ,2,ENL,0)=$S(ENC("MSG")=ENT("MSG"):"$",1:"~")
50 S ^XMB(3.9,XMZ,2,0)="^3.92A^"_ENL_U_ENL_U_DT
51 S XMY(DUZ)=""
52 S:"F"[ENTY XMY("G.OFMRD@"_ENDOMAIN)="",XMY("S.OFMRD-SRV1@"_ENDOMAIN)=""
53 S:"A"[ENTY XMY("G.OFMRD@"_ENDOMAIN)="",XMY("S.OFMRD-SRV2@"_ENDOMAIN)=""
54 S:"R"[ENTY XMY("S.EN_UPDATEA"_"@"_ENDOMAIN)=""
55 S XMCHAN=1 D ENT1^XMD K XMCHAN
56 K XMZ
57 Q
58UPD ; update project
59 Q:"FA"'[ENTY
60 K ENTXT
61 S ENTXT(1)=ENCLDT_" "_$S(ENTY="F":"5-Yr",ENTY="A":"Appl",1:" ")
62 S ENTXT(1)=ENTXT(1)_" Site transmitted project to Region"
63 D POSTCL^ENPLUTL(ENDA,"ENTXT") K ENTXT
64 I $$GET1^DIQ(6925,ENDA_",",181.1,"I")=1 K ENFDA S ENFDA(6925,ENDA_",",181.1)=0 D FILE^DIE("","ENFDA")
65 I ENTY="A",$$GET1^DIQ(6925,ENDA_",",251,"I")=1 K ENFDA S ENFDA(6925,ENDA_",",251)=0 D FILE^DIE("","ENFDA")
66 S:ENTY="F" $P(^ENG("PROJ",ENDA,33),U,7,8)=ENDT_U_DUZ
67 S:ENTY="A" $P(^ENG("PROJ",ENDA,33),U,9,10)=ENDT_U_DUZ
68 Q
69MG ; mail group members
70 N ENC,ENI,ENQ,ENT,ENX
71 S ENX=$$FIND1^DIC(3.8,"","X","EN PROJECTS") I 'ENX Q
72 D LIST^DIC(3.81,","_ENX_",","","","*","","","","","","ENQ")
73 S ENT=$P(ENQ("DILIST",0),U)
74 S ENX=""
75 I ENT S ENI="" F ENC=1:1 S ENI=$O(ENQ("DILIST",1,ENI)) Q:ENI="" D
76 . S ENX=ENX_U_ENQ("DILIST",1,ENI)
77 . I '(ENC#5)!(ENC=ENT) D
78 . . S ENX="MG^"_(ENC+4\5)_U_(ENT+4\5)_ENX_$E("^^^^^",1,6-$L(ENX,U))
79 . . S ENX=ENX_"^|"
80 . . S ENL=ENL+1,^XMB(3.9,XMZ,2,ENL,0)=ENX
81 . . S ENX=""
82 Q
83REPTPR ; Progress Report Pre-Xmit
84 Q:"R"'[ENTY
85 N ENPR,ENY52
86 K ENFDA
87 ; check 'Not Applicable' fields
88 S ENPR=$P($G(^ENG("PROJ",ENDA,0)),U,6)
89 S ENY52=$G(^ENG("PROJ",ENDA,52))
90 I "^NR^"'[(U_ENPR_U) D ; delete both EPA fields
91 . I $P(ENY52,U,7)]"" S ENFDA(6925,ENDA_",",158.6)="@"
92 . I $P(ENY52,U,8)]"" S ENFDA(6925,ENDA_",",158.7)="@"
93 I $P(ENY52,U,7)'="Y" D ; delete EPA REPORTING CATEGORY
94 . I $P(ENY52,U,8)]"" S ENFDA(6925,ENDA_",",158.7)="@"
95 I "^NR^SL^"'[(U_ENPR_U) D ; delete BONUS CATEGORY
96 . I $P(ENY52,U,9)]"" S ENFDA(6925,ENDA_",",158.8)="@"
97 ; update reporting period
98 S ENFDA(6925,ENDA_",",1)=ENRP
99 ;
100 D FILE^DIE("","ENFDA")
101 Q
102REPTPS ; Progress Report Post-Xmit
103 Q:"R"'[ENTY
104 ; update prior submission
105 S ^ENG("PROJ",ENDA,60)=$G(^ENG("PROJ",ENDA,0))
106 I $D(^ENG("PROJ",ENDA,1)) S $P(^(60),U,11)="",^(60)=^(60)_^(1)
107 S ^ENG("PROJ",ENDA,61)=$G(^ENG("PROJ",ENDA,2))
108 S ^ENG("PROJ",ENDA,62)=$G(^ENG("PROJ",ENDA,3))
109 S ^ENG("PROJ",ENDA,63)=$G(^ENG("PROJ",ENDA,4))
110 S ^ENG("PROJ",ENDA,64)=$G(^ENG("PROJ",ENDA,5))
111 I $D(^ENG("PROJ",ENDA,8)) S $P(^(64),U,11)="",^(64)=^(64)_^(8)
112 I $D(^ENG("PROJ",ENDA,10)) S $P(^(64),U,21)="",^(64)=^(64)_^(10)
113 S ^ENG("PROJ",ENDA,65)=$G(^ENG("PROJ",ENDA,13))
114 S ^ENG("PROJ",ENDA,66)=$G(^ENG("PROJ",ENDA,50))
115 S ^ENG("PROJ",ENDA,67)=$G(^ENG("PROJ",ENDA,51))
116 S ^ENG("PROJ",ENDA,68)=$G(^ENG("PROJ",ENDA,52))
117 I $D(^ENG("PROJ",ENDA,53)) S $P(^(68),U,11)="",^(68)=^(68)_^(53)
118 S ^ENG("PROJ",ENDA,69)=$G(^ENG("PROJ",ENDA,56))
119 S ^ENG("PROJ",ENDA,70)=$P($G(^ENG("PROJ",ENDA,15)),U)
120 K ^ENG("PROJ",ENDA,58) MERGE ^ENG("PROJ",ENDA,58)=^ENG("PROJ",ENDA,57)
121 S:$D(^ENG("PROJ",ENDA,58)) $P(^ENG("PROJ",ENDA,58),U,2)="6925.0186S"
122 ; move progress notes to remarks
123 S ENX=$P($G(^ENG("PROJ",ENDA,13)),U) I ENX]"" D
124 . K ENXT
125 . S ENDATE=$$FMTE^XLFDT(DT)
126 . S ENXT="@"
127 . S ENXT(1)="Progress note transmitted "_ENDATE_":"
128 . S ENXT(2)=ENX
129 . S ENXT(3)="End of note ("_ENDATE_")"
130 . D WP^DIE(6925,ENDA_",",145,"A","ENXT")
131 . S $P(^ENG("PROJ",ENDA,13),U)=""
132 ; if status = completed project then turn-off monthly updates
133 S:$P($G(^ENG("PROJ",ENDA,1)),U,3)=16 $P(^ENG("PROJ",ENDA,0),U,5)="N"
134 Q
135 ;ENPLX1
Note: See TracBrowser for help on using the repository browser.