ENNEWPK2 ;(WASH ISC)/DH-Initialization Routine ;8/17/93 14:34
;;7.0;ENGINEERING;;Aug 17, 1993
EN ;Entry point
S %DT="",X="T" D ^%DT X ^DD("DD") S ENDATE=Y S:'$D(DTIME) DTIME=600
G:'$D(^ENG) EXIT
I $D(^ENG("VERSION"))#10,$E(^ENG("VERSION"))=7 G DDA
DD ;Update DD's
;Trash old screens - ENINIT's will replace them
S DIK="^ENG(6910.9," W ! F ENDA="ENEQ1","ENEQ1D","ENEQ1S","ENEQ1E","ENEQ2","ENEQ2D","ENEQ2S","ENEQ2E","ENEQ3","ENEQ3D","ENEQ3S" S DA=$O(^ENG(6910.9,"B",ENDA,0)) I DA>0,$D(^ENG(6910.9,DA,0)) D ^DIK W "."
F ENDA="ENEQNX1","ENEQNX2","ENEQNX3" S DA=$O(^ENG(6910.9,"B",ENDA,0)) I DA>0,$D(^ENG(6910.9,DA,0)) D ^DIK W "."
S DIK="^DD(6920,",DA=35,DA(1)=6920 D ^DIK ;Remove old WORK ACTION
F DA=.01,3,.05,4,16 D ^DIK W "."
S DIK="^DD(6925,",DA(1)=6925
F DA=3.4,106,107,158.1,158.2,135 D ^DIK W "."
S DIK="^DD(6914,",DA(1)=6914 F DA=19,24 D ^DIK
K DIK D WCC G EXIT
DDA S DIK="^DD(6925,",DA(1)=6925
F DA=3.5,20.2,32.2,34.2,71,90.1,105.1,106,110.1,126 D ^DIK W "."
F DA=145,146,157:.1:157.4,158.1,158.2,158.4,177,190.6,222,262.3 D ^DIK W "."
F DA=3.4,160,161,176,178,181,181.3,182,183,187.5,188,189,190,190.2,190.3,190.4 D ^DIK W "."
F DA=191,194.6,194.7,209,209.1,210,213,214,215,216,217,218 D ^DIK W "."
F DA=218.1,218.2,219,220,220.1,221,223,231,233,234,235,236.2 D ^DIK W "."
F DA=237,238,238.5,239,240,241,242,243,245,246,247 D ^DIK W "."
F DA=250:1:253,258:.1:259.5,266:.1:267.7,268:.1:269.7,270:.1:272.1 D ^DIK W "."
F DA=248,249,264,277,278 D ^DIK W "."
S DIK="^DD(6925.02,",DA(1)=1 F DA=.01,2 D ^DIK W "."
S DIK="^DD(6925.0164,",DA(1)=1 F DA=.01,1,3,7,8 D ^DIK W "."
S DIK="^DD(6925.0177,",DA(1)=1,DA=.01 D ^DIK
S DIK="^DD(6925.03,",DA(1)=1,DA=.01 D ^DIK
S DIK="^DD(6925.04,",DA(1)=1 F DA=.01,1,2,3 D ^DIK W "."
S DIK="^DD(6925.0225,",DA(1)=1 F DA=.01,1,2 D ^DIK W "."
S DIK="^DD(6914,",DA(1)=6914 F DA=19,24 D ^DIK
K DIK
K DA S X="DEVELOPMENT OF NEW CEMETARY",DIC="^OFM(7336.8,",DIC(0)="X" D ^DIC K DIC
I +Y>0 S DA=+Y,DIE="^OFM(7336.8,",DR=".01///DEVELOPMENT OF NEW CEMETERY" D ^DIE K DIE,DR,DA
K Y
D WCC
EXIT K DA,ENDA
Q
;
WCC ;Correct 4 entries in Work Center Codes
S (DIC,DIE)="^DIC(6921,",DIC(0)="X",X=54515 D ^DIC I Y>0 S DA=+Y,DR=".01///54515/STEAM DISTRIBUTION SYS,PREV MAINT" D ^DIE
S X=55210 D ^DIC I Y>0 S DA=+Y,DR=".01///55210/LAUNDRY & DRYCLEANING EQUIP,PMI" D ^DIE
S X=55536 D ^DIC I Y>0 S DA=+Y,DR=".01///55536/NUCLEAR MEDICINE EQUIP,REPAIR" D ^DIE
S X=55537 D ^DIC I Y>0 S DA=+Y,DR=".01///55537/NUCLEAR MEDICINE EQUIP,REPLACE" D ^DIE
K DIC,DIE,DR
Q
;ENNEWPK2
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENNEWPK2 2575 printed Dec 13, 2024@01:54:30 Page 2
ENNEWPK2 ;(WASH ISC)/DH-Initialization Routine ;8/17/93 14:34
+1 ;;7.0;ENGINEERING;;Aug 17, 1993
EN ;Entry point
+1 SET %DT=""
SET X="T"
DO ^%DT
XECUTE ^DD("DD")
SET ENDATE=Y
if '$DATA(DTIME)
SET DTIME=600
+2 if '$DATA(^ENG)
GOTO EXIT
+3 IF $DATA(^ENG("VERSION"))#10
IF $EXTRACT(^ENG("VERSION"))=7
GOTO DDA
DD ;Update DD's
+1 ;Trash old screens - ENINIT's will replace them
+2 SET DIK="^ENG(6910.9,"
WRITE !
FOR ENDA="ENEQ1","ENEQ1D","ENEQ1S","ENEQ1E","ENEQ2","ENEQ2D","ENEQ2S","ENEQ2E","ENEQ3","ENEQ3D","ENEQ3S"
SET DA=$ORDER(^ENG(6910.9,"B",ENDA,0))
IF DA>0
IF $DATA(^ENG(6910.9,DA,0))
DO ^DIK
WRITE "."
+3 FOR ENDA="ENEQNX1","ENEQNX2","ENEQNX3"
SET DA=$ORDER(^ENG(6910.9,"B",ENDA,0))
IF DA>0
IF $DATA(^ENG(6910.9,DA,0))
DO ^DIK
WRITE "."
+4 ;Remove old WORK ACTION
SET DIK="^DD(6920,"
SET DA=35
SET DA(1)=6920
DO ^DIK
+5 FOR DA=.01,3,.05,4,16
DO ^DIK
WRITE "."
+6 SET DIK="^DD(6925,"
SET DA(1)=6925
+7 FOR DA=3.4,106,107,158.1,158.2,135
DO ^DIK
WRITE "."
+8 SET DIK="^DD(6914,"
SET DA(1)=6914
FOR DA=19,24
DO ^DIK
+9 KILL DIK
DO WCC
GOTO EXIT
DDA SET DIK="^DD(6925,"
SET DA(1)=6925
+1 FOR DA=3.5,20.2,32.2,34.2,71,90.1,105.1,106,110.1,126
DO ^DIK
WRITE "."
+2 FOR DA=145,146,157:.1:157.4,158.1,158.2,158.4,177,190.6,222,262.3
DO ^DIK
WRITE "."
+3 FOR DA=3.4,160,161,176,178,181,181.3,182,183,187.5,188,189,190,190.2,190.3,190.4
DO ^DIK
WRITE "."
+4 FOR DA=191,194.6,194.7,209,209.1,210,213,214,215,216,217,218
DO ^DIK
WRITE "."
+5 FOR DA=218.1,218.2,219,220,220.1,221,223,231,233,234,235,236.2
DO ^DIK
WRITE "."
+6 FOR DA=237,238,238.5,239,240,241,242,243,245,246,247
DO ^DIK
WRITE "."
+7 FOR DA=250:1:253,258:.1:259.5,266:.1:267.7,268:.1:269.7,270:.1:272.1
DO ^DIK
WRITE "."
+8 FOR DA=248,249,264,277,278
DO ^DIK
WRITE "."
+9 SET DIK="^DD(6925.02,"
SET DA(1)=1
FOR DA=.01,2
DO ^DIK
WRITE "."
+10 SET DIK="^DD(6925.0164,"
SET DA(1)=1
FOR DA=.01,1,3,7,8
DO ^DIK
WRITE "."
+11 SET DIK="^DD(6925.0177,"
SET DA(1)=1
SET DA=.01
DO ^DIK
+12 SET DIK="^DD(6925.03,"
SET DA(1)=1
SET DA=.01
DO ^DIK
+13 SET DIK="^DD(6925.04,"
SET DA(1)=1
FOR DA=.01,1,2,3
DO ^DIK
WRITE "."
+14 SET DIK="^DD(6925.0225,"
SET DA(1)=1
FOR DA=.01,1,2
DO ^DIK
WRITE "."
+15 SET DIK="^DD(6914,"
SET DA(1)=6914
FOR DA=19,24
DO ^DIK
+16 KILL DIK
+17 KILL DA
SET X="DEVELOPMENT OF NEW CEMETARY"
SET DIC="^OFM(7336.8,"
SET DIC(0)="X"
DO ^DIC
KILL DIC
+18 IF +Y>0
SET DA=+Y
SET DIE="^OFM(7336.8,"
SET DR=".01///DEVELOPMENT OF NEW CEMETERY"
DO ^DIE
KILL DIE,DR,DA
+19 KILL Y
+20 DO WCC
EXIT KILL DA,ENDA
+1 QUIT
+2 ;
WCC ;Correct 4 entries in Work Center Codes
+1 SET (DIC,DIE)="^DIC(6921,"
SET DIC(0)="X"
SET X=54515
DO ^DIC
IF Y>0
SET DA=+Y
SET DR=".01///54515/STEAM DISTRIBUTION SYS,PREV MAINT"
DO ^DIE
+2 SET X=55210
DO ^DIC
IF Y>0
SET DA=+Y
SET DR=".01///55210/LAUNDRY & DRYCLEANING EQUIP,PMI"
DO ^DIE
+3 SET X=55536
DO ^DIC
IF Y>0
SET DA=+Y
SET DR=".01///55536/NUCLEAR MEDICINE EQUIP,REPAIR"
DO ^DIE
+4 SET X=55537
DO ^DIC
IF Y>0
SET DA=+Y
SET DR=".01///55537/NUCLEAR MEDICINE EQUIP,REPLACE"
DO ^DIE
+5 KILL DIC,DIE,DR
+6 QUIT
+7 ;ENNEWPK2
