SROXR2 ;B'HAM ISC/MAM - CROSS REFERENCES ; 7 AUG 1989 9:00 AM
;;3.0; Surgery ;**6,15**;24 Jun 93
ADT ; set 'ADT x-ref
S SRINVDT=9999999.999999-X S ^SRF("ADT",$P(^SRF(DA,0),"^"),SRINVDT,DA)=X K SRINVDT
Q
KADT ; kill 'ADT' x-ref
S SRINVDT=9999999.999999-X K ^SRF("ADT",$P(^SRF(DA,0),"^"),SRINVDT,DA),SRINVDT
Q
AMM ; set 'AMM' x-ref when scheduling finish time is entered
Q:$P($G(^SRF(DA,.2)),"^",12) S SROOM=$P(^SRF(DA,0),"^",2),SRSTART=$P(^SRF(DA,31),"^",4) Q:'SROOM!'SRSTART
S SRSEND=X_"0000",SRSBEG=SRSTART_"0000" S SRSEND=$E(SRSEND,1,12),SRSBEG=$E(SRSBEG,1,12)
S SRLN=$E(SRSEND,9,10)-$E(SRSBEG,9,10)*60+$E(SRSEND,11,12)-$E(SRSBEG,11,12)+($E(SRSEND,1,7)>$E(SRSBEG,1,7)*1440)
S ^SRF("AMM",SROOM,SRSTART,DA)=X_"^"_SRLN
K SRSBEG,SRSEND,SROOM,SRSTART,SRLN
Q
KILLAMM ; kill 'AMM' x-ref
S SROOM=$P(^SRF(DA,0),"^",2),SRSTART=$P(^SRF(DA,31),"^",4) Q:'SROOM!'SRSTART
K ^SRF("AMM",SROOM,SRSTART,DA),SROOM,SRSTART
Q
AM1 ; kill 'AMM' x-ref and update graph when PAT OUT OF OR is entered
I $P($G(^SRF(DA,"REQ")),"^") K ^SRF("AR",$E($P(^SRF(DA,0),"^",9),1,7),$P(^SRF(DA,0),"^"),DA)
I '$D(^SRF(DA,31)) Q
Q:$P(^SRF(DA,31),"^",4)="" S SROOM=$P(^SRF(DA,0),"^",2),SRSTART=$P(^SRF(DA,31),"^",4)
Q:'SROOM!'SRSTART K ^SRF("AMM",SROOM,SRSTART,DA)
S SRSDATE=$E(SRSTART,1,7) I DT'<SRSDATE G AM1OUT
S SRSEND=$P(^SRF(DA,31),"^",5),SRSEDT=$E(SRSEND,1,7)
S SRDAT=SRSDATE,X=$J($P(SRSTART,".",2)_"0000",4),Y=$J($P(SRSEND,".",2)_"0000",4)
S START=$E(X,1,2)_"."_$E(X,3,4),END=$E(Y,1,2)_"."_$E(Y,3,4),SRSTIME=START_"^"_END
I $E(SRSEND,1,7)>($E(SRSTART,1,7)) S $P(SRSTIME,"^",2)="24.00"
GRPH S SRSST=$P(SRSTIME,"^"),SRSET=$P(SRSTIME,"^",2)
S SRS1=11+($P(SRSST,".")*5)+(SRSST-$P(SRSST,".")*100\15),SRS2=11+($P(SRSET,".")*5)+(SRSET-$P(SRSET,".")*100\15),S="="
S SRS1=11+($P(SRSST,".")*5)+(SRSST-$P(SRSST,".")*100\15),SRS2=11+($P(SRSET,".")*5)+(SRSET-$P(SRSET,".")*100\15),S="" F I=SRS1:1:SRS2-1 S S=S_$S('(I#5):"|",1:"_")
S X0=^SRS(SROOM,"SS",SRSDATE,1),X1=^SRS(SROOM,"S",SRSDATE,1),(^(1),X1)=$E(X1,1,SRS1)_S_$E(X1,SRS2+1,200),^SRS(SROOM,"S",SRSDATE,0)=SRSDATE
F I=SRS1:1:SRS2+1 I $E(X1,I)'="X" S X1=$E(X1,1,I-1)_$E(X0,I)_$E(X1,I+1,200)
S ^SRS(SROOM,"S",SRSDATE,1)=X1
I SRSEDT'=SRSDATE S SRSTIME="00.00^"_END,SRSDATE=SRSEDT G GRPH
S SRSDATE=SRDAT
AM1OUT K END,SRDAT,SROOM,SRS1,SRS2,SRSDATE,SRSEDT,SRSEND,SRSET,SRSST,SRSTART,SRSTIME,START,X0,X1
Q
AM2 ; reset 'AMM' x-ref when Scheduling Start Time is entered
Q:$P($G(^SRF(DA,.2)),"^",12) Q:$P($G(^SRF(DA,31)),"^",5)="" S SROOM=$P(^SRF(DA,0),"^",2) Q:'SROOM
S SRSEND1=$P(^SRF(DA,31),"^",5),SRSEND=SRSEND1_"0000",SRSEND=$E(SRSEND,1,12)
S SRSBEG=X_"0000",SRSBEG=$E(SRSBEG,1,12)
S SRLN=$E(SRSEND,9,10)-$E(SRSBEG,9,10)*60+$E(SRSEND,11,12)-$E(SRSBEG,11,12)+($E(SRSEND,1,7)>$E(SRSBEG,1,7)*1440)
S ^SRF("AMM",SROOM,X,DA)=SRSEND1_"^"_SRLN
Q
KILLAM2 ; kill 'AMM' x-ref when Scheduling Start Time is updated
S SROOM=$P(^SRF(DA,0),"^",2) K:SROOM ^SRF("AMM",SROOM,X,DA) K SROOM
Q
AM3 ; reset 'AMM' x-ref when Operating Room is entered
Q:$P($G(^SRF(DA,.2)),"^",12) S SRSBEG=$P($G(^SRF(DA,31)),"^",4),SRSEND=$P($G(^SRF(DA,31)),"^",5) Q:'SRSBEG!('SRSEND)
S SRSBEG1=SRSBEG_"0000",SRSBEG1=$E(SRSBEG1,1,12),SRSEND1=SRSEND_"0000",SRSEND1=$E(SRSEND1,1,12)
S SRLN=$E(SRSEND1,9,10)-$E(SRSBEG1,9,10)*60+$E(SRSEND1,11,12)-$E(SRSBEG1,11,12)+($E(SRSEND1,1,7)>$E(SRSBEG,1,7)*1440)
S ^SRF("AMM",X,SRSBEG,DA)=SRSEND_"^"_SRLN K SRSBEG,SRSBEG1,SRSEND,SRSEND1,SRLN
Q
KILLAM3 ; kill 'AMM' x-ref when Operating Room is updated
S SRSTART=$P($G(^SRF(DA,31)),"^",4) Q:'SRSTART K ^SRF("AMM",X,SRSTART,DA),SRSTART
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROXR2 3600 printed Dec 13, 2024@02:46:46 Page 2
SROXR2 ;B'HAM ISC/MAM - CROSS REFERENCES ; 7 AUG 1989 9:00 AM
+1 ;;3.0; Surgery ;**6,15**;24 Jun 93
ADT ; set 'ADT x-ref
+1 SET SRINVDT=9999999.999999-X
SET ^SRF("ADT",$PIECE(^SRF(DA,0),"^"),SRINVDT,DA)=X
KILL SRINVDT
+2 QUIT
KADT ; kill 'ADT' x-ref
+1 SET SRINVDT=9999999.999999-X
KILL ^SRF("ADT",$PIECE(^SRF(DA,0),"^"),SRINVDT,DA),SRINVDT
+2 QUIT
AMM ; set 'AMM' x-ref when scheduling finish time is entered
+1 if $PIECE($GET(^SRF(DA,.2)),"^",12)
QUIT
SET SROOM=$PIECE(^SRF(DA,0),"^",2)
SET SRSTART=$PIECE(^SRF(DA,31),"^",4)
if 'SROOM!'SRSTART
QUIT
+2 SET SRSEND=X_"0000"
SET SRSBEG=SRSTART_"0000"
SET SRSEND=$EXTRACT(SRSEND,1,12)
SET SRSBEG=$EXTRACT(SRSBEG,1,12)
+3 SET SRLN=$EXTRACT(SRSEND,9,10)-$EXTRACT(SRSBEG,9,10)*60+$EXTRACT(SRSEND,11,12)-$EXTRACT(SRSBEG,11,12)+($EXTRACT(SRSEND,1,7)>$EXTRACT(SRSBEG,1,7)*1440)
+4 SET ^SRF("AMM",SROOM,SRSTART,DA)=X_"^"_SRLN
+5 KILL SRSBEG,SRSEND,SROOM,SRSTART,SRLN
+6 QUIT
KILLAMM ; kill 'AMM' x-ref
+1 SET SROOM=$PIECE(^SRF(DA,0),"^",2)
SET SRSTART=$PIECE(^SRF(DA,31),"^",4)
if 'SROOM!'SRSTART
QUIT
+2 KILL ^SRF("AMM",SROOM,SRSTART,DA),SROOM,SRSTART
+3 QUIT
AM1 ; kill 'AMM' x-ref and update graph when PAT OUT OF OR is entered
+1 IF $PIECE($GET(^SRF(DA,"REQ")),"^")
KILL ^SRF("AR",$EXTRACT($PIECE(^SRF(DA,0),"^",9),1,7),$PIECE(^SRF(DA,0),"^"),DA)
+2 IF '$DATA(^SRF(DA,31))
QUIT
+3 if $PIECE(^SRF(DA,31),"^",4)=""
QUIT
SET SROOM=$PIECE(^SRF(DA,0),"^",2)
SET SRSTART=$PIECE(^SRF(DA,31),"^",4)
+4 if 'SROOM!'SRSTART
QUIT
KILL ^SRF("AMM",SROOM,SRSTART,DA)
+5 SET SRSDATE=$EXTRACT(SRSTART,1,7)
IF DT'<SRSDATE
GOTO AM1OUT
+6 SET SRSEND=$PIECE(^SRF(DA,31),"^",5)
SET SRSEDT=$EXTRACT(SRSEND,1,7)
+7 SET SRDAT=SRSDATE
SET X=$JUSTIFY($PIECE(SRSTART,".",2)_"0000",4)
SET Y=$JUSTIFY($PIECE(SRSEND,".",2)_"0000",4)
+8 SET START=$EXTRACT(X,1,2)_"."_$EXTRACT(X,3,4)
SET END=$EXTRACT(Y,1,2)_"."_$EXTRACT(Y,3,4)
SET SRSTIME=START_"^"_END
+9 IF $EXTRACT(SRSEND,1,7)>($EXTRACT(SRSTART,1,7))
SET $PIECE(SRSTIME,"^",2)="24.00"
GRPH SET SRSST=$PIECE(SRSTIME,"^")
SET SRSET=$PIECE(SRSTIME,"^",2)
+1 SET SRS1=11+($PIECE(SRSST,".")*5)+(SRSST-$PIECE(SRSST,".")*100\15)
SET SRS2=11+($PIECE(SRSET,".")*5)+(SRSET-$PIECE(SRSET,".")*100\15)
SET S="="
+2 SET SRS1=11+($PIECE(SRSST,".")*5)+(SRSST-$PIECE(SRSST,".")*100\15)
SET SRS2=11+($PIECE(SRSET,".")*5)+(SRSET-$PIECE(SRSET,".")*100\15)
SET S=""
FOR I=SRS1:1:SRS2-1
SET S=S_$SELECT('(I#5):"|",1:"_")
+3 SET X0=^SRS(SROOM,"SS",SRSDATE,1)
SET X1=^SRS(SROOM,"S",SRSDATE,1)
SET (^(1),X1)=$EXTRACT(X1,1,SRS1)_S_$EXTRACT(X1,SRS2+1,200)
SET ^SRS(SROOM,"S",SRSDATE,0)=SRSDATE
+4 FOR I=SRS1:1:SRS2+1
IF $EXTRACT(X1,I)'="X"
SET X1=$EXTRACT(X1,1,I-1)_$EXTRACT(X0,I)_$EXTRACT(X1,I+1,200)
+5 SET ^SRS(SROOM,"S",SRSDATE,1)=X1
+6 IF SRSEDT'=SRSDATE
SET SRSTIME="00.00^"_END
SET SRSDATE=SRSEDT
GOTO GRPH
+7 SET SRSDATE=SRDAT
AM1OUT KILL END,SRDAT,SROOM,SRS1,SRS2,SRSDATE,SRSEDT,SRSEND,SRSET,SRSST,SRSTART,SRSTIME,START,X0,X1
+1 QUIT
AM2 ; reset 'AMM' x-ref when Scheduling Start Time is entered
+1 if $PIECE($GET(^SRF(DA,.2)),"^",12)
QUIT
if $PIECE($GET(^SRF(DA,31)),"^",5)=""
QUIT
SET SROOM=$PIECE(^SRF(DA,0),"^",2)
if 'SROOM
QUIT
+2 SET SRSEND1=$PIECE(^SRF(DA,31),"^",5)
SET SRSEND=SRSEND1_"0000"
SET SRSEND=$EXTRACT(SRSEND,1,12)
+3 SET SRSBEG=X_"0000"
SET SRSBEG=$EXTRACT(SRSBEG,1,12)
+4 SET SRLN=$EXTRACT(SRSEND,9,10)-$EXTRACT(SRSBEG,9,10)*60+$EXTRACT(SRSEND,11,12)-$EXTRACT(SRSBEG,11,12)+($EXTRACT(SRSEND,1,7)>$EXTRACT(SRSBEG,1,7)*1440)
+5 SET ^SRF("AMM",SROOM,X,DA)=SRSEND1_"^"_SRLN
+6 QUIT
KILLAM2 ; kill 'AMM' x-ref when Scheduling Start Time is updated
+1 SET SROOM=$PIECE(^SRF(DA,0),"^",2)
if SROOM
KILL ^SRF("AMM",SROOM,X,DA)
KILL SROOM
+2 QUIT
AM3 ; reset 'AMM' x-ref when Operating Room is entered
+1 if $PIECE($GET(^SRF(DA,.2)),"^",12)
QUIT
SET SRSBEG=$PIECE($GET(^SRF(DA,31)),"^",4)
SET SRSEND=$PIECE($GET(^SRF(DA,31)),"^",5)
if 'SRSBEG!('SRSEND)
QUIT
+2 SET SRSBEG1=SRSBEG_"0000"
SET SRSBEG1=$EXTRACT(SRSBEG1,1,12)
SET SRSEND1=SRSEND_"0000"
SET SRSEND1=$EXTRACT(SRSEND1,1,12)
+3 SET SRLN=$EXTRACT(SRSEND1,9,10)-$EXTRACT(SRSBEG1,9,10)*60+$EXTRACT(SRSEND1,11,12)-$EXTRACT(SRSBEG1,11,12)+($EXTRACT(SRSEND1,1,7)>$EXTRACT(SRSBEG,1,7)*1440)
+4 SET ^SRF("AMM",X,SRSBEG,DA)=SRSEND_"^"_SRLN
KILL SRSBEG,SRSBEG1,SRSEND,SRSEND1,SRLN
+5 QUIT
KILLAM3 ; kill 'AMM' x-ref when Operating Room is updated
+1 SET SRSTART=$PIECE($GET(^SRF(DA,31)),"^",4)
if 'SRSTART
QUIT
KILL ^SRF("AMM",X,SRSTART,DA),SRSTART
+2 QUIT
