source: WorldVistAEHR/trunk/r/SURGERY-SR/SROERR2.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.4 KB
Line 
1SROERR2 ;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
13PRINT ;
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
24LOOP ; 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
27OPTM ; 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
Note: See TracBrowser for help on using the repository browser.