SROXREF ;B'HAM ISC/MAM - SET PRINCIPAL OP CODE; 3 Feb 1989 7:51 AM
;;3.0; Surgery ;;24 Jun 93
R ; invoked by the 'R" cross reference of the 'END-TIME' sub-field of the
; SERVICE BLOCKOUT sub-file in the OPERATING ROOM file
;
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)
S ^SRS("R",DAY,OR,ST,SRSNUMB)=SURG_"^"_DAY_SRSNUMB_"^"_ST_"^"_ET_"^"_SER
K DAY,OR,SER,SRSNUMB,SURG,ST,ET,TIME
Q
SER ; invoked by the 'SER' cross reference on the 'END-TIME sub-field
; of the SERVICE BLOCKOUT sub-file in the OPERATING ROOM file
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)
S ^SRS("SER",SER,OR,DAY,ST)=ST_"^"_ET_"^"_SURG_"^"_SRSNUMB
K DAY,OR,SER,SRSNUMB,SURG,ST,ET,TIME
Q
AWL ; invoked by the 'AWL' cross reference on the DATE ENTERED ON LIST
; field in the SURGERY WAITING LIST file
S ^SRO(133.8,"AWL",DA(1),X,DA)=""
Q
KAWL ; invoked by the kill logic of the 'AWL' cross reference on the
; DATE ENTERED ON LIST field in the SURGERY WAITING LIST file
K ^SRO(133.8,"AWL",DA(1),X,DA)
Q
AP ; invoked by the 'AP' cross reference on the PATIENT field in the
; SURGERY WAITING LIST file
S ^SRO(133.8,"AP",X,DA(1),DA)=""
Q
KAP ; invoked by the kill logic of the 'AP' cross reference on the
; PATIENT field in the SURGERY WAITING LIST file
K ^SRO(133.8,"AP",X,DA(1),DA)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROXREF 1621 printed Nov 22, 2024@17:56:46 Page 2
SROXREF ;B'HAM ISC/MAM - SET PRINCIPAL OP CODE; 3 Feb 1989 7:51 AM
+1 ;;3.0; Surgery ;;24 Jun 93
R ; invoked by the 'R" cross reference of the 'END-TIME' sub-field of the
+1 ; SERVICE BLOCKOUT sub-file in the OPERATING ROOM file
+2 ;
+3 SET OR=DA(3)
SET DAY=$PIECE(^SRS(OR,1,DA(2),0),"^")
SET SER=^SRS(OR,1,DA(2),1,DA(1),0)
SET SURG=$PIECE(SER,"^",2)
SET SER=$PIECE(SER,"^",1)
SET TIME=^SRS(OR,1,DA(2),1,DA(1),1,DA,0)
SET ST=$PIECE(TIME,"^")
SET ET=$PIECE(TIME,"^",2)
SET SRSNUMB=$PIECE(TIME,"^",3)
+4 SET ^SRS("R",DAY,OR,ST,SRSNUMB)=SURG_"^"_DAY_SRSNUMB_"^"_ST_"^"_ET_"^"_SER
+5 KILL DAY,OR,SER,SRSNUMB,SURG,ST,ET,TIME
+6 QUIT
SER ; invoked by the 'SER' cross reference on the 'END-TIME sub-field
+1 ; of the SERVICE BLOCKOUT sub-file in the OPERATING ROOM file
+2 SET OR=DA(3)
SET DAY=$PIECE(^SRS(OR,1,DA(2),0),"^")
SET SER=^SRS(OR,1,DA(2),1,DA(1),0)
SET SURG=$PIECE(SER,"^",2)
SET SER=$PIECE(SER,"^")
SET TIME=^SRS(OR,1,DA(2),1,DA(1),1,DA,0)
SET ST=$PIECE(TIME,"^")
SET ET=$PIECE(TIME,"^",2)
SET SRSNUMB=$PIECE(TIME,"^",3)
+3 SET ^SRS("SER",SER,OR,DAY,ST)=ST_"^"_ET_"^"_SURG_"^"_SRSNUMB
+4 KILL DAY,OR,SER,SRSNUMB,SURG,ST,ET,TIME
+5 QUIT
AWL ; invoked by the 'AWL' cross reference on the DATE ENTERED ON LIST
+1 ; field in the SURGERY WAITING LIST file
+2 SET ^SRO(133.8,"AWL",DA(1),X,DA)=""
+3 QUIT
KAWL ; invoked by the kill logic of the 'AWL' cross reference on the
+1 ; DATE ENTERED ON LIST field in the SURGERY WAITING LIST file
+2 KILL ^SRO(133.8,"AWL",DA(1),X,DA)
+3 QUIT
AP ; invoked by the 'AP' cross reference on the PATIENT field in the
+1 ; SURGERY WAITING LIST file
+2 SET ^SRO(133.8,"AP",X,DA(1),DA)=""
+3 QUIT
KAP ; invoked by the kill logic of the 'AP' cross reference on the
+1 ; PATIENT field in the SURGERY WAITING LIST file
+2 KILL ^SRO(133.8,"AP",X,DA(1),DA)
+3 QUIT
