Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SROSCH2

SROSCH2.m

Go to the documentation of this file.
  1. 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
  1. 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
  1. Q
  1. QUEUE ; queue report to device
  1. K %ZIS,POP S %ZIS="QN" D ^%ZIS Q:POP
  1. S ZTDESC="SCHEDULE OF OPERATIONS",ZTRTN="SROSCH",(ZTSAVE("SRDT"),ZTSAVE("SRDT1"),ZTSAVE("SRSITE*"),ZTSAVE("SRFORM"))="",ZTDTH=$H D ^%ZTLOAD
  1. Q
  1. PRINT ; print variables
  1. D:$Y+10>IOSL ASK^SROSCH1 Q:SRQ
  1. W:SX=1 !!,"OPERATING ROOM: ",SROOM,!
  1. W !,SRNM,?24,SROPD,?40,SRDIAG,?92,SRANES,?115,SRSUR,!,VA("PID"),?16,AGE,?24,SRSST,?40,SROPS(1),?92,SRAN1,?115,SRFST
  1. W !,SRSLOC,?24,SRSET W:$D(SROPS(2)) ?40,SROPS(2) W ?92,SRAN2,?115,SRATT I $D(SROPS(3)) W !,?40,SROPS(3)
  1. I $D(SROPS(4)) W !,?40,SROPS(4) I $D(SROPS(5)) W !,?40,SROPS(5) I $D(SROPS(6)) W !,?40,SROPS(6)
  1. I $D(^SRF(SRTN,"CON")),$P(^("CON"),"^")'="" S SRCON=+^("CON") D CON^SROSCH1
  1. W !,"Case # "_SRTN D PRINT^SROBLOD W !,SRPREAD
  1. S SR("1.0")=$S($D(^SRF(SRTN,"1.0")):^("1.0"),1:"")
  1. S SRFROZ=$P(SR("1.0"),"^",2),SRXRAY1=$P(SR("1.0"),"^",3),SRXRAY2=$P(SR("1.0"),"^",5)
  1. I SRXRAY1'=""!(SRXRAY2'="N") D XRAY
  1. I SRFROZ="Y" W ?24,"FROZEN SECTION TESTS REQUIRED",!
  1. N II,DRUG,JJ,SRIEN
  1. I $$SPIN^SRTOVRF() W !,?24,"SPINAL LEVEL: ",?45,$P($G(^SRF(SRTN,1.1)),"^",4)
  1. I SRFORM="L" D
  1. .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)),"^")
  1. .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)),"^")
  1. .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)),"^")
  1. .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)),"^")
  1. .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),"^")
  1. Q
  1. XRAY ; print x-rays
  1. I SRXRAY1'="" W ?24,"PREOPERATIVE XRAYS: "_SRXRAY1 W:SRXRAY2="Y" " INTRAOPERATIVE X-RAYS REQUESTED" W:SRXRAY2="C" " C-ARM REQUESTED" W ! Q
  1. I SRXRAY2="Y" W ?24,"INTRAOPERATIVE X-RAYS REQUESTED",! Q
  1. I SRXRAY2="C" W ?24,"C-ARM REQUESTED"
  1. W !
  1. Q