ENAEMS ;WOIFO/SU-AEMS/MERS WO PERFORMANCE EXTRACT ; 07/25/2002 03:30 PM
;;7.0;ENGINEERING;**72**;August 17,1993
;Per VHA Directive 10-93-142, this routine should not be modified.
;
BEGIN ;
;
NEW FY
W !!,"AEMS/MERS WORK ORDER PERFORMANCE EXTRACT",!!!
R "PLEASE ENTER FISCAL YEAR FOR PROCESSING: 2002//",FY:$S($D(DTIME):DTIME,1:60)
I FY="^" G EXIT
I FY="" S FY=2002
I FY'?4N W !!,"Please enter 4 digits Fiscal Year",!! G BEGIN
W !!,"Processing ... "
POST ;
NEW I,J,K,X,Y,STA,OSTA,LC,FDT,TP,QT,AA,BB,A1,U,PMST
NEW X1,X2,XMSUB,XMTEXT,XMY,FYB,FYE,END,DIFROM
I $G(FY)="" NEW FY S FY=2002
K ^TMP("ENAEMS#10"),^TMP("ENAEMS#19")
; get report period ( FY Begin/End date )
S U="^",FYB=FY-1701_1000,FYE=FY-1700_"0931"
; get reporting site
S STA=$P(^DIC(6910,1,0),U,2),END=$$LEGACY^XUAF4(STA)
I END=1 G EXIT
I STA="" S STA="UNKNOWN"
;
MS10 ; measure #10
;
S I=0 F S I=$O(^ENG(6914,I)) Q:'I D
. ; get owning station
. S OSTA=$P($G(^ENG(6914,I,9)),U,5) I OSTA="" S OSTA=STA
. S J=0 F S J=$O(^ENG(6914,I,6,J)) Q:'J D
.. S K=$G(^ENG(6914,I,6,J,0)),AA=+K
.. I AA<FYB!(AA>FYE) Q ;Quit if falls outside the range
.. S TP=$E($P(K,U,2),1,2) I TP="Y2" Q ; skip Y2K record
.. I TP'="PM" S TP="UNSCH"
.. I TP="PM" S PMST=$E($P(K,U,3)) S TP=$S(PMST="D":"PMDEF",1:"PMNDF")
.. S QT=$E(AA,4,5)+2\3+1 I QT>4 S QT=1 ; calculate quarter by month
.. ; get hour:p4, labor:p5, material:p6, vendor:p7
.. F A1=4:1:7 S BB(A1-2)=$P(K,U,A1)
.. S AA=$G(^TMP("ENAEMS#10",$J,OSTA,QT,TP)),BB(1)=1
.. ; increment each counter: count, hour, labor$, material$, vendor$
.. F A1=1:1:5 S $P(AA,",",A1)=$P(AA,",",A1)+BB(A1)
.. S ^TMP("ENAEMS#10",$J,OSTA,QT,TP)=AA
;
MS19 ; measure #19
S I=0 F S I=$O(^ENG(6920,I)) Q:'I D
. Q:'$D(^ENG(6920,I,0))
. ; exclude PM, Y2K work order
. S TP=$E(^ENG(6920,I,0),1,2) I TP="PM"!(TP="Y2") Q
. ; X1: date complete, X2: date request
. S X2=$P($P($G(^ENG(6920,I,0)),U,2),".")
. S X1=$P($P($G(^ENG(6920,I,5)),U,2),".")
. Q:X2="" ; if request date is null
. Q:X1<X2 ; date complete smaller than date request
. I X1<FYB!(X1>FYE) Q ; Quit if falls outside the range
. S QT=$E(X1,4,5)+2\3+1 I QT>4 S QT=1 ; calculate quarter by month
. D ^%DTC ; calculate total date spent by date X1 and X2
. S AA=$G(^TMP("ENAEMS#19",$J,QT)),AA(1)=1,AA(2)=X+1
. ; increment each counter: count, date spent
. F A1=1,2 S $P(AA,",",A1)=$P(AA,",",A1)+AA(A1)
. S ^TMP("ENAEMS#19",$J,QT)=AA
;
D RPT
EXIT ;
K ^TMP("ENAEMS#10"),^TMP("ENAEMS#19")
Q
;
RPT ;
; Construct Email text file
S LC=1,X=","
S OSTA="" F S OSTA=$O(^TMP("ENAEMS#10",$J,OSTA)) Q:OSTA="" D
. S QT=0 F S QT=$O(^TMP("ENAEMS#10",$J,OSTA,QT)) Q:'QT D
.. S TP="" F S TP=$O(^TMP("ENAEMS#10",$J,OSTA,QT,TP)) Q:TP="" D
... S AA=^TMP("ENAEMS#10",$J,OSTA,QT,TP)
... S LC=LC+1,FDT(LC)=STA_X_OSTA_X_FY_"-"_QT_X_TP_X_AA
D MAIL(10)
S LC=1,QT=0 K FDT
F S QT=$O(^TMP("ENAEMS#19",$J,QT)) Q:'QT D
. S AA=^TMP("ENAEMS#19",$J,QT),$P(AA,X,2)=$J($P(AA,X,2)/AA,1,1)
. S LC=LC+1,FDT(LC)=STA_X_FY_"-"_QT_X_AA
D MAIL(19)
Q
;
MAIL(MN) ;
; Send report to mail group member and patch installer
X ^%ZOSF("UCI") S J=^%ZOSF("PROD")
S:J'["," Y=$P(Y,",") S END=$$KSP^XUPARAM("WHERE")
; send report to mail group for PRODUCTION UCI only
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)=""
; mail to user who install this patch
I $G(DUZ),$D(^VA(200,DUZ)) S XMY(DUZ)=""
; if no data extracted, send blank MSG anyway
I '$D(FDT) S FDT(LC)=""
S XMSUB="Measure #"_MN_", Site "_STA_", FY "_FY_", WO Performance Extract"
S XMTEXT="FDT("
D ^XMD
Q
MAILGRP ;
;;G.CoreFLS AEMS/MERS EXTRACT@DOMAIN.EXT
;;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENAEMS 3833 printed Sep 23, 2025@19:27:30 Page 2
ENAEMS ;WOIFO/SU-AEMS/MERS WO PERFORMANCE EXTRACT ; 07/25/2002 03:30 PM
+1 ;;7.0;ENGINEERING;**72**;August 17,1993
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
BEGIN ;
+1 ;
+2 NEW FY
+3 WRITE !!,"AEMS/MERS WORK ORDER PERFORMANCE EXTRACT",!!!
+4 READ "PLEASE ENTER FISCAL YEAR FOR PROCESSING: 2002//",FY:$SELECT($DATA(DTIME):DTIME,1:60)
+5 IF FY="^"
GOTO EXIT
+6 IF FY=""
SET FY=2002
+7 IF FY'?4N
WRITE !!,"Please enter 4 digits Fiscal Year",!!
GOTO BEGIN
+8 WRITE !!,"Processing ... "
POST ;
+1 NEW I,J,K,X,Y,STA,OSTA,LC,FDT,TP,QT,AA,BB,A1,U,PMST
+2 NEW X1,X2,XMSUB,XMTEXT,XMY,FYB,FYE,END,DIFROM
+3 IF $GET(FY)=""
NEW FY
SET FY=2002
+4 KILL ^TMP("ENAEMS#10"),^TMP("ENAEMS#19")
+5 ; get report period ( FY Begin/End date )
+6 SET U="^"
SET FYB=FY-1701_1000
SET FYE=FY-1700_"0931"
+7 ; get reporting site
+8 SET STA=$PIECE(^DIC(6910,1,0),U,2)
SET END=$$LEGACY^XUAF4(STA)
+9 IF END=1
GOTO EXIT
+10 IF STA=""
SET STA="UNKNOWN"
+11 ;
MS10 ; measure #10
+1 ;
+2 SET I=0
FOR
SET I=$ORDER(^ENG(6914,I))
if 'I
QUIT
Begin DoDot:1
+3 ; get owning station
+4 SET OSTA=$PIECE($GET(^ENG(6914,I,9)),U,5)
IF OSTA=""
SET OSTA=STA
+5 SET J=0
FOR
SET J=$ORDER(^ENG(6914,I,6,J))
if 'J
QUIT
Begin DoDot:2
+6 SET K=$GET(^ENG(6914,I,6,J,0))
SET AA=+K
+7 ;Quit if falls outside the range
IF AA<FYB!(AA>FYE)
QUIT
+8 ; skip Y2K record
SET TP=$EXTRACT($PIECE(K,U,2),1,2)
IF TP="Y2"
QUIT
+9 IF TP'="PM"
SET TP="UNSCH"
+10 IF TP="PM"
SET PMST=$EXTRACT($PIECE(K,U,3))
SET TP=$SELECT(PMST="D":"PMDEF",1:"PMNDF")
+11 ; calculate quarter by month
SET QT=$EXTRACT(AA,4,5)+2\3+1
IF QT>4
SET QT=1
+12 ; get hour:p4, labor:p5, material:p6, vendor:p7
+13 FOR A1=4:1:7
SET BB(A1-2)=$PIECE(K,U,A1)
+14 SET AA=$GET(^TMP("ENAEMS#10",$JOB,OSTA,QT,TP))
SET BB(1)=1
+15 ; increment each counter: count, hour, labor$, material$, vendor$
+16 FOR A1=1:1:5
SET $PIECE(AA,",",A1)=$PIECE(AA,",",A1)+BB(A1)
+17 SET ^TMP("ENAEMS#10",$JOB,OSTA,QT,TP)=AA
End DoDot:2
End DoDot:1
+18 ;
MS19 ; measure #19
+1 SET I=0
FOR
SET I=$ORDER(^ENG(6920,I))
if 'I
QUIT
Begin DoDot:1
+2 if '$DATA(^ENG(6920,I,0))
QUIT
+3 ; exclude PM, Y2K work order
+4 SET TP=$EXTRACT(^ENG(6920,I,0),1,2)
IF TP="PM"!(TP="Y2")
QUIT
+5 ; X1: date complete, X2: date request
+6 SET X2=$PIECE($PIECE($GET(^ENG(6920,I,0)),U,2),".")
+7 SET X1=$PIECE($PIECE($GET(^ENG(6920,I,5)),U,2),".")
+8 ; if request date is null
if X2=""
QUIT
+9 ; date complete smaller than date request
if X1<X2
QUIT
+10 ; Quit if falls outside the range
IF X1<FYB!(X1>FYE)
QUIT
+11 ; calculate quarter by month
SET QT=$EXTRACT(X1,4,5)+2\3+1
IF QT>4
SET QT=1
+12 ; calculate total date spent by date X1 and X2
DO ^%DTC
+13 SET AA=$GET(^TMP("ENAEMS#19",$JOB,QT))
SET AA(1)=1
SET AA(2)=X+1
+14 ; increment each counter: count, date spent
+15 FOR A1=1,2
SET $PIECE(AA,",",A1)=$PIECE(AA,",",A1)+AA(A1)
+16 SET ^TMP("ENAEMS#19",$JOB,QT)=AA
End DoDot:1
+17 ;
+18 DO RPT
EXIT ;
+1 KILL ^TMP("ENAEMS#10"),^TMP("ENAEMS#19")
+2 QUIT
+3 ;
RPT ;
+1 ; Construct Email text file
+2 SET LC=1
SET X=","
+3 SET OSTA=""
FOR
SET OSTA=$ORDER(^TMP("ENAEMS#10",$JOB,OSTA))
if OSTA=""
QUIT
Begin DoDot:1
+4 SET QT=0
FOR
SET QT=$ORDER(^TMP("ENAEMS#10",$JOB,OSTA,QT))
if 'QT
QUIT
Begin DoDot:2
+5 SET TP=""
FOR
SET TP=$ORDER(^TMP("ENAEMS#10",$JOB,OSTA,QT,TP))
if TP=""
QUIT
Begin DoDot:3
+6 SET AA=^TMP("ENAEMS#10",$JOB,OSTA,QT,TP)
+7 SET LC=LC+1
SET FDT(LC)=STA_X_OSTA_X_FY_"-"_QT_X_TP_X_AA
End DoDot:3
End DoDot:2
End DoDot:1
+8 DO MAIL(10)
+9 SET LC=1
SET QT=0
KILL FDT
+10 FOR
SET QT=$ORDER(^TMP("ENAEMS#19",$JOB,QT))
if 'QT
QUIT
Begin DoDot:1
+11 SET AA=^TMP("ENAEMS#19",$JOB,QT)
SET $PIECE(AA,X,2)=$JUSTIFY($PIECE(AA,X,2)/AA,1,1)
+12 SET LC=LC+1
SET FDT(LC)=STA_X_FY_"-"_QT_X_AA
End DoDot:1
+13 DO MAIL(19)
+14 QUIT
+15 ;
MAIL(MN) ;
+1 ; Send report to mail group member and patch installer
+2 XECUTE ^%ZOSF("UCI")
SET J=^%ZOSF("PROD")
+3 if J'[","
SET Y=$PIECE(Y,",")
SET END=$$KSP^XUPARAM("WHERE")
+4 ; send report to mail group for PRODUCTION UCI only
+5 IF Y=J
IF END'["FO-"
IF END'["ISC-"
FOR I=1:1
SET J=$TEXT(MAILGRP+I)
SET J=$PIECE(J,";;",2)
if J=""
QUIT
SET XMY(J)=""
+6 ; mail to user who install this patch
+7 IF $GET(DUZ)
IF $DATA(^VA(200,DUZ))
SET XMY(DUZ)=""
+8 ; if no data extracted, send blank MSG anyway
+9 IF '$DATA(FDT)
SET FDT(LC)=""
+10 SET XMSUB="Measure #"_MN_", Site "_STA_", FY "_FY_", WO Performance Extract"
+11 SET XMTEXT="FDT("
+12 DO ^XMD
+13 QUIT
MAILGRP ;
+1 ;;G.CoreFLS AEMS/MERS EXTRACT@DOMAIN.EXT
+2 ;;
+3 QUIT
