- 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 Feb 19, 2025@00:27:35 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
