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

SDSCE.m

Go to the documentation of this file.
SDSCE ;ALB/GRR - TO CHANGE EXISTING PATTERN AVAILABILITY FROM 15 TO 30 OR 60 MIN SLOTS ; 30 NOV 84
 ;;5.3;Scheduling;**79**;Aug 13, 1993
RD K SDFSW S SDONE=0 D DT^DICRW S DIC=44,DIC(0)="AEQMZ",DIC("A")="Select CLINIC NAME: ",DIC("S")="I $P(^(0),""^"",3)=""C"",'$G(^(""OOS""))"
 S:'$D(DTIME) DTIME=300 I '$D(DT) D DT^SDUTL
 D ^DIC K DIC("A"),DIC("S") Q:"^"[X  G:Y<0 RD S U="^",DIE=44,(SDHSC,DA)=+Y,DR="1912;Q;I X'=60,X'=30 W *7,!,""This function will only change appt length to 30 or 60 minutes"" S Y="""";1917;S SDZZ=1"
 K SDRE,SDRE1,SDIN,SDIN1 I $D(^SC(DA,"I")) S SDIN=+^("I"),Y=SDIN D DTS^SDUTL S SDIN1=Y,SDRE=+$P(^("I"),"^",2),Y=SDRE D DTS^SDUTL S SDRE1=Y
 I $S('$D(SDIN):0,'SDIN:0,SDIN>DT:0,SDRE'>DT&(SDRE):0,1:1) W !,*7,"Clinic is inactivated ",$S(SDRE:"from ",1:"as of "),SDIN1,$S(SDRE:" to "_SDRE1,1:"")," -- you must reactivate to perform this function" Q
 K SDIN1,SDRE1 S SL=$S($D(^SC(DA,"SL")):^SC(DA,"SL"),1:"")
 I SL="" W !,*7,"THIS CLINIC DOES NOT HAVE AN APPOINTMENT LENGTH NOR THE INCREMENTS",!,"PER HOUR DATA DEFINED. YOU MUST USE THE SETUP CLINIC OPTION",!,"FOR THIS CLINIC!" G RD
 S (SDLA,SDAL)=$P(SL,"^",1),SDSI=$P(SL,"^",6) K SDINH,SDZZ S:$D(SDIN) SDINH=SDIN D ^DIE S SDZQ=1 D:$D(SDZZ) EN^SDB I '$D(SDZZ) D REST G PART
 K SDZZ G:SDONE RD
 D REST W !,*7,"BECAUSE YOU DID NOT CHOOSE AN AVAILABILITY DATE" G PART
REST S DIE=44,DA=SDHSC,DR="1912///"_SDAL_";Q;1917///"_SDSI D ^DIE
 Q
PART W !,"THE ORIGINAL APPOINTMENT LENGTH AND INCREMENTS",!,"PER HOUR DATA HAVE BEEN RESTORED!"
 G RD