| 1 | ENNEWPK2 ;(WASH ISC)/DH-Initialization Routine ;8/17/93 14:34
|
|---|
| 2 | ;;7.0;ENGINEERING;;Aug 17, 1993
|
|---|
| 3 | EN ;Entry point
|
|---|
| 4 | S %DT="",X="T" D ^%DT X ^DD("DD") S ENDATE=Y S:'$D(DTIME) DTIME=600
|
|---|
| 5 | G:'$D(^ENG) EXIT
|
|---|
| 6 | I $D(^ENG("VERSION"))#10,$E(^ENG("VERSION"))=7 G DDA
|
|---|
| 7 | DD ;Update DD's
|
|---|
| 8 | ;Trash old screens - ENINIT's will replace them
|
|---|
| 9 | 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 "."
|
|---|
| 10 | 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 "."
|
|---|
| 11 | S DIK="^DD(6920,",DA=35,DA(1)=6920 D ^DIK ;Remove old WORK ACTION
|
|---|
| 12 | F DA=.01,3,.05,4,16 D ^DIK W "."
|
|---|
| 13 | S DIK="^DD(6925,",DA(1)=6925
|
|---|
| 14 | F DA=3.4,106,107,158.1,158.2,135 D ^DIK W "."
|
|---|
| 15 | S DIK="^DD(6914,",DA(1)=6914 F DA=19,24 D ^DIK
|
|---|
| 16 | K DIK D WCC G EXIT
|
|---|
| 17 | DDA S DIK="^DD(6925,",DA(1)=6925
|
|---|
| 18 | F DA=3.5,20.2,32.2,34.2,71,90.1,105.1,106,110.1,126 D ^DIK W "."
|
|---|
| 19 | F DA=145,146,157:.1:157.4,158.1,158.2,158.4,177,190.6,222,262.3 D ^DIK W "."
|
|---|
| 20 | 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 "."
|
|---|
| 21 | F DA=191,194.6,194.7,209,209.1,210,213,214,215,216,217,218 D ^DIK W "."
|
|---|
| 22 | F DA=218.1,218.2,219,220,220.1,221,223,231,233,234,235,236.2 D ^DIK W "."
|
|---|
| 23 | F DA=237,238,238.5,239,240,241,242,243,245,246,247 D ^DIK W "."
|
|---|
| 24 | F DA=250:1:253,258:.1:259.5,266:.1:267.7,268:.1:269.7,270:.1:272.1 D ^DIK W "."
|
|---|
| 25 | F DA=248,249,264,277,278 D ^DIK W "."
|
|---|
| 26 | S DIK="^DD(6925.02,",DA(1)=1 F DA=.01,2 D ^DIK W "."
|
|---|
| 27 | S DIK="^DD(6925.0164,",DA(1)=1 F DA=.01,1,3,7,8 D ^DIK W "."
|
|---|
| 28 | S DIK="^DD(6925.0177,",DA(1)=1,DA=.01 D ^DIK
|
|---|
| 29 | S DIK="^DD(6925.03,",DA(1)=1,DA=.01 D ^DIK
|
|---|
| 30 | S DIK="^DD(6925.04,",DA(1)=1 F DA=.01,1,2,3 D ^DIK W "."
|
|---|
| 31 | S DIK="^DD(6925.0225,",DA(1)=1 F DA=.01,1,2 D ^DIK W "."
|
|---|
| 32 | S DIK="^DD(6914,",DA(1)=6914 F DA=19,24 D ^DIK
|
|---|
| 33 | K DIK
|
|---|
| 34 | K DA S X="DEVELOPMENT OF NEW CEMETARY",DIC="^OFM(7336.8,",DIC(0)="X" D ^DIC K DIC
|
|---|
| 35 | I +Y>0 S DA=+Y,DIE="^OFM(7336.8,",DR=".01///DEVELOPMENT OF NEW CEMETERY" D ^DIE K DIE,DR,DA
|
|---|
| 36 | K Y
|
|---|
| 37 | D WCC
|
|---|
| 38 | EXIT K DA,ENDA
|
|---|
| 39 | Q
|
|---|
| 40 | ;
|
|---|
| 41 | WCC ;Correct 4 entries in Work Center Codes
|
|---|
| 42 | 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
|
|---|
| 43 | S X=55210 D ^DIC I Y>0 S DA=+Y,DR=".01///55210/LAUNDRY & DRYCLEANING EQUIP,PMI" D ^DIE
|
|---|
| 44 | S X=55536 D ^DIC I Y>0 S DA=+Y,DR=".01///55536/NUCLEAR MEDICINE EQUIP,REPAIR" D ^DIE
|
|---|
| 45 | S X=55537 D ^DIC I Y>0 S DA=+Y,DR=".01///55537/NUCLEAR MEDICINE EQUIP,REPLACE" D ^DIE
|
|---|
| 46 | K DIC,DIE,DR
|
|---|
| 47 | Q
|
|---|
| 48 | ;ENNEWPK2
|
|---|
