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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDSCE 1517 printed Oct 16, 2024@19:01:28 Page 2
SDSCE ;ALB/GRR - TO CHANGE EXISTING PATTERN AVAILABILITY FROM 15 TO 30 OR 60 MIN SLOTS ; 30 NOV 84
+1 ;;5.3;Scheduling;**79**;Aug 13, 1993
RD KILL SDFSW
SET SDONE=0
DO DT^DICRW
SET DIC=44
SET DIC(0)="AEQMZ"
SET DIC("A")="Select CLINIC NAME: "
SET DIC("S")="I $P(^(0),""^"",3)=""C"",'$G(^(""OOS""))"
+1 if '$DATA(DTIME)
SET DTIME=300
IF '$DATA(DT)
DO DT^SDUTL
+2 DO ^DIC
KILL DIC("A"),DIC("S")
if "^"[X
QUIT
if Y<0
GOTO RD
SET U="^"
SET DIE=44
SET (SDHSC,DA)=+Y
SET 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"
+3 KILL SDRE,SDRE1,SDIN,SDIN1
IF $DATA(^SC(DA,"I"))
SET SDIN=+^("I")
SET Y=SDIN
DO DTS^SDUTL
SET SDIN1=Y
SET SDRE=+$PIECE(^("I"),"^",2)
SET Y=SDRE
DO DTS^SDUTL
SET SDRE1=Y
+4 IF $SELECT('$DATA(SDIN):0,'SDIN:0,SDIN>DT:0,SDRE'>DT&(SDRE):0,1:1)
WRITE !,*7,"Clinic is inactivated ",$SELECT(SDRE:"from ",1:"as of "),SDIN1,$SELECT(SDRE:" to "_SDRE1,1:"")," -- you must reactivate to perform this function"
QUIT
+5 KILL SDIN1,SDRE1
SET SL=$SELECT($DATA(^SC(DA,"SL")):^SC(DA,"SL"),1:"")
+6 IF SL=""
WRITE !,*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!"
GOTO RD
+7 SET (SDLA,SDAL)=$PIECE(SL,"^",1)
SET SDSI=$PIECE(SL,"^",6)
KILL SDINH,SDZZ
if $DATA(SDIN)
SET SDINH=SDIN
DO ^DIE
SET SDZQ=1
if $DATA(SDZZ)
DO EN^SDB
IF '$DATA(SDZZ)
DO REST
GOTO PART
+8 KILL SDZZ
if SDONE
GOTO RD
+9 DO REST
WRITE !,*7,"BECAUSE YOU DID NOT CHOOSE AN AVAILABILITY DATE"
GOTO PART
REST SET DIE=44
SET DA=SDHSC
SET DR="1912///"_SDAL_";Q;1917///"_SDSI
DO ^DIE
+1 QUIT
PART WRITE !,"THE ORIGINAL APPOINTMENT LENGTH AND INCREMENTS",!,"PER HOUR DATA HAVE BEEN RESTORED!"
+1 GOTO RD
