source: FOIAVistA/tag/r/ENGINEERING-EN/ENNEWPK2.m@ 1778

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