SROSCH2 ;B'HAM ISC/MAM - QUEUE SCHEDULE TO ALL LOCATIONS ; [ 07/27/98 2:33 PM ]
;;3.0;Surgery;**34,48,50,108,184**;24 Jun 93;Build 35
DEVICE S SRDEV=0 F I=0:0 S SRDEV=$O(^SRO(133,SRSITE,1,SRDEV)) Q:'SRDEV S IOP=$P(^SRO(133,SRSITE,1,SRDEV,0),"^") D QUEUE
Q
QUEUE ; queue report to device
K %ZIS,POP S %ZIS="QN" D ^%ZIS Q:POP
S ZTDESC="SCHEDULE OF OPERATIONS",ZTRTN="SROSCH",(ZTSAVE("SRDT"),ZTSAVE("SRDT1"),ZTSAVE("SRSITE*"),ZTSAVE("SRFORM"))="",ZTDTH=$H D ^%ZTLOAD
Q
PRINT ; print variables
D:$Y+10>IOSL ASK^SROSCH1 Q:SRQ
W:SX=1 !!,"OPERATING ROOM: ",SROOM,!
W !,SRNM,?24,SROPD,?40,SRDIAG,?92,SRANES,?115,SRSUR,!,VA("PID"),?16,AGE,?24,SRSST,?40,SROPS(1),?92,SRAN1,?115,SRFST
W !,SRSLOC,?24,SRSET W:$D(SROPS(2)) ?40,SROPS(2) W ?92,SRAN2,?115,SRATT I $D(SROPS(3)) W !,?40,SROPS(3)
I $D(SROPS(4)) W !,?40,SROPS(4) I $D(SROPS(5)) W !,?40,SROPS(5) I $D(SROPS(6)) W !,?40,SROPS(6)
I $D(^SRF(SRTN,"CON")),$P(^("CON"),"^")'="" S SRCON=+^("CON") D CON^SROSCH1
W !,"Case # "_SRTN D PRINT^SROBLOD W !,SRPREAD
S SR("1.0")=$S($D(^SRF(SRTN,"1.0")):^("1.0"),1:"")
S SRFROZ=$P(SR("1.0"),"^",2),SRXRAY1=$P(SR("1.0"),"^",3),SRXRAY2=$P(SR("1.0"),"^",5)
I SRXRAY1'=""!(SRXRAY2'="N") D XRAY
I SRFROZ="Y" W ?24,"FROZEN SECTION TESTS REQUIRED",!
N II,DRUG,JJ,SRIEN
I $$SPIN^SRTOVRF() W !,?24,"SPINAL LEVEL: ",?45,$P($G(^SRF(SRTN,1.1)),"^",4)
I SRFORM="L" D
.I $O(^SRF(SRTN,58,0)) S (II,JJ)=0 F S II=$O(^SRF(SRTN,58,II)) Q:'II S SRIEN=$G(^(II,0)),JJ=JJ+1 W !,@$S(JJ=1:"?24"_",""SPECIAL EQUIPMENT: """,1:"?45"),$P($G(^SRO(131.3,SRIEN,0)),"^")
.I $O(^SRF(SRTN,59,0)) S (II,JJ)=0 F S II=$O(^SRF(SRTN,59,II)) Q:'II S SRIEN=$G(^(II,0)),JJ=JJ+1 W !,@$S(JJ=1:"?24"_",""PLANNED IMPLANT: """,1:"?45"),$P($G(^SRO(131.5,SRIEN,0)),"^")
.I $O(^SRF(SRTN,60,0)) S (II,JJ)=0 F S II=$O(^SRF(SRTN,60,II)) Q:'II S SRIEN=$G(^(II,0)),JJ=JJ+1 W !,@$S(JJ=1:"?24"_",""SPECIAL SUPPLIES: """,1:"?45"),$P($G(^SRO(131.04,SRIEN,0)),"^")
.I $O(^SRF(SRTN,61,0)) S (II,JJ)=0 F S II=$O(^SRF(SRTN,61,II)) Q:'II S SRIEN=$G(^(II,0)),JJ=JJ+1 W !,@$S(JJ=1:"?24"_",""SPECIAL INSTRUMENTS: """,1:"?45"),$P($G(^SRO(131.02,SRIEN,0)),"^")
.I $O(^SRF(SRTN,62,0)) S (II,JJ)=0 F S II=$O(^SRF(SRTN,62,II)) Q:'II S SRIEN=$G(^(II,0)),JJ=JJ+1 W !,@$S(JJ=1:"?24"_",""PHARMACY ITEMS: """,1:"?45"),$P(^PSDRUG(+$G(^SRO(131.06,SRIEN,0)),0),"^")
Q
XRAY ; print x-rays
I SRXRAY1'="" W ?24,"PREOPERATIVE XRAYS: "_SRXRAY1 W:SRXRAY2="Y" " INTRAOPERATIVE X-RAYS REQUESTED" W:SRXRAY2="C" " C-ARM REQUESTED" W ! Q
I SRXRAY2="Y" W ?24,"INTRAOPERATIVE X-RAYS REQUESTED",! Q
I SRXRAY2="C" W ?24,"C-ARM REQUESTED"
W !
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROSCH2 2625 printed Nov 22, 2024@17:55:59 Page 2
SROSCH2 ;B'HAM ISC/MAM - QUEUE SCHEDULE TO ALL LOCATIONS ; [ 07/27/98 2:33 PM ]
+1 ;;3.0;Surgery;**34,48,50,108,184**;24 Jun 93;Build 35
DEVICE SET SRDEV=0
FOR I=0:0
SET SRDEV=$ORDER(^SRO(133,SRSITE,1,SRDEV))
if 'SRDEV
QUIT
SET IOP=$PIECE(^SRO(133,SRSITE,1,SRDEV,0),"^")
DO QUEUE
+1 QUIT
QUEUE ; queue report to device
+1 KILL %ZIS,POP
SET %ZIS="QN"
DO ^%ZIS
if POP
QUIT
+2 SET ZTDESC="SCHEDULE OF OPERATIONS"
SET ZTRTN="SROSCH"
SET (ZTSAVE("SRDT"),ZTSAVE("SRDT1"),ZTSAVE("SRSITE*"),ZTSAVE("SRFORM"))=""
SET ZTDTH=$HOROLOG
DO ^%ZTLOAD
+3 QUIT
PRINT ; print variables
+1 if $Y+10>IOSL
DO ASK^SROSCH1
if SRQ
QUIT
+2 if SX=1
WRITE !!,"OPERATING ROOM: ",SROOM,!
+3 WRITE !,SRNM,?24,SROPD,?40,SRDIAG,?92,SRANES,?115,SRSUR,!,VA("PID"),?16,AGE,?24,SRSST,?40,SROPS(1),?92,SRAN1,?115,SRFST
+4 WRITE !,SRSLOC,?24,SRSET
if $DATA(SROPS(2))
WRITE ?40,SROPS(2)
WRITE ?92,SRAN2,?115,SRATT
IF $DATA(SROPS(3))
WRITE !,?40,SROPS(3)
+5 IF $DATA(SROPS(4))
WRITE !,?40,SROPS(4)
IF $DATA(SROPS(5))
WRITE !,?40,SROPS(5)
IF $DATA(SROPS(6))
WRITE !,?40,SROPS(6)
+6 IF $DATA(^SRF(SRTN,"CON"))
IF $PIECE(^("CON"),"^")'=""
SET SRCON=+^("CON")
DO CON^SROSCH1
+7 WRITE !,"Case # "_SRTN
DO PRINT^SROBLOD
WRITE !,SRPREAD
+8 SET SR("1.0")=$SELECT($DATA(^SRF(SRTN,"1.0")):^("1.0"),1:"")
+9 SET SRFROZ=$PIECE(SR("1.0"),"^",2)
SET SRXRAY1=$PIECE(SR("1.0"),"^",3)
SET SRXRAY2=$PIECE(SR("1.0"),"^",5)
+10 IF SRXRAY1'=""!(SRXRAY2'="N")
DO XRAY
+11 IF SRFROZ="Y"
WRITE ?24,"FROZEN SECTION TESTS REQUIRED",!
+12 NEW II,DRUG,JJ,SRIEN
+13 IF $$SPIN^SRTOVRF()
WRITE !,?24,"SPINAL LEVEL: ",?45,$PIECE($GET(^SRF(SRTN,1.1)),"^",4)
+14 IF SRFORM="L"
Begin DoDot:1
+15 IF $ORDER(^SRF(SRTN,58,0))
SET (II,JJ)=0
FOR
SET II=$ORDER(^SRF(SRTN,58,II))
if 'II
QUIT
SET SRIEN=$GET(^(II,0))
SET JJ=JJ+1
WRITE !,@$SELECT(JJ=1:"?24"_",""SPECIAL EQUIPMENT: """,1:"?45"),$PIECE($GET(^SRO(131.3,SRIEN,0)),"^")
+16 IF $ORDER(^SRF(SRTN,59,0))
SET (II,JJ)=0
FOR
SET II=$ORDER(^SRF(SRTN,59,II))
if 'II
QUIT
SET SRIEN=$GET(^(II,0))
SET JJ=JJ+1
WRITE !,@$SELECT(JJ=1:"?24"_",""PLANNED IMPLANT: """,1:"?45"),$PIECE($GET(^SRO(131.5,SRIEN,0)),"^")
+17 IF $ORDER(^SRF(SRTN,60,0))
SET (II,JJ)=0
FOR
SET II=$ORDER(^SRF(SRTN,60,II))
if 'II
QUIT
SET SRIEN=$GET(^(II,0))
SET JJ=JJ+1
WRITE !,@$SELECT(JJ=1:"?24"_",""SPECIAL SUPPLIES: """,1:"?45"),$PIECE($GET(^SRO(131.04,SRIEN,0)),"^")
+18 IF $ORDER(^SRF(SRTN,61,0))
SET (II,JJ)=0
FOR
SET II=$ORDER(^SRF(SRTN,61,II))
if 'II
QUIT
SET SRIEN=$GET(^(II,0))
SET JJ=JJ+1
WRITE !,@$SELECT(JJ=1:"?24"_",""SPECIAL INSTRUMENTS: """,1:"?45"),$PIECE($GET(^SRO(131.02,SRIEN,0)),"^")
+19 IF $ORDER(^SRF(SRTN,62,0))
SET (II,JJ)=0
FOR
SET II=$ORDER(^SRF(SRTN,62,II))
if 'II
QUIT
SET SRIEN=$GET(^(II,0))
SET JJ=JJ+1
WRITE !,@$SELECT(JJ=1:"?24"_",""PHARMACY ITEMS: """,1:"?45"),$PIECE(^PSDRUG(+$GET(^SRO(131.06,SRIEN,0)),0),"^")
End DoDot:1
+20 QUIT
XRAY ; print x-rays
+1 IF SRXRAY1'=""
WRITE ?24,"PREOPERATIVE XRAYS: "_SRXRAY1
if SRXRAY2="Y"
WRITE " INTRAOPERATIVE X-RAYS REQUESTED"
if SRXRAY2="C"
WRITE " C-ARM REQUESTED"
WRITE !
QUIT
+2 IF SRXRAY2="Y"
WRITE ?24,"INTRAOPERATIVE X-RAYS REQUESTED",!
QUIT
+3 IF SRXRAY2="C"
WRITE ?24,"C-ARM REQUESTED"
+4 WRITE !
+5 QUIT
