SRONRPT0.m

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)