- 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 Mar 13, 2025@20:59:10 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
