- SRONRPT2 ;BIR/ADM - NURSE INTRAOP REPORT ; [ 09/08/03 2:47 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.
- ;
- N BLOOD,COLOR,CONS,COUNTER,DRESS,INSTR,INTEG,MOOD,PACK,SHARP,SPONGE,URINE,VERIFY
- 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 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=SPONGE,C=$P(^DD(130,44,0),"^",2) D:Y'="" Y^DIQ S SPONGE=$S(Y'="":Y,VERIFY'="N/A":"* 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":"* 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":"* 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")
- I 'SRALL,SPONGE="N/A" G SHARP
- D LINE(1) S @SRG@(SRI)="Sponge Count Correct:",@SRG@(SRI)=@SRG@(SRI)_$$SPACE(26)_SPONGE
- SHARP I 'SRALL,SHARP="N/A" G INSTR
- D LINE(1) S @SRG@(SRI)="Sharps Count Correct:",@SRG@(SRI)=@SRG@(SRI)_$$SPACE(26)_SHARP
- INSTR I 'SRALL,INSTR="N/A" G COUNT
- D LINE(1) S @SRG@(SRI)="Instrument Count Correct: "_INSTR
- 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
- SRONRPT2 ;BIR/ADM - NURSE INTRAOP REPORT ; [ 09/08/03 2:47 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 NEW BLOOD,COLOR,CONS,COUNTER,DRESS,INSTR,INTEG,MOOD,PACK,SHARP,SPONGE,URINE,VERIFY
- +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 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
- +14 SET Y=SPONGE
- SET C=$PIECE(^DD(130,44,0),"^",2)
- IF Y'=""
- DO Y^DIQ
- SET SPONGE=$SELECT(Y'="":Y,VERIFY'="N/A":"* NOT ENTERED *",1:"N/A")
- +15 SET Y=SHARP
- SET C=$PIECE(^DD(130,45,0),"^",2)
- IF Y'=""
- DO Y^DIQ
- SET SHARP=$SELECT(Y'="":Y,VERIFY'="N/A":"* NOT ENTERED *",1:"N/A")
- +16 SET Y=INSTR
- SET C=$PIECE(^DD(130,46,0),"^",2)
- IF Y'=""
- DO Y^DIQ
- SET INSTR=$SELECT(Y'="":Y,VERIFY'="N/A":"* NOT ENTERED *",1:"N/A")
- +17 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")
- +18 IF 'SRALL
- IF SPONGE="N/A"
- GOTO SHARP
- +19 DO LINE(1)
- SET @SRG@(SRI)="Sponge Count Correct:"
- SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(26)_SPONGE
- SHARP IF 'SRALL
- IF SHARP="N/A"
- GOTO INSTR
- +1 DO LINE(1)
- SET @SRG@(SRI)="Sharps Count Correct:"
- SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(26)_SHARP
- INSTR IF 'SRALL
- IF INSTR="N/A"
- GOTO COUNT
- +1 DO LINE(1)
- SET @SRG@(SRI)="Instrument Count Correct: "_INSTR
- 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
