SRONRPT1 ;BIR/ADM - NURSE INTRAOP REPORT ;02/20/05
;;3.0; Surgery ;**100,143,157**;24 Jun 93;Build 3
;
;** 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,SERIAL,SIZE,SRISC,SRSED,SRRN,STERILE,VENDOR
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)
.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/Serial Number: "_$S(SERIAL'="":SERIAL,1:"N/A"),@SRG@(SRI)=@SRG@(SRI)_$$SPACE(53)_"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")
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
SRONRPT1 ;BIR/ADM - NURSE INTRAOP REPORT ;02/20/05
+1 ;;3.0; Surgery ;**100,143,157**;24 Jun 93;Build 3
+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 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"
+8 IF SRTD'=""
DO LINE(1)
SET @SRG@(SRI)="Tubes and Drains: "
DO LINE(1)
SET @SRG@(SRI)=" "_SRTD
+9 SET SRLF=1
IF '$ORDER(^SRF(SRTN,2,0))
IF SRALL
DO LINE(1)
SET @SRG@(SRI)="Tourniquet: N/A"
+10 IF $ORDER(^SRF(SRTN,2,0))
DO LINE(1)
SET @SRG@(SRI)="Tourniquet:"
DO TOUR
+11 SET SRLF=1
SET SRLINE="Thermal Unit: "
IF '$ORDER(^SRF(SRTN,21,0))
IF SRALL
DO LINE(1)
SET @SRG@(SRI)=SRLINE_"N/A"
+12 IF $ORDER(^SRF(SRTN,21,0))
DO LINE(1)
SET @SRG@(SRI)=SRLINE
DO THERM
+13 SET SRLF=1
SET SRLINE="Prosthesis Installed: "
IF '$ORDER(^SRF(SRTN,1,0))
IF SRALL
DO LINE(1)
SET @SRG@(SRI)=SRLINE_"N/A"
+14 IF $ORDER(^SRF(SRTN,1,0))
DO LINE(1)
SET @SRG@(SRI)=SRLINE
DO PRO
+15 SET SRLF=1
SET SRLINE="Medications: "
IF '$ORDER(^SRF(SRTN,22,0))
IF SRALL
DO LINE(1)
SET @SRG@(SRI)=SRLINE_"N/A"
+16 IF $ORDER(^SRF(SRTN,22,0))
DO LINE(1)
SET @SRG@(SRI)=SRLINE
DO MED
+17 DO ^SRONRPT2
+18 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,SERIAL,SIZE,SRISC,SRSED,SRRN,STERILE,VENDOR
+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)
+5 SET X=$GET(^SRF(SRTN,1,PRO,2))
SET SRISC=$SELECT($PIECE(X,"^")="Y":"YES",1:$PIECE(X,"^"))
+6 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)
+7 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)
+8 DO LINE(1)
SET @SRG@(SRI)=" Item: "_$PIECE(^SRO(131.9,ITEM,0),"^")
+9 DO LINE(1)
SET @SRG@(SRI)=" Implant Sterility Checked (Y/N): "_$SELECT(SRISC'="":SRISC,1:"NOT ENTERED")
+10 DO LINE(1)
SET @SRG@(SRI)=" Sterility Expiration Date: "_SRSED
+11 DO LINE(1)
SET @SRG@(SRI)=" RN Verifier: "_SRRN
+12 DO LINE(1)
SET @SRG@(SRI)=" Vendor: "_$SELECT(VENDOR'="":VENDOR,1:"N/A")
+13 DO LINE(1)
SET @SRG@(SRI)=" Model: "_$SELECT(MODEL'="":MODEL,1:"N/A")
+14 DO LINE(1)
SET @SRG@(SRI)=" Lot/Serial Number: "_$SELECT(SERIAL'="":SERIAL,1:"N/A")
SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(53)_"Sterile Resp: "_STERILE
+15 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")
End DoDot:1
+16 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