- SROPAC0 ;B'HAM ISC/MAM - DAILY ACTIVITY REPORT ; [ 07/27/98 2:33 PM ]
- ;;3.0; Surgery ;**34,50**;24 Jun 93
- S SRSOUT=0 D HDR^SROPAC1
- S SROR=0 F S SROR=$O(^TMP("SRACT",$J,SROR)) Q:SROR=""!(SRSOUT) D ROOM S SRSDATE=0 F S SRSDATE=$O(^TMP("SRACT",$J,SROR,SRSDATE)) Q:'SRSDATE!(SRSOUT) D CASE
- I '$D(^TMP("SRACT",$J)) W $$NODATA^SROUTL0()
- Q
- CASE S SRTN=0 F S SRTN=$O(^TMP("SRACT",$J,SROR,SRSDATE,SRTN)) Q:'SRTN!(SRSOUT) D SET
- Q
- SET ;
- S DFN=$P(^SRF(SRTN,0),"^") D DEM^VADPT
- S SRNM=VADM(1) I $L(SRNM)>23 S SRNM=$P(SRNM,",")_","_$E($P(SRNM,",",2))
- K SRSLOC I $D(^DPT(DFN,.1)) S SRSLOC=$P(^(.1),"^") I $D(^DPT(DFN,.101)) S SRSLOC=SRSLOC_" "_$P(^(.101),"^")
- I '$D(SRSLOC) S SRSLOC="OUTPATIENT"
- S (SRSUR,SRFST,SRATT,SRAN1,SRAN2)="",SR(.1)=$S($D(^SRF(SRTN,.1)):^(.1),1:""),SR(.3)=$S($D(^SRF(SRTN,.3)):^(.3),1:"")
- S SRSUR=$P(SR(.1),"^",4),SRATT=$P(SR(.1),"^",13),SRFST=$P(SR(.1),"^",5),SRAN1=$P(SR(.3),"^",4),SRAN2=$P(SR(.3),"^") S:SRSUR'="" SRSUR=$P(^VA(200,SRSUR,0),"^") S:SRATT'="" SRATT=$P(^VA(200,SRATT,0),"^") S:SRFST'="" SRFST=$P(^VA(200,SRFST,0),"^")
- S:SRAN1'="" SRAN1=$P(^VA(200,SRAN1,0),"^") S:SRAN2'="" SRAN2=$P(^VA(200,SRAN2,0),"^")
- F USER="SRSUR","SRFST","SRATT","SRAN1","SRAN2" S:'$D(@USER) @USER="" I @USER]"" S @USER=$P(@USER,",")_","_$E($P(@USER,",",2))
- S SRDIAG=$S($D(^SRF(SRTN,34)):$P(^(34),"^"),1:"")
- OPS S SROPER=$P(^SRF(SRTN,"OP"),"^"),OPER=0 F I=0:0 S OPER=$O(^SRF(SRTN,13,OPER)) Q:OPER="" D OTHER
- K SROP,MM,MMM S:$L(SROPER)<50 SROP(1)=SROPER I $L(SROPER)>49 S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM=""
- S SRINTIME=$P(^SRF(SRTN,.2),"^",10),SROUTIME=$P(^(.2),"^",12)
- S Y=SRINTIME D D^DIQ S SRINTIME=$E(SRINTIME,4,5)_"/"_$E(SRINTIME,6,7)_" "_$P(Y,"@",2)
- I 'SROUTIME S SROUTIME="-----"
- I SROUTIME S Y=SROUTIME D D^DIQ S SROUTIME=$E(SROUTIME,4,5)_"/"_$E(SROUTIME,6,7)_" "_$P(Y,"@",2)
- D ^SROPAC1
- Q
- OTHER ; other operations
- S SRLONG=1 I $L(SROPER)+$L($P(^SRF(SRTN,13,OPER,0),"^"))>250 S SRLONG=0,OPER=999,SROPERS=" ..."
- I SRLONG S SROPERS=$P(^SRF(SRTN,13,OPER,0),"^")
- S SROPER=SROPER_$S(SROPERS=" ...":SROPERS,1:", "_SROPERS)
- Q
- LOOP ; break procedure if greater than 50 characters
- S SROP(M)="" F LOOP=1:1 S MM=$P(SROPER," "),MMM=$P(SROPER," ",2,200) Q:MMM="" Q:$L(SROP(M))+$L(MM)'<50 S SROP(M)=SROP(M)_MM_" ",SROPER=MMM
- Q
- ROOM I $Y+9>IOSL D PAGE^SROPAC1 Q
- W !!,"OPERATING ROOM: "_SROR,!
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROPAC0 2369 printed Feb 19, 2025@00:11:16 Page 2
- SROPAC0 ;B'HAM ISC/MAM - DAILY ACTIVITY REPORT ; [ 07/27/98 2:33 PM ]
- +1 ;;3.0; Surgery ;**34,50**;24 Jun 93
- +2 SET SRSOUT=0
- DO HDR^SROPAC1
- +3 SET SROR=0
- FOR
- SET SROR=$ORDER(^TMP("SRACT",$JOB,SROR))
- if SROR=""!(SRSOUT)
- QUIT
- DO ROOM
- SET SRSDATE=0
- FOR
- SET SRSDATE=$ORDER(^TMP("SRACT",$JOB,SROR,SRSDATE))
- if 'SRSDATE!(SRSOUT)
- QUIT
- DO CASE
- +4 IF '$DATA(^TMP("SRACT",$JOB))
- WRITE $$NODATA^SROUTL0()
- +5 QUIT
- CASE SET SRTN=0
- FOR
- SET SRTN=$ORDER(^TMP("SRACT",$JOB,SROR,SRSDATE,SRTN))
- if 'SRTN!(SRSOUT)
- QUIT
- DO SET
- +1 QUIT
- SET ;
- +1 SET DFN=$PIECE(^SRF(SRTN,0),"^")
- DO DEM^VADPT
- +2 SET SRNM=VADM(1)
- IF $LENGTH(SRNM)>23
- SET SRNM=$PIECE(SRNM,",")_","_$EXTRACT($PIECE(SRNM,",",2))
- +3 KILL SRSLOC
- IF $DATA(^DPT(DFN,.1))
- SET SRSLOC=$PIECE(^(.1),"^")
- IF $DATA(^DPT(DFN,.101))
- SET SRSLOC=SRSLOC_" "_$PIECE(^(.101),"^")
- +4 IF '$DATA(SRSLOC)
- SET SRSLOC="OUTPATIENT"
- +5 SET (SRSUR,SRFST,SRATT,SRAN1,SRAN2)=""
- SET SR(.1)=$SELECT($DATA(^SRF(SRTN,.1)):^(.1),1:"")
- SET SR(.3)=$SELECT($DATA(^SRF(SRTN,.3)):^(.3),1:"")
- +6 SET SRSUR=$PIECE(SR(.1),"^",4)
- SET SRATT=$PIECE(SR(.1),"^",13)
- SET SRFST=$PIECE(SR(.1),"^",5)
- SET SRAN1=$PIECE(SR(.3),"^",4)
- SET SRAN2=$PIECE(SR(.3),"^")
- if SRSUR'=""
- SET SRSUR=$PIECE(^VA(200,SRSUR,0),"^")
- if SRATT'=""
- SET SRATT=$PIECE(^VA(200,SRATT,0),"^")
- if SRFST'=""
- SET SRFST=$PIECE(^VA(200,SRFST,0),"^")
- +7 if SRAN1'=""
- SET SRAN1=$PIECE(^VA(200,SRAN1,0),"^")
- if SRAN2'=""
- SET SRAN2=$PIECE(^VA(200,SRAN2,0),"^")
- +8 FOR USER="SRSUR","SRFST","SRATT","SRAN1","SRAN2"
- if '$DATA(@USER)
- SET @USER=""
- IF @USER]""
- SET @USER=$PIECE(@USER,",")_","_$EXTRACT($PIECE(@USER,",",2))
- +9 SET SRDIAG=$SELECT($DATA(^SRF(SRTN,34)):$PIECE(^(34),"^"),1:"")
- OPS SET SROPER=$PIECE(^SRF(SRTN,"OP"),"^")
- SET OPER=0
- FOR I=0:0
- SET OPER=$ORDER(^SRF(SRTN,13,OPER))
- if OPER=""
- QUIT
- DO OTHER
- +1 KILL SROP,MM,MMM
- if $LENGTH(SROPER)<50
- SET SROP(1)=SROPER
- IF $LENGTH(SROPER)>49
- SET SROPER=SROPER_" "
- FOR M=1:1
- DO LOOP
- if MMM=""
- QUIT
- +2 SET SRINTIME=$PIECE(^SRF(SRTN,.2),"^",10)
- SET SROUTIME=$PIECE(^(.2),"^",12)
- +3 SET Y=SRINTIME
- DO D^DIQ
- SET SRINTIME=$EXTRACT(SRINTIME,4,5)_"/"_$EXTRACT(SRINTIME,6,7)_" "_$PIECE(Y,"@",2)
- +4 IF 'SROUTIME
- SET SROUTIME="-----"
- +5 IF SROUTIME
- SET Y=SROUTIME
- DO D^DIQ
- SET SROUTIME=$EXTRACT(SROUTIME,4,5)_"/"_$EXTRACT(SROUTIME,6,7)_" "_$PIECE(Y,"@",2)
- +6 DO ^SROPAC1
- +7 QUIT
- OTHER ; other operations
- +1 SET SRLONG=1
- IF $LENGTH(SROPER)+$LENGTH($PIECE(^SRF(SRTN,13,OPER,0),"^"))>250
- SET SRLONG=0
- SET OPER=999
- SET SROPERS=" ..."
- +2 IF SRLONG
- SET SROPERS=$PIECE(^SRF(SRTN,13,OPER,0),"^")
- +3 SET SROPER=SROPER_$SELECT(SROPERS=" ...":SROPERS,1:", "_SROPERS)
- +4 QUIT
- LOOP ; break procedure if greater than 50 characters
- +1 SET SROP(M)=""
- FOR LOOP=1:1
- SET MM=$PIECE(SROPER," ")
- SET MMM=$PIECE(SROPER," ",2,200)
- if MMM=""
- QUIT
- if $LENGTH(SROP(M))+$LENGTH(MM)'<50
- QUIT
- SET SROP(M)=SROP(M)_MM_" "
- SET SROPER=MMM
- +2 QUIT
- ROOM IF $Y+9>IOSL
- DO PAGE^SROPAC1
- QUIT
- +1 WRITE !!,"OPERATING ROOM: "_SROR,!
- +2 QUIT