ENPLX1 ;WISC/SAB; PROJECT TRANSMISSION (cont); 6/12/97
;;7.0;ENGINEERING;**23,28**;Aug 17, 1993
LOCK ; lock valid projects on list
S ENPN=""
F S ENPN=$O(^TMP($J,"L",ENPN)) Q:ENPN="" S ENX=^(ENPN) D
. S ENDA=$P(ENX,U)
. I $P(ENX,U,2)>1 L +^ENG("PROJ",ENDA):10 I '$T S END=1,$P(^TMP($J,"L",ENPN),U,3)=1
Q:'END
;
S XMSUB="ERROR DURING QUEUED TRANSMISSION"
S XMDUZ="Engineering Package"
D XMZ^XMA2 I XMZ<1 Q
S ENX="Your queued transmission of "
S ENX=ENX_$S(ENTY="F":"Five Year Facility Plan Projects",ENTY="A":"Project Applications",ENTY="R":"Project Progress Reports",1:"")
S ENL=1,^XMB(3.9,XMZ,2,ENL,0)=ENX
S ENL=ENL+1,^XMB(3.9,XMZ,2,ENL,0)="was not performed because the asterisked projects were being edited."
S ENL=ENL+1,^XMB(3.9,XMZ,2,ENL,0)=" "
S ENPN=""
F S ENPN=$O(^TMP($J,"L",ENPN)) Q:ENPN="" S ENX=^(ENPN) D
. S ENDA=$P(ENX,U)
. I $P(ENX,U,2)>1 S ENL=ENL+1,^XMB(3.9,XMZ,2,ENL,0)=$S($P(ENX,U,3):"*",1:" ")_ENPN
S ^XMB(3.9,XMZ,2,0)="^3.92A^"_ENL_U_ENL_U_DT
S XMY(DUZ)=""
D ENT1^XMD
K XMZ
Q
CREATE ; Create Mail Message
I $G(XMZ)'<1 D SEND
S ENC("MSG")=ENC("MSG")+1
S ENX="EN XMIT "_$P("^FYFP^APPL^REPT",U,$F("FAR",ENTY))_" "
S:ENT("PACK")=1!(ENT("PROJ")=1) ENX=ENX_ENPN
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")
S XMSUB=ENX
S XMDUZ=DUZ
D XMZ^XMA2 I XMZ<1 S END=1 Q
D NOW^%DTC S ENDT=%\1,ENY=$P(%,".",2)
S ENCLDT=$$FDT^ENPLUTL(%)
S ENX="ENG^"_$E(1000+$E($P($G(^DIC(6910,1,0)),U,2),1,3),2,4)
S ENX=ENX_U_$P("^5YRP^1193^0051",U,$F("FAR",ENTY))
S ENX=ENX_U_(%+17000000\1)_U_ENY_$E("000000",1,6-$L(ENY))
S ENX=ENX_U_$$LTZ^ENPLUTL_$E(" ",1,3-$L($$LTZ^ENPLUTL))
S ENX=ENX_U_$E(1000+ENC("MSG"),2,4)_U_$E(1000+ENT("MSG"),2,4)
S ENX=ENX_U_$P("^004^004^002",U,$F("FAR",ENTY))
S ENX=ENX_"^|"
S ENL=1,^XMB(3.9,XMZ,2,ENL,0)=ENX
I ENC("MSG")=1,"FA"[ENTY D MG
Q
SEND ; Send Mail Message
S ENL=ENL+1,^XMB(3.9,XMZ,2,ENL,0)=$S(ENC("MSG")=ENT("MSG"):"$",1:"~")
S ^XMB(3.9,XMZ,2,0)="^3.92A^"_ENL_U_ENL_U_DT
S XMY(DUZ)=""
S:"F"[ENTY XMY("G.OFMRD@"_ENDOMAIN)="",XMY("S.OFMRD-SRV1@"_ENDOMAIN)=""
S:"A"[ENTY XMY("G.OFMRD@"_ENDOMAIN)="",XMY("S.OFMRD-SRV2@"_ENDOMAIN)=""
S:"R"[ENTY XMY("S.EN_UPDATEA"_"@"_ENDOMAIN)=""
S XMCHAN=1 D ENT1^XMD K XMCHAN
K XMZ
Q
UPD ; update project
Q:"FA"'[ENTY
K ENTXT
S ENTXT(1)=ENCLDT_" "_$S(ENTY="F":"5-Yr",ENTY="A":"Appl",1:" ")
S ENTXT(1)=ENTXT(1)_" Site transmitted project to Region"
D POSTCL^ENPLUTL(ENDA,"ENTXT") K ENTXT
I $$GET1^DIQ(6925,ENDA_",",181.1,"I")=1 K ENFDA S ENFDA(6925,ENDA_",",181.1)=0 D FILE^DIE("","ENFDA")
I ENTY="A",$$GET1^DIQ(6925,ENDA_",",251,"I")=1 K ENFDA S ENFDA(6925,ENDA_",",251)=0 D FILE^DIE("","ENFDA")
S:ENTY="F" $P(^ENG("PROJ",ENDA,33),U,7,8)=ENDT_U_DUZ
S:ENTY="A" $P(^ENG("PROJ",ENDA,33),U,9,10)=ENDT_U_DUZ
Q
MG ; mail group members
N ENC,ENI,ENQ,ENT,ENX
S ENX=$$FIND1^DIC(3.8,"","X","EN PROJECTS") I 'ENX Q
D LIST^DIC(3.81,","_ENX_",","","","*","","","","","","ENQ")
S ENT=$P(ENQ("DILIST",0),U)
S ENX=""
I ENT S ENI="" F ENC=1:1 S ENI=$O(ENQ("DILIST",1,ENI)) Q:ENI="" D
. S ENX=ENX_U_ENQ("DILIST",1,ENI)
. I '(ENC#5)!(ENC=ENT) D
. . S ENX="MG^"_(ENC+4\5)_U_(ENT+4\5)_ENX_$E("^^^^^",1,6-$L(ENX,U))
. . S ENX=ENX_"^|"
. . S ENL=ENL+1,^XMB(3.9,XMZ,2,ENL,0)=ENX
. . S ENX=""
Q
REPTPR ; Progress Report Pre-Xmit
Q:"R"'[ENTY
N ENPR,ENY52
K ENFDA
; check 'Not Applicable' fields
S ENPR=$P($G(^ENG("PROJ",ENDA,0)),U,6)
S ENY52=$G(^ENG("PROJ",ENDA,52))
I "^NR^"'[(U_ENPR_U) D ; delete both EPA fields
. I $P(ENY52,U,7)]"" S ENFDA(6925,ENDA_",",158.6)="@"
. I $P(ENY52,U,8)]"" S ENFDA(6925,ENDA_",",158.7)="@"
I $P(ENY52,U,7)'="Y" D ; delete EPA REPORTING CATEGORY
. I $P(ENY52,U,8)]"" S ENFDA(6925,ENDA_",",158.7)="@"
I "^NR^SL^"'[(U_ENPR_U) D ; delete BONUS CATEGORY
. I $P(ENY52,U,9)]"" S ENFDA(6925,ENDA_",",158.8)="@"
; update reporting period
S ENFDA(6925,ENDA_",",1)=ENRP
;
D FILE^DIE("","ENFDA")
Q
REPTPS ; Progress Report Post-Xmit
Q:"R"'[ENTY
; update prior submission
S ^ENG("PROJ",ENDA,60)=$G(^ENG("PROJ",ENDA,0))
I $D(^ENG("PROJ",ENDA,1)) S $P(^(60),U,11)="",^(60)=^(60)_^(1)
S ^ENG("PROJ",ENDA,61)=$G(^ENG("PROJ",ENDA,2))
S ^ENG("PROJ",ENDA,62)=$G(^ENG("PROJ",ENDA,3))
S ^ENG("PROJ",ENDA,63)=$G(^ENG("PROJ",ENDA,4))
S ^ENG("PROJ",ENDA,64)=$G(^ENG("PROJ",ENDA,5))
I $D(^ENG("PROJ",ENDA,8)) S $P(^(64),U,11)="",^(64)=^(64)_^(8)
I $D(^ENG("PROJ",ENDA,10)) S $P(^(64),U,21)="",^(64)=^(64)_^(10)
S ^ENG("PROJ",ENDA,65)=$G(^ENG("PROJ",ENDA,13))
S ^ENG("PROJ",ENDA,66)=$G(^ENG("PROJ",ENDA,50))
S ^ENG("PROJ",ENDA,67)=$G(^ENG("PROJ",ENDA,51))
S ^ENG("PROJ",ENDA,68)=$G(^ENG("PROJ",ENDA,52))
I $D(^ENG("PROJ",ENDA,53)) S $P(^(68),U,11)="",^(68)=^(68)_^(53)
S ^ENG("PROJ",ENDA,69)=$G(^ENG("PROJ",ENDA,56))
S ^ENG("PROJ",ENDA,70)=$P($G(^ENG("PROJ",ENDA,15)),U)
K ^ENG("PROJ",ENDA,58) MERGE ^ENG("PROJ",ENDA,58)=^ENG("PROJ",ENDA,57)
S:$D(^ENG("PROJ",ENDA,58)) $P(^ENG("PROJ",ENDA,58),U,2)="6925.0186S"
; move progress notes to remarks
S ENX=$P($G(^ENG("PROJ",ENDA,13)),U) I ENX]"" D
. K ENXT
. S ENDATE=$$FMTE^XLFDT(DT)
. S ENXT="@"
. S ENXT(1)="Progress note transmitted "_ENDATE_":"
. S ENXT(2)=ENX
. S ENXT(3)="End of note ("_ENDATE_")"
. D WP^DIE(6925,ENDA_",",145,"A","ENXT")
. S $P(^ENG("PROJ",ENDA,13),U)=""
; if status = completed project then turn-off monthly updates
S:$P($G(^ENG("PROJ",ENDA,1)),U,3)=16 $P(^ENG("PROJ",ENDA,0),U,5)="N"
Q
;ENPLX1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENPLX1 5557 printed Apr 09, 2024@20:56:59 Page 2
ENPLX1 ;WISC/SAB; PROJECT TRANSMISSION (cont); 6/12/97
+1 ;;7.0;ENGINEERING;**23,28**;Aug 17, 1993
LOCK ; lock valid projects on list
+1 SET ENPN=""
+2 FOR
SET ENPN=$ORDER(^TMP($JOB,"L",ENPN))
if ENPN=""
QUIT
SET ENX=^(ENPN)
Begin DoDot:1
+3 SET ENDA=$PIECE(ENX,U)
+4 IF $PIECE(ENX,U,2)>1
LOCK +^ENG("PROJ",ENDA):10
IF '$TEST
SET END=1
SET $PIECE(^TMP($JOB,"L",ENPN),U,3)=1
End DoDot:1
+5 if 'END
QUIT
+6 ;
+7 SET XMSUB="ERROR DURING QUEUED TRANSMISSION"
+8 SET XMDUZ="Engineering Package"
+9 DO XMZ^XMA2
IF XMZ<1
QUIT
+10 SET ENX="Your queued transmission of "
+11 SET ENX=ENX_$SELECT(ENTY="F":"Five Year Facility Plan Projects",ENTY="A":"Project Applications",ENTY="R":"Project Progress Reports",1:"")
+12 SET ENL=1
SET ^XMB(3.9,XMZ,2,ENL,0)=ENX
+13 SET ENL=ENL+1
SET ^XMB(3.9,XMZ,2,ENL,0)="was not performed because the asterisked projects were being edited."
+14 SET ENL=ENL+1
SET ^XMB(3.9,XMZ,2,ENL,0)=" "
+15 SET ENPN=""
+16 FOR
SET ENPN=$ORDER(^TMP($JOB,"L",ENPN))
if ENPN=""
QUIT
SET ENX=^(ENPN)
Begin DoDot:1
+17 SET ENDA=$PIECE(ENX,U)
+18 IF $PIECE(ENX,U,2)>1
SET ENL=ENL+1
SET ^XMB(3.9,XMZ,2,ENL,0)=$SELECT($PIECE(ENX,U,3):"*",1:" ")_ENPN
End DoDot:1
+19 SET ^XMB(3.9,XMZ,2,0)="^3.92A^"_ENL_U_ENL_U_DT
+20 SET XMY(DUZ)=""
+21 DO ENT1^XMD
+22 KILL XMZ
+23 QUIT
CREATE ; Create Mail Message
+1 IF $GET(XMZ)'<1
DO SEND
+2 SET ENC("MSG")=ENC("MSG")+1
+3 SET ENX="EN XMIT "_$PIECE("^FYFP^APPL^REPT",U,$FIND("FAR",ENTY))_" "
+4 if ENT("PACK")=1!(ENT("PROJ")=1)
SET ENX=ENX_ENPN
+5 if ENT("PACK")'=1&(ENT("PROJ")>1)
SET ENX=ENX_$EXTRACT(1000+$EXTRACT($PIECE($GET(^DIC(6910,1,0)),U,2),1,3),2,4)_" SEQ "_ENC("MSG")_" OF "_ENT("MSG")
+6 SET XMSUB=ENX
+7 SET XMDUZ=DUZ
+8 DO XMZ^XMA2
IF XMZ<1
SET END=1
QUIT
+9 DO NOW^%DTC
SET ENDT=%\1
SET ENY=$PIECE(%,".",2)
+10 SET ENCLDT=$$FDT^ENPLUTL(%)
+11 SET ENX="ENG^"_$EXTRACT(1000+$EXTRACT($PIECE($GET(^DIC(6910,1,0)),U,2),1,3),2,4)
+12 SET ENX=ENX_U_$PIECE("^5YRP^1193^0051",U,$FIND("FAR",ENTY))
+13 SET ENX=ENX_U_(%+17000000\1)_U_ENY_$EXTRACT("000000",1,6-$LENGTH(ENY))
+14 SET ENX=ENX_U_$$LTZ^ENPLUTL_$E(" ",1,3-$LENGTH($$LTZ^ENPLUTL))
+15 SET ENX=ENX_U_$EXTRACT(1000+ENC("MSG"),2,4)_U_$EXTRACT(1000+ENT("MSG"),2,4)
+16 SET ENX=ENX_U_$PIECE("^004^004^002",U,$FIND("FAR",ENTY))
+17 SET ENX=ENX_"^|"
+18 SET ENL=1
SET ^XMB(3.9,XMZ,2,ENL,0)=ENX
+19 IF ENC("MSG")=1
IF "FA"[ENTY
DO MG
+20 QUIT
SEND ; Send Mail Message
+1 SET ENL=ENL+1
SET ^XMB(3.9,XMZ,2,ENL,0)=$SELECT(ENC("MSG")=ENT("MSG"):"$",1:"~")
+2 SET ^XMB(3.9,XMZ,2,0)="^3.92A^"_ENL_U_ENL_U_DT
+3 SET XMY(DUZ)=""
+4 if "F"[ENTY
SET XMY("G.OFMRD@"_ENDOMAIN)=""
SET XMY("S.OFMRD-SRV1@"_ENDOMAIN)=""
+5 if "A"[ENTY
SET XMY("G.OFMRD@"_ENDOMAIN)=""
SET XMY("S.OFMRD-SRV2@"_ENDOMAIN)=""
+6 if "R"[ENTY
SET XMY("S.EN_UPDATEA"_"@"_ENDOMAIN)=""
+7 SET XMCHAN=1
DO ENT1^XMD
KILL XMCHAN
+8 KILL XMZ
+9 QUIT
UPD ; update project
+1 if "FA"'[ENTY
QUIT
+2 KILL ENTXT
+3 SET ENTXT(1)=ENCLDT_" "_$SELECT(ENTY="F":"5-Yr",ENTY="A":"Appl",1:" ")
+4 SET ENTXT(1)=ENTXT(1)_" Site transmitted project to Region"
+5 DO POSTCL^ENPLUTL(ENDA,"ENTXT")
KILL ENTXT
+6 IF $$GET1^DIQ(6925,ENDA_",",181.1,"I")=1
KILL ENFDA
SET ENFDA(6925,ENDA_",",181.1)=0
DO FILE^DIE("","ENFDA")
+7 IF ENTY="A"
IF $$GET1^DIQ(6925,ENDA_",",251,"I")=1
KILL ENFDA
SET ENFDA(6925,ENDA_",",251)=0
DO FILE^DIE("","ENFDA")
+8 if ENTY="F"
SET $PIECE(^ENG("PROJ",ENDA,33),U,7,8)=ENDT_U_DUZ
+9 if ENTY="A"
SET $PIECE(^ENG("PROJ",ENDA,33),U,9,10)=ENDT_U_DUZ
+10 QUIT
MG ; mail group members
+1 NEW ENC,ENI,ENQ,ENT,ENX
+2 SET ENX=$$FIND1^DIC(3.8,"","X","EN PROJECTS")
IF 'ENX
QUIT
+3 DO LIST^DIC(3.81,","_ENX_",","","","*","","","","","","ENQ")
+4 SET ENT=$PIECE(ENQ("DILIST",0),U)
+5 SET ENX=""
+6 IF ENT
SET ENI=""
FOR ENC=1:1
SET ENI=$ORDER(ENQ("DILIST",1,ENI))
if ENI=""
QUIT
Begin DoDot:1
+7 SET ENX=ENX_U_ENQ("DILIST",1,ENI)
+8 IF '(ENC#5)!(ENC=ENT)
Begin DoDot:2
+9 SET ENX="MG^"_(ENC+4\5)_U_(ENT+4\5)_ENX_$EXTRACT("^^^^^",1,6-$LENGTH(ENX,U))
+10 SET ENX=ENX_"^|"
+11 SET ENL=ENL+1
SET ^XMB(3.9,XMZ,2,ENL,0)=ENX
+12 SET ENX=""
End DoDot:2
End DoDot:1
+13 QUIT
REPTPR ; Progress Report Pre-Xmit
+1 if "R"'[ENTY
QUIT
+2 NEW ENPR,ENY52
+3 KILL ENFDA
+4 ; check 'Not Applicable' fields
+5 SET ENPR=$PIECE($GET(^ENG("PROJ",ENDA,0)),U,6)
+6 SET ENY52=$GET(^ENG("PROJ",ENDA,52))
+7 ; delete both EPA fields
IF "^NR^"'[(U_ENPR_U)
Begin DoDot:1
+8 IF $PIECE(ENY52,U,7)]""
SET ENFDA(6925,ENDA_",",158.6)="@"
+9 IF $PIECE(ENY52,U,8)]""
SET ENFDA(6925,ENDA_",",158.7)="@"
End DoDot:1
+10 ; delete EPA REPORTING CATEGORY
IF $PIECE(ENY52,U,7)'="Y"
Begin DoDot:1
+11 IF $PIECE(ENY52,U,8)]""
SET ENFDA(6925,ENDA_",",158.7)="@"
End DoDot:1
+12 ; delete BONUS CATEGORY
IF "^NR^SL^"'[(U_ENPR_U)
Begin DoDot:1
+13 IF $PIECE(ENY52,U,9)]""
SET ENFDA(6925,ENDA_",",158.8)="@"
End DoDot:1
+14 ; update reporting period
+15 SET ENFDA(6925,ENDA_",",1)=ENRP
+16 ;
+17 DO FILE^DIE("","ENFDA")
+18 QUIT
REPTPS ; Progress Report Post-Xmit
+1 if "R"'[ENTY
QUIT
+2 ; update prior submission
+3 SET ^ENG("PROJ",ENDA,60)=$GET(^ENG("PROJ",ENDA,0))
+4 IF $DATA(^ENG("PROJ",ENDA,1))
SET $PIECE(^(60),U,11)=""
SET ^(60)=^(60)_^(1)
+5 SET ^ENG("PROJ",ENDA,61)=$GET(^ENG("PROJ",ENDA,2))
+6 SET ^ENG("PROJ",ENDA,62)=$GET(^ENG("PROJ",ENDA,3))
+7 SET ^ENG("PROJ",ENDA,63)=$GET(^ENG("PROJ",ENDA,4))
+8 SET ^ENG("PROJ",ENDA,64)=$GET(^ENG("PROJ",ENDA,5))
+9 IF $DATA(^ENG("PROJ",ENDA,8))
SET $PIECE(^(64),U,11)=""
SET ^(64)=^(64)_^(8)
+10 IF $DATA(^ENG("PROJ",ENDA,10))
SET $PIECE(^(64),U,21)=""
SET ^(64)=^(64)_^(10)
+11 SET ^ENG("PROJ",ENDA,65)=$GET(^ENG("PROJ",ENDA,13))
+12 SET ^ENG("PROJ",ENDA,66)=$GET(^ENG("PROJ",ENDA,50))
+13 SET ^ENG("PROJ",ENDA,67)=$GET(^ENG("PROJ",ENDA,51))
+14 SET ^ENG("PROJ",ENDA,68)=$GET(^ENG("PROJ",ENDA,52))
+15 IF $DATA(^ENG("PROJ",ENDA,53))
SET $PIECE(^(68),U,11)=""
SET ^(68)=^(68)_^(53)
+16 SET ^ENG("PROJ",ENDA,69)=$GET(^ENG("PROJ",ENDA,56))
+17 SET ^ENG("PROJ",ENDA,70)=$PIECE($GET(^ENG("PROJ",ENDA,15)),U)
+18 KILL ^ENG("PROJ",ENDA,58)
MERGE ^ENG("PROJ",ENDA,58)=^ENG("PROJ",ENDA,57)
+19 if $DATA(^ENG("PROJ",ENDA,58))
SET $PIECE(^ENG("PROJ",ENDA,58),U,2)="6925.0186S"
+20 ; move progress notes to remarks
+21 SET ENX=$PIECE($GET(^ENG("PROJ",ENDA,13)),U)
IF ENX]""
Begin DoDot:1
+22 KILL ENXT
+23 SET ENDATE=$$FMTE^XLFDT(DT)
+24 SET ENXT="@"
+25 SET ENXT(1)="Progress note transmitted "_ENDATE_":"
+26 SET ENXT(2)=ENX
+27 SET ENXT(3)="End of note ("_ENDATE_")"
+28 DO WP^DIE(6925,ENDA_",",145,"A","ENXT")
+29 SET $PIECE(^ENG("PROJ",ENDA,13),U)=""
End DoDot:1
+30 ; if status = completed project then turn-off monthly updates
+31 if $PIECE($GET(^ENG("PROJ",ENDA,1)),U,3)=16
SET $PIECE(^ENG("PROJ",ENDA,0),U,5)="N"
+32 QUIT
+33 ;ENPLX1
