source: WorldVistAEHR/trunk/r/SURGERY-SR/SRONP.m@ 1195

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

initial load of WorldVistAEHR

File size: 2.1 KB
Line 
1SRONP ;BIR/ADM - PROCEDURE REPORT (NON-OR) ; [ 10/06/03 10:45 AM ]
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 ;
10OPTOP(SRTN,SRLAST,SRG) ; send op-top to ^TMP
11 ; SRTN - case number in file 130
12 ; SRLAST - (optional)
13 ; 0 or null : include summary status at end
14 ; 1 : omit summary status at end
15 ; 2 : include summary status at end plus summary in TIU
16 ; SRG - (optional) return array
17 ;
18 Q:'$D(SROVP)
19 N J,LOOP,SR,SRALL,SRCASE,SRERR,SRI,SRLF,SRSTAT,SRT,SRTIU
20 S SRTIU=$P($G(^SRF(SRTN,"TIU")),"^",3) Q:'SRTIU
21 D STATUS Q:SRSTAT>1
22 S SRCASE=SRTN S:'$L($G(SRG)) SRG=$NA(^TMP("SRNOR",$J,SRCASE)) K @SRG
23 S SRI=0,SRLAST=$S($G(SRLAST):SRLAST,1:1),@SRG@(SRI)=3
24 I $P($G(^SRF(SRTN,30)),"^")!$P($G(^SRF(SRTN,31)),"^",8) D LINE(1) S @SRG@(SRI)=" * * PROCEDURE ABORTED * *" D LINE(1)
25 S SR(0)=^SRF(SRTN,0)
26 D PRIN I $O(^SRF(SRTN,13,0)) D OTHER
27 Q
28STATUS ; check status of TIU document
29 D EXTRACT^TIULQ(SRTIU,"SRT",.SRERR,".05") S SRSTAT=SRT(SRTIU,.05,"I")
30 Q
31PRIN ; print principal procedure information
32 N I,M,MM,MMM,SRJ,SROPER,SROPS
33 D LINE(1) S @SRG@(SRI)="Non-O.R. Procedure(s) Performed:"
34PRIN2 S SROPER=$P(^SRF(SRTN,"OP"),"^")
35 I $P($G(^SRF(SRTN,30)),"^") S SROPER="** ABORTED ** "_SROPER
36 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=""
37 F I=1:1 Q:'$D(SROPS(I)) D LINE(1) S @SRG@(SRI)=$S(I=1:" Principal: ",1:" ")_SROPS(I)
38 Q
39OTHER ; other procedures
40 N CNT,OTH,OTHER
41 S (OTH,CNT)=0 F S OTH=$O(^SRF(SRTN,13,OTH)) Q:'OTH S CNT=CNT+1 D OTH
42 Q
43OTH S OTHER=$P(^SRF(SRTN,13,OTH,0),"^")
44 D LINE(1) S @SRG@(SRI)=" Other: "_OTHER
45 Q
46LOOP ; break procedure if greater than 70 characters
47 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
48 Q
49LINE(NUM) ;create carriage returns
50 I $G(SRLF) S NUM=NUM+1,SRLF=0
51 F J=1:1:NUM S SRI=SRI+1,@SRG@(SRI)=" "
52 Q
Note: See TracBrowser for help on using the repository browser.