SROSRPT ;BIR/ADM - OPERATION REPORT ; [ 10/06/03 2:45 PM ]
;;3.0; Surgery ;**100**;24 Jun 93
;
;** NOTICE: This routine is part of an implementation of a nationally
;** controlled procedure. Local modifications to this routine
;** are prohibited.
;
; Reference to EXTRACT^TIULQ supported by DBIA #2693
;
Q
OPTOP(SRTN,SRLAST,SRG) ; send op-top to ^TMP
; SRTN - case number in file 130
; SRLAST - (optional)
; 0 or null : include summary status at end
; 1 : omit summary status at end
; 2 : include summary status at end plus summary in TIU
; SRG - (optional) return array
;
Q:'$D(SROVP)
N J,LOOP,SR,SRALL,SRCASE,SRERR,SRI,SRLF,SRSTAT,SRT,SRTIU
S SRTIU=$P($G(^SRF(SRTN,"TIU")),"^") Q:'SRTIU
D STATUS Q:SRSTAT>1
S SRCASE=SRTN S:'$L($G(SRG)) SRG=$NA(^TMP("SROP",$J,SRCASE)) K @SRG
S SRI=0,SRLAST=$S($G(SRLAST):SRLAST,1:1),@SRG@(SRI)=3
I $P($G(^SRF(SRTN,30)),"^")!$P($G(^SRF(SRTN,31)),"^",8) D LINE(1) S @SRG@(SRI)=" * * OPERATION ABORTED * *" D LINE(1)
S SR(0)=^SRF(SRTN,0)
D PRIN I $O(^SRF(SRTN,13,0)) D OTHER
Q
STATUS ; check status of TIU document
D EXTRACT^TIULQ(SRTIU,"SRT",.SRERR,".05") S SRSTAT=SRT(SRTIU,.05,"I")
Q
PRIN ; print principal procedure information
N I,M,MM,MMM,SRJ,SROPER,SROPS
D LINE(1) S @SRG@(SRI)="Procedure(s) Performed:"
PRIN2 S SROPER=$P(^SRF(SRTN,"OP"),"^")
I $P($G(^SRF(SRTN,30)),"^")&$P($G(^SRF(SRTN,.2)),"^",10) S SROPER="** ABORTED ** "_SROPER
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=""
F I=1:1 Q:'$D(SROPS(I)) D LINE(1) S @SRG@(SRI)=$S(I=1:" Principal: ",1:" ")_SROPS(I)
Q
OTHER ; other procedures
N CNT,OTH,OTHER
S (OTH,CNT)=0 F S OTH=$O(^SRF(SRTN,13,OTH)) Q:'OTH S CNT=CNT+1 D OTH
Q
OTH S OTHER=$P(^SRF(SRTN,13,OTH,0),"^")
D LINE(1) S @SRG@(SRI)=" Other: "_OTHER
Q
LOOP ; break procedure if greater than 70 characters
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
Q
LINE(NUM) ;create carriage returns
I $G(SRLF) S NUM=NUM+1,SRLF=0
F J=1:1:NUM S SRI=SRI+1,@SRG@(SRI)=" "
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROSRPT 2230 printed Apr 09, 2024@21:51:24 Page 2
SROSRPT ;BIR/ADM - OPERATION REPORT ; [ 10/06/03 2:45 PM ]
+1 ;;3.0; Surgery ;**100**;24 Jun 93
+2 ;
+3 ;** NOTICE: This routine is part of an implementation of a nationally
+4 ;** controlled procedure. Local modifications to this routine
+5 ;** are prohibited.
+6 ;
+7 ; Reference to EXTRACT^TIULQ supported by DBIA #2693
+8 ;
+9 QUIT
OPTOP(SRTN,SRLAST,SRG) ; send op-top to ^TMP
+1 ; SRTN - case number in file 130
+2 ; SRLAST - (optional)
+3 ; 0 or null : include summary status at end
+4 ; 1 : omit summary status at end
+5 ; 2 : include summary status at end plus summary in TIU
+6 ; SRG - (optional) return array
+7 ;
+8 if '$DATA(SROVP)
QUIT
+9 NEW J,LOOP,SR,SRALL,SRCASE,SRERR,SRI,SRLF,SRSTAT,SRT,SRTIU
+10 SET SRTIU=$PIECE($GET(^SRF(SRTN,"TIU")),"^")
if 'SRTIU
QUIT
+11 DO STATUS
if SRSTAT>1
QUIT
+12 SET SRCASE=SRTN
if '$LENGTH($GET(SRG))
SET SRG=$NAME(^TMP("SROP",$JOB,SRCASE))
KILL @SRG
+13 SET SRI=0
SET SRLAST=$SELECT($GET(SRLAST):SRLAST,1:1)
SET @SRG@(SRI)=3
+14 IF $PIECE($GET(^SRF(SRTN,30)),"^")!$PIECE($GET(^SRF(SRTN,31)),"^",8)
DO LINE(1)
SET @SRG@(SRI)=" * * OPERATION ABORTED * *"
DO LINE(1)
+15 SET SR(0)=^SRF(SRTN,0)
+16 DO PRIN
IF $ORDER(^SRF(SRTN,13,0))
DO OTHER
+17 QUIT
STATUS ; check status of TIU document
+1 DO EXTRACT^TIULQ(SRTIU,"SRT",.SRERR,".05")
SET SRSTAT=SRT(SRTIU,.05,"I")
+2 QUIT
PRIN ; print principal procedure information
+1 NEW I,M,MM,MMM,SRJ,SROPER,SROPS
+2 DO LINE(1)
SET @SRG@(SRI)="Procedure(s) Performed:"
PRIN2 SET SROPER=$PIECE(^SRF(SRTN,"OP"),"^")
+1 IF $PIECE($GET(^SRF(SRTN,30)),"^")&$PIECE($GET(^SRF(SRTN,.2)),"^",10)
SET SROPER="** ABORTED ** "_SROPER
+2 KILL SROPS,MM,MMM
if $LENGTH(SROPER)<70
SET SROPS(1)=SROPER
IF $LENGTH(SROPER)>69
SET SROPER=SROPER_" "
FOR M=1:1
DO LOOP
if MMM=""
QUIT
+3 FOR I=1:1
if '$DATA(SROPS(I))
QUIT
DO LINE(1)
SET @SRG@(SRI)=$SELECT(I=1:" Principal: ",1:" ")_SROPS(I)
+4 QUIT
OTHER ; other procedures
+1 NEW CNT,OTH,OTHER
+2 SET (OTH,CNT)=0
FOR
SET OTH=$ORDER(^SRF(SRTN,13,OTH))
if 'OTH
QUIT
SET CNT=CNT+1
DO OTH
+3 QUIT
OTH SET OTHER=$PIECE(^SRF(SRTN,13,OTH,0),"^")
+1 DO LINE(1)
SET @SRG@(SRI)=" Other: "_OTHER
+2 QUIT
LOOP ; break procedure if greater than 70 characters
+1 SET SROPS(M)=""
FOR LOOP=1:1
SET MM=$PIECE(SROPER," ")
SET MMM=$PIECE(SROPER," ",2,200)
if MMM=""
QUIT
if $LENGTH(SROPS(M))+$LENGTH(MM)'<70
QUIT
SET SROPS(M)=SROPS(M)_MM_" "
SET SROPER=MMM
+2 QUIT
LINE(NUM) ;create carriage returns
+1 IF $GET(SRLF)
SET NUM=NUM+1
SET SRLF=0
+2 FOR J=1:1:NUM
SET SRI=SRI+1
SET @SRG@(SRI)=" "
+3 QUIT
