SRONRPT2 ;BIR/ADM - NURSE INTRAOP REPORT ; [ 09/08/03 2:47 PM ]
;;3.0;Surgery;**100,182**;24 Jun 93;Build 49
;
;** NOTICE: This routine is part of an implementation of a nationally
;** controlled procedure. Local modifications to this routine
;** are prohibited.
;
N BLOOD,COLOR,CONS,COUNTER,DRESS,INSTR,INTEG,INTXRAY,MOOD,PACK,SHARP,SPONGE,SRPIR,URINE,VERIFY,WOUND
S SRLF=1,SRLINE="Irrigation Solution(s): " I '$O(^SRF(SRTN,26,0)),SRALL D LINE(1) S @SRG@(SRI)=SRLINE_"N/A"
I $O(^SRF(SRTN,26,0)) D LINE(1) S @SRG@(SRI)=SRLINE D IRR
S SRLF=1,SRLINE="Blood Replacement Fluids: " I '$O(^SRF(SRTN,4,0)),SRALL D LINE(1) S @SRG@(SRI)=SRLINE_"N/A"
I $O(^SRF(SRTN,4,0)) D LINE(1) S @SRG@(SRI)=SRLINE D REP
S SRLF=1,SR(25)=$G(^SRF(SRTN,25)),SPONGE=$P(SR(25),"^"),SHARP=$P(SR(25),"^",2),INSTR=$P(SR(25),"^",3)
S SRPIR=$P(SR(25),"^",6),WOUND=$P(SR(25),"^",7),INTXRAY=$P(SR(25),"^",8)
S Y=$P(SR(25),"^",5),C=$P(^DD(130,48,0),"^",2) D:Y'="" Y^DIQ S:Y="" Y="N/A" S VERIFY=Y
S Y=SRPIR,C=$P(^DD(130,630,0),"^",2) D:Y'="" Y^DIQ S SRPIR=$S(Y'="":Y,1:"* NOT ENTERED *")
S Y=WOUND,C=$P(^DD(130,633,0),"^",2) D:Y'="" Y^DIQ S WOUND=$S(Y'="":Y,1:"* NOT ENTERED *")
S Y=INTXRAY,C=$P(^DD(130,636,0),"^",2) D:Y'="" Y^DIQ S INTXRAY=$S(Y'="":Y,1:"* NOT ENTERED *")
S Y=SPONGE,C=$P(^DD(130,44,0),"^",2) D:Y'="" Y^DIQ S SPONGE=$S(Y'="":Y,VERIFY'="N/A"!(VERIFY'="NA"):"* NOT ENTERED *",1:"N/A")
S Y=SHARP,C=$P(^DD(130,45,0),"^",2) D:Y'="" Y^DIQ S SHARP=$S(Y'="":Y,VERIFY'="N/A"!(VERIFY'="NA"):"* NOT ENTERED *",1:"N/A")
S Y=INSTR,C=$P(^DD(130,46,0),"^",2) D:Y'="" Y^DIQ S INSTR=$S(Y'="":Y,VERIFY'="N/A"!(VERIFY'="NA"):"* NOT ENTERED *",1:"N/A")
S Y=$P(SR(25),"^",4),C=$P(^DD(130,47,0),"^",2) D:Y'="" Y^DIQ S COUNTER=$S(Y'="":Y,VERIFY'="N/A":"* NOT ENTERED *",1:"N/A")
D LINE(1) S @SRG@(SRI)="Possible Item Retention:",@SRG@(SRI)=@SRG@(SRI)_$$SPACE(28)_SRPIR
SPONGE I 'SRALL,(SPONGE="NA"!(SPONGE="N/A")) G SHARP
D LINE(1) S @SRG@(SRI)="Sponge Final Count Correct:",@SRG@(SRI)=@SRG@(SRI)_$$SPACE(28)_SPONGE
SHARP I 'SRALL,(SHARP="NA"!(SHARP="N/A")) G INSTR
D LINE(1) S @SRG@(SRI)="Sharps Final Count Correct:",@SRG@(SRI)=@SRG@(SRI)_$$SPACE(28)_SHARP
INSTR I 'SRALL,(INSTR="NA"!(INSTR="N/A")) G WS
D LINE(1) S @SRG@(SRI)="Instrument Final Count Correct: "_INSTR
WS I 'SRALL,INSTR="N/A" G XRAY
D LINE(1) S @SRG@(SRI)="Wound Sweep:",@SRG@(SRI)=@SRG@(SRI)_$$SPACE(28)_WOUND
S II=53 D ENSC^SRONRPT0
XRAY I 'SRALL,INSTR="N/A" G COUNT
D LINE(1) S @SRG@(SRI)="Intra-Operative X-Ray:",@SRG@(SRI)=@SRG@(SRI)_$$SPACE(28)_INTXRAY
S II=54 D ENSC^SRONRPT0
COUNT I 'SRALL,COUNTER="N/A" G CNTV
D LINE(1) S @SRG@(SRI)="Counter:",@SRG@(SRI)=@SRG@(SRI)_$$SPACE(26)_COUNTER
CNTV I 'SRALL,VERIFY="N/A" G DRESS
D LINE(1) S @SRG@(SRI)="Counts Verified By: ",@SRG@(SRI)=@SRG@(SRI)_$$SPACE(26)_VERIFY
DRESS S SRLF=1,SR(35)=$G(^SRF(SRTN,35)),DRESS=$P(SR(35),"^"),Y=$P(SR(.8),"^",11),C=$P(^DD(130,.875,0),"^",2) D:Y'="" Y^DIQ S PACK=$S(Y'="":Y,1:"N/A")
S DRESS=$S(DRESS'="":DRESS,1:"N/A") I 'SRALL,DRESS="N/A" G PACK
D LINE(1) S @SRG@(SRI)="Dressing: "_DRESS
PACK I 'SRALL,PACK="N/A" G LOSS
D LINE(1) S @SRG@(SRI)="Packing: "_PACK
LOSS S SRLF=1,BLOOD=$P(SR(.2),"^",5),URINE=$P(SR(.2),"^",16) I 'SRALL,BLOOD="",URINE="" G NEXT
S BLOOD=$S(BLOOD="":"",1:BLOOD_" ml"),URINE=$S(URINE="":"",1:URINE_" ml") D LINE(1) S @SRG@(SRI)="Blood Loss: "_BLOOD,@SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Urine Output: "_URINE
NEXT D ^SRONRPT3
Q
REP ; replacement fluids
N FLUID,QTY,REP,SRCE,VID,SRCT
S REP=0 F S REP=$O(^SRF(SRTN,4,REP)) Q:'REP D
.S X=^SRF(SRTN,4,REP,0),FLUID=$P(^SRO(133.7,$P(X,"^"),0),"^"),QTY=$P(X,"^",2),SRCE=$P(X,"^",4),VID=$P(X,"^",5)
.S:QTY="" QTY="N/A" S:SRCE="" SRCE="N/A" S:VID="" VID="N/A"
.D LINE(1) S @SRG@(SRI)=" "_FLUID,@SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Quantity: "_QTY_" ml"
.D LINE(1) S @SRG@(SRI)=" Source Identification: "_SRCE
.D LINE(1) S @SRG@(SRI)=" VA Identification: "_VID
.S (SRCT,SRLINE)=0 F S SRLINE=$O(^SRF(SRTN,4,REP,1,SRLINE)) Q:'SRLINE S SRCT=SRCT+1
.Q:'SRCT D LINE(1) S SRLINE=0,SRL=4,SRLINE=$O(^SRF(SRTN,4,REP,1,SRLINE)),X=^SRF(SRTN,4,REP,1,SRLINE,0)
.I SRCT=1,$L(X)<67 S @SRG@(SRI)=" Comments: "_X Q
.S @SRG@(SRI)=" Comments:" D COMM^SRONRPT3(X,SRL)
.F S SRLINE=$O(^SRF(SRTN,4,REP,1,SRLINE)) Q:'SRLINE S X=^SRF(SRTN,4,REP,1,SRLINE,0) D COMM^SRONRPT3(X,SRL)
Q
IRR ; irrigations
N AMT,DOC,IRR,MM,SOLU,TIME,USED
S IRR=0 F S IRR=$O(^SRF(SRTN,26,IRR)) Q:'IRR D
.S X=^SRF(SRTN,26,IRR,0),SOLU=$P(^SRO(133.6,X,0),"^") D LINE(1) S @SRG@(SRI)=" "_SOLU
.S USED=0 F S USED=$O(^SRF(SRTN,26,IRR,1,USED)) Q:'USED S MM=^SRF(SRTN,26,IRR,1,USED,0),Y=$P(MM,"^") D D^DIQ S TIME=$P(Y,"@")_" "_$P(Y,"@",2) D
..D LINE(1) S @SRG@(SRI)=" Time Used: "_TIME S AMT=$P(MM,"^",2) S:AMT="" AMT="N/A"
..S Y=$P(MM,"^",3),C=$P(^DD(130.39,2,0),"^",2) D:Y'="" Y^DIQ,N(29) S:Y="" Y="N/A" S DOC=Y
..D LINE(1) S @SRG@(SRI)=" Amount: "_AMT,@SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Provider: "_DOC
Q
N(SRL) N SRN I $L(Y)>SRL S SRN=$P(Y,",")_","_$E($P(Y,",",2))_".",Y=SRN
Q
SPACE(NUM) ; create spaces
;pass in position returns number of needed spaces
I '$D(@SRG@(SRI)) S @SRG@(SRI)=""
Q $J("",NUM-$L(@SRG@(SRI)))
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[HSRONRPT2 5336 printed Nov 22, 2024@17:54:35 Page 2
SRONRPT2 ;BIR/ADM - NURSE INTRAOP REPORT ; [ 09/08/03 2:47 PM ]
+1 ;;3.0;Surgery;**100,182**;24 Jun 93;Build 49
+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 NEW BLOOD,COLOR,CONS,COUNTER,DRESS,INSTR,INTEG,INTXRAY,MOOD,PACK,SHARP,SPONGE,SRPIR,URINE,VERIFY,WOUND
+8 SET SRLF=1
SET SRLINE="Irrigation Solution(s): "
IF '$ORDER(^SRF(SRTN,26,0))
IF SRALL
DO LINE(1)
SET @SRG@(SRI)=SRLINE_"N/A"
+9 IF $ORDER(^SRF(SRTN,26,0))
DO LINE(1)
SET @SRG@(SRI)=SRLINE
DO IRR
+10 SET SRLF=1
SET SRLINE="Blood Replacement Fluids: "
IF '$ORDER(^SRF(SRTN,4,0))
IF SRALL
DO LINE(1)
SET @SRG@(SRI)=SRLINE_"N/A"
+11 IF $ORDER(^SRF(SRTN,4,0))
DO LINE(1)
SET @SRG@(SRI)=SRLINE
DO REP
+12 SET SRLF=1
SET SR(25)=$GET(^SRF(SRTN,25))
SET SPONGE=$PIECE(SR(25),"^")
SET SHARP=$PIECE(SR(25),"^",2)
SET INSTR=$PIECE(SR(25),"^",3)
+13 SET SRPIR=$PIECE(SR(25),"^",6)
SET WOUND=$PIECE(SR(25),"^",7)
SET INTXRAY=$PIECE(SR(25),"^",8)
+14 SET Y=$PIECE(SR(25),"^",5)
SET C=$PIECE(^DD(130,48,0),"^",2)
if Y'=""
DO Y^DIQ
if Y=""
SET Y="N/A"
SET VERIFY=Y
+15 SET Y=SRPIR
SET C=$PIECE(^DD(130,630,0),"^",2)
if Y'=""
DO Y^DIQ
SET SRPIR=$SELECT(Y'="":Y,1:"* NOT ENTERED *")
+16 SET Y=WOUND
SET C=$PIECE(^DD(130,633,0),"^",2)
if Y'=""
DO Y^DIQ
SET WOUND=$SELECT(Y'="":Y,1:"* NOT ENTERED *")
+17 SET Y=INTXRAY
SET C=$PIECE(^DD(130,636,0),"^",2)
if Y'=""
DO Y^DIQ
SET INTXRAY=$SELECT(Y'="":Y,1:"* NOT ENTERED *")
+18 SET Y=SPONGE
SET C=$PIECE(^DD(130,44,0),"^",2)
if Y'=""
DO Y^DIQ
SET SPONGE=$SELECT(Y'="":Y,VERIFY'="N/A"!(VERIFY'="NA"):"* NOT ENTERED *",1:"N/A")
+19 SET Y=SHARP
SET C=$PIECE(^DD(130,45,0),"^",2)
if Y'=""
DO Y^DIQ
SET SHARP=$SELECT(Y'="":Y,VERIFY'="N/A"!(VERIFY'="NA"):"* NOT ENTERED *",1:"N/A")
+20 SET Y=INSTR
SET C=$PIECE(^DD(130,46,0),"^",2)
if Y'=""
DO Y^DIQ
SET INSTR=$SELECT(Y'="":Y,VERIFY'="N/A"!(VERIFY'="NA"):"* NOT ENTERED *",1:"N/A")
+21 SET Y=$PIECE(SR(25),"^",4)
SET C=$PIECE(^DD(130,47,0),"^",2)
if Y'=""
DO Y^DIQ
SET COUNTER=$SELECT(Y'="":Y,VERIFY'="N/A":"* NOT ENTERED *",1:"N/A")
+22 DO LINE(1)
SET @SRG@(SRI)="Possible Item Retention:"
SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(28)_SRPIR
SPONGE IF 'SRALL
IF (SPONGE="NA"!(SPONGE="N/A"))
GOTO SHARP
+1 DO LINE(1)
SET @SRG@(SRI)="Sponge Final Count Correct:"
SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(28)_SPONGE
SHARP IF 'SRALL
IF (SHARP="NA"!(SHARP="N/A"))
GOTO INSTR
+1 DO LINE(1)
SET @SRG@(SRI)="Sharps Final Count Correct:"
SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(28)_SHARP
INSTR IF 'SRALL
IF (INSTR="NA"!(INSTR="N/A"))
GOTO WS
+1 DO LINE(1)
SET @SRG@(SRI)="Instrument Final Count Correct: "_INSTR
WS IF 'SRALL
IF INSTR="N/A"
GOTO XRAY
+1 DO LINE(1)
SET @SRG@(SRI)="Wound Sweep:"
SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(28)_WOUND
+2 SET II=53
DO ENSC^SRONRPT0
XRAY IF 'SRALL
IF INSTR="N/A"
GOTO COUNT
+1 DO LINE(1)
SET @SRG@(SRI)="Intra-Operative X-Ray:"
SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(28)_INTXRAY
+2 SET II=54
DO ENSC^SRONRPT0
COUNT IF 'SRALL
IF COUNTER="N/A"
GOTO CNTV
+1 DO LINE(1)
SET @SRG@(SRI)="Counter:"
SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(26)_COUNTER
CNTV IF 'SRALL
IF VERIFY="N/A"
GOTO DRESS
+1 DO LINE(1)
SET @SRG@(SRI)="Counts Verified By: "
SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(26)_VERIFY
DRESS SET SRLF=1
SET SR(35)=$GET(^SRF(SRTN,35))
SET DRESS=$PIECE(SR(35),"^")
SET Y=$PIECE(SR(.8),"^",11)
SET C=$PIECE(^DD(130,.875,0),"^",2)
if Y'=""
DO Y^DIQ
SET PACK=$SELECT(Y'="":Y,1:"N/A")
+1 SET DRESS=$SELECT(DRESS'="":DRESS,1:"N/A")
IF 'SRALL
IF DRESS="N/A"
GOTO PACK
+2 DO LINE(1)
SET @SRG@(SRI)="Dressing: "_DRESS
PACK IF 'SRALL
IF PACK="N/A"
GOTO LOSS
+1 DO LINE(1)
SET @SRG@(SRI)="Packing: "_PACK
LOSS SET SRLF=1
SET BLOOD=$PIECE(SR(.2),"^",5)
SET URINE=$PIECE(SR(.2),"^",16)
IF 'SRALL
IF BLOOD=""
IF URINE=""
GOTO NEXT
+1 SET BLOOD=$SELECT(BLOOD="":"",1:BLOOD_" ml")
SET URINE=$SELECT(URINE="":"",1:URINE_" ml")
DO LINE(1)
SET @SRG@(SRI)="Blood Loss: "_BLOOD
SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Urine Output: "_URINE
NEXT DO ^SRONRPT3
+1 QUIT
REP ; replacement fluids
+1 NEW FLUID,QTY,REP,SRCE,VID,SRCT
+2 SET REP=0
FOR
SET REP=$ORDER(^SRF(SRTN,4,REP))
if 'REP
QUIT
Begin DoDot:1
+3 SET X=^SRF(SRTN,4,REP,0)
SET FLUID=$PIECE(^SRO(133.7,$PIECE(X,"^"),0),"^")
SET QTY=$PIECE(X,"^",2)
SET SRCE=$PIECE(X,"^",4)
SET VID=$PIECE(X,"^",5)
+4 if QTY=""
SET QTY="N/A"
if SRCE=""
SET SRCE="N/A"
if VID=""
SET VID="N/A"
+5 DO LINE(1)
SET @SRG@(SRI)=" "_FLUID
SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Quantity: "_QTY_" ml"
+6 DO LINE(1)
SET @SRG@(SRI)=" Source Identification: "_SRCE
+7 DO LINE(1)
SET @SRG@(SRI)=" VA Identification: "_VID
+8 SET (SRCT,SRLINE)=0
FOR
SET SRLINE=$ORDER(^SRF(SRTN,4,REP,1,SRLINE))
if 'SRLINE
QUIT
SET SRCT=SRCT+1
+9 if 'SRCT
QUIT
DO LINE(1)
SET SRLINE=0
SET SRL=4
SET SRLINE=$ORDER(^SRF(SRTN,4,REP,1,SRLINE))
SET X=^SRF(SRTN,4,REP,1,SRLINE,0)
+10 IF SRCT=1
IF $LENGTH(X)<67
SET @SRG@(SRI)=" Comments: "_X
QUIT
+11 SET @SRG@(SRI)=" Comments:"
DO COMM^SRONRPT3(X,SRL)
+12 FOR
SET SRLINE=$ORDER(^SRF(SRTN,4,REP,1,SRLINE))
if 'SRLINE
QUIT
SET X=^SRF(SRTN,4,REP,1,SRLINE,0)
DO COMM^SRONRPT3(X,SRL)
End DoDot:1
+13 QUIT
IRR ; irrigations
+1 NEW AMT,DOC,IRR,MM,SOLU,TIME,USED
+2 SET IRR=0
FOR
SET IRR=$ORDER(^SRF(SRTN,26,IRR))
if 'IRR
QUIT
Begin DoDot:1
+3 SET X=^SRF(SRTN,26,IRR,0)
SET SOLU=$PIECE(^SRO(133.6,X,0),"^")
DO LINE(1)
SET @SRG@(SRI)=" "_SOLU
+4 SET USED=0
FOR
SET USED=$ORDER(^SRF(SRTN,26,IRR,1,USED))
if 'USED
QUIT
SET MM=^SRF(SRTN,26,IRR,1,USED,0)
SET Y=$PIECE(MM,"^")
DO D^DIQ
SET TIME=$PIECE(Y,"@")_" "_$PIECE(Y,"@",2)
Begin DoDot:2
+5 DO LINE(1)
SET @SRG@(SRI)=" Time Used: "_TIME
SET AMT=$PIECE(MM,"^",2)
if AMT=""
SET AMT="N/A"
+6 SET Y=$PIECE(MM,"^",3)
SET C=$PIECE(^DD(130.39,2,0),"^",2)
if Y'=""
DO Y^DIQ
DO N(29)
if Y=""
SET Y="N/A"
SET DOC=Y
+7 DO LINE(1)
SET @SRG@(SRI)=" Amount: "_AMT
SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Provider: "_DOC
End DoDot:2
End DoDot:1
+8 QUIT
N(SRL) NEW SRN
IF $LENGTH(Y)>SRL
SET SRN=$PIECE(Y,",")_","_$EXTRACT($PIECE(Y,",",2))_"."
SET Y=SRN
+1 QUIT
SPACE(NUM) ; create spaces
+1 ;pass in position returns number of needed spaces
+2 IF '$DATA(@SRG@(SRI))
SET @SRG@(SRI)=""
+3 QUIT $JUSTIFY("",NUM-$LENGTH(@SRG@(SRI)))
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
