SRSCHD.m

SRSCHD ;B'HAM ISC/MAM - SCHEDULING UNREQUESTED CASES ; [ 02/25/02  7:27 AM ]

 ;;3.0; Surgery ;**77,100,131**;24 Jun 93

BEG W @IOF S SRSOUT=0

 K SRSDATE W ! S (SRNOREQ,SRSCHD,SRSC1)=1,ST="SCHEDULING"

 K %DT S %DT="AEFX",%DT("A")="Schedule a Procedure for which Date ?  " D ^%DT I Y<0 W !!,"The schedule cannot be updated without a date.",!! G END

 S SRSDATE=+Y I SRSDATE<DT W !!,"Reservations cannot be made for dates in the past.  Please select another date.",!!,"Press RETURN to continue  " R X:DTIME G BEG

 S X=SRSDATE D H^%DTC S SRDAY=%Y+1 S SRDL=$P($G(^SRO(133,SRSITE,2)),"^",SRDAY) S:SRDL="" SRDL=1

 I 'SRDL W !!,"Scheduling not allowed for "_$S(SRDAY=1:"SUNDAY",SRDAY=2:"MONDAY",SRDAY=3:"TUESDAY",SRDAY=4:"WEDNESDAY",SRDAY=5:"THURSDAY",SRDAY=6:"FRIDAY",1:"SATURDAY")_" !!",!!!,"Press RETURN to continue  " R X:DTIME G BEG

 K SRY S DIC=40.5,DR=".01;2",DA=SRSDATE,DIQ="SRY",DIQ(0)="E" D EN^DIQ1 K DA,DIC,DIQ,DR

 I $D(SRY(40.5,SRSDATE,.01,"E")),'$D(^SRO(133,SRSITE,3,SRSDATE,0)) W !!,"Scheduling not allowed for "_$G(SRY(40.5,SRSDATE,2,"E"))_" !!",!!!,"Press RETURN to continue  " R X:DTIME G BEG

 S Y=SRSDATE D D^DIQ S SREQDT=Y

 W ! S DIC=2,DIC("A")="Select Patient: ",DIC(0)="QEAMZ" D ^DIC K DIC G:Y<0 END S (DFN,SRSDPT)=+Y D DEM^VADPT S SRNM=VADM(1),SRSSN=VA("PID")

 I $D(^DPT(SRSDPT,.35)),$P(^(.35),"^")'="" S Y=$E($P(^(.35),"^"),1,7) D D^DIQ W !!,"The records show that "_SRNM_" died on "_Y_".",! G END

OR D ^SRSCHOR I SRSOUT W !!,"No surgical case has been scheduled.",! S SRSOUT=0 G END

 D ^SRSCHUN I SRSOUT S SRSOUT=0 G END

 I $$LOCK^SROUTL(SRTN) D ^SRSCHUN1,UNLOCK^SROUTL(SRTN)

END ;

 I 'SRSOUT K DIR S DIR(0)="FOA",DIR("A")=" Press RETURN to continue. " D ^DIR

 D ^SRSKILL K SRTN,SRLCK W @IOF

 Q

SRSCHD    ;B'HAM ISC/MAM - SCHEDULING UNREQUESTED CASES ; [ 02/25/02  7:27 AM ]

 +1       ;;3.0; Surgery ;**77,100,131**;24 Jun 93

BEG        WRITE @IOF

           SET SRSOUT=0

 +1        KILL SRSDATE

           WRITE !

           SET (SRNOREQ,SRSCHD,SRSC1)=1

           SET ST="SCHEDULING"

 +2        KILL %DT

           SET %DT="AEFX"

           SET %DT("A")="Schedule a Procedure for which Date ?  "

           DO ^%DT

           IF Y<0

               WRITE !!,"The schedule cannot be updated without a date.",!!

               GOTO END

 +3        SET SRSDATE=+Y

           IF SRSDATE<DT

               WRITE !!,"Reservations cannot be made for dates in the past.  Please select another date.",!!,"Press RETURN to continue  "

               READ X:DTIME

               GOTO BEG

 +4        SET X=SRSDATE

           DO H^%DTC

           SET SRDAY=%Y+1

           SET SRDL=$PIECE($GET(^SRO(133,SRSITE,2)),"^",SRDAY)

           IF SRDL=""

               SET SRDL=1

 +5        IF 'SRDL

               WRITE !!,"Scheduling not allowed for "_$SELECT(SRDAY=1:"SUNDAY",SRDAY=2:"MONDAY",SRDAY=3:"TUESDAY",SRDAY=4:"WEDNESDAY",SRDAY=5:"THURSDAY",SRDAY=6:"FRIDAY",1:"SATURDAY")_" !!",!!!,"Press RETURN to continue  "

               READ X:DTIME

               GOTO BEG

 +6        KILL SRY

           SET DIC=40.5

           SET DR=".01;2"

           SET DA=SRSDATE

           SET DIQ="SRY"

           SET DIQ(0)="E"

           DO EN^DIQ1

           KILL DA,DIC,DIQ,DR

 +7        IF $DATA(SRY(40.5,SRSDATE,.01,"E"))

               IF '$DATA(^SRO(133,SRSITE,3,SRSDATE,0))

                   WRITE !!,"Scheduling not allowed for "_$GET(SRY(40.5,SRSDATE,2,"E"))_" !!",!!!,"Press RETURN to continue  "

                   READ X:DTIME

                   GOTO BEG

 +8        SET Y=SRSDATE

           DO D^DIQ

           SET SREQDT=Y

 +9        WRITE !

           SET DIC=2

           SET DIC("A")="Select Patient: "

           SET DIC(0)="QEAMZ"

           DO ^DIC

           KILL DIC

           IF Y<0

               GOTO END

           SET (DFN,SRSDPT)=+Y

           DO DEM^VADPT

           SET SRNM=VADM(1)

           SET SRSSN=VA("PID")

 +10       IF $DATA(^DPT(SRSDPT,.35))

               IF $PIECE(^(.35),"^")'=""

                   SET Y=$EXTRACT($PIECE(^(.35),"^"),1,7)

                   DO D^DIQ

                   WRITE !!,"The records show that "_SRNM_" died on "_Y_".",!

                   GOTO END

OR         DO ^SRSCHOR

           IF SRSOUT

               WRITE !!,"No surgical case has been scheduled.",!

               SET SRSOUT=0

               GOTO END

 +1        DO ^SRSCHUN

           IF SRSOUT

               SET SRSOUT=0

               GOTO END

 +2        IF $$LOCK^SROUTL(SRTN)

               DO ^SRSCHUN1

               DO UNLOCK^SROUTL(SRTN)

END       ;

 +1        IF 'SRSOUT

               KILL DIR

               SET DIR(0)="FOA"

               SET DIR("A")=" Press RETURN to continue. "

               DO ^DIR

 +2        DO ^SRSKILL

           KILL SRTN,SRLCK

           WRITE @IOF

 +3        QUIT