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 Dec 13, 2024@02:46:32 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 ;
