Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SD53P567

SD53P567.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ; THIS POST-INIT ROUTINE WILL READ THROUGH THE HOSPITAL LOCATION FILE
  1. ; #44 AND FOR EVERY CLINIC SET UP WITH A SPECIAL PATTERN IT WILL
  1. ; UPDATE THE SPECIAL AVAILABILITY FLAG TO THE APPROPRIATE DATE VERSUS
  1. ; THE RECORD INTERNAL ENTRY NUMBER AS THE DATA DICTIONARY INDICATES
  1. ; THIS IS SUPPOSE TO BE A DATE FIELD.
  1. ;
  1. Q ; must call at entry point
  1. ;
  1. EN ; entry point
  1. S SCIEN=0
  1. F S SCIEN=$O(^SC(SCIEN)) Q:'SCIEN D
  1. .S SCDATE=3091000 ;start file read from start of FY2009, Oct 1, 2010
  1. .F S SCDATE=$O(^SC(SCIEN,"ST",SCDATE)) Q:'SCDATE D
  1. ..I $D(^SC(SCIEN,"ST",SCDATE,9)) I '$D(^(0)) D DELETE
  1. ..Q:'$D(^SC(SCIEN,"ST",SCDATE,9))
  1. ..S DA=SCDATE,DA(1)=SCIEN
  1. ..S DIE="^SC("_DA(1)_",""ST"","
  1. ..S DR="3///^S X=SCDATE" D ^DIE
  1. ..K DA,DR,DIE
  1. K SCIEN,SCDATE,X,DA,DR,DIE,X1,X2
  1. Q
  1. ;
  1. DELETE ; kill bad record
  1. S DA=SCDATE,DA(1)=SCIEN
  1. S DIK="^SC("_DA(1)_",""ST"","
  1. D ^DIK
  1. K DA,DIK
  1. Q
  1. ;