source: FOIAVistA/trunk/r/SURGERY-SR/SRSCHC.m@ 949

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

initial load of FOIAVistA 6/30/08 version

File size: 2.0 KB
Line 
1SRSCHC ;B'HAM ISC/MAM - SCHEDULE CONCURRENT CASES ; [ 09/22/98 11:50 AM ]
2 ;;3.0; Surgery ;**67,50**;24 Jun 93
3 W @IOF,! S (SRNOREQ,SRSCHD,SRSC1)=1,ST="SCHEDULING" D ^SRSDISP
4 W ! K DIC S DIC="^SRS(",DIC(0)="QEAMZ",DIC("S")="I $$ORDIV^SROUTL0(+Y,$G(SRSITE(""DIV""))),('$P(^SRS(+Y,0),U,6))",DIC("A")="Schedule "_$S($D(SRSCON(2)):"these cases",1:"this case")_" for which Operating Room ? " D ^DIC
5 I Y<0 W !,"A case cannot be scheduled without selecting an operating room.",!!,"Press RETURN to continue " R X:DTIME S SRSOUT=1 Q
6 S SRSOR=+Y,X1=SRSDATE,X2=2830103 D ^%DTC S SRSDAY=$P("MO^TU^WE^TH^FR^SA^SU","^",X#7+1)
7 S (SRSOUT,SRSST,SRSET)=0,P="",Z="^" D ^SRSTIME I SRSOUT Q
8 K SRGRPH,SRSDT3 S COUNT=1,MM=$E(SRSDT2,1,7),XX=$E(SRSDT1,1,7) I MM>XX S SRSDT3=MM,$P(SRSTIME,"^",2)="24:00"
9GRPH I '$D(SRSTIME) Q
10 S SRSST=$P(SRSTIME,"^"),SRSET=$P(SRSTIME,"^",2),SRSST=$P(SRSST,":")_"."_$P(SRSST,":",2),SRSET=$P(SRSET,":")_"."_$P(SRSET,":",2)
11 S SRS1=11+($P(SRSST,".")*5)+(SRSST-$P(SRSST,".")*100\15),SRS2=11+($P(SRSET,".")*5)+(SRSET-$P(SRSET,".")*100\15),S="="
12 F I=SRS1+1:1:SRS2-1 S S=S_$S('(I#5):"|",1:"X")
13PATRN ; set up pattern
14 I $E(^SRS(SRSOR,"S",SRSDATE,1),SRS1+1,SRS2)["X"!($E(^SRS(SRSOR,"S",SRSDATE,1),SRS1+1,SRS2)["=") D LAP H 1 S SRNOGO=1 Q
15 S SRGRPH(COUNT)=SRSDATE_"^"_SRS1_"^"_SRS2_"^"_S,COUNT=COUNT+1
16 I $D(SRSDT3) S SRSTIME="00:00^"_SRSET1,SRSDATE=SRSDT3 K SRSDT3 G GRPH
17 F COUNT=1,2 I $D(SRGRPH(COUNT)) S SRSDATE=$P(SRGRPH(COUNT),"^"),SRS1=$P(SRGRPH(COUNT),"^",2),SRS2=$P(SRGRPH(COUNT),"^",3),S=$P(SRGRPH(COUNT),"^",4) D ^SRSGRPH
18 S SRSDATE=$E(SRSDT1,1,7)
19 S CON=0 F I=0:0 S CON=$O(SRSCON(CON)) Q:'CON D SCH
20 Q
21SCH ; stuff scheduling info
22 S SRTN=SRSCON(CON) K DR,DA S DIE=130,DA=SRTN,DR=".02////"_SRSOR_";Q;10////"_SRSDT1_";11////"_SRSDT2_";36////0;Q;.09///"_SRSDATE D ^DIE K DR
23 S SRSOP=SRSCON(CON,"OP")
24 S SROERR=SRTN D ^SROERR0
25 Q
26LAP W !!,"Overlapping reservations on "_$E(SRSDATE,4,5)_"/"_$E(SRSDATE,6,7)_"/"_$E(SRSDATE,2,3)_". This case cannot be scheduled."
27 W !!,"Press RETURN to continue " R X:DTIME
28 Q
Note: See TracBrowser for help on using the repository browser.