- SRONRPT1 ;BIR/ADM - NURSE INTRAOP REPORT ;06/08/2011
- ;;3.0;Surgery;**100,143,157,176,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.
- ;
- S SRLF=1 N SRTD S SRTD=$P($G(^SRF(SRTN,3)),"^") I SRTD="",SRALL D LINE(1) S @SRG@(SRI)="Tubes and Drains: N/A"
- I SRTD'="" D LINE(1) S @SRG@(SRI)="Tubes and Drains: " D LINE(1) S @SRG@(SRI)=" "_SRTD
- S SRLF=1 I '$O(^SRF(SRTN,2,0)),SRALL D LINE(1) S @SRG@(SRI)="Tourniquet: N/A"
- I $O(^SRF(SRTN,2,0)) D LINE(1) S @SRG@(SRI)="Tourniquet:" D TOUR
- S SRLF=1,SRLINE="Thermal Unit: " I '$O(^SRF(SRTN,21,0)),SRALL D LINE(1) S @SRG@(SRI)=SRLINE_"N/A"
- I $O(^SRF(SRTN,21,0)) D LINE(1) S @SRG@(SRI)=SRLINE D THERM
- S SRLF=1,SRLINE="Prosthesis Installed: " I '$O(^SRF(SRTN,1,0)),SRALL D LINE(1) S @SRG@(SRI)=SRLINE_"N/A"
- I $O(^SRF(SRTN,1,0)) D LINE(1) S @SRG@(SRI)=SRLINE D PRO
- S SRLF=1,SRLINE="Medications: " I '$O(^SRF(SRTN,22,0)),SRALL D LINE(1) S @SRG@(SRI)=SRLINE_"N/A"
- I $O(^SRF(SRTN,22,0)) D LINE(1) S @SRG@(SRI)=SRLINE D MED
- D ^SRONRPT2
- Q
- MED ; medications
- N ADBY,ADM,COMMENT,DOSE,DRUG,MED,MM,ORBY,ROUTE,TIME
- S MED=0 F S MED=$O(^SRF(SRTN,22,MED)) Q:'MED D
- .S Y=$P(^SRF(SRTN,22,MED,0),"^"),C=$P(^DD(130.33,.01,0),"^",2) D Y^DIQ,LINE(1) S @SRG@(SRI)=" "_Y,ADM=0 F S ADM=$O(^SRF(SRTN,22,MED,1,ADM)) Q:'ADM D
- ..S MM=^SRF(SRTN,22,MED,1,ADM,0),Y=$P(MM,"^") D D^DIQ S TIME=$P(Y,"@")_" "_$P(Y,"@",2)
- ..S DOSE=$P(MM,"^",2),X=$P(MM,"^",3) S:X="" ORBY="N/A" I X S Y=$P(^VA(200,X,0),"^") D N(20) S ORBY=Y
- ..S X=$P(MM,"^",4) S:X="" ADBY="N/A" I X S Y=$P(^VA(200,X,0),"^") D N(29) S ADBY=Y
- ..S Y=$P(MM,"^",5),C=$P(^DD(130.34,4,0),"^",2) D:Y'="" Y^DIQ S ROUTE=Y
- ..S COMMENT=$P(MM,"^",6) S:COMMENT="" COMMENT="N/A"
- ..D LINE(1) S @SRG@(SRI)=" Time Administered: "_TIME D LINE(1) S @SRG@(SRI)=" Route: "_ROUTE,@SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Dosage: "_DOSE
- ..D LINE(1) S @SRG@(SRI)=" Ordered By: "_ORBY S @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Admin By: "_ADBY
- ..D LINE(1) S @SRG@(SRI)=" Comments: "_COMMENT
- Q
- N(SRL) N SRN I $L(Y)>SRL S SRN=$P(Y,",")_","_$E($P(Y,",",2))_".",Y=SRN
- Q
- PRO ; prosthesis
- N C,ITEM,MODEL,PRO,QTY,SERI,SERIAL,SLOT,SIZE,SRISC,SRSED,SRRN,STERILE,VENDOR,SREAD
- S PRO=0 F S PRO=$O(^SRF(SRTN,1,PRO)) Q:'PRO D
- .S X=^SRF(SRTN,1,PRO,0),ITEM=$P(X,"^"),VENDOR=$P(X,"^",2),MODEL=$P(X,"^",3),SERIAL=$P(X,"^",5),Y=$P(X,"^",7),C=$P(^DD(130.01,5,0),"^",2) D:Y'="" Y^DIQ S STERILE=$S(Y'="":Y,1:"N/A")
- .S X=$G(^SRF(SRTN,1,PRO,1)),SIZE=$P(X,"^"),QTY=$P(X,"^",2),SLOT=$P(X,"^",3),SERI=$P(X,"^",4)
- .S Y=$P(X,"^",5),C=$P(^DD(130.01,13,0),"^",2) D:Y'="" Y^DIQ S SREAD=$S(Y="":"NOT ENTERED",1:Y)
- .S X=$G(^SRF(SRTN,1,PRO,2)),SRISC=$S($P(X,"^")="Y":"YES",1:$P(X,"^"))
- .S Y=$P(X,"^",2),C=$P(^DD(130.01,9,0),"^",2) D:Y'="" Y^DIQ S SRSED=$S(Y="":"NOT ENTERED",1:Y)
- .S Y=$P(X,"^",3),C=$P(^DD(130.01,10,0),"^",2) D:Y'="" Y^DIQ S SRRN=$S(Y="":"NOT ENTERED",1:Y)
- .D LINE(1) S @SRG@(SRI)=" Item: "_$P(^SRO(131.9,ITEM,0),"^")
- .D LINE(1) S @SRG@(SRI)=" Implant Sterility Checked (Y/N): "_$S(SRISC'="":SRISC,1:"NOT ENTERED")
- .D LINE(1) S @SRG@(SRI)=" Sterility Expiration Date: "_SRSED
- .D LINE(1) S @SRG@(SRI)=" RN Verifier: "_SRRN
- .D LINE(1) S @SRG@(SRI)=" Vendor: "_$S(VENDOR'="":VENDOR,1:"N/A")
- .D LINE(1) S @SRG@(SRI)=" Model: "_$S(MODEL'="":MODEL,1:"N/A")
- .D LINE(1) S @SRG@(SRI)=" Lot Number: "_$S(SLOT'="":SLOT,1:"N/A")
- .D LINE(1) S @SRG@(SRI)=" Serial Number: "_$S(SERI'="":SERI,1:"N/A")
- .D LINE(1) S:SERIAL'="" @SRG@(SRI)=" Lot/Serial Number: "_$S(SERIAL'="":SERIAL,1:"N/A") S @SRG@(SRI)=@SRG@(SRI)_$S(SERIAL'="":$$SPACE(53),1:" ")_"Sterile Resp: "_STERILE
- .D LINE(1) S @SRG@(SRI)=" Size: "_$S(SIZE'="":SIZE,1:"N/A"),@SRG@(SRI)=@SRG@(SRI)_$$SPACE(53)_"Quantity: "_$S(QTY'="":QTY,1:"N/A")
- .D LINE(1) S @SRG@(SRI)=" Provider Read Back Performed: "_SREAD
- Q
- THERM ; thermal unit
- N OFF,ON,TEMP,TH,UNIT S TH=0 F S TH=$O(^SRF(SRTN,21,TH)) Q:'TH D
- .S UNIT=^SRF(SRTN,21,TH,0),TEMP=$P(UNIT,"^",3),TEMP=$S(TEMP'="":TEMP,1:"N/A"),ON=$P(UNIT,"^",2),OFF=$P(UNIT,"^",4)
- .D LINE(1) S @SRG@(SRI)=" "_$P(UNIT,"^"),@SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Temperature: "_TEMP
- .S Y=ON D:Y D^DIQ S ON=$S(Y="":"N/A",1:$P(Y,"@")_" "_$P(Y,"@",2)),Y=OFF D:Y D^DIQ S OFF=$S(Y="":"N/A",1:$P(Y,"@")_" "_$P(Y,"@",2))
- .D LINE(1) S @SRG@(SRI)=" Time On: "_ON,@SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Time Off: "_OFF
- Q
- TOUR ; tourniquet info
- N APBY,C,M,PRESS,SITE,TIME,TIME2,TOUR
- S TOUR=0 F S TOUR=$O(^SRF(SRTN,2,TOUR)) Q:'TOUR D
- .S M=^SRF(SRTN,2,TOUR,0),Y=$P(M,"^") D D^DIQ S TIME=$P(Y,"@")_" "_$P(Y,"@",2),Y=$P(M,"^",4) S TIME2="NOT ENTERED" I Y D D^DIQ S TIME2=$P(Y,"@")_" "_$P(Y,"@",2)
- .D LINE(1) S @SRG@(SRI)=" Time Applied: "_TIME S @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Time Released: "_TIME2
- .S Y=$P(M,"^",2),C=$P(^DD(130.02,1,0),"^",2) D:Y'="" Y^DIQ S SITE=$S(Y="":"NOT ENTERED",1:Y),X=$P(M,"^",5),PRESS=$S(X="":"N/A",1:X)
- .D LINE(1) S @SRG@(SRI)=" Site Applied: "_SITE,@SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Pressure Applied (in TORR): "_PRESS
- .S Y=$P(M,"^",3),C=$P(^DD(130.02,2,0),"^",2) D:Y'="" Y^DIQ S APBY=$S(Y="":"N/A",1:Y) D LINE(1) S @SRG@(SRI)=" Applied By: "_APBY
- 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[HSRONRPT1 5558 printed Mar 13, 2025@21:49:47 Page 2
- SRONRPT1 ;BIR/ADM - NURSE INTRAOP REPORT ;06/08/2011
- +1 ;;3.0;Surgery;**100,143,157,176,182**;24 Jun 93;Build 49
- +2 ;** NOTICE: This routine is part of an implementation of a nationally
- +3 ;** controlled procedure. Local modifications to this routine
- +4 ;** are prohibited.
- +5 ;
- +6 SET SRLF=1
- NEW SRTD
- SET SRTD=$PIECE($GET(^SRF(SRTN,3)),"^")
- IF SRTD=""
- IF SRALL
- DO LINE(1)
- SET @SRG@(SRI)="Tubes and Drains: N/A"
- +7 IF SRTD'=""
- DO LINE(1)
- SET @SRG@(SRI)="Tubes and Drains: "
- DO LINE(1)
- SET @SRG@(SRI)=" "_SRTD
- +8 SET SRLF=1
- IF '$ORDER(^SRF(SRTN,2,0))
- IF SRALL
- DO LINE(1)
- SET @SRG@(SRI)="Tourniquet: N/A"
- +9 IF $ORDER(^SRF(SRTN,2,0))
- DO LINE(1)
- SET @SRG@(SRI)="Tourniquet:"
- DO TOUR
- +10 SET SRLF=1
- SET SRLINE="Thermal Unit: "
- IF '$ORDER(^SRF(SRTN,21,0))
- IF SRALL
- DO LINE(1)
- SET @SRG@(SRI)=SRLINE_"N/A"
- +11 IF $ORDER(^SRF(SRTN,21,0))
- DO LINE(1)
- SET @SRG@(SRI)=SRLINE
- DO THERM
- +12 SET SRLF=1
- SET SRLINE="Prosthesis Installed: "
- IF '$ORDER(^SRF(SRTN,1,0))
- IF SRALL
- DO LINE(1)
- SET @SRG@(SRI)=SRLINE_"N/A"
- +13 IF $ORDER(^SRF(SRTN,1,0))
- DO LINE(1)
- SET @SRG@(SRI)=SRLINE
- DO PRO
- +14 SET SRLF=1
- SET SRLINE="Medications: "
- IF '$ORDER(^SRF(SRTN,22,0))
- IF SRALL
- DO LINE(1)
- SET @SRG@(SRI)=SRLINE_"N/A"
- +15 IF $ORDER(^SRF(SRTN,22,0))
- DO LINE(1)
- SET @SRG@(SRI)=SRLINE
- DO MED
- +16 DO ^SRONRPT2
- +17 QUIT
- MED ; medications
- +1 NEW ADBY,ADM,COMMENT,DOSE,DRUG,MED,MM,ORBY,ROUTE,TIME
- +2 SET MED=0
- FOR
- SET MED=$ORDER(^SRF(SRTN,22,MED))
- if 'MED
- QUIT
- Begin DoDot:1
- +3 SET Y=$PIECE(^SRF(SRTN,22,MED,0),"^")
- SET C=$PIECE(^DD(130.33,.01,0),"^",2)
- DO Y^DIQ
- DO LINE(1)
- SET @SRG@(SRI)=" "_Y
- SET ADM=0
- FOR
- SET ADM=$ORDER(^SRF(SRTN,22,MED,1,ADM))
- if 'ADM
- QUIT
- Begin DoDot:2
- +4 SET MM=^SRF(SRTN,22,MED,1,ADM,0)
- SET Y=$PIECE(MM,"^")
- DO D^DIQ
- SET TIME=$PIECE(Y,"@")_" "_$PIECE(Y,"@",2)
- +5 SET DOSE=$PIECE(MM,"^",2)
- SET X=$PIECE(MM,"^",3)
- if X=""
- SET ORBY="N/A"
- IF X
- SET Y=$PIECE(^VA(200,X,0),"^")
- DO N(20)
- SET ORBY=Y
- +6 SET X=$PIECE(MM,"^",4)
- if X=""
- SET ADBY="N/A"
- IF X
- SET Y=$PIECE(^VA(200,X,0),"^")
- DO N(29)
- SET ADBY=Y
- +7 SET Y=$PIECE(MM,"^",5)
- SET C=$PIECE(^DD(130.34,4,0),"^",2)
- if Y'=""
- DO Y^DIQ
- SET ROUTE=Y
- +8 SET COMMENT=$PIECE(MM,"^",6)
- if COMMENT=""
- SET COMMENT="N/A"
- +9 DO LINE(1)
- SET @SRG@(SRI)=" Time Administered: "_TIME
- DO LINE(1)
- SET @SRG@(SRI)=" Route: "_ROUTE
- SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Dosage: "_DOSE
- +10 DO LINE(1)
- SET @SRG@(SRI)=" Ordered By: "_ORBY
- SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Admin By: "_ADBY
- +11 DO LINE(1)
- SET @SRG@(SRI)=" Comments: "_COMMENT
- End DoDot:2
- End DoDot:1
- +12 QUIT
- N(SRL) NEW SRN
- IF $LENGTH(Y)>SRL
- SET SRN=$PIECE(Y,",")_","_$EXTRACT($PIECE(Y,",",2))_"."
- SET Y=SRN
- +1 QUIT
- PRO ; prosthesis
- +1 NEW C,ITEM,MODEL,PRO,QTY,SERI,SERIAL,SLOT,SIZE,SRISC,SRSED,SRRN,STERILE,VENDOR,SREAD
- +2 SET PRO=0
- FOR
- SET PRO=$ORDER(^SRF(SRTN,1,PRO))
- if 'PRO
- QUIT
- Begin DoDot:1
- +3 SET X=^SRF(SRTN,1,PRO,0)
- SET ITEM=$PIECE(X,"^")
- SET VENDOR=$PIECE(X,"^",2)
- SET MODEL=$PIECE(X,"^",3)
- SET SERIAL=$PIECE(X,"^",5)
- SET Y=$PIECE(X,"^",7)
- SET C=$PIECE(^DD(130.01,5,0),"^",2)
- if Y'=""
- DO Y^DIQ
- SET STERILE=$SELECT(Y'="":Y,1:"N/A")
- +4 SET X=$GET(^SRF(SRTN,1,PRO,1))
- SET SIZE=$PIECE(X,"^")
- SET QTY=$PIECE(X,"^",2)
- SET SLOT=$PIECE(X,"^",3)
- SET SERI=$PIECE(X,"^",4)
- +5 SET Y=$PIECE(X,"^",5)
- SET C=$PIECE(^DD(130.01,13,0),"^",2)
- if Y'=""
- DO Y^DIQ
- SET SREAD=$SELECT(Y="":"NOT ENTERED",1:Y)
- +6 SET X=$GET(^SRF(SRTN,1,PRO,2))
- SET SRISC=$SELECT($PIECE(X,"^")="Y":"YES",1:$PIECE(X,"^"))
- +7 SET Y=$PIECE(X,"^",2)
- SET C=$PIECE(^DD(130.01,9,0),"^",2)
- if Y'=""
- DO Y^DIQ
- SET SRSED=$SELECT(Y="":"NOT ENTERED",1:Y)
- +8 SET Y=$PIECE(X,"^",3)
- SET C=$PIECE(^DD(130.01,10,0),"^",2)
- if Y'=""
- DO Y^DIQ
- SET SRRN=$SELECT(Y="":"NOT ENTERED",1:Y)
- +9 DO LINE(1)
- SET @SRG@(SRI)=" Item: "_$PIECE(^SRO(131.9,ITEM,0),"^")
- +10 DO LINE(1)
- SET @SRG@(SRI)=" Implant Sterility Checked (Y/N): "_$SELECT(SRISC'="":SRISC,1:"NOT ENTERED")
- +11 DO LINE(1)
- SET @SRG@(SRI)=" Sterility Expiration Date: "_SRSED
- +12 DO LINE(1)
- SET @SRG@(SRI)=" RN Verifier: "_SRRN
- +13 DO LINE(1)
- SET @SRG@(SRI)=" Vendor: "_$SELECT(VENDOR'="":VENDOR,1:"N/A")
- +14 DO LINE(1)
- SET @SRG@(SRI)=" Model: "_$SELECT(MODEL'="":MODEL,1:"N/A")
- +15 DO LINE(1)
- SET @SRG@(SRI)=" Lot Number: "_$SELECT(SLOT'="":SLOT,1:"N/A")
- +16 DO LINE(1)
- SET @SRG@(SRI)=" Serial Number: "_$SELECT(SERI'="":SERI,1:"N/A")
- +17 DO LINE(1)
- if SERIAL'=""
- SET @SRG@(SRI)=" Lot/Serial Number: "_$SELECT(SERIAL'="":SERIAL,1:"N/A")
- SET @SRG@(SRI)=@SRG@(SRI)_$SELECT(SERIAL'="":$$SPACE(53),1:" ")_"Sterile Resp: "_STERILE
- +18 DO LINE(1)
- SET @SRG@(SRI)=" Size: "_$SELECT(SIZE'="":SIZE,1:"N/A")
- SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(53)_"Quantity: "_$SELECT(QTY'="":QTY,1:"N/A")
- +19 DO LINE(1)
- SET @SRG@(SRI)=" Provider Read Back Performed: "_SREAD
- End DoDot:1
- +20 QUIT
- THERM ; thermal unit
- +1 NEW OFF,ON,TEMP,TH,UNIT
- SET TH=0
- FOR
- SET TH=$ORDER(^SRF(SRTN,21,TH))
- if 'TH
- QUIT
- Begin DoDot:1
- +2 SET UNIT=^SRF(SRTN,21,TH,0)
- SET TEMP=$PIECE(UNIT,"^",3)
- SET TEMP=$SELECT(TEMP'="":TEMP,1:"N/A")
- SET ON=$PIECE(UNIT,"^",2)
- SET OFF=$PIECE(UNIT,"^",4)
- +3 DO LINE(1)
- SET @SRG@(SRI)=" "_$PIECE(UNIT,"^")
- SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Temperature: "_TEMP
- +4 SET Y=ON
- if Y
- DO D^DIQ
- SET ON=$SELECT(Y="":"N/A",1:$PIECE(Y,"@")_" "_$PIECE(Y,"@",2))
- SET Y=OFF
- if Y
- DO D^DIQ
- SET OFF=$SELECT(Y="":"N/A",1:$PIECE(Y,"@")_" "_$PIECE(Y,"@",2))
- +5 DO LINE(1)
- SET @SRG@(SRI)=" Time On: "_ON
- SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Time Off: "_OFF
- End DoDot:1
- +6 QUIT
- TOUR ; tourniquet info
- +1 NEW APBY,C,M,PRESS,SITE,TIME,TIME2,TOUR
- +2 SET TOUR=0
- FOR
- SET TOUR=$ORDER(^SRF(SRTN,2,TOUR))
- if 'TOUR
- QUIT
- Begin DoDot:1
- +3 SET M=^SRF(SRTN,2,TOUR,0)
- SET Y=$PIECE(M,"^")
- DO D^DIQ
- SET TIME=$PIECE(Y,"@")_" "_$PIECE(Y,"@",2)
- SET Y=$PIECE(M,"^",4)
- SET TIME2="NOT ENTERED"
- IF Y
- DO D^DIQ
- SET TIME2=$PIECE(Y,"@")_" "_$PIECE(Y,"@",2)
- +4 DO LINE(1)
- SET @SRG@(SRI)=" Time Applied: "_TIME
- SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Time Released: "_TIME2
- +5 SET Y=$PIECE(M,"^",2)
- SET C=$PIECE(^DD(130.02,1,0),"^",2)
- if Y'=""
- DO Y^DIQ
- SET SITE=$SELECT(Y="":"NOT ENTERED",1:Y)
- SET X=$PIECE(M,"^",5)
- SET PRESS=$SELECT(X="":"N/A",1:X)
- +6 DO LINE(1)
- SET @SRG@(SRI)=" Site Applied: "_SITE
- SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Pressure Applied (in TORR): "_PRESS
- +7 SET Y=$PIECE(M,"^",3)
- SET C=$PIECE(^DD(130.02,2,0),"^",2)
- if Y'=""
- DO Y^DIQ
- SET APBY=$SELECT(Y="":"N/A",1:Y)
- DO LINE(1)
- SET @SRG@(SRI)=" Applied By: "_APBY
- End DoDot:1
- +8 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
