- SD53P567 ;ALB/RLC - POST-INIT TO CLEAN UP SPECIAL AVAIL FLAG FIELD; 7/27/07
- ;;5.3;SCHEDULING;**567**;21-MAR-94;Build 7
- ;
- ; THIS POST-INIT ROUTINE WILL READ THROUGH THE HOSPITAL LOCATION FILE
- ; #44 AND FOR EVERY CLINIC SET UP WITH A SPECIAL PATTERN IT WILL
- ; UPDATE THE SPECIAL AVAILABILITY FLAG TO THE APPROPRIATE DATE VERSUS
- ; THE RECORD INTERNAL ENTRY NUMBER AS THE DATA DICTIONARY INDICATES
- ; THIS IS SUPPOSE TO BE A DATE FIELD.
- ;
- Q ; must call at entry point
- ;
- EN ; entry point
- S SCIEN=0
- F S SCIEN=$O(^SC(SCIEN)) Q:'SCIEN D
- .S SCDATE=3091000 ;start file read from start of FY2009, Oct 1, 2010
- .F S SCDATE=$O(^SC(SCIEN,"ST",SCDATE)) Q:'SCDATE D
- ..I $D(^SC(SCIEN,"ST",SCDATE,9)) I '$D(^(0)) D DELETE
- ..Q:'$D(^SC(SCIEN,"ST",SCDATE,9))
- ..S DA=SCDATE,DA(1)=SCIEN
- ..S DIE="^SC("_DA(1)_",""ST"","
- ..S DR="3///^S X=SCDATE" D ^DIE
- ..K DA,DR,DIE
- K SCIEN,SCDATE,X,DA,DR,DIE,X1,X2
- Q
- ;
- DELETE ; kill bad record
- S DA=SCDATE,DA(1)=SCIEN
- S DIK="^SC("_DA(1)_",""ST"","
- D ^DIK
- K DA,DIK
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSD53P567 1043 printed Feb 19, 2025@00:12:59 Page 2
- SD53P567 ;ALB/RLC - POST-INIT TO CLEAN UP SPECIAL AVAIL FLAG FIELD; 7/27/07
- +1 ;;5.3;SCHEDULING;**567**;21-MAR-94;Build 7
- +2 ;
- +3 ; THIS POST-INIT ROUTINE WILL READ THROUGH THE HOSPITAL LOCATION FILE
- +4 ; #44 AND FOR EVERY CLINIC SET UP WITH A SPECIAL PATTERN IT WILL
- +5 ; UPDATE THE SPECIAL AVAILABILITY FLAG TO THE APPROPRIATE DATE VERSUS
- +6 ; THE RECORD INTERNAL ENTRY NUMBER AS THE DATA DICTIONARY INDICATES
- +7 ; THIS IS SUPPOSE TO BE A DATE FIELD.
- +8 ;
- +9 ; must call at entry point
- QUIT
- +10 ;
- EN ; entry point
- +1 SET SCIEN=0
- +2 FOR
- SET SCIEN=$ORDER(^SC(SCIEN))
- if 'SCIEN
- QUIT
- Begin DoDot:1
- +3 ;start file read from start of FY2009, Oct 1, 2010
- SET SCDATE=3091000
- +4 FOR
- SET SCDATE=$ORDER(^SC(SCIEN,"ST",SCDATE))
- if 'SCDATE
- QUIT
- Begin DoDot:2
- +5 IF $DATA(^SC(SCIEN,"ST",SCDATE,9))
- IF '$DATA(^(0))
- DO DELETE
- +6 if '$DATA(^SC(SCIEN,"ST",SCDATE,9))
- QUIT
- +7 SET DA=SCDATE
- SET DA(1)=SCIEN
- +8 SET DIE="^SC("_DA(1)_",""ST"","
- +9 SET DR="3///^S X=SCDATE"
- DO ^DIE
- +10 KILL DA,DR,DIE
- End DoDot:2
- End DoDot:1
- +11 KILL SCIEN,SCDATE,X,DA,DR,DIE,X1,X2
- +12 QUIT
- +13 ;
- DELETE ; kill bad record
- +1 SET DA=SCDATE
- SET DA(1)=SCIEN
- +2 SET DIK="^SC("_DA(1)_",""ST"","
- +3 DO ^DIK
- +4 KILL DA,DIK
- +5 QUIT
- +6 ;