source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDSCE.m@ 1093

Last change on this file since 1093 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.5 KB
Line 
1SDSCE ;ALB/GRR - TO CHANGE EXISTING PATTERN AVAILABILITY FROM 15 TO 30 OR 60 MIN SLOTS ; 30 NOV 84
2 ;;5.3;Scheduling;**79**;Aug 13, 1993
3RD 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""))"
4 S:'$D(DTIME) DTIME=300 I '$D(DT) D DT^SDUTL
5 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"
6 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
7 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
8 K SDIN1,SDRE1 S SL=$S($D(^SC(DA,"SL")):^SC(DA,"SL"),1:"")
9 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
10 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
11 K SDZZ G:SDONE RD
12 D REST W !,*7,"BECAUSE YOU DID NOT CHOOSE AN AVAILABILITY DATE" G PART
13REST S DIE=44,DA=SDHSC,DR="1912///"_SDAL_";Q;1917///"_SDSI D ^DIE
14 Q
15PART W !,"THE ORIGINAL APPOINTMENT LENGTH AND INCREMENTS",!,"PER HOUR DATA HAVE BEEN RESTORED!"
16 G RD
Note: See TracBrowser for help on using the repository browser.