- SROERR2 ;B'HAM/ADM - ORDER ENTRY ROUTINE ; 25 JUNE 1992 10:00 AM
- ;;3.0; Surgery ;;24 Jun 93
- S DFN=+ORVP D DEM^VADPT S SRNAME=VADM(1),SRSSN=VA("PID"),SRAGE=ORAGE,SRWARD=$S($D(^DPT(DFN,.1)):^(.1),1:"NOT ENTERED")
- S SRSS=$P(^SRF(SRTN,"NON"),"^",8),SRSNM=$S(SRSS:$P(^ECC(723,SRSS,0),"^"),1:"UNKNOWN")
- S SROSUR=$P(^SRF(SRTN,"NON"),"^",6),SROATT=$P(^("NON"),"^",7)
- S SROR=$P(^SRF(SRTN,"NON"),"^",2),Y=$P(^SRF(SRTN,"NON"),"^",3) D D^DIQ S SRSDATE=Y
- S SROPER=$P(^SRF(SRTN,"OP"),"^") K SROP S (X,CNT)=0 F S X=$O(^SRF(SRTN,13,X)) Q:'X S CNT=CNT+1,SROP(CNT)=$P(^SRF(SRTN,13,X,0),"^")
- K SROPS,MM,MMM S:$L(SROPER)<56 SROPS(1)=SROPER I $L(SROPER)>55 S SROPER=SROPER_" ",J=55 F M=1:1 D LOOP Q:MMM=""
- S:SROSUR SROSUR=$P(^VA(200,SROSUR,0),"^") S SROATT=$S(SROATT:$P(^VA(200,SROATT,0),"^"),1:"NOT ENTERED")
- S SRDIAG=$S($D(^SRF(SRTN,33)):$P(^(33),"^"),1:"") I SRDIAG="" S SRDIAG="NOT ENTERED"
- S SRSTAT=$S($P($G(^SRF(SRTN,30)),"^"):" (ABORTED)",$P($G(^SRF(SRTN,"NON")),"^",5):" (COMPLETED)",1:" (NOT COMPLETE)")
- I $P($G(^SRF(SRTN,"NON")),"^",4) D OPTM
- PRINT ;
- I $E(IOST)="C" W @IOF,!,"Patient: "_SRNAME,?40,"ID#: "_VA("PID"),?65,"Age: "_SRAGE,!,"Ward: "_SRWARD,?40,"Case #"_SRTN_SRSTAT,! F LINE=1:1:80 W "-"
- I $E(IOST)'="C" W !,"Ward: "_SRWARD,?40,"Case #"_SRTN_SRSTAT
- W !,"Date of Procedure: "_SRSDATE
- I $P($G(^SRF(SRTN,"NON")),"^",4) W !,"Time Procedure Began: "_SRSTART,?40,"Time Procedure Ended: "_SREND
- I SROR W !,"Non-O.R. Location: "_$P(^SC(SROR,0),"^")
- W !!,"Medical Specialty: "_SRSNM,!,"Provider: "_SROSUR,?40,"Attending: "_SROATT,!,"Preoperative Diagnosis: "_SRDIAG
- W !!,"Principal Procedure:",?22,SROPS(1) I $D(SROPS(2)) W !,?22,SROPS(2) I $D(SROPS(3)) W !,?22,SROPS(3) I $D(SROPS(4)) W !,?22,SROPS(4) I $D(SROPS(5)) W !,?22,SROPS(5)
- I $O(SROP(0)) W !,"Other Procedures:",?22,SROP(1) S CNT=1 F I=0:0 S CNT=$O(SROP(CNT)) Q:'CNT W !,?22,SROP(CNT)
- I $O(^SRF(SRTN,5,0)) W !!,"Comments: " S X=0 F I=0:0 S X=$O(^SRF(SRTN,5,X)) Q:'X W !,^SRF(SRTN,5,X,0)
- Q
- LOOP ; break procedure if greater than J characters
- S SROPS(M)="" F LOOP=1:1 S MM=$P(SROPER," "),MMM=$P(SROPER," ",2,200) Q:MMM="" Q:$L(SROPS(M))+$L(MM)'<J S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM
- Q
- OPTM ; find begin and end times
- S (SRSTART,Y)=$P($G(^SRF(SRTN,"NON")),"^",4) I Y D D^DIQ S SRFIND=$F(Y,":"),SRSTART=$S(SRFIND:$E(Y,SRFIND-3,SRFIND+1),1:"")
- S (SREND,Y)=$P($G(^SRF(SRTN,"NON")),"^",5) I Y D D^DIQ S SRFIND=$F(Y,":"),SREND=$S(SRFIND:$E(Y,SRFIND-3,SRFIND+1),1:"")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROERR2 2479 printed Feb 19, 2025@00:09:50 Page 2
- SROERR2 ;B'HAM/ADM - ORDER ENTRY ROUTINE ; 25 JUNE 1992 10:00 AM
- +1 ;;3.0; Surgery ;;24 Jun 93
- +2 SET DFN=+ORVP
- DO DEM^VADPT
- SET SRNAME=VADM(1)
- SET SRSSN=VA("PID")
- SET SRAGE=ORAGE
- SET SRWARD=$SELECT($DATA(^DPT(DFN,.1)):^(.1),1:"NOT ENTERED")
- +3 SET SRSS=$PIECE(^SRF(SRTN,"NON"),"^",8)
- SET SRSNM=$SELECT(SRSS:$PIECE(^ECC(723,SRSS,0),"^"),1:"UNKNOWN")
- +4 SET SROSUR=$PIECE(^SRF(SRTN,"NON"),"^",6)
- SET SROATT=$PIECE(^("NON"),"^",7)
- +5 SET SROR=$PIECE(^SRF(SRTN,"NON"),"^",2)
- SET Y=$PIECE(^SRF(SRTN,"NON"),"^",3)
- DO D^DIQ
- SET SRSDATE=Y
- +6 SET SROPER=$PIECE(^SRF(SRTN,"OP"),"^")
- KILL SROP
- SET (X,CNT)=0
- FOR
- SET X=$ORDER(^SRF(SRTN,13,X))
- if 'X
- QUIT
- SET CNT=CNT+1
- SET SROP(CNT)=$PIECE(^SRF(SRTN,13,X,0),"^")
- +7 KILL SROPS,MM,MMM
- if $LENGTH(SROPER)<56
- SET SROPS(1)=SROPER
- IF $LENGTH(SROPER)>55
- SET SROPER=SROPER_" "
- SET J=55
- FOR M=1:1
- DO LOOP
- if MMM=""
- QUIT
- +8 if SROSUR
- SET SROSUR=$PIECE(^VA(200,SROSUR,0),"^")
- SET SROATT=$SELECT(SROATT:$PIECE(^VA(200,SROATT,0),"^"),1:"NOT ENTERED")
- +9 SET SRDIAG=$SELECT($DATA(^SRF(SRTN,33)):$PIECE(^(33),"^"),1:"")
- IF SRDIAG=""
- SET SRDIAG="NOT ENTERED"
- +10 SET SRSTAT=$SELECT($PIECE($GET(^SRF(SRTN,30)),"^"):" (ABORTED)",$PIECE($GET(^SRF(SRTN,"NON")),"^",5):" (COMPLETED)",1:" (NOT COMPLETE)")
- +11 IF $PIECE($GET(^SRF(SRTN,"NON")),"^",4)
- DO OPTM
- PRINT ;
- +1 IF $EXTRACT(IOST)="C"
- WRITE @IOF,!,"Patient: "_SRNAME,?40,"ID#: "_VA("PID"),?65,"Age: "_SRAGE,!,"Ward: "_SRWARD,?40,"Case #"_SRTN_SRSTAT,!
- FOR LINE=1:1:80
- WRITE "-"
- +2 IF $EXTRACT(IOST)'="C"
- WRITE !,"Ward: "_SRWARD,?40,"Case #"_SRTN_SRSTAT
- +3 WRITE !,"Date of Procedure: "_SRSDATE
- +4 IF $PIECE($GET(^SRF(SRTN,"NON")),"^",4)
- WRITE !,"Time Procedure Began: "_SRSTART,?40,"Time Procedure Ended: "_SREND
- +5 IF SROR
- WRITE !,"Non-O.R. Location: "_$PIECE(^SC(SROR,0),"^")
- +6 WRITE !!,"Medical Specialty: "_SRSNM,!,"Provider: "_SROSUR,?40,"Attending: "_SROATT,!,"Preoperative Diagnosis: "_SRDIAG
- +7 WRITE !!,"Principal Procedure:",?22,SROPS(1)
- IF $DATA(SROPS(2))
- WRITE !,?22,SROPS(2)
- IF $DATA(SROPS(3))
- WRITE !,?22,SROPS(3)
- IF $DATA(SROPS(4))
- WRITE !,?22,SROPS(4)
- IF $DATA(SROPS(5))
- WRITE !,?22,SROPS(5)
- +8 IF $ORDER(SROP(0))
- WRITE !,"Other Procedures:",?22,SROP(1)
- SET CNT=1
- FOR I=0:0
- SET CNT=$ORDER(SROP(CNT))
- if 'CNT
- QUIT
- WRITE !,?22,SROP(CNT)
- +9 IF $ORDER(^SRF(SRTN,5,0))
- WRITE !!,"Comments: "
- SET X=0
- FOR I=0:0
- SET X=$ORDER(^SRF(SRTN,5,X))
- if 'X
- QUIT
- WRITE !,^SRF(SRTN,5,X,0)
- +10 QUIT
- LOOP ; break procedure if greater than J characters
- +1 SET SROPS(M)=""
- FOR LOOP=1:1
- SET MM=$PIECE(SROPER," ")
- SET MMM=$PIECE(SROPER," ",2,200)
- if MMM=""
- QUIT
- if $LENGTH(SROPS(M))+$LENGTH(MM)'<J
- QUIT
- SET SROPS(M)=SROPS(M)_MM_" "
- SET SROPER=MMM
- +2 QUIT
- OPTM ; find begin and end times
- +1 SET (SRSTART,Y)=$PIECE($GET(^SRF(SRTN,"NON")),"^",4)
- IF Y
- DO D^DIQ
- SET SRFIND=$FIND(Y,":")
- SET SRSTART=$SELECT(SRFIND:$EXTRACT(Y,SRFIND-3,SRFIND+1),1:"")
- +2 SET (SREND,Y)=$PIECE($GET(^SRF(SRTN,"NON")),"^",5)
- IF Y
- DO D^DIQ
- SET SRFIND=$FIND(Y,":")
- SET SREND=$SELECT(SRFIND:$EXTRACT(Y,SRFIND-3,SRFIND+1),1:"")
- +3 QUIT