ENWOUTL.m

ENWOUTL ;(WCIOFO)/SAB-Work Order Utilities ;10/21/1998

 ;;7.0;ENGINEERING;**35,42,48,59**;Aug 17, 1993

 Q

 ;

ASKCC(ENWODA) ; Ask Condition Code Extrinsic Function

 ; Input ENWODA - ien of work order

 ; Output - 0 (don't ask) or 1 (ask) condition code

 N ENASK,ENEQDA,ENSHKEY,ENSHPAR

 S ENASK=0

 I $G(ENWODA) S ENEQDA=$P($G(^ENG(6920,ENWODA,3)),U,8) D:ENEQDA

 . S ENSHKEY=$P($G(^ENG(6920,ENWODA,2)),U) Q:'ENSHKEY

 . S ENSHPAR=+$P($G(^DIC(6922,ENSHKEY,0)),U,4)

 . S ENASK=$S(ENSHPAR=0:0,ENSHPAR=2:1,$P($G(^ENG(6914,ENEQDA,2)),U,3)>4999.99:1,1:0)

 Q ENASK

 ;

WO ; select work order entry point

 ; called from various places where work orders are selected

 ; Input

 ;   DIC("S") - (optional and not returned)

 ; Output

 ;   Y        - "ien^.01 value" or "-1" if unsuccessful

 N D,ENX,X

 S DIC="^ENG(6920,"

WOA ; ask user

 R !,"Select WORK ORDER #: ",ENX:DTIME I ENX=""!(ENX["^")!'$T S Y=-1 G WOX

 I $E(ENX,2,2)="." D  I D]"" S X=$E(ENX,3,99),DIC(0)="QE" D IX^DIC G WOR

 . S D=""

 . I $E(ENX)="E" S D="G" Q  ; equipment id#

 . I $E(ENX)="L" S D="C" Q  ; location

 I ENX="?" D

 . W !," Use 'E.value' to list W.O.s whose EQUIPMENT ID# equals 'value'"

 . W !," Use 'L.value' to list W.O.s whose LOCATION starts with 'value'"

 S X=ENX,DIC(0)="QEM" D ^DIC

WOR ; Result of DIC call

 I Y'>0 G WOA

WOX ; Exit

 K DIC

 Q

 ;

CDATE(Y) ; Check on COMPLETION DATE (field 36, file 6920)

 ;

 ;  Expects: Y as COMPLETION DATE (internal format)

 ;           DA as IEN in Work Order File (returned)

 ;

 ;  COMPLETION DATE may not preceed REQUEST DATE for unscheduled w.o.

 ;  For PM work orders, COMPLETION DATE may not preceed nominal date of

 ;    PM w.o. - where century is inferred

 ;

 ;  Returns X as "^" if no date

 ;               "^1" NOMINAL DATE > COMPLETE DATE (PM)

 ;               "^2" REQUEST DATE > COMPLETE DATE (unscheduled)

 ;               Y if acceptable

 ;

 I Y'>0 S X="^",EN("BAD COMPLETION DATE")="" D EN^DDIOL("Inappropriate COMPLETION DATE.") Q X

 N REQDATE,X S REQDATE=$P($P(^ENG(6920,DA,0),U,2),".")

 I REQDATE'>Y S X=Y Q X

 I $E($P(^ENG(6920,DA,0),U),1,3)="PM-" D  Q X

 . N DELYR,NOMDATE

 . S NOMDATE=$E($TR($P(^ENG(6920,DA,0),U),"ABCDEFGHIJKLMNOPQRSTUVWXYZ-",""),1,4)

 . S DELYR=$E(DT,2,3)-$E(NOMDATE,1,2),NOMDATE=$E(DT)+$S(DELYR>79:1,DELYR<-20:-1,1:0)_NOMDATE_"00"

 . I NOMDATE'>Y S X=Y,$P(^ENG(6920,DA,0),U,2)=NOMDATE Q

 . S X="^1",EN("BAD COMPLETION DATE")="" D EN^DDIOL("COMPLETION DATE may not precede nominal PM date.")

 S X="^2" D EN^DDIOL("COMPLETION DATE may not precede REQUEST DATE (unscheduled).")

 Q X

 ;

LBRCST(ENFLAG) ; Calculate work order TOTAL HOURS and the TOTAL LABOR COST

 ;         based on the TECHNICIANS ASSIGNED multiple in file 6920

 ; Called by MUMPS X-REFs in file 6920, fields .01 and 1 in multiple

 ; Input   ENFLAG (1 for SET LOGIC or 2 for KILL LOGIC)

 ; Expects DA(1) as work order IEN

 ;         DA as ASSIGNED TECH IEN [within DA(1)]

 ;

 N HOURS,WAGE,COST,X

 S (HOURS,WAGE,COST,X)=0

 F  S X=$O(^ENG(6920,DA(1),7,X)) Q:X'>0  D

 . I ENFLAG=2,X=DA Q  ; don't include hours of the deleted tech

 . S HOURS(X)=$P(^ENG(6920,DA(1),7,X,0),U,2)

 . S X(0)=$P(^ENG(6920,DA(1),7,X,0),U)

 . S WAGE(X)=$P($G(^ENG("EMP",X(0),0)),U,3)

 . I WAGE(X)'>0,$E(^ENG(6920,DA(1),0),1,3)="PM-" S WAGE(X)=$P($G(^DIC(6910,1,0)),U,4)

 . S COST(X)=HOURS(X)*WAGE(X)

 S X=0

 F  S X=$O(HOURS(X)) Q:X'>0  S HOURS=HOURS+HOURS(X),COST=COST+COST(X)

 S COST=$J(COST,0,2)

 S $P(^ENG(6920,DA(1),5),U,3)=HOURS,$P(^(5),U,6)=COST

 Q

 ;ENWOUTL

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ENWOUTL   3527     printed  Feb 18, 2025@23:22:54                                                                                                                                                                                                     Page 2

ENWOUTL   ;(WCIOFO)/SAB-Work Order Utilities ;10/21/1998

 +1       ;;7.0;ENGINEERING;**35,42,48,59**;Aug 17, 1993

 +2        QUIT 

 +3       ;

ASKCC(ENWODA) ; Ask Condition Code Extrinsic Function

 +1       ; Input ENWODA - ien of work order

 +2       ; Output - 0 (don't ask) or 1 (ask) condition code

 +3        NEW ENASK,ENEQDA,ENSHKEY,ENSHPAR

 +4        SET ENASK=0

 +5        IF $GET(ENWODA)

               SET ENEQDA=$PIECE($GET(^ENG(6920,ENWODA,3)),U,8)

               if ENEQDA

                   Begin DoDot:1

 +6                    SET ENSHKEY=$PIECE($GET(^ENG(6920,ENWODA,2)),U)

                       if 'ENSHKEY

                           QUIT 

 +7                    SET ENSHPAR=+$PIECE($GET(^DIC(6922,ENSHKEY,0)),U,4)

 +8                    SET ENASK=$SELECT(ENSHPAR=0:0,ENSHPAR=2:1,$PIECE($GET(^ENG(6914,ENEQDA,2)),U,3)>4999.99:1,1:0)

                   End DoDot:1

 +9        QUIT ENASK

 +10      ;

WO        ; select work order entry point

 +1       ; called from various places where work orders are selected

 +2       ; Input

 +3       ;   DIC("S") - (optional and not returned)

 +4       ; Output

 +5       ;   Y        - "ien^.01 value" or "-1" if unsuccessful

 +6        NEW D,ENX,X

 +7        SET DIC="^ENG(6920,"

WOA       ; ask user

 +1        READ !,"Select WORK ORDER #: ",ENX:DTIME

           IF ENX=""!(ENX["^")!'$TEST

               SET Y=-1

               GOTO WOX

 +2        IF $EXTRACT(ENX,2,2)="."

               Begin DoDot:1

 +3                SET D=""

 +4       ; equipment id#

                   IF $EXTRACT(ENX)="E"

                       SET D="G"

                       QUIT 

 +5       ; location

                   IF $EXTRACT(ENX)="L"

                       SET D="C"

                       QUIT 

               End DoDot:1

               IF D]""

                   SET X=$EXTRACT(ENX,3,99)

                   SET DIC(0)="QE"

                   DO IX^DIC

                   GOTO WOR

 +6        IF ENX="?"

               Begin DoDot:1

 +7                WRITE !," Use 'E.value' to list W.O.s whose EQUIPMENT ID# equals 'value'"

 +8                WRITE !," Use 'L.value' to list W.O.s whose LOCATION starts with 'value'"

               End DoDot:1

 +9        SET X=ENX

           SET DIC(0)="QEM"

           DO ^DIC

WOR       ; Result of DIC call

 +1        IF Y'>0

               GOTO WOA

WOX       ; Exit

 +1        KILL DIC

 +2        QUIT 

 +3       ;

CDATE(Y)  ; Check on COMPLETION DATE (field 36, file 6920)

 +1       ;

 +2       ;  Expects: Y as COMPLETION DATE (internal format)

 +3       ;           DA as IEN in Work Order File (returned)

 +4       ;

 +5       ;  COMPLETION DATE may not preceed REQUEST DATE for unscheduled w.o.

 +6       ;  For PM work orders, COMPLETION DATE may not preceed nominal date of

 +7       ;    PM w.o. - where century is inferred

 +8       ;

 +9       ;  Returns X as "^" if no date

 +10      ;               "^1" NOMINAL DATE > COMPLETE DATE (PM)

 +11      ;               "^2" REQUEST DATE > COMPLETE DATE (unscheduled)

 +12      ;               Y if acceptable

 +13      ;

 +14       IF Y'>0

               SET X="^"

               SET EN("BAD COMPLETION DATE")=""

               DO EN^DDIOL("Inappropriate COMPLETION DATE.")

               QUIT X

 +15       NEW REQDATE,X

           SET REQDATE=$PIECE($PIECE(^ENG(6920,DA,0),U,2),".")

 +16       IF REQDATE'>Y

               SET X=Y

               QUIT X

 +17       IF $EXTRACT($PIECE(^ENG(6920,DA,0),U),1,3)="PM-"

               Begin DoDot:1

 +18               NEW DELYR,NOMDATE

 +19               SET NOMDATE=$EXTRACT($TRANSLATE($PIECE(^ENG(6920,DA,0),U),"ABCDEFGHIJKLMNOPQRSTUVWXYZ-",""),1,4)

 +20               SET DELYR=$EXTRACT(DT,2,3)-$EXTRACT(NOMDATE,1,2)

                   SET NOMDATE=$EXTRACT(DT)+$SELECT(DELYR>79:1,DELYR<-20:-1,1:0)_NOMDATE_"00"

 +21               IF NOMDATE'>Y

                       SET X=Y

                       SET $PIECE(^ENG(6920,DA,0),U,2)=NOMDATE

                       QUIT 

 +22               SET X="^1"

                   SET EN("BAD COMPLETION DATE")=""

                   DO EN^DDIOL("COMPLETION DATE may not precede nominal PM date.")

               End DoDot:1

               QUIT X

 +23       SET X="^2"

           DO EN^DDIOL("COMPLETION DATE may not precede REQUEST DATE (unscheduled).")

 +24       QUIT X

 +25      ;

LBRCST(ENFLAG) ; Calculate work order TOTAL HOURS and the TOTAL LABOR COST

 +1       ;         based on the TECHNICIANS ASSIGNED multiple in file 6920

 +2       ; Called by MUMPS X-REFs in file 6920, fields .01 and 1 in multiple

 +3       ; Input   ENFLAG (1 for SET LOGIC or 2 for KILL LOGIC)

 +4       ; Expects DA(1) as work order IEN

 +5       ;         DA as ASSIGNED TECH IEN [within DA(1)]

 +6       ;

 +7        NEW HOURS,WAGE,COST,X

 +8        SET (HOURS,WAGE,COST,X)=0

 +9        FOR 

               SET X=$ORDER(^ENG(6920,DA(1),7,X))

               if X'>0

                   QUIT 

               Begin DoDot:1

 +10      ; don't include hours of the deleted tech

                   IF ENFLAG=2

                       IF X=DA

                           QUIT 

 +11               SET HOURS(X)=$PIECE(^ENG(6920,DA(1),7,X,0),U,2)

 +12               SET X(0)=$PIECE(^ENG(6920,DA(1),7,X,0),U)

 +13               SET WAGE(X)=$PIECE($GET(^ENG("EMP",X(0),0)),U,3)

 +14               IF WAGE(X)'>0

                       IF $EXTRACT(^ENG(6920,DA(1),0),1,3)="PM-"

                           SET WAGE(X)=$PIECE($GET(^DIC(6910,1,0)),U,4)

 +15               SET COST(X)=HOURS(X)*WAGE(X)

               End DoDot:1

 +16       SET X=0

 +17       FOR 

               SET X=$ORDER(HOURS(X))

               if X'>0

                   QUIT 

               SET HOURS=HOURS+HOURS(X)

               SET COST=COST+COST(X)

 +18       SET COST=$JUSTIFY(COST,0,2)

 +19       SET $PIECE(^ENG(6920,DA(1),5),U,3)=HOURS

           SET $PIECE(^(5),U,6)=COST

 +20       QUIT 

 +21      ;ENWOUTL