source: FOIAVistA/trunk/r/SURGERY-SR/SRSCHD2.m@ 1470

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

initial load of FOIAVistA 6/30/08 version

File size: 3.1 KB
Line 
1SRSCHD2 ;B'HAM ISC/MAM - SCHEDULE REQUESTED CASES ; [ 09/22/98 11:51 AM ]
2 ;;3.0; Surgery ;**3,19,67,41,50,114**;24 Jun 93
3ROOM ; display graph, select room
4 S SRSOUT=0 D ^SRSTCH I SRSOUT Q
5 D ^SRSDISP I SRSOUT Q
6 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 a Case for which Operating Room ? " D ^DIC I Y<0 S SRSOUT=1 Q
7 S SRSOR=+Y,X1=SRSDATE,X2=2830103 D ^%DTC S SRSDAY=$P("MO^TU^WE^TH^FR^SA^SU","^",X#7+1)
8 S SRSOUT=0,Z="^" D ^SRSTIME I SRSOUT Q
9 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"
10GRPH Q:'$D(SRSTIME)
11EN2 S SRSST=$P(SRSTIME,"^"),SRSET=$P(SRSTIME,"^",2),SRSST=$P(SRSST,":")_"."_$P(SRSST,":",2),SRSET=$P(SRSET,":")_"."_$P(SRSET,":",2)
12 S SRS1=11+($P(SRSST,".")*5)+(SRSST-$P(SRSST,".")*100\15),SRS2=11+($P(SRSET,".")*5)+(SRSET-$P(SRSET,".")*100\15),S="="
13 F I=SRS1+1:1:SRS2-1 S S=S_$S('(I#5):"|",1:"X")
14PATRN ; set up pattern
15 I $E(^SRS(SRSOR,"S",SRSDATE,1),SRS1+1,SRS2)["X"!($E(^SRS(SRSOR,"S",SRSDATE,1),SRS1+1,SRS2)["=") D LAP S SRSLAP=1 Q:$D(SRSUPDT) Q
16 I $G(SRSLAP)'=1 D HL7RS
17 S SRGRPH(COUNT)=SRSDATE_"^"_SRS1_"^"_SRS2_"^"_S,COUNT=COUNT+1
18 I $D(SRSDT3) S SRSTIME="00:00^"_SRSET1,SRSDATE=SRSDT3 K SRSDT3 G GRPH
19 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
20 S SRSDATE=$E(SRSDT1,1,7)
21SRF ;
22 S SRNOCON=1 K DR I '$D(SRSCC) W !! S SR(.3)=$G(^SRF(SRTN,.3)),SRSA=$P(SR(.3),"^"),SRSAS=$P(SR(.3),"^",4),DA=SRTN,DIE=130,DR=".31T;.34T" D ^DIE K DR
23 I $D(SRSCC) S OTHER=$P(^SRF(SRTN,"CON"),"^"),SR(.3)=$G(^SRF(OTHER,.3)),SRSA=$P(SR(.3),"^"),SRSAS=$P(SR(.3),"^",4),DA=SRTN,DIE=130,DR=".31////"_SRSA_";.34////"_SRSAS D ^DIE K DR
24 ;S:$P(SRSDT1,".",2)="" SRSDT1=SRSDT1_".0000"
25 K DR S DA=SRTN,DIE=130,DR=".02////"_SRSOR_";10////"_SRSDT1_";11////"_SRSDT2_";Q;36////0;Q;.09////"_SRSDATE D ^DIE
26 D HL7
27CC I '$D(SRSCC),$D(^SRF(SRTN,"CON")),$P(^("CON"),"^")'="" D CONCRNT^SRSUTL I SRBOTH=1 D HL7RS G SRF
28 Q:$D(SRUPDT) K SRSCC W @IOF Q
29LOOP ; break procedure if greater than 75 characters
30 S SROPS(M)="" F LOOP=1:1 S MM=$P(SROPER," "),MMM=$P(SROPER," ",2,200) Q:MMM="" Q:$L(SROPS(M))+$L(MM)'<75 S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM
31 Q
32LAP W !!,"Overlapping reservations on "_$E(SRSDATE,4,5)_"/"_$E(SRSDATE,6,7)_"/"_$E(SRSDATE,2,3)_". This case cannot be scheduled."
33 W !!,"Press RETURN to continue " R X:DTIME
34 Q
35DW Q:'SRSDATE S X1=SRSDATE,X2=2830103 D ^%DTC S SRSDAY=$P("MO^TU^WE^TH^FR^SA^SU","^",X#7+1) Q
36 Q
37HL7 ;check for case modification
38 I '$D(SRTN("OR"))!('$D(^SRF(SRTN,.3))) S SROERR=SRTN D ^SROERR0 Q
39 I $G(SRTN("OR"))'=$G(SRSOR)!($G(SRSA)'=$P(^SRF(SRTN,.3),"^"))!($G(SRSAS)'=$P(^SRF(SRTN,.3),"^",4)) S SROERR=SRTN D ^SROERR0
40 Q
41HL7RS ;check for case reschedule
42 Q:'$D(SRTN("START"))
43 I $G(SRTN("START"))'=$G(SRSDT1)!($G(SRTN("END"))'=$G(SRSDT2))!($G(SRSDATE)'=$G(OLDATE)) K DR S DA=SRTN,DIE=130,DR="10////"_SRSDT1_";11////"_SRSDT2 D ^DIE K DR D
44 .N SREVENT S SREVENT="S13" K SRSTATUS S SROERR=SRTN D STATUS^SROERR0,MSG^SRHLZIU(SRTN,SRSTATUS,SREVENT)
45 Q
Note: See TracBrowser for help on using the repository browser.