source: FOIAVistA/tag/r/SURGERY-SR/SROXR2.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 3.5 KB
Line 
1SROXR2 ;B'HAM ISC/MAM - CROSS REFERENCES ; 7 AUG 1989 9:00 AM
2 ;;3.0; Surgery ;**6,15**;24 Jun 93
3ADT ; set 'ADT x-ref
4 S SRINVDT=9999999.999999-X S ^SRF("ADT",$P(^SRF(DA,0),"^"),SRINVDT,DA)=X K SRINVDT
5 Q
6KADT ; kill 'ADT' x-ref
7 S SRINVDT=9999999.999999-X K ^SRF("ADT",$P(^SRF(DA,0),"^"),SRINVDT,DA),SRINVDT
8 Q
9AMM ; set 'AMM' x-ref when scheduling finish time is entered
10 Q:$P($G(^SRF(DA,.2)),"^",12) S SROOM=$P(^SRF(DA,0),"^",2),SRSTART=$P(^SRF(DA,31),"^",4) Q:'SROOM!'SRSTART
11 S SRSEND=X_"0000",SRSBEG=SRSTART_"0000" S SRSEND=$E(SRSEND,1,12),SRSBEG=$E(SRSBEG,1,12)
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)
13 S ^SRF("AMM",SROOM,SRSTART,DA)=X_"^"_SRLN
14 K SRSBEG,SRSEND,SROOM,SRSTART,SRLN
15 Q
16KILLAMM ; kill 'AMM' x-ref
17 S SROOM=$P(^SRF(DA,0),"^",2),SRSTART=$P(^SRF(DA,31),"^",4) Q:'SROOM!'SRSTART
18 K ^SRF("AMM",SROOM,SRSTART,DA),SROOM,SRSTART
19 Q
20AM1 ; kill 'AMM' x-ref and update graph when PAT OUT OF OR is entered
21 I $P($G(^SRF(DA,"REQ")),"^") K ^SRF("AR",$E($P(^SRF(DA,0),"^",9),1,7),$P(^SRF(DA,0),"^"),DA)
22 I '$D(^SRF(DA,31)) Q
23 Q:$P(^SRF(DA,31),"^",4)="" S SROOM=$P(^SRF(DA,0),"^",2),SRSTART=$P(^SRF(DA,31),"^",4)
24 Q:'SROOM!'SRSTART K ^SRF("AMM",SROOM,SRSTART,DA)
25 S SRSDATE=$E(SRSTART,1,7) I DT'<SRSDATE G AM1OUT
26 S SRSEND=$P(^SRF(DA,31),"^",5),SRSEDT=$E(SRSEND,1,7)
27 S SRDAT=SRSDATE,X=$J($P(SRSTART,".",2)_"0000",4),Y=$J($P(SRSEND,".",2)_"0000",4)
28 S START=$E(X,1,2)_"."_$E(X,3,4),END=$E(Y,1,2)_"."_$E(Y,3,4),SRSTIME=START_"^"_END
29 I $E(SRSEND,1,7)>($E(SRSTART,1,7)) S $P(SRSTIME,"^",2)="24.00"
30GRPH S SRSST=$P(SRSTIME,"^"),SRSET=$P(SRSTIME,"^",2)
31 S SRS1=11+($P(SRSST,".")*5)+(SRSST-$P(SRSST,".")*100\15),SRS2=11+($P(SRSET,".")*5)+(SRSET-$P(SRSET,".")*100\15),S="="
32 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:"_")
33 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
34 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)
35 S ^SRS(SROOM,"S",SRSDATE,1)=X1
36 I SRSEDT'=SRSDATE S SRSTIME="00.00^"_END,SRSDATE=SRSEDT G GRPH
37 S SRSDATE=SRDAT
38AM1OUT K END,SRDAT,SROOM,SRS1,SRS2,SRSDATE,SRSEDT,SRSEND,SRSET,SRSST,SRSTART,SRSTIME,START,X0,X1
39 Q
40AM2 ; reset 'AMM' x-ref when Scheduling Start Time is entered
41 Q:$P($G(^SRF(DA,.2)),"^",12) Q:$P($G(^SRF(DA,31)),"^",5)="" S SROOM=$P(^SRF(DA,0),"^",2) Q:'SROOM
42 S SRSEND1=$P(^SRF(DA,31),"^",5),SRSEND=SRSEND1_"0000",SRSEND=$E(SRSEND,1,12)
43 S SRSBEG=X_"0000",SRSBEG=$E(SRSBEG,1,12)
44 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)
45 S ^SRF("AMM",SROOM,X,DA)=SRSEND1_"^"_SRLN
46 Q
47KILLAM2 ; kill 'AMM' x-ref when Scheduling Start Time is updated
48 S SROOM=$P(^SRF(DA,0),"^",2) K:SROOM ^SRF("AMM",SROOM,X,DA) K SROOM
49 Q
50AM3 ; reset 'AMM' x-ref when Operating Room is entered
51 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)
52 S SRSBEG1=SRSBEG_"0000",SRSBEG1=$E(SRSBEG1,1,12),SRSEND1=SRSEND_"0000",SRSEND1=$E(SRSEND1,1,12)
53 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)
54 S ^SRF("AMM",X,SRSBEG,DA)=SRSEND_"^"_SRLN K SRSBEG,SRSBEG1,SRSEND,SRSEND1,SRLN
55 Q
56KILLAM3 ; kill 'AMM' x-ref when Operating Room is updated
57 S SRSTART=$P($G(^SRF(DA,31)),"^",4) Q:'SRSTART K ^SRF("AMM",X,SRSTART,DA),SRSTART
58 Q
Note: See TracBrowser for help on using the repository browser.