source: WorldVistAEHR/trunk/r/SURGERY-SR/SROSRPT.m@ 1259

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

initial load of WorldVistAEHR

File size: 2.1 KB
Line 
1SROSRPT ;BIR/ADM - OPERATION REPORT ; [ 10/06/03 2:45 PM ]
2 ;;3.0; Surgery ;**100**;24 Jun 93
3 ;
4 ;** NOTICE: This routine is part of an implementation of a nationally
5 ;** controlled procedure. Local modifications to this routine
6 ;** are prohibited.
7 ;
8 ; Reference to EXTRACT^TIULQ supported by DBIA #2693
9 ;
10 Q
11OPTOP(SRTN,SRLAST,SRG) ; send op-top to ^TMP
12 ; SRTN - case number in file 130
13 ; SRLAST - (optional)
14 ; 0 or null : include summary status at end
15 ; 1 : omit summary status at end
16 ; 2 : include summary status at end plus summary in TIU
17 ; SRG - (optional) return array
18 ;
19 Q:'$D(SROVP)
20 N J,LOOP,SR,SRALL,SRCASE,SRERR,SRI,SRLF,SRSTAT,SRT,SRTIU
21 S SRTIU=$P($G(^SRF(SRTN,"TIU")),"^") Q:'SRTIU
22 D STATUS Q:SRSTAT>1
23 S SRCASE=SRTN S:'$L($G(SRG)) SRG=$NA(^TMP("SROP",$J,SRCASE)) K @SRG
24 S SRI=0,SRLAST=$S($G(SRLAST):SRLAST,1:1),@SRG@(SRI)=3
25 I $P($G(^SRF(SRTN,30)),"^")!$P($G(^SRF(SRTN,31)),"^",8) D LINE(1) S @SRG@(SRI)=" * * OPERATION ABORTED * *" D LINE(1)
26 S SR(0)=^SRF(SRTN,0)
27 D PRIN I $O(^SRF(SRTN,13,0)) D OTHER
28 Q
29STATUS ; check status of TIU document
30 D EXTRACT^TIULQ(SRTIU,"SRT",.SRERR,".05") S SRSTAT=SRT(SRTIU,.05,"I")
31 Q
32PRIN ; print principal procedure information
33 N I,M,MM,MMM,SRJ,SROPER,SROPS
34 D LINE(1) S @SRG@(SRI)="Procedure(s) Performed:"
35PRIN2 S SROPER=$P(^SRF(SRTN,"OP"),"^")
36 I $P($G(^SRF(SRTN,30)),"^")&$P($G(^SRF(SRTN,.2)),"^",10) S SROPER="** ABORTED ** "_SROPER
37 K SROPS,MM,MMM S:$L(SROPER)<70 SROPS(1)=SROPER I $L(SROPER)>69 S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM=""
38 F I=1:1 Q:'$D(SROPS(I)) D LINE(1) S @SRG@(SRI)=$S(I=1:" Principal: ",1:" ")_SROPS(I)
39 Q
40OTHER ; other procedures
41 N CNT,OTH,OTHER
42 S (OTH,CNT)=0 F S OTH=$O(^SRF(SRTN,13,OTH)) Q:'OTH S CNT=CNT+1 D OTH
43 Q
44OTH S OTHER=$P(^SRF(SRTN,13,OTH,0),"^")
45 D LINE(1) S @SRG@(SRI)=" Other: "_OTHER
46 Q
47LOOP ; break procedure if greater than 70 characters
48 S SROPS(M)="" F LOOP=1:1 S MM=$P(SROPER," "),MMM=$P(SROPER," ",2,200) Q:MMM="" Q:$L(SROPS(M))+$L(MM)'<70 S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM
49 Q
50LINE(NUM) ;create carriage returns
51 I $G(SRLF) S NUM=NUM+1,SRLF=0
52 F J=1:1:NUM S SRI=SRI+1,@SRG@(SRI)=" "
53 Q
Note: See TracBrowser for help on using the repository browser.