SD53P567.m

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 ---SD53P567   1043     printed  Apr 09, 2024@21:55:15                                                                                                                                                                                                    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       ;