SRONRPT0 ;BIR/ADM - NURSE INTRAOP REPORT ;05/31/06
;;3.0; Surgery ;**100,129,147,153,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.
;
D LINE(2) S @SRG@(SRI)="OR Support Personnel:" D LINE(1) S @SRG@(SRI)=" Scrubbed",@SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Circulating" D NURSE
S SRLF=1,SRLINE="Other Persons in OR: " I '$O(^SRF(SRTN,32,0)),SRALL D LINE(1) S @SRG@(SRI)=SRLINE_"N/A"
I $O(^SRF(SRTN,32,0)) D LINE(1) S @SRG@(SRI)=SRLINE D
.S OTH=0 F S OTH=$O(^SRF(SRTN,32,OTH)) Q:'OTH D
..S X=^SRF(SRTN,32,OTH,0),SRLINE=" "_$P(X,"^")
..S Y=$P(X,"^",2) S:Y'="" SRLINE=SRLINE_" ("_Y_")"
..D LINE(1) S @SRG@(SRI)=SRLINE
S SRLF=1
S X=$P(SR(.1),"^",9),SRMOOD=$S(X:$E($P(^SRO(135.3,X,0),"^"),1,20),1:"N/A")
S X=$P(SR(.1),"^",15),SRCONS=$S(X:$E($P(^SRO(135.4,X,0),"^"),1,24),1:"N/A")
S X=$P(SR(0),"^",7),SRSKIN=$S(X:$E($P(^SRO(135.2,X,0),"^"),1,20),1:"N/A")
S Y=$P(SR(.1),"^",14),C=$P(^DD(130,.195,0),"^",2) D:Y'="" Y^DIQ S SRCONV=$S(Y'="":Y,1:"N/A")
I 'SRALL,SRMOOD="N/A",SRCONS="N/A" G SKIN
D LINE(1) S @SRG@(SRI)="Preop Mood:",@SRG@(SRI)=@SRG@(SRI)_$$SPACE(18)_SRMOOD,@SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Preop Consc:",@SRG@(SRI)=@SRG@(SRI)_$$SPACE(56)_SRCONS
SKIN I 'SRALL,SRSKIN="N/A",SRCONV="N/A" G VAL
D LINE(1) S @SRG@(SRI)="Preop Skin Integ: "_SRSKIN,@SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Preop Converse: "_SRCONV
VAL S SRLF=1,Y=$P(SR(.6),"^",9),C=$P(^DD(130,.69,0),"^",2) D:Y'="" Y^DIQ S SRUSER=$S(Y="":"N/A",1:Y)
I 'SRALL,SRUSER="N/A" G VER
D LINE(1) S @SRG@(SRI)="Valid Consent/ID Band Confirmed By: "_SRUSER
;
VER N II,SROIM,SROUT,SROIN,SRHRM
S Y=$P(SR("VER"),"^",5),SROIN=$S(Y="Y":"YES",Y="M":"MARKING NOT REQUIRED FOR THIS PROCEDURE",Y="N":"NO - MARKING REQUIRED BUT NOT DONE (see MARKED SITE COMMENTS)",1:"* NOT ENTERED *")
D LINE(1) S @SRG@(SRI)="Mark on Surgical Site Confirmed: "_$S($L(SROIN)>43:"",1:SROIN)
I $L(SROIN)>43 D LINE(1) S @SRG@(SRI)=$$SPACE(2)_SROIN
S II=84 D ENSC,LINE(1)
S Y=$P(SR("VER"),"^",4),SROIM=$S(Y="Y":"YES",Y="I":"IMAGING NOT REQUIRED FOR THIS PROCEDURE",Y="N":"IMAGING REQUIRED BUT NOT VIEWED (see IMAGING CONFIRMED COMMENTS)",1:"* NOT ENTERED *")
D LINE(1) S @SRG@(SRI)="Preoperative Imaging Confirmed: "_$S($L(SROIM)>43:"",1:SROIM)
I $L(SROIM)>43 D LINE(1) S @SRG@(SRI)=$$SPACE(2)_SROIM
S II=83 D ENSC,LINE(1)
S Y=$P(SR("VER"),"^",3),SROUT=$S(Y="Y":"YES",Y="N":"NO (see TIME OUT VERIFIED COMMENTS)",1:"* NOT ENTERED *")
D LINE(1) S @SRG@(SRI)="Time Out Verification Completed: "_$S($L(SROUT)>43:"",1:SROUT)
S II=82 D ENSC
S SRLF=1
;
PREP N SRSKIP S SRSKIP=0
S Y=$P(SR(.1),"^",8),C=$P(^DD(130,.18,0),"^",2) D:Y'="" Y^DIQ,N(25) S SRUSER=$S(Y="":"N/A",1:Y)
S Y=$P(SR(.1),"^",7),C=$P(^DD(130,.175,0),"^",2) D:Y'="" Y^DIQ S SRAGNT=$S(Y="":"N/A",1:$E(Y,1,22))
I 'SRALL,SRUSER="N/A",SRAGNT="N/A" G PREP2
D LINE(1) S @SRG@(SRI)="Skin Prep By: "_SRUSER,@SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Skin Prep Agent: "_SRAGNT
S SRSKIP=1
PREP2 S Y=$P(SR(.1),"^",12),C=$P(^DD(130,4,0),"^",2) D:Y'="" Y^DIQ,N(21) S SRUSER=$S(Y="":"N/A",1:Y)
S Y=$P(SR(31),"^",2),C=$P(^DD(130,8,0),"^",2) D:Y'="" Y^DIQ S SRAGNT=$S(Y="":"N/A",1:$E(Y,1,18))
I 'SRALL,SRUSER="N/A",SRAGNT="N/A" G PREOP
D LINE(1) S @SRG@(SRI)="Skin Prep By (2): "_SRUSER,@SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"2nd Skin Prep Agent: "_SRAGNT
S SRSKIP=0 D LINE(1)
PREOP S Y=$P(SR(.1),"^",2),C=$P(^DD(130,.12,0),"^",2) D:Y'="" Y^DIQ S SRUSER=$S(Y="":"N/A",1:Y)
D:SRSKIP LINE(1) D LINE(1) S @SRG@(SRI)="Preop Surgical Site Hair Removal by: "_SRUSER
S Y=$P(SR("VER"),"^",6),C=$P(^DD(130,506,0),"^",2) D:Y'="" Y^DIQ S SRHRM=$S(Y="":"* NOT ENTERED *",1:Y)
D LINE(1) S @SRG@(SRI)="Surgical Site Hair Removal Method: "_$S($L(SRHRM)>43:"",1:SRHRM)
I $L(SRHRM)>43 D LINE(1) S @SRG@(SRI)=$$SPACE(2)_SRHRM
S II=49 D ENSC
;
POS S SRLF=1,SRLINE="Surgery Position(s): " I '$O(^SRF(SRTN,42,0)),SRALL D LINE(1) S @SRG@(SRI)=SRLINE_"N/A"
I $O(^SRF(SRTN,42,0)) D LINE(1) S @SRG@(SRI)=SRLINE D
.S SRP=0 F S SRP=$O(^SRF(SRTN,42,SRP)) Q:'SRP S X=^SRF(SRTN,42,SRP,0),Z=$P(X,"^"),Y=$P(X,"^",2) D
..S SRPOS=$P(^SRO(132,Z,0),"^") D:Y D^DIQ S SRTIME=$S(Y'="":$P(Y,"@")_" "_$P(Y,"@",2),1:"N/A")
..D LINE(1) S @SRG@(SRI)=" "_SRPOS,@SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Placed: "_SRTIME
S SRLF=1,SRLINE="Restraints and Position Aids: "
I '$O(^SRF(SRTN,20,0)),SRALL D LINE(1) S @SRG@(SRI)=SRLINE_"N/A"
I $O(^SRF(SRTN,20,0)) N SRRP D LINE(1) S @SRG@(SRI)=SRLINE,(SRRP,CNT)=0 F S SRRP=$O(^SRF(SRTN,20,SRRP)) Q:'SRRP S CNT=CNT+1,X=^SRF(SRTN,20,SRRP,0),Z=$P(X,"^"),Y=$P(X,"^",2),W=$P(X,"^",3) D
.S SREST=$P(^SRO(132.05,Z,0),"^"),C=$P(^DD(130.31,1,0),"^",2) D:Y'="" Y^DIQ,N(31) S:Y="" Y="N/A"
.D LINE(1) S @SRG@(SRI)=" "_SREST,@SRG@(SRI)=@SRG@(SRI)_$$SPACE(36)_"Applied By: "_Y
.I W'="" D LINE(1) S @SRG@(SRI)=" Comments: "_W
S SRLF=1,X=$P(SR(.7),"^",5),SREL=$S(X'="":X,1:"N/A")
S X=$P(SR(.5),"^",4),SRELP=$S(X:$P(^SRO(138,X,0),"^"),1:"N/A")
S X=$P(SR(.5),"^",13),SRELP2=$S(X:$P(^SRO(138,X,0),"^"),1:"")
S X=$P(SR(.7),"^"),SRC=$S(X'="":X,1:"N/A"),X=$P(SR(.7),"^",2),SRCT=$S(X'="":X,1:"N/A")
I 'SRALL,SREL="N/A",SRELP="N/A",SRELP2="" G LAB
D LINE(1) S @SRG@(SRI)="Electrocautery Unit: "_SREL
D LINE(1) S @SRG@(SRI)="ESU Coagulation Range: "_SRC
D LINE(1) S @SRG@(SRI)="ESU Cutting Range: "_SRCT
D LINE(1) S @SRG@(SRI)="Electroground Position(s): "_SRELP
I SRELP2'="" D LINE(1) S @SRG@(SRI)=$$SPACE(27)_SRELP2
LAB S SRLF=1 I $O(^SRF(SRTN,9,0))!SRALL D LAB1
S SRLF=1 I $O(^SRF(SRTN,6,0)) D LINE(1) S @SRG@(SRI)="Anesthesia Technique(s):" S ANE=0 F S ANE=$O(^SRF(SRTN,6,ANE)) Q:'ANE D ANE
I '$O(^SRF(SRTN,6,0)),SRALL D LINE(1) S @SRG@(SRI)="Anesthesia Technique(s): N/A"
D ^SRONRPT1
Q
NURSE ; nurse info
N CNT,CIRC,I,NURSE,SCRU,X,Y,Z
S (CNT,CIRC)=0 F S CIRC=$O(^SRF(SRTN,19,CIRC)) Q:'CIRC S CNT=CNT+1 D
.S Z=^SRF(SRTN,19,CIRC,0),Y=$P(Z,"^"),C=$P(^DD(130.28,.01,0),"^",2) D Y^DIQ,N(21) S SRX=Y
.S Y=$P(Z,"^",3),C=$P(^DD(130.28,3,0),"^",2) D:Y'="" Y^DIQ S CIRC(CNT)=SRX_" ("_Y_")"
S (CNT,SCRU)=0 F S SCRU=$O(^SRF(SRTN,23,SCRU)) Q:'SCRU S CNT=CNT+1 D
.S Z=^SRF(SRTN,23,SCRU,0),Y=$P(Z,"^"),C=$P(^DD(130.36,.01,0),"^",2) D Y^DIQ,N(21) S SRX=Y
.S Y=$P(Z,"^",3),C=$P(^DD(130.36,3,0),"^",2) D:Y'="" Y^DIQ S SCRU(CNT)=SRX_" ("_Y_")"
S:'$D(SCRU(1)) SCRU(1)="N/A" S:'$D(CIRC(1)) CIRC(1)="N/A"
F I=1:1 Q:('$D(SCRU(I))&'$D(CIRC(I))) S NURSE(I)=$S($D(SCRU(I)):SCRU(I),1:"")_"^"_$S($D(CIRC(I)):CIRC(I),1:"")
S I=0 F S I=$O(NURSE(I)) Q:'I D LINE(1) S @SRG@(SRI)=$$SPACE(2)_$P(NURSE(I),"^") S @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_$P(NURSE(I),"^",2)
Q
LAB1 N SRSP S SRLF=1 D LINE(1) S @SRG@(SRI)="Material Sent to Laboratory for Analysis: "
I 'SRALL,'$O(^SRF(SRTN,9,0)),'$O(^SRF(SRTN,41,0)) S @SRG@(SRI)=@SRG@(SRI)_"N/A" Q
D LINE(1) S @SRG@(SRI)="Specimens: " D
.I '$O(^SRF(SRTN,9,0)) S @SRG@(SRI)=@SRG@(SRI)_"N/A" Q
.S SRSP=0 F S SRSP=$O(^SRF(SRTN,9,SRSP)) Q:'SRSP D LINE(1) S @SRG@(SRI)=$$SPACE(2)_^SRF(SRTN,9,SRSP,0)
D LINE(1) S @SRG@(SRI)="Cultures: " D
.I '$O(^SRF(SRTN,41,0)) S @SRG@(SRI)=@SRG@(SRI)_"N/A" Q
.S SRSP=0 F S SRSP=$O(^SRF(SRTN,41,SRSP)) Q:'SRSP D LINE(1) S @SRG@(SRI)=$$SPACE(2)_^SRF(SRTN,41,SRSP,0)
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
ANE ; print anesthesia technique
N A,AGNT,C,CNT,DRUG
S A=^SRF(SRTN,6,ANE,0),Y=$P(A,"^"),C=$P(^DD(130.06,.01,0),"^",2) D:Y'="" Y^DIQ D LINE(1) S Y=Y_$S($P(A,"^",3)="Y":" (PRINCIPAL)",1:""),@SRG@(SRI)=$$SPACE(2)_Y
Q
ENSC N X,SRLINE
D LINE(1) S @SRG@(SRI)=" "_$S(II=82:"Time Out Verified Comments: ",II=83:"Imaging Confirmed Comments: ",II=84:"Marked Site Comments: ",II=49:"Hair Removal Comments: ",1:"") D
.I '$O(^SRF(SRTN,II,0)) S @SRG@(SRI)=@SRG@(SRI)_"NO COMMENTS ENTERED" Q
.S SRLINE=0 F S SRLINE=$O(^SRF(SRTN,II,SRLINE)) Q:'SRLINE S X=^SRF(SRTN,II,SRLINE,0) D COMM^SRONRPT3(X,3)
Q
SRONRPT0 ;BIR/ADM - NURSE INTRAOP REPORT ;05/31/06
+1 ;;3.0; Surgery ;**100,129,147,153,157**;24 Jun 93;Build 3
+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 DO LINE(2)
SET @SRG@(SRI)="OR Support Personnel:"
DO LINE(1)
SET @SRG@(SRI)=" Scrubbed"
SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Circulating"
DO NURSE
+7 SET SRLF=1
SET SRLINE="Other Persons in OR: "
IF '$ORDER(^SRF(SRTN,32,0))
IF SRALL
DO LINE(1)
SET @SRG@(SRI)=SRLINE_"N/A"
+8 IF $ORDER(^SRF(SRTN,32,0))
DO LINE(1)
SET @SRG@(SRI)=SRLINE
Begin DoDot:1
+9 SET OTH=0
FOR
SET OTH=$ORDER(^SRF(SRTN,32,OTH))
IF 'OTH
QUIT
Begin DoDot:2
+10 SET X=^SRF(SRTN,32,OTH,0)
SET SRLINE=" "_$PIECE(X,"^")
+11 SET Y=$PIECE(X,"^",2)
IF Y'=""
SET SRLINE=SRLINE_" ("_Y_")"
+12 DO LINE(1)
SET @SRG@(SRI)=SRLINE
End DoDot:2
End DoDot:1
+13 SET SRLF=1
+14 SET X=$PIECE(SR(.1),"^",9)
SET SRMOOD=$SELECT(X:$EXTRACT($PIECE(^SRO(135.3,X,0),"^"),1,20),1:"N/A")
+15 SET X=$PIECE(SR(.1),"^",15)
SET SRCONS=$SELECT(X:$EXTRACT($PIECE(^SRO(135.4,X,0),"^"),1,24),1:"N/A")
+16 SET X=$PIECE(SR(0),"^",7)
SET SRSKIN=$SELECT(X:$EXTRACT($PIECE(^SRO(135.2,X,0),"^"),1,20),1:"N/A")
+17 SET Y=$PIECE(SR(.1),"^",14)
SET C=$PIECE(^DD(130,.195,0),"^",2)
IF Y'=""
DO Y^DIQ
SET SRCONV=$SELECT(Y'="":Y,1:"N/A")
+18 IF 'SRALL
IF SRMOOD="N/A"
IF SRCONS="N/A"
GOTO SKIN
+19 DO LINE(1)
SET @SRG@(SRI)="Preop Mood:"
SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(18)_SRMOOD
SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Preop Consc:"
SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(56)_SRCONS
SKIN IF 'SRALL
IF SRSKIN="N/A"
IF SRCONV="N/A"
GOTO VAL
+1 DO LINE(1)
SET @SRG@(SRI)="Preop Skin Integ: "_SRSKIN
SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Preop Converse: "_SRCONV
VAL SET SRLF=1
SET Y=$PIECE(SR(.6),"^",9)
SET C=$PIECE(^DD(130,.69,0),"^",2)
IF Y'=""
DO Y^DIQ
SET SRUSER=$SELECT(Y="":"N/A",1:Y)
+1 IF 'SRALL
IF SRUSER="N/A"
GOTO VER
+2 DO LINE(1)
SET @SRG@(SRI)="Valid Consent/ID Band Confirmed By: "_SRUSER
+3 ;
VER NEW II,SROIM,SROUT,SROIN,SRHRM
+1 SET Y=$PIECE(SR("VER"),"^",5)
SET SROIN=$SELECT(Y="Y":"YES",Y="M":"MARKING NOT REQUIRED FOR THIS PROCEDURE",Y="N":"NO - MARKING REQUIRED BUT NOT DONE (see MARKED SITE COMMENTS)",1:"* NOT ENTERED *")
+2 DO LINE(1)
SET @SRG@(SRI)="Mark on Surgical Site Confirmed: "_$SELECT($LENGTH(SROIN)>43:"",1:SROIN)
+3 IF $LENGTH(SROIN)>43
DO LINE(1)
SET @SRG@(SRI)=$$SPACE(2)_SROIN
+4 SET II=84
DO ENSC
DO LINE(1)
+5 SET Y=$PIECE(SR("VER"),"^",4)
SET SROIM=$SELECT(Y="Y":"YES",Y="I":"IMAGING NOT REQUIRED FOR THIS PROCEDURE",Y="N":"IMAGING REQUIRED BUT NOT VIEWED (see IMAGING CONFIRMED COMMENTS)",1:"* NOT ENTERED *")
+6 DO LINE(1)
SET @SRG@(SRI)="Preoperative Imaging Confirmed: "_$SELECT($LENGTH(SROIM)>43:"",1:SROIM)
+7 IF $LENGTH(SROIM)>43
DO LINE(1)
SET @SRG@(SRI)=$$SPACE(2)_SROIM
+8 SET II=83
DO ENSC
DO LINE(1)
+9 SET Y=$PIECE(SR("VER"),"^",3)
SET SROUT=$SELECT(Y="Y":"YES",Y="N":"NO (see TIME OUT VERIFIED COMMENTS)",1:"* NOT ENTERED *")
+10 DO LINE(1)
SET @SRG@(SRI)="Time Out Verification Completed: "_$SELECT($LENGTH(SROUT)>43:"",1:SROUT)
+11 SET II=82
DO ENSC
+12 SET SRLF=1
+13 ;
PREP NEW SRSKIP
SET SRSKIP=0
+1 SET Y=$PIECE(SR(.1),"^",8)
SET C=$PIECE(^DD(130,.18,0),"^",2)
IF Y'=""
DO Y^DIQ
DO N(25)
SET SRUSER=$SELECT(Y="":"N/A",1:Y)
+2 SET Y=$PIECE(SR(.1),"^",7)
SET C=$PIECE(^DD(130,.175,0),"^",2)
IF Y'=""
DO Y^DIQ
SET SRAGNT=$SELECT(Y="":"N/A",1:$EXTRACT(Y,1,22))
+3 IF 'SRALL
IF SRUSER="N/A"
IF SRAGNT="N/A"
GOTO PREP2
+4 DO LINE(1)
SET @SRG@(SRI)="Skin Prep By: "_SRUSER
SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Skin Prep Agent: "_SRAGNT
+5 SET SRSKIP=1
PREP2 SET Y=$PIECE(SR(.1),"^",12)
SET C=$PIECE(^DD(130,4,0),"^",2)
IF Y'=""
DO Y^DIQ
DO N(21)
SET SRUSER=$SELECT(Y="":"N/A",1:Y)
+1 SET Y=$PIECE(SR(31),"^",2)
SET C=$PIECE(^DD(130,8,0),"^",2)
IF Y'=""
DO Y^DIQ
SET SRAGNT=$SELECT(Y="":"N/A",1:$EXTRACT(Y,1,18))
+2 IF 'SRALL
IF SRUSER="N/A"
IF SRAGNT="N/A"
GOTO PREOP
+3 DO LINE(1)
SET @SRG@(SRI)="Skin Prep By (2): "_SRUSER
SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"2nd Skin Prep Agent: "_SRAGNT
+4 SET SRSKIP=0
DO LINE(1)
PREOP SET Y=$PIECE(SR(.1),"^",2)
SET C=$PIECE(^DD(130,.12,0),"^",2)
IF Y'=""
DO Y^DIQ
SET SRUSER=$SELECT(Y="":"N/A",1:Y)
+1 IF SRSKIP
DO LINE(1)
DO LINE(1)
SET @SRG@(SRI)="Preop Surgical Site Hair Removal by: "_SRUSER
+2 SET Y=$PIECE(SR("VER"),"^",6)
SET C=$PIECE(^DD(130,506,0),"^",2)
IF Y'=""
DO Y^DIQ
SET SRHRM=$SELECT(Y="":"* NOT ENTERED *",1:Y)
+3 DO LINE(1)
SET @SRG@(SRI)="Surgical Site Hair Removal Method: "_$SELECT($LENGTH(SRHRM)>43:"",1:SRHRM)
+4 IF $LENGTH(SRHRM)>43
DO LINE(1)
SET @SRG@(SRI)=$$SPACE(2)_SRHRM
+5 SET II=49
DO ENSC
+6 ;
POS SET SRLF=1
SET SRLINE="Surgery Position(s): "
IF '$ORDER(^SRF(SRTN,42,0))
IF SRALL
DO LINE(1)
SET @SRG@(SRI)=SRLINE_"N/A"
+1 IF $ORDER(^SRF(SRTN,42,0))
DO LINE(1)
SET @SRG@(SRI)=SRLINE
Begin DoDot:1
+2 SET SRP=0
FOR
SET SRP=$ORDER(^SRF(SRTN,42,SRP))
IF 'SRP
QUIT
SET X=^SRF(SRTN,42,SRP,0)
SET Z=$PIECE(X,"^")
SET Y=$PIECE(X,"^",2)
Begin DoDot:2
+3 SET SRPOS=$PIECE(^SRO(132,Z,0),"^")
IF Y
DO D^DIQ
SET SRTIME=$SELECT(Y'="":$PIECE(Y,"@")_" "_$PIECE(Y,"@",2),1:"N/A")
+4 DO LINE(1)
SET @SRG@(SRI)=" "_SRPOS
SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Placed: "_SRTIME
End DoDot:2
End DoDot:1
+5 SET SRLF=1
SET SRLINE="Restraints and Position Aids: "
+6 IF '$ORDER(^SRF(SRTN,20,0))
IF SRALL
DO LINE(1)
SET @SRG@(SRI)=SRLINE_"N/A"
+7 IF $ORDER(^SRF(SRTN,20,0))
NEW SRRP
DO LINE(1)
SET @SRG@(SRI)=SRLINE
SET (SRRP,CNT)=0
FOR
SET SRRP=$ORDER(^SRF(SRTN,20,SRRP))
IF 'SRRP
QUIT
SET CNT=CNT+1
SET X=^SRF(SRTN,20,SRRP,0)
SET Z=$PIECE(X,"^")
SET Y=$PIECE(X,"^",2)
SET W=$PIECE(X,"^",3)
Begin DoDot:1
+8 SET SREST=$PIECE(^SRO(132.05,Z,0),"^")
SET C=$PIECE(^DD(130.31,1,0),"^",2)
IF Y'=""
DO Y^DIQ
DO N(31)
IF Y=""
SET Y="N/A"
+9 DO LINE(1)
SET @SRG@(SRI)=" "_SREST
SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(36)_"Applied By: "_Y
+10 IF W'=""
DO LINE(1)
SET @SRG@(SRI)=" Comments: "_W
End DoDot:1
+11 SET SRLF=1
SET X=$PIECE(SR(.7),"^",5)
SET SREL=$SELECT(X'="":X,1:"N/A")
+12 SET X=$PIECE(SR(.5),"^",4)
SET SRELP=$SELECT(X:$PIECE(^SRO(138,X,0),"^"),1:"N/A")
+13 SET X=$PIECE(SR(.5),"^",13)
SET SRELP2=$SELECT(X:$PIECE(^SRO(138,X,0),"^"),1:"")
+14 SET X=$PIECE(SR(.7),"^")
SET SRC=$SELECT(X'="":X,1:"N/A")
SET X=$PIECE(SR(.7),"^",2)
SET SRCT=$SELECT(X'="":X,1:"N/A")
+15 IF 'SRALL
IF SREL="N/A"
IF SRELP="N/A"
IF SRELP2=""
GOTO LAB
+16 DO LINE(1)
SET @SRG@(SRI)="Electrocautery Unit: "_SREL
+17 DO LINE(1)
SET @SRG@(SRI)="ESU Coagulation Range: "_SRC
+18 DO LINE(1)
SET @SRG@(SRI)="ESU Cutting Range: "_SRCT
+19 DO LINE(1)
SET @SRG@(SRI)="Electroground Position(s): "_SRELP
+20 IF SRELP2'=""
DO LINE(1)
SET @SRG@(SRI)=$$SPACE(27)_SRELP2
LAB SET SRLF=1
IF $ORDER(^SRF(SRTN,9,0))!SRALL
DO LAB1
+1 SET SRLF=1
IF $ORDER(^SRF(SRTN,6,0))
DO LINE(1)
SET @SRG@(SRI)="Anesthesia Technique(s):"
SET ANE=0
FOR
SET ANE=$ORDER(^SRF(SRTN,6,ANE))
IF 'ANE
QUIT
DO ANE
+2 IF '$ORDER(^SRF(SRTN,6,0))
IF SRALL
DO LINE(1)
SET @SRG@(SRI)="Anesthesia Technique(s): N/A"
+3 DO ^SRONRPT1
+4 QUIT
NURSE ; nurse info
+1 NEW CNT,CIRC,I,NURSE,SCRU,X,Y,Z
+2 SET (CNT,CIRC)=0
FOR
SET CIRC=$ORDER(^SRF(SRTN,19,CIRC))
IF 'CIRC
QUIT
SET CNT=CNT+1
Begin DoDot:1
+3 SET Z=^SRF(SRTN,19,CIRC,0)
SET Y=$PIECE(Z,"^")
SET C=$PIECE(^DD(130.28,.01,0),"^",2)
DO Y^DIQ
DO N(21)
SET SRX=Y
+4 SET Y=$PIECE(Z,"^",3)
SET C=$PIECE(^DD(130.28,3,0),"^",2)
IF Y'=""
DO Y^DIQ
SET CIRC(CNT)=SRX_" ("_Y_")"
End DoDot:1
+5 SET (CNT,SCRU)=0
FOR
SET SCRU=$ORDER(^SRF(SRTN,23,SCRU))
IF 'SCRU
QUIT
SET CNT=CNT+1
Begin DoDot:1
+6 SET Z=^SRF(SRTN,23,SCRU,0)
SET Y=$PIECE(Z,"^")
SET C=$PIECE(^DD(130.36,.01,0),"^",2)
DO Y^DIQ
DO N(21)
SET SRX=Y
+7 SET Y=$PIECE(Z,"^",3)
SET C=$PIECE(^DD(130.36,3,0),"^",2)
IF Y'=""
DO Y^DIQ
SET SCRU(CNT)=SRX_" ("_Y_")"
End DoDot:1
+8 IF '$DATA(SCRU(1))
SET SCRU(1)="N/A"
IF '$DATA(CIRC(1))
SET CIRC(1)="N/A"
+9 FOR I=1:1
IF ('$DATA(SCRU(I))&'$DATA(CIRC(I)))
QUIT
SET NURSE(I)=$SELECT($DATA(SCRU(I)):SCRU(I),1:"")_"^"_$SELECT($DATA(CIRC(I)):CIRC(I),1:"")
+10 SET I=0
FOR
SET I=$ORDER(NURSE(I))
IF 'I
QUIT
DO LINE(1)
SET @SRG@(SRI)=$$SPACE(2)_$PIECE(NURSE(I),"^")
SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_$PIECE(NURSE(I),"^",2)
+11 QUIT
LAB1 NEW SRSP
SET SRLF=1
DO LINE(1)
SET @SRG@(SRI)="Material Sent to Laboratory for Analysis: "
+1 IF 'SRALL
IF '$ORDER(^SRF(SRTN,9,0))
IF '$ORDER(^SRF(SRTN,41,0))
SET @SRG@(SRI)=@SRG@(SRI)_"N/A"
QUIT
+2 DO LINE(1)
SET @SRG@(SRI)="Specimens: "
Begin DoDot:1
+3 IF '$ORDER(^SRF(SRTN,9,0))
SET @SRG@(SRI)=@SRG@(SRI)_"N/A"
QUIT
+4 SET SRSP=0
FOR
SET SRSP=$ORDER(^SRF(SRTN,9,SRSP))
IF 'SRSP
QUIT
DO LINE(1)
SET @SRG@(SRI)=$$SPACE(2)_^SRF(SRTN,9,SRSP,0)
End DoDot:1
+5 DO LINE(1)
SET @SRG@(SRI)="Cultures: "
Begin DoDot:1
+6 IF '$ORDER(^SRF(SRTN,41,0))
SET @SRG@(SRI)=@SRG@(SRI)_"N/A"
QUIT
+7 SET SRSP=0
FOR
SET SRSP=$ORDER(^SRF(SRTN,41,SRSP))
IF 'SRSP
QUIT
DO LINE(1)
SET @SRG@(SRI)=$$SPACE(2)_^SRF(SRTN,41,SRSP,0)
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
ANE ; print anesthesia technique
+1 NEW A,AGNT,C,CNT,DRUG
+2 SET A=^SRF(SRTN,6,ANE,0)
SET Y=$PIECE(A,"^")
SET C=$PIECE(^DD(130.06,.01,0),"^",2)
IF Y'=""
DO Y^DIQ
DO LINE(1)
SET Y=Y_$SELECT($PIECE(A,"^",3)="Y":" (PRINCIPAL)",1:"")
SET @SRG@(SRI)=$$SPACE(2)_Y
+3 QUIT
ENSC NEW X,SRLINE
+1 DO LINE(1)
SET @SRG@(SRI)=" "_$SELECT(II=82:"Time Out Verified Comments: ",II=83:"Imaging Confirmed Comments: ",II=84:"Marked Site Comments: ",II=49:"Hair Removal Comments: ",1:"")
Begin DoDot:1
+2 IF '$ORDER(^SRF(SRTN,II,0))
SET @SRG@(SRI)=@SRG@(SRI)_"NO COMMENTS ENTERED"
QUIT
+3 SET SRLINE=0
FOR
SET SRLINE=$ORDER(^SRF(SRTN,II,SRLINE))
IF 'SRLINE
QUIT
SET X=^SRF(SRTN,II,SRLINE,0)
DO COMM^SRONRPT3(X,3)
End DoDot:1
+4 QUIT
