source: FOIAVistA/trunk/r/SURGERY-SR/SRSCHDC.m@ 711

Last change on this file since 711 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.7 KB
Line 
1SRSCHDC ;B'HAM ISC/MAM - SCHEDULE CONCURRENT CASES ; [ 02/25/02 7:47 AM ]
2 ;;3.0; Surgery ;**67,77,100,131**;24 Jun 93
3 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
4 S (DFN,SRSDPT)=+Y D DEM^VADPT S SRNM=VADM(1),SRSSN=VA("PID")
5DEAD 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
6DATE 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
7 I Y<DT W !!,"Cases cannot be scheduled for past dates. Please enter a different date.",! G DATE
8 S (SRSDATE,X)=+Y D H^%DTC S SRDAY=%Y+1 S SRDL=$P($G(^SRO(133,SRSITE,2)),"^",SRDAY) S:SRDL="" SRDL=1
9 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
10 K SRY S DIC=40.5,DR=".01;2",DA=SRSDATE,DIQ="SRY",DIQ(0)="E" D EN^DIQ1 K DA,DIC,DIQ,DR
11 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
12 S Y=SRSDATE D D^DIQ S (SREQDT,SRSDT)=Y,ST="SCHEDULING"
13OR D ^SRSCHOR I SRSOUT W !!,"No surgical case has been scheduled.",! S SRSOUT=0 G END
14 K SRTN F SRSCON=1,2 D CON^SRSCHUN I SRSOUT,SRSCON=1 Q
15 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
16 I SRSOUT,SRSCON=2 K SRSCON(2) D DEL I SRSOUT G END
17DISP W @IOF,!,"The following cases have been entered."
18 S CON=0 F I=0:0 S CON=$O(SRSCON(CON)) Q:'CON D LIST
19 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
20 W !!!!,"1. Enter Information for Case #"_SRSCON(1),!,"2. Enter Information for Case #"_SRSCON(2),!
21REQ 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."
22 S DIR(0)="NO^1:2",DIR("A")="Select Number" D ^DIR I Y=""!$D(DUOUT) S SRSOUT=1 G END
23 N SRLCK S SRSCON=Y S (DA,SRTN)=SRSCON(SRSCON),SRLCK=$$LOCK^SROUTL(SRTN) D ^SRSCHUN1 D:$G(SRLCK) UNLOCK^SROUTL(SRTN) G DISP
24END I 'SRSOUT W ! K DIR S DIR(0)="FOA",DIR("A")=" Press RETURN to continue. " D ^DIR
25 K SRTN D ^SRSKILL W @IOF
26 Q
27LIST ; list stub info
28 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=""
29 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)
30 Q
31LOOP ; break procedure if greater than 60 characters
32 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
33 Q
34DEL ; delete first request ?
35 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."
36ASK W !!,"Do you want to delete the entry for Case "_SRSCON(1)_" also ? YES // " R SRYN:DTIME I '$T!(SRYN["^") S SRYN="Y"
37 S SRYN=$E(SRYN) S:SRYN="" SRYN="Y"
38 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
39 I "Yy"'[SRYN S SRSOUT=0 Q
40 S SRTN=SRSCON(1),SRTN("OR")=SRSOR,SRTN("START")=SRSDT1,SRTN("END")=SRSDT2,SRSEDT=$E(SRSDT2,1,7) D ^SRSCG
41 D OERR
42 W !!," Deleting Case "_SRSCON(1)_" ..." S DA=SRSCON(1),DIK="^SRF(" D ^DIK K SRTN
43 Q
44OERR ; delete from ORDER file (100)
45 N SRTN S SRTN=SRSCON(1) D DEL^SROERR
46 Q
Note: See TracBrowser for help on using the repository browser.