Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SRSCHD2

SRSCHD2.m

Go to the documentation of this file.
  1. SRSCHD2 ;B'HAM ISC/MAM - SCHEDULE REQUESTED CASES ; [ 09/22/98 11:51 AM ]
  1. ;;3.0; Surgery ;**3,19,67,41,50,114**;24 Jun 93
  1. ROOM ; display graph, select room
  1. S SRSOUT=0 D ^SRSTCH I SRSOUT Q
  1. D ^SRSDISP I SRSOUT Q
  1. 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
  1. S SRSOR=+Y,X1=SRSDATE,X2=2830103 D ^%DTC S SRSDAY=$P("MO^TU^WE^TH^FR^SA^SU","^",X#7+1)
  1. S SRSOUT=0,Z="^" D ^SRSTIME I SRSOUT Q
  1. 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"
  1. GRPH Q:'$D(SRSTIME)
  1. EN2 S SRSST=$P(SRSTIME,"^"),SRSET=$P(SRSTIME,"^",2),SRSST=$P(SRSST,":")_"."_$P(SRSST,":",2),SRSET=$P(SRSET,":")_"."_$P(SRSET,":",2)
  1. S SRS1=11+($P(SRSST,".")*5)+(SRSST-$P(SRSST,".")*100\15),SRS2=11+($P(SRSET,".")*5)+(SRSET-$P(SRSET,".")*100\15),S="="
  1. F I=SRS1+1:1:SRS2-1 S S=S_$S('(I#5):"|",1:"X")
  1. PATRN ; set up pattern
  1. 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
  1. I $G(SRSLAP)'=1 D HL7RS
  1. S SRGRPH(COUNT)=SRSDATE_"^"_SRS1_"^"_SRS2_"^"_S,COUNT=COUNT+1
  1. I $D(SRSDT3) S SRSTIME="00:00^"_SRSET1,SRSDATE=SRSDT3 K SRSDT3 G GRPH
  1. 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
  1. S SRSDATE=$E(SRSDT1,1,7)
  1. SRF ;
  1. 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
  1. 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
  1. ;S:$P(SRSDT1,".",2)="" SRSDT1=SRSDT1_".0000"
  1. K DR S DA=SRTN,DIE=130,DR=".02////"_SRSOR_";10////"_SRSDT1_";11////"_SRSDT2_";Q;36////0;Q;.09////"_SRSDATE D ^DIE
  1. D HL7
  1. CC I '$D(SRSCC),$D(^SRF(SRTN,"CON")),$P(^("CON"),"^")'="" D CONCRNT^SRSUTL I SRBOTH=1 D HL7RS G SRF
  1. Q:$D(SRUPDT) K SRSCC W @IOF Q
  1. LOOP ; break procedure if greater than 75 characters
  1. 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
  1. Q
  1. LAP W !!,"Overlapping reservations on "_$E(SRSDATE,4,5)_"/"_$E(SRSDATE,6,7)_"/"_$E(SRSDATE,2,3)_". This case cannot be scheduled."
  1. W !!,"Press RETURN to continue " R X:DTIME
  1. Q
  1. DW Q:'SRSDATE S X1=SRSDATE,X2=2830103 D ^%DTC S SRSDAY=$P("MO^TU^WE^TH^FR^SA^SU","^",X#7+1) Q
  1. Q
  1. HL7 ;check for case modification
  1. I '$D(SRTN("OR"))!('$D(^SRF(SRTN,.3))) S SROERR=SRTN D ^SROERR0 Q
  1. I $G(SRTN("OR"))'=$G(SRSOR)!($G(SRSA)'=$P(^SRF(SRTN,.3),"^"))!($G(SRSAS)'=$P(^SRF(SRTN,.3),"^",4)) S SROERR=SRTN D ^SROERR0
  1. Q
  1. HL7RS ;check for case reschedule
  1. Q:'$D(SRTN("START"))
  1. 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
  1. .N SREVENT S SREVENT="S13" K SRSTATUS S SROERR=SRTN D STATUS^SROERR0,MSG^SRHLZIU(SRTN,SRSTATUS,SREVENT)
  1. Q