SDSCE.m

SDSCE ;ALB/GRR - TO CHANGE EXISTING PATTERN AVAILABILITY FROM 15 TO 30 OR 60 MIN SLOTS ; 30 NOV 84

 ;;5.3;Scheduling;**79,1015**;Aug 13, 1993;Build 21

 ;IHS/ANMC/LJF  8/18/2000 added DIC("W") to warn if clinic inactivated

 ;

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

 S DIC("W")=$$INACTMSG^BSDU   ;IHS/ANMC/LJF 8/18/2000

 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

SDSCE     ;ALB/GRR - TO CHANGE EXISTING PATTERN AVAILABILITY FROM 15 TO 30 OR 60 MIN SLOTS ; 30 NOV 84

 +1       ;;5.3;Scheduling;**79,1015**;Aug 13, 1993;Build 21

 +2       ;IHS/ANMC/LJF  8/18/2000 added DIC("W") to warn if clinic inactivated

 +3       ;

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       ;IHS/ANMC/LJF 8/18/2000

           SET DIC("W")=$$INACTMSG^BSDU

 +3        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"

 +4        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

 +5        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 

 +6        KILL SDIN1,SDRE1

           SET SL=$SELECT($DATA(^SC(DA,"SL")):^SC(DA,"SL"),1:"")

 +7        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

 +8        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

 +9        KILL SDZZ

           IF SDONE

               GOTO RD

 +10       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