| [613] | 1 | SROERR2 ;B'HAM/ADM - ORDER ENTRY ROUTINE ; 25 JUNE 1992 10:00 AM
|
|---|
| 2 | ;;3.0; Surgery ;;24 Jun 93
|
|---|
| 3 | 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")
|
|---|
| 4 | S SRSS=$P(^SRF(SRTN,"NON"),"^",8),SRSNM=$S(SRSS:$P(^ECC(723,SRSS,0),"^"),1:"UNKNOWN")
|
|---|
| 5 | S SROSUR=$P(^SRF(SRTN,"NON"),"^",6),SROATT=$P(^("NON"),"^",7)
|
|---|
| 6 | S SROR=$P(^SRF(SRTN,"NON"),"^",2),Y=$P(^SRF(SRTN,"NON"),"^",3) D D^DIQ S SRSDATE=Y
|
|---|
| 7 | 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),"^")
|
|---|
| 8 | 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=""
|
|---|
| 9 | S:SROSUR SROSUR=$P(^VA(200,SROSUR,0),"^") S SROATT=$S(SROATT:$P(^VA(200,SROATT,0),"^"),1:"NOT ENTERED")
|
|---|
| 10 | S SRDIAG=$S($D(^SRF(SRTN,33)):$P(^(33),"^"),1:"") I SRDIAG="" S SRDIAG="NOT ENTERED"
|
|---|
| 11 | S SRSTAT=$S($P($G(^SRF(SRTN,30)),"^"):" (ABORTED)",$P($G(^SRF(SRTN,"NON")),"^",5):" (COMPLETED)",1:" (NOT COMPLETE)")
|
|---|
| 12 | I $P($G(^SRF(SRTN,"NON")),"^",4) D OPTM
|
|---|
| 13 | PRINT ;
|
|---|
| 14 | 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 "-"
|
|---|
| 15 | I $E(IOST)'="C" W !,"Ward: "_SRWARD,?40,"Case #"_SRTN_SRSTAT
|
|---|
| 16 | W !,"Date of Procedure: "_SRSDATE
|
|---|
| 17 | I $P($G(^SRF(SRTN,"NON")),"^",4) W !,"Time Procedure Began: "_SRSTART,?40,"Time Procedure Ended: "_SREND
|
|---|
| 18 | I SROR W !,"Non-O.R. Location: "_$P(^SC(SROR,0),"^")
|
|---|
| 19 | W !!,"Medical Specialty: "_SRSNM,!,"Provider: "_SROSUR,?40,"Attending: "_SROATT,!,"Preoperative Diagnosis: "_SRDIAG
|
|---|
| 20 | 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)
|
|---|
| 21 | 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)
|
|---|
| 22 | 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)
|
|---|
| 23 | Q
|
|---|
| 24 | LOOP ; break procedure if greater than J characters
|
|---|
| 25 | 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
|
|---|
| 26 | Q
|
|---|
| 27 | OPTM ; find begin and end times
|
|---|
| 28 | 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:"")
|
|---|
| 29 | 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:"")
|
|---|
| 30 | Q
|
|---|
