| [613] | 1 | SRONP ;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 | ;
|
|---|
| 10 | OPTOP(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
|
|---|
| 28 | STATUS ; check status of TIU document
|
|---|
| 29 | D EXTRACT^TIULQ(SRTIU,"SRT",.SRERR,".05") S SRSTAT=SRT(SRTIU,.05,"I")
|
|---|
| 30 | Q
|
|---|
| 31 | PRIN ; 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:"
|
|---|
| 34 | PRIN2 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
|
|---|
| 39 | OTHER ; 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
|
|---|
| 43 | OTH S OTHER=$P(^SRF(SRTN,13,OTH,0),"^")
|
|---|
| 44 | D LINE(1) S @SRG@(SRI)=" Other: "_OTHER
|
|---|
| 45 | Q
|
|---|
| 46 | LOOP ; 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
|
|---|
| 49 | LINE(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
|
|---|
