Routine: ENAEMS

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")

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)

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

MAILGRP ;

 ;;G.CoreFLS AEMS/MERS EXTRACT@DOMAIN.EXT

;;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENAEMS   3833     printed  Mar 13, 2025@20:56:08                                                                                                                                                                                                      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

ENAEMS.m