- SRSCHDC ;B'HAM ISC/MAM - SCHEDULE CONCURRENT CASES ; Feb 25, 2002@07:47
- ;;3.0;Surgery ;**67,77,100,131,203**;24 Jun 93;Build 7
- W @IOF,! S SRCC=1,SRSOUT=0 K DIC S DIC=2,DIC(0)="QEAMZ",DIC("A")="Schedule Concurrent Cases for which Patient ? " D ^DIC K DIC I Y<0 S SRSOUT=1 G END
- S (DFN,SRSDPT)=+Y D DEM^VADPT S SRNM=VADM(1),SRSSN=VA("PID")
- DEAD 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
- DATE W ! K SRDUOUT,%DT,SRSDATE S %DT="AEFX",%DT("A")="Schedule Concurrent Procedures for which Date ? " D ^%DT I Y<0 S SRSOUT=1 G END
- I Y<DT W !!,"Cases cannot be scheduled for past dates. Please enter a different date.",! G DATE
- S (SRSDATE,X)=+Y 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")_" !!",!! G DATE
- 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"))_" !!",!! G DATE
- S Y=SRSDATE D D^DIQ S (SREQDT,SRSDT)=Y,ST="SCHEDULING"
- OR ;
- D SURG^SRSCHD 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
- K SRTN F SRSCON=1,2 D CON^SRSCHUN I SRSOUT,SRSCON=1 Q
- I SRSOUT,SRSCON=1 W !!,"No surgical case has been scheduled.",! S SRTN("OR")=SRSOR,SRTN("START")=SRSDT1,SRTN("END")=SRSDT2,SRSEDT=$E(SRSDT2,1,7) D ^SRSCG S SRSOUT=0 G END
- I SRSOUT,SRSCON=2 K SRSCON(2) D DEL I SRSOUT G END
- DISP W @IOF,!,"The following cases have been entered."
- S CON=0 F I=0:0 S CON=$O(SRSCON(CON)) Q:'CON D LIST
- I '$D(SRSCON(2)) S SRSCON=1,SRTN=SRSCON(1) N SRLCK S SRLCK=$$LOCK^SROUTL(SRTN) D ^SRSCHUN1 D:$G(SRLOCK) UNLOCK^SROUTL(SRTN) G END
- W !!!!,"1. Enter Information for Case #"_SRSCON(1),!,"2. Enter Information for Case #"_SRSCON(2),!
- REQ K DIR S DIR("?")=" ",DIR("?",1)="Select the number corresponding to the case for which you want",DIR("?",2)="to enter information. Enter '^' or RETURN to exit."
- S DIR(0)="NO^1:2",DIR("A")="Select Number" D ^DIR I Y=""!$D(DUOUT) S SRSOUT=1 G END
- N SRLCK S SRSCON=Y S (DA,SRTN)=SRSCON(SRSCON),SRLCK=$$LOCK^SROUTL(SRTN) D ^SRSCHUN1 D:$G(SRLCK) UNLOCK^SROUTL(SRTN) G DISP
- END I 'SRSOUT W ! K DIR S DIR(0)="FOA",DIR("A")=" Press RETURN to continue. " D ^DIR
- K SRTN D ^SRSKILL W @IOF
- Q
- LIST ; list stub info
- S SROPER=SRSCON(CON,"OP") K SROPS,MM,MMM S:$L(SROPER)<60 SROPS(1)=SROPER I $L(SROPER)>59 S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM=""
- W !!,CON_". ",?4,"Case # "_SRSCON(CON),?40,SRSDT,!,?4,"Surgeon: "_SRSCON(CON,"DOC"),?40,SRSCON(CON,"SS"),!,?4,"Procedure: ",?16,SROPS(1) I $D(SROPS(2)) W !,?16,SROPS(2) I $D(SROPS(3)) W !,?16,SROPS(3)
- Q
- LOOP ; break procedure if greater than 60 characters
- S SROPS(M)="" F LOOP=1:1 S MM=$P(SROPER," "),MMM=$P(SROPER," ",2,200) Q:MMM="" Q:$L(SROPS(M))+$L(MM)'<60 S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM
- Q
- DEL ; delete first request ?
- W !!,"Since you were unable to complete the information for the concurrent case, you",!,"may want to delete the first case and re-enter both at another time."
- ASK W !!,"Do you want to delete the entry for Case "_SRSCON(1)_" also ? YES // " R SRYN:DTIME I '$T!(SRYN["^") S SRYN="Y"
- S SRYN=$E(SRYN) S:SRYN="" SRYN="Y"
- I "YyNn"'[SRYN S SRTN=1 W !!,"Enter RETURN to delete Case "_SRSCON(1)_", or 'NO' to continue entering information",!,"for this case." G ASK
- I "Yy"'[SRYN S SRSOUT=0 Q
- S SRTN=SRSCON(1),SRTN("OR")=SRSOR,SRTN("START")=SRSDT1,SRTN("END")=SRSDT2,SRSEDT=$E(SRSDT2,1,7) D ^SRSCG
- D OERR
- W !!," Deleting Case "_SRSCON(1)_" ..." S DA=SRSCON(1),DIK="^SRF(" D ^DIK K SRTN
- Q
- OERR ; delete from ORDER file (100)
- N SRTN S SRTN=SRSCON(1) D DEL^SROERR
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRSCHDC 3981 printed Feb 19, 2025@00:13:45 Page 2
- SRSCHDC ;B'HAM ISC/MAM - SCHEDULE CONCURRENT CASES ; Feb 25, 2002@07:47
- +1 ;;3.0;Surgery ;**67,77,100,131,203**;24 Jun 93;Build 7
- +2 WRITE @IOF,!
- SET SRCC=1
- SET SRSOUT=0
- KILL DIC
- SET DIC=2
- SET DIC(0)="QEAMZ"
- SET DIC("A")="Schedule Concurrent Cases for which Patient ? "
- DO ^DIC
- KILL DIC
- IF Y<0
- SET SRSOUT=1
- GOTO END
- +3 SET (DFN,SRSDPT)=+Y
- DO DEM^VADPT
- SET SRNM=VADM(1)
- SET SRSSN=VA("PID")
- DEAD 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
- DATE WRITE !
- KILL SRDUOUT,%DT,SRSDATE
- SET %DT="AEFX"
- SET %DT("A")="Schedule Concurrent Procedures for which Date ? "
- DO ^%DT
- IF Y<0
- SET SRSOUT=1
- GOTO END
- +1 IF Y<DT
- WRITE !!,"Cases cannot be scheduled for past dates. Please enter a different date.",!
- GOTO DATE
- +2 SET (SRSDATE,X)=+Y
- DO H^%DTC
- SET SRDAY=%Y+1
- SET SRDL=$PIECE($GET(^SRO(133,SRSITE,2)),"^",SRDAY)
- if SRDL=""
- SET SRDL=1
- +3 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")_" !!",!!
- GOTO DATE
- +4 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
- +5 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"))_" !!",!!
- GOTO DATE
- +6 SET Y=SRSDATE
- DO D^DIQ
- SET (SREQDT,SRSDT)=Y
- SET ST="SCHEDULING"
- OR ;
- +1 ;SR203: ask Primary Surgeon before OR, etc
- DO SURG^SRSCHD
- 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 KILL SRTN
- FOR SRSCON=1,2
- DO CON^SRSCHUN
- IF SRSOUT
- IF SRSCON=1
- QUIT
- +4 IF SRSOUT
- IF SRSCON=1
- WRITE !!,"No surgical case has been scheduled.",!
- SET SRTN("OR")=SRSOR
- SET SRTN("START")=SRSDT1
- SET SRTN("END")=SRSDT2
- SET SRSEDT=$EXTRACT(SRSDT2,1,7)
- DO ^SRSCG
- SET SRSOUT=0
- GOTO END
- +5 IF SRSOUT
- IF SRSCON=2
- KILL SRSCON(2)
- DO DEL
- IF SRSOUT
- GOTO END
- DISP WRITE @IOF,!,"The following cases have been entered."
- +1 SET CON=0
- FOR I=0:0
- SET CON=$ORDER(SRSCON(CON))
- if 'CON
- QUIT
- DO LIST
- +2 IF '$DATA(SRSCON(2))
- SET SRSCON=1
- SET SRTN=SRSCON(1)
- NEW SRLCK
- SET SRLCK=$$LOCK^SROUTL(SRTN)
- DO ^SRSCHUN1
- if $GET(SRLOCK)
- DO UNLOCK^SROUTL(SRTN)
- GOTO END
- +3 WRITE !!!!,"1. Enter Information for Case #"_SRSCON(1),!,"2. Enter Information for Case #"_SRSCON(2),!
- REQ KILL DIR
- SET DIR("?")=" "
- SET DIR("?",1)="Select the number corresponding to the case for which you want"
- SET DIR("?",2)="to enter information. Enter '^' or RETURN to exit."
- +1 SET DIR(0)="NO^1:2"
- SET DIR("A")="Select Number"
- DO ^DIR
- IF Y=""!$DATA(DUOUT)
- SET SRSOUT=1
- GOTO END
- +2 NEW SRLCK
- SET SRSCON=Y
- SET (DA,SRTN)=SRSCON(SRSCON)
- SET SRLCK=$$LOCK^SROUTL(SRTN)
- DO ^SRSCHUN1
- if $GET(SRLCK)
- DO UNLOCK^SROUTL(SRTN)
- GOTO DISP
- END IF 'SRSOUT
- WRITE !
- KILL DIR
- SET DIR(0)="FOA"
- SET DIR("A")=" Press RETURN to continue. "
- DO ^DIR
- +1 KILL SRTN
- DO ^SRSKILL
- WRITE @IOF
- +2 QUIT
- LIST ; list stub info
- +1 SET SROPER=SRSCON(CON,"OP")
- KILL SROPS,MM,MMM
- if $LENGTH(SROPER)<60
- SET SROPS(1)=SROPER
- IF $LENGTH(SROPER)>59
- SET SROPER=SROPER_" "
- FOR M=1:1
- DO LOOP
- if MMM=""
- QUIT
- +2 WRITE !!,CON_". ",?4,"Case # "_SRSCON(CON),?40,SRSDT,!,?4,"Surgeon: "_SRSCON(CON,"DOC"),?40,SRSCON(CON,"SS"),!,?4,"Procedure: ",?16,SROPS(1)
- IF $DATA(SROPS(2))
- WRITE !,?16,SROPS(2)
- IF $DATA(SROPS(3))
- WRITE !,?16,SROPS(3)
- +3 QUIT
- LOOP ; break procedure if greater than 60 characters
- +1 SET SROPS(M)=""
- FOR LOOP=1:1
- SET MM=$PIECE(SROPER," ")
- SET MMM=$PIECE(SROPER," ",2,200)
- if MMM=""
- QUIT
- if $LENGTH(SROPS(M))+$LENGTH(MM)'<60
- QUIT
- SET SROPS(M)=SROPS(M)_MM_" "
- SET SROPER=MMM
- +2 QUIT
- DEL ; delete first request ?
- +1 WRITE !!,"Since you were unable to complete the information for the concurrent case, you",!,"may want to delete the first case and re-enter both at another time."
- ASK WRITE !!,"Do you want to delete the entry for Case "_SRSCON(1)_" also ? YES // "
- READ SRYN:DTIME
- IF '$TEST!(SRYN["^")
- SET SRYN="Y"
- +1 SET SRYN=$EXTRACT(SRYN)
- if SRYN=""
- SET SRYN="Y"
- +2 IF "YyNn"'[SRYN
- SET SRTN=1
- WRITE !!,"Enter RETURN to delete Case "_SRSCON(1)_", or 'NO' to continue entering information",!,"for this case."
- GOTO ASK
- +3 IF "Yy"'[SRYN
- SET SRSOUT=0
- QUIT
- +4 SET SRTN=SRSCON(1)
- SET SRTN("OR")=SRSOR
- SET SRTN("START")=SRSDT1
- SET SRTN("END")=SRSDT2
- SET SRSEDT=$EXTRACT(SRSDT2,1,7)
- DO ^SRSCG
- +5 DO OERR
- +6 WRITE !!," Deleting Case "_SRSCON(1)_" ..."
- SET DA=SRSCON(1)
- SET DIK="^SRF("
- DO ^DIK
- KILL SRTN
- +7 QUIT
- OERR ; delete from ORDER file (100)
- +1 NEW SRTN
- SET SRTN=SRSCON(1)
- DO DEL^SROERR
- +2 QUIT