ENXIP65 ;WCIOFO/SAB-PATCH INSTALL ROUTINE ;5/18/2000
;;7.0;ENGINEERING;**65**;Aug 17, 1993
Q
;
PS ;Post Install Entry Point
;
; only perform during 1st install
I $$PATCH^XPDUTL("EN*7.0*65") D BMES^XPDUTL(" Skipping post install since patch was previously installed.") Q
;
N ENX,Y
; create KIDS checkpoints with call backs
F ENX="XTIME","EQHIST" D
. S Y=$$NEWCP^XPDUTL(ENX,ENX_"^ENXIP65")
. I 'Y D BMES^XPDUTL("ERROR Creating "_ENX_" Checkpoint.")
Q
;
XTIME ; Remove time from equipment history entries
; Previous patch EN*7*48 resulted in work orders with a time being
; incorrectly posted to the equipment history
N ENACTN,ENC,ENDTCP,ENH,ENHDA,ENHR,ENINV
N XPDIDTOT
;
D BMES^XPDUTL(" Removing time from equipment histories...")
;
; estimate count of equipment to examine
S ENC("TOT")=$P($G(^ENG(6914,0)),U,4)
I ENC("TOT")<1 S ENC("TOT")=1
S ENC("EQ")=0 ; count of evaluated equipment
S ENC("FIX")=0 ; count of modified histories
S XPDIDTOT=ENC("TOT") ; set total for status bar
S ENC("UPD")=5 ; initial % required to update status bar
;
; loop thru equipment
S ENINV=0 F S ENINV=$O(^ENG(6914,ENINV)) Q:'ENINV D
. S ENC("EQ")=ENC("EQ")+1
. S ENC("%")=ENC("EQ")*100/ENC("TOT") ; calculate % complete
. ;
. ; check if status bar should be updated
. I ENC("%")>ENC("UPD"),ENC("%")<100 D
. . D UPDATE^XPDID(ENC("EQ")) ; update status bar
. . S ENC("UPD")=ENC("UPD")+5 ; increase update criteria by 5%
. ;
. ; loop thru history multiple
. S ENHDA=0
. F S ENHDA=$O(^ENG(6914,ENINV,6,ENHDA)) Q:'ENHDA I ENHDA["." D
. . ; contains a time
. . ;
. . ; get current data
. . S ENH=$G(^ENG(6914,ENINV,6,ENHDA,0))
. . Q:ENH=""
. . S ENHR=$P(ENH,U)
. . S ENDTCP=$P(ENHR,"-") ; date complete
. . S ENACTN=$P(ENHR,"-",2) ; work action(s)
. . ;W !!,ENINV,?10,ENHDA,?25,ENDTCP,!," ",ENH
. . ;
. . ; remove time from the date in the history reference field
. . S ENDTCP=$P(ENDTCP,".")
. . S $P(ENH,U)=ENDTCP_"-"_ENACTN
. . ;
. . ;W !,ENINV,?25,ENDTCP,!," ",ENH
. . ; post to history as a new entry (uses ENINV, ENDTCP, and ENH)
. . D EXT^ENEQHS
. . ;
. . ; delete original entry from history
. . K ^ENG(6914,ENINV,6,ENHDA,0)
. . S $P(^ENG(6914,ENINV,6,0),U,4)=$P(^ENG(6914,ENINV,6,0),U,4)-1
. . ;
. . S ENC("FIX")=ENC("FIX")+1
;
D MES^XPDUTL(" "_ENC("FIX")_" equipment histories were modified.")
Q
;
EQHIST ; update equipment history data based on completed work orders
;
N ENC,ENEQDA,ENEQHDA,ENEQHX,ENH,ENI,ENINV,ENTEC,ENWODA,ENWODC,ENWOX
N XPDIDTOT
;
D BMES^XPDUTL(" Using completed work order data to correct equipment histories...")
;
; estimate count of work orders to examine
S ENC("TOT")=$P($G(^ENG(6920,0)),U,4)
I ENC("TOT")<1 S ENC("TOT")=1
S ENC("WO")=0 ; count of evaluated work orders
S XPDIDTOT=ENC("TOT") ; set total for status bar
S ENC("UPD")=5 ; initial % required to update status bar
;
S ENC("WOC")=0 ; count of work orders with status = complete
S ENC("EHM")=0 ; count of missing equipment histories
S ENC("DIF")=0 ; count of different equip hist vs w.o.
;
K ^XTMP("EN7P65")
S ^XTMP("EN7P65",0)=$$FMADD^XLFDT(DT,90)_U_DT
;
; loop thru work orders
S ENWODA=0 F S ENWODA=$O(^ENG(6920,ENWODA)) Q:'ENWODA D
. S ENC("WO")=ENC("WO")+1
. S ENC("%")=ENC("WO")*100/ENC("TOT") ; calculate % complete
. ;
. ; check if status bar should be updated
. I ENC("%")>ENC("UPD"),ENC("%")<100 D
. . D UPDATE^XPDID(ENC("WO")) ; update status bar
. . S ENC("UPD")=ENC("UPD")+5 ; increase update criteria by 5%
. ;
. S ENEQDA=$P($G(^ENG(6920,ENWODA,3)),U,8) ; equip entry #
. Q:ENEQDA'>0 ; not linked with equipment entry
. S ENWODC=$P($G(^ENG(6920,ENWODA,5)),U,2) ; date complete
. Q:ENWODC="" ; not completed
. Q:$P($G(^ENG(6920,ENWODA,4)),U,3)=5 ; disapproved
. ; have found a completed work order for an equipment record
. S ENC("WOC")=ENC("WOC")+1 ; count it
. S ENWOX=$P($G(^ENG(6920,ENWODA,0)),U)
. ;
. ; check if equipment record exists
. Q:'$D(^ENG(6914,ENEQDA,0)) ; equip must have been deleted or archived
. ;
. ; determine expected history value based on work order
. S ENH=$$HIST(ENWODA)
. ;
. ; look for work order in the equipment history
. S ENEQHDA=0
. S ENI=0 F S ENI=$O(^ENG(6914,ENEQDA,6,ENI)) Q:'ENI D Q:ENEQHDA
. . S ENEQHX=$G(^ENG(6914,ENEQDA,6,ENI,0))
. . I $P(ENEQHX,U,2)=ENWOX S ENEQHDA=ENI ; found it
. I ENEQHDA'>0 D Q ; equipment hist missing
. . ; add to equip hist
. . S DA=ENWODA,ENINV=ENEQDA
. . S ENTEC=$P($G(^ENG(6920,DA,2)),U,2)
. . D W^ENEQHS
. . ;
. . S ENC("EHM")=ENC("EHM")+1
. . S ^XTMP("EN7P65","ADD",ENWODA,ENEQDA)=ENH
. ;
. ; compare history with expected history and update if necessary
. I $P(ENEQHX,U,3,7)'=$P(ENH,U,3,7) D ; values differ
. . ;
. . S ^XTMP("EN7P65","UPD",ENEQDA,ENEQHDA)=ENWODA
. . S ^XTMP("EN7P65","UPD",ENEQDA,ENEQHDA,"OLD")=ENEQHX
. . F I=3:1:7 S $P(ENEQHX,U,I)=$P(ENH,U,I)
. . S ^ENG(6914,ENEQDA,6,ENEQHDA,0)=ENEQHX
. . ;
. . S ENC("DIF")=ENC("DIF")+1
. . S ^XTMP("EN7P65","UPD",ENEQDA,ENEQHDA,"NEW")=ENEQHX
;
; save counts
S ^XTMP("EN7P65","UPD",0)=ENC("DIF")
S ^XTMP("EN7P65","ADD",0)=ENC("EHM")
;
D MES^XPDUTL(" Processed "_ENC("WOC")_" completed work orders.")
D MES^XPDUTL(" "_ENC("EHM")_" missing equipment histories were added.")
D MES^XPDUTL(" "_ENC("DIF")_" inaccurate equipment histories were fixed.")
Q
;
HIST(DA) ; determine equipment hist value based on work order data
; input DA - work order internal entry #
N ENACTN,ENDTCP,ENEMPL,ENH,ENHRS,ENINV,ENLABOR,ENMTL
N ENODE,ENRET,ENSTAT,ENTEC,ENVEND,ENWORK,ENWOX,I,J,J1,K
S ENRET=""
;
I $D(^ENG(6920,DA,4)),$P(^(4),U,3)=5 Q ENRET ; disapproved work order
S ENWOX=$P($G(^ENG(6920,DA,0)),U)
S ENINV=$P($G(^ENG(6920,DA,3)),U,8)
S ENTEC=$P($G(^ENG(6920,DA,2)),U,2)
;
I ENTEC="" S ENEMPL=$S($E(ENWOX,1,3)="PM-":"STAFF",1:"NO ENTRY")
E S ENEMPL=$E($P($G(^ENG("EMP",ENTEC,0)),U),1,15)
;
S ENODE=$G(^ENG(6920,DA,5))
S ENDTCP=$P($P(ENODE,U,2),"."),ENHRS=$P(ENODE,U,3),ENMTL=$P(ENODE,U,4)
S ENLABOR=$P(ENODE,U,6),ENSTAT=$P(ENODE,U,8),ENWORK=$P(ENODE,U,7)
S ENACTN="XX"
I $D(^ENG(6920,DA,8)) D
. F I=0:0 S I=$O(^ENG(6920,DA,8,I)) Q:I'>0!($L(ENACTN)=8) D
.. S J=$P(^ENG(6920,DA,8,I,0),U)
.. Q:'$D(^ENG(6920.1,J,0)) S J1=$P(^(0),U,2)
.. I ENACTN="XX" S ENACTN=""
.. S ENACTN=ENACTN_J1
S ENVEND=$P($P($G(^ENG(6920,DA,4)),U,4),".")
S ENRET=ENDTCP_"-"_ENACTN_U_ENWOX_U_ENSTAT_U_ENHRS_U_ENLABOR_U_ENMTL_U_ENVEND_U_ENEMPL_U_ENWORK
Q ENRET
;
;ENXIP65
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENXIP65 6638 printed Nov 22, 2024@17:07:02 Page 2
ENXIP65 ;WCIOFO/SAB-PATCH INSTALL ROUTINE ;5/18/2000
+1 ;;7.0;ENGINEERING;**65**;Aug 17, 1993
+2 QUIT
+3 ;
PS ;Post Install Entry Point
+1 ;
+2 ; only perform during 1st install
+3 IF $$PATCH^XPDUTL("EN*7.0*65")
DO BMES^XPDUTL(" Skipping post install since patch was previously installed.")
QUIT
+4 ;
+5 NEW ENX,Y
+6 ; create KIDS checkpoints with call backs
+7 FOR ENX="XTIME","EQHIST"
Begin DoDot:1
+8 SET Y=$$NEWCP^XPDUTL(ENX,ENX_"^ENXIP65")
+9 IF 'Y
DO BMES^XPDUTL("ERROR Creating "_ENX_" Checkpoint.")
End DoDot:1
+10 QUIT
+11 ;
XTIME ; Remove time from equipment history entries
+1 ; Previous patch EN*7*48 resulted in work orders with a time being
+2 ; incorrectly posted to the equipment history
+3 NEW ENACTN,ENC,ENDTCP,ENH,ENHDA,ENHR,ENINV
+4 NEW XPDIDTOT
+5 ;
+6 DO BMES^XPDUTL(" Removing time from equipment histories...")
+7 ;
+8 ; estimate count of equipment to examine
+9 SET ENC("TOT")=$PIECE($GET(^ENG(6914,0)),U,4)
+10 IF ENC("TOT")<1
SET ENC("TOT")=1
+11 ; count of evaluated equipment
SET ENC("EQ")=0
+12 ; count of modified histories
SET ENC("FIX")=0
+13 ; set total for status bar
SET XPDIDTOT=ENC("TOT")
+14 ; initial % required to update status bar
SET ENC("UPD")=5
+15 ;
+16 ; loop thru equipment
+17 SET ENINV=0
FOR
SET ENINV=$ORDER(^ENG(6914,ENINV))
if 'ENINV
QUIT
Begin DoDot:1
+18 SET ENC("EQ")=ENC("EQ")+1
+19 ; calculate % complete
SET ENC("%")=ENC("EQ")*100/ENC("TOT")
+20 ;
+21 ; check if status bar should be updated
+22 IF ENC("%")>ENC("UPD")
IF ENC("%")<100
Begin DoDot:2
+23 ; update status bar
DO UPDATE^XPDID(ENC("EQ"))
+24 ; increase update criteria by 5%
SET ENC("UPD")=ENC("UPD")+5
End DoDot:2
+25 ;
+26 ; loop thru history multiple
+27 SET ENHDA=0
+28 FOR
SET ENHDA=$ORDER(^ENG(6914,ENINV,6,ENHDA))
if 'ENHDA
QUIT
IF ENHDA["."
Begin DoDot:2
+29 ; contains a time
+30 ;
+31 ; get current data
+32 SET ENH=$GET(^ENG(6914,ENINV,6,ENHDA,0))
+33 if ENH=""
QUIT
+34 SET ENHR=$PIECE(ENH,U)
+35 ; date complete
SET ENDTCP=$PIECE(ENHR,"-")
+36 ; work action(s)
SET ENACTN=$PIECE(ENHR,"-",2)
+37 ;W !!,ENINV,?10,ENHDA,?25,ENDTCP,!," ",ENH
+38 ;
+39 ; remove time from the date in the history reference field
+40 SET ENDTCP=$PIECE(ENDTCP,".")
+41 SET $PIECE(ENH,U)=ENDTCP_"-"_ENACTN
+42 ;
+43 ;W !,ENINV,?25,ENDTCP,!," ",ENH
+44 ; post to history as a new entry (uses ENINV, ENDTCP, and ENH)
+45 DO EXT^ENEQHS
+46 ;
+47 ; delete original entry from history
+48 KILL ^ENG(6914,ENINV,6,ENHDA,0)
+49 SET $PIECE(^ENG(6914,ENINV,6,0),U,4)=$PIECE(^ENG(6914,ENINV,6,0),U,4)-1
+50 ;
+51 SET ENC("FIX")=ENC("FIX")+1
End DoDot:2
End DoDot:1
+52 ;
+53 DO MES^XPDUTL(" "_ENC("FIX")_" equipment histories were modified.")
+54 QUIT
+55 ;
EQHIST ; update equipment history data based on completed work orders
+1 ;
+2 NEW ENC,ENEQDA,ENEQHDA,ENEQHX,ENH,ENI,ENINV,ENTEC,ENWODA,ENWODC,ENWOX
+3 NEW XPDIDTOT
+4 ;
+5 DO BMES^XPDUTL(" Using completed work order data to correct equipment histories...")
+6 ;
+7 ; estimate count of work orders to examine
+8 SET ENC("TOT")=$PIECE($GET(^ENG(6920,0)),U,4)
+9 IF ENC("TOT")<1
SET ENC("TOT")=1
+10 ; count of evaluated work orders
SET ENC("WO")=0
+11 ; set total for status bar
SET XPDIDTOT=ENC("TOT")
+12 ; initial % required to update status bar
SET ENC("UPD")=5
+13 ;
+14 ; count of work orders with status = complete
SET ENC("WOC")=0
+15 ; count of missing equipment histories
SET ENC("EHM")=0
+16 ; count of different equip hist vs w.o.
SET ENC("DIF")=0
+17 ;
+18 KILL ^XTMP("EN7P65")
+19 SET ^XTMP("EN7P65",0)=$$FMADD^XLFDT(DT,90)_U_DT
+20 ;
+21 ; loop thru work orders
+22 SET ENWODA=0
FOR
SET ENWODA=$ORDER(^ENG(6920,ENWODA))
if 'ENWODA
QUIT
Begin DoDot:1
+23 SET ENC("WO")=ENC("WO")+1
+24 ; calculate % complete
SET ENC("%")=ENC("WO")*100/ENC("TOT")
+25 ;
+26 ; check if status bar should be updated
+27 IF ENC("%")>ENC("UPD")
IF ENC("%")<100
Begin DoDot:2
+28 ; update status bar
DO UPDATE^XPDID(ENC("WO"))
+29 ; increase update criteria by 5%
SET ENC("UPD")=ENC("UPD")+5
End DoDot:2
+30 ;
+31 ; equip entry #
SET ENEQDA=$PIECE($GET(^ENG(6920,ENWODA,3)),U,8)
+32 ; not linked with equipment entry
if ENEQDA'>0
QUIT
+33 ; date complete
SET ENWODC=$PIECE($GET(^ENG(6920,ENWODA,5)),U,2)
+34 ; not completed
if ENWODC=""
QUIT
+35 ; disapproved
if $PIECE($GET(^ENG(6920,ENWODA,4)),U,3)=5
QUIT
+36 ; have found a completed work order for an equipment record
+37 ; count it
SET ENC("WOC")=ENC("WOC")+1
+38 SET ENWOX=$PIECE($GET(^ENG(6920,ENWODA,0)),U)
+39 ;
+40 ; check if equipment record exists
+41 ; equip must have been deleted or archived
if '$DATA(^ENG(6914,ENEQDA,0))
QUIT
+42 ;
+43 ; determine expected history value based on work order
+44 SET ENH=$$HIST(ENWODA)
+45 ;
+46 ; look for work order in the equipment history
+47 SET ENEQHDA=0
+48 SET ENI=0
FOR
SET ENI=$ORDER(^ENG(6914,ENEQDA,6,ENI))
if 'ENI
QUIT
Begin DoDot:2
+49 SET ENEQHX=$GET(^ENG(6914,ENEQDA,6,ENI,0))
+50 ; found it
IF $PIECE(ENEQHX,U,2)=ENWOX
SET ENEQHDA=ENI
End DoDot:2
if ENEQHDA
QUIT
+51 ; equipment hist missing
IF ENEQHDA'>0
Begin DoDot:2
+52 ; add to equip hist
+53 SET DA=ENWODA
SET ENINV=ENEQDA
+54 SET ENTEC=$PIECE($GET(^ENG(6920,DA,2)),U,2)
+55 DO W^ENEQHS
+56 ;
+57 SET ENC("EHM")=ENC("EHM")+1
+58 SET ^XTMP("EN7P65","ADD",ENWODA,ENEQDA)=ENH
End DoDot:2
QUIT
+59 ;
+60 ; compare history with expected history and update if necessary
+61 ; values differ
IF $PIECE(ENEQHX,U,3,7)'=$PIECE(ENH,U,3,7)
Begin DoDot:2
+62 ;
+63 SET ^XTMP("EN7P65","UPD",ENEQDA,ENEQHDA)=ENWODA
+64 SET ^XTMP("EN7P65","UPD",ENEQDA,ENEQHDA,"OLD")=ENEQHX
+65 FOR I=3:1:7
SET $PIECE(ENEQHX,U,I)=$PIECE(ENH,U,I)
+66 SET ^ENG(6914,ENEQDA,6,ENEQHDA,0)=ENEQHX
+67 ;
+68 SET ENC("DIF")=ENC("DIF")+1
+69 SET ^XTMP("EN7P65","UPD",ENEQDA,ENEQHDA,"NEW")=ENEQHX
End DoDot:2
End DoDot:1
+70 ;
+71 ; save counts
+72 SET ^XTMP("EN7P65","UPD",0)=ENC("DIF")
+73 SET ^XTMP("EN7P65","ADD",0)=ENC("EHM")
+74 ;
+75 DO MES^XPDUTL(" Processed "_ENC("WOC")_" completed work orders.")
+76 DO MES^XPDUTL(" "_ENC("EHM")_" missing equipment histories were added.")
+77 DO MES^XPDUTL(" "_ENC("DIF")_" inaccurate equipment histories were fixed.")
+78 QUIT
+79 ;
HIST(DA) ; determine equipment hist value based on work order data
+1 ; input DA - work order internal entry #
+2 NEW ENACTN,ENDTCP,ENEMPL,ENH,ENHRS,ENINV,ENLABOR,ENMTL
+3 NEW ENODE,ENRET,ENSTAT,ENTEC,ENVEND,ENWORK,ENWOX,I,J,J1,K
+4 SET ENRET=""
+5 ;
+6 ; disapproved work order
IF $DATA(^ENG(6920,DA,4))
IF $PIECE(^(4),U,3)=5
QUIT ENRET
+7 SET ENWOX=$PIECE($GET(^ENG(6920,DA,0)),U)
+8 SET ENINV=$PIECE($GET(^ENG(6920,DA,3)),U,8)
+9 SET ENTEC=$PIECE($GET(^ENG(6920,DA,2)),U,2)
+10 ;
+11 IF ENTEC=""
SET ENEMPL=$SELECT($EXTRACT(ENWOX,1,3)="PM-":"STAFF",1:"NO ENTRY")
+12 IF '$TEST
SET ENEMPL=$EXTRACT($PIECE($GET(^ENG("EMP",ENTEC,0)),U),1,15)
+13 ;
+14 SET ENODE=$GET(^ENG(6920,DA,5))
+15 SET ENDTCP=$PIECE($PIECE(ENODE,U,2),".")
SET ENHRS=$PIECE(ENODE,U,3)
SET ENMTL=$PIECE(ENODE,U,4)
+16 SET ENLABOR=$PIECE(ENODE,U,6)
SET ENSTAT=$PIECE(ENODE,U,8)
SET ENWORK=$PIECE(ENODE,U,7)
+17 SET ENACTN="XX"
+18 IF $DATA(^ENG(6920,DA,8))
Begin DoDot:1
+19 FOR I=0:0
SET I=$ORDER(^ENG(6920,DA,8,I))
if I'>0!($LENGTH(ENACTN)=8)
QUIT
Begin DoDot:2
+20 SET J=$PIECE(^ENG(6920,DA,8,I,0),U)
+21 if '$DATA(^ENG(6920.1,J,0))
QUIT
SET J1=$PIECE(^(0),U,2)
+22 IF ENACTN="XX"
SET ENACTN=""
+23 SET ENACTN=ENACTN_J1
End DoDot:2
End DoDot:1
+24 SET ENVEND=$PIECE($PIECE($GET(^ENG(6920,DA,4)),U,4),".")
+25 SET ENRET=ENDTCP_"-"_ENACTN_U_ENWOX_U_ENSTAT_U_ENHRS_U_ENLABOR_U_ENMTL_U_ENVEND_U_ENEMPL_U_ENWORK
+26 QUIT ENRET
+27 ;
+28 ;ENXIP65