- SRSCHD ;B'HAM ISC/MAM - SCHEDULING UNREQUESTED CASES ; Feb 25, 2002@07:27
- ;;3.0;Surgery;**77,100,131,203**;24 Jun 93;Build 7
- 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 SURG I SRSOUT S SRSOUT=0 G END ;SR203: ask Primary Surgeon before OR, etc
- 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
- SURG ; surgeon
- K DIR S DIR(0)="130,.14",DIR("A")="Primary Surgeon" D ^DIR K DIR I $D(DTOUT)!(X="^") S SRSOUT=1 Q
- I Y=""!(X["^") W !!,"To create a surgical case, a surgeon MUST be selected. Enter '^' to exit.",! G SURG
- S SRSDOC=+Y
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRSCHD 2060 printed Feb 19, 2025@00:13:41 Page 2
- SRSCHD ;B'HAM ISC/MAM - SCHEDULING UNREQUESTED CASES ; Feb 25, 2002@07:27
- +1 ;;3.0;Surgery;**77,100,131,203**;24 Jun 93;Build 7
- 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 ;
- +1 ;SR203: ask Primary Surgeon before OR, etc
- DO SURG
- IF SRSOUT
- SET SRSOUT=0
- GOTO END
- +2 DO ^SRSCHOR
- IF SRSOUT
- WRITE !!,"No surgical case has been scheduled.",!
- SET SRSOUT=0
- GOTO END
- +3 DO ^SRSCHUN
- IF SRSOUT
- SET SRSOUT=0
- GOTO END
- +4 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
- SURG ; surgeon
- +1 KILL DIR
- SET DIR(0)="130,.14"
- SET DIR("A")="Primary Surgeon"
- DO ^DIR
- KILL DIR
- IF $DATA(DTOUT)!(X="^")
- SET SRSOUT=1
- QUIT
- +2 IF Y=""!(X["^")
- WRITE !!,"To create a surgical case, a surgeon MUST be selected. Enter '^' to exit.",!
- GOTO SURG
- +3 SET SRSDOC=+Y
- +4 QUIT