source: WorldVistAEHR/trunk/r/SURGERY-SR/SROXREF.m@ 1375

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

initial load of WorldVistAEHR

File size: 1.6 KB
RevLine 
[613]1SROXREF ;B'HAM ISC/MAM - SET PRINCIPAL OP CODE; 3 Feb 1989 7:51 AM
2 ;;3.0; Surgery ;;24 Jun 93
3R ; invoked by the 'R" cross reference of the 'END-TIME' sub-field of the
4 ; SERVICE BLOCKOUT sub-file in the OPERATING ROOM file
5 ;
6 S OR=DA(3),DAY=$P(^SRS(OR,1,DA(2),0),"^"),SER=^SRS(OR,1,DA(2),1,DA(1),0),SURG=$P(SER,"^",2),SER=$P(SER,"^",1),TIME=^SRS(OR,1,DA(2),1,DA(1),1,DA,0),ST=$P(TIME,"^"),ET=$P(TIME,"^",2),SRSNUMB=$P(TIME,"^",3)
7 S ^SRS("R",DAY,OR,ST,SRSNUMB)=SURG_"^"_DAY_SRSNUMB_"^"_ST_"^"_ET_"^"_SER
8 K DAY,OR,SER,SRSNUMB,SURG,ST,ET,TIME
9 Q
10SER ; invoked by the 'SER' cross reference on the 'END-TIME sub-field
11 ; of the SERVICE BLOCKOUT sub-file in the OPERATING ROOM file
12 S OR=DA(3),DAY=$P(^SRS(OR,1,DA(2),0),"^"),SER=^SRS(OR,1,DA(2),1,DA(1),0),SURG=$P(SER,"^",2),SER=$P(SER,"^"),TIME=^SRS(OR,1,DA(2),1,DA(1),1,DA,0),ST=$P(TIME,"^"),ET=$P(TIME,"^",2),SRSNUMB=$P(TIME,"^",3)
13 S ^SRS("SER",SER,OR,DAY,ST)=ST_"^"_ET_"^"_SURG_"^"_SRSNUMB
14 K DAY,OR,SER,SRSNUMB,SURG,ST,ET,TIME
15 Q
16AWL ; invoked by the 'AWL' cross reference on the DATE ENTERED ON LIST
17 ; field in the SURGERY WAITING LIST file
18 S ^SRO(133.8,"AWL",DA(1),X,DA)=""
19 Q
20KAWL ; invoked by the kill logic of the 'AWL' cross reference on the
21 ; DATE ENTERED ON LIST field in the SURGERY WAITING LIST file
22 K ^SRO(133.8,"AWL",DA(1),X,DA)
23 Q
24AP ; invoked by the 'AP' cross reference on the PATIENT field in the
25 ; SURGERY WAITING LIST file
26 S ^SRO(133.8,"AP",X,DA(1),DA)=""
27 Q
28KAP ; invoked by the kill logic of the 'AP' cross reference on the
29 ; PATIENT field in the SURGERY WAITING LIST file
30 K ^SRO(133.8,"AP",X,DA(1),DA)
31 Q
Note: See TracBrowser for help on using the repository browser.