- SRONRPT3 ;BIR/ADM - NURSE INTRAOP REPORT ;10/05/2011
- ;;3.0;Surgery;**100,176,182,184,190**;24 Jun 93;Build 1
- ;** NOTICE: This routine is part of an implementation of a nationally
- ;** controlled procedure. Local modifications to this routine
- ;** are prohibited.
- ;
- S SRLF=1,MOOD=$P(SR(.8),"^"),CONS=$P(SR(.8),"^",10),INTEG=$P(SR(.7),"^",6),COLOR=$P(SR(.7),"^",7)
- S MOOD=$S(MOOD:$P(^SRO(135.3,MOOD,0),"^"),1:"N/A"),CONS=$S(CONS:$P(^SRO(135.4,CONS,0),"^"),1:"N/A"),INTEG=$S(INTEG:$P(^SRO(135.2,INTEG,0),"^"),1:"N/A")
- S Y=COLOR,C=$P(^DD(130,.77,0),"^",2) D:Y'="" Y^DIQ S COLOR=$S(Y="":"N/A",1:Y)
- I 'SRALL,MOOD="N/A" G CONS
- D LINE(1) S @SRG@(SRI)="Postoperative Mood:",@SRG@(SRI)=@SRG@(SRI)_$$SPACE(30)_MOOD
- CONS I 'SRALL,CONS="N/A" G INTEG
- D LINE(1) S @SRG@(SRI)="Postoperative Consciousness: "_CONS
- INTEG I 'SRALL,INTEG="N/A" G COLOR
- D LINE(1) S @SRG@(SRI)="Postoperative Skin Integrity: "_INTEG
- COLOR I 'SRALL,COLOR="N/A" G NEXT
- D LINE(1) S @SRG@(SRI)="Postoperative Skin Color: "_COLOR
- NEXT D LASER^SRONRPT4
- S Y=$P(SR(.7),"^",3) I 'SRALL,Y="" G CS
- S Y=$S(Y="Y":"YES",Y="N":"NO",1:"N/A") D LINE(2) S @SRG@(SRI)="Sequential Compression Device: "_Y
- CS S SRLF=1,SRLINE="Cell Saver(s): " I '$O(^SRF(SRTN,45,0)),SRALL D LINE(1) S @SRG@(SRI)=SRLINE_"N/A"
- I $O(^SRF(SRTN,45,0)) D LINE(1) S @SRG@(SRI)=SRLINE D SAVE
- S X=$P($G(^SRF(SRTN,46)),"^") S:X="" X="N/A" I 'SRALL,X="N/A" S SRLF=0
- E D LINE(2) S @SRG@(SRI)="Devices: "_X
- D ORGDNR^SRONRPT4
- FLASH S SRLF=1,SRLINE="Immediate Use Steam Sterilization Episodes: " I '$D(^SRF(SRTN,52)) D LINE(1) S @SRG@(SRI)=SRLINE_"N/A"
- I $D(^SRF(SRTN,52)) D LINE(1) S @SRG@(SRI)=SRLINE S X=$G(^SRF(SRTN,52)) D
- .D LINE(1) S @SRG@(SRI)=" Contamination: "_$P(X,"^")
- .D LINE(1) S @SRG@(SRI)=" SPS Processing/OR Management Issues: "_$P(X,"^",2)
- .D LINE(1) S @SRG@(SRI)=" Emergency Case: "_$P(X,"^",3)
- .D LINE(1) S @SRG@(SRI)=" No Better Option: "_$P(X,"^",4)
- .D LINE(1) S @SRG@(SRI)=" Loaner or Short Notice Instrument: "_$P(X,"^",5)
- .D LINE(1) S @SRG@(SRI)=" Decontamination of Instruments Contaminated During the Case: "_$P(X,"^",6)
- NCC S SRLINE="Nursing Care Comments: " D LINE(2) S @SRG@(SRI)=SRLINE D
- .I '$O(^SRF(SRTN,7,0)) S @SRG@(SRI)=@SRG@(SRI)_"NO COMMENTS ENTERED" Q
- .S SRLINE=0 F S SRLINE=$O(^SRF(SRTN,7,SRLINE)) Q:'SRLINE S X=^SRF(SRTN,7,SRLINE,0) D COMM(X,2)
- Q
- SAVE ; cell saver(s)
- N C,DISP,DNM,ID,INF,LOT,OP,SAL,SAV,SRCT,QTY,X,Y
- S SAV=0 F S SAV=$O(^SRF(SRTN,45,SAV)) Q:'SAV D
- .S X=^SRF(SRTN,45,SAV,0),ID=$P(X,"^"),SAL=$P(X,"^",3),INF=$P(X,"^",4),Y=$P(X,"^",2),C=$P(^DD(130.013,1,0),"^",2) D:Y Y^DIQ S OP=$S(Y'="":Y,1:"N/A")
- .D LINE(1) S @SRG@(SRI)=" "_ID,@SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Amount Salvaged: "_$S(SAL:SAL_" ml",1:"N/A")
- .D LINE(1) S @SRG@(SRI)=" Operator:"_OP,@SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Amount Reinfused: "_$S(INF:INF_" ml",1:"N/A")
- .I $O(^SRF(SRTN,45,SAV,1,0)) D LINE(1) S @SRG@(SRI)=" Disposables:",DISP=0 F S DISP=$O(^SRF(SRTN,45,SAV,1,DISP)) Q:'DISP D
- ..S X=^SRF(SRTN,45,SAV,1,DISP,0),DNM=$P(X,"^"),LOT=$P(X,"^",2),QTY=$P(X,"^",3) D LINE(1) S @SRG@(SRI)=" "_DNM
- ..D LINE(1) S @SRG@(SRI)=$$SPACE(8)_"Lot: "_LOT,@SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Quantity: "_QTY
- .S (SRCT,SRLINE)=0 F S SRLINE=$O(^SRF(SRTN,45,SAV,2,SRLINE)) Q:'SRLINE S SRCT=SRCT+1
- .Q:'SRCT D LINE(1) S SRLINE=0,SRL=4,SRLINE=$O(^SRF(SRTN,45,SAV,2,SRLINE)),X=^SRF(SRTN,45,SAV,2,SRLINE,0)
- .I SRCT=1,$L(X)<67 S @SRG@(SRI)=" Comments: "_X Q
- .S @SRG@(SRI)=" Comments:" D COMM(X,SRL)
- .F S SRLINE=$O(^SRF(SRTN,45,SAV,2,SRLINE)) Q:'SRLINE S X=^SRF(SRTN,45,SAV,2,SRLINE,0) D COMM(X,SRL)
- Q
- N(SRL) N SRN I $L(Y)>SRL S SRN=$P(Y,",")_","_$E($P(Y,",",2))_".",Y=SRN
- Q
- COMM(X,NUM) ; output text
- ; X = line of text to be processed
- ; NUM = left margin
- N I,J,K,Y,SRL S SRL=80-NUM
- I $L(X)<(SRL+1)!($E(X,1,SRL)'[" ") D LINE(1) S @SRG@(SRI)=$$SPACE(NUM)_X Q
- S K=1 F D I $L(X)<SRL+1 S X(K)=X Q
- .F I=0:1:SRL-1 S J=SRL-I,Y=$E(X,J) I Y=" " S X(K)=$E(X,1,J-1),X=$E(X,J+1,$L(X)) S K=K+1 Q
- F I=1:1:K D LINE(1) S @SRG@(SRI)=$$SPACE(NUM)_X(I)
- 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[HSRONRPT3 4442 printed Feb 19, 2025@00:11:07 Page 2
- SRONRPT3 ;BIR/ADM - NURSE INTRAOP REPORT ;10/05/2011
- +1 ;;3.0;Surgery;**100,176,182,184,190**;24 Jun 93;Build 1
- +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
- SET MOOD=$PIECE(SR(.8),"^")
- SET CONS=$PIECE(SR(.8),"^",10)
- SET INTEG=$PIECE(SR(.7),"^",6)
- SET COLOR=$PIECE(SR(.7),"^",7)
- +7 SET MOOD=$SELECT(MOOD:$PIECE(^SRO(135.3,MOOD,0),"^"),1:"N/A")
- SET CONS=$SELECT(CONS:$PIECE(^SRO(135.4,CONS,0),"^"),1:"N/A")
- SET INTEG=$SELECT(INTEG:$PIECE(^SRO(135.2,INTEG,0),"^"),1:"N/A")
- +8 SET Y=COLOR
- SET C=$PIECE(^DD(130,.77,0),"^",2)
- if Y'=""
- DO Y^DIQ
- SET COLOR=$SELECT(Y="":"N/A",1:Y)
- +9 IF 'SRALL
- IF MOOD="N/A"
- GOTO CONS
- +10 DO LINE(1)
- SET @SRG@(SRI)="Postoperative Mood:"
- SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(30)_MOOD
- CONS IF 'SRALL
- IF CONS="N/A"
- GOTO INTEG
- +1 DO LINE(1)
- SET @SRG@(SRI)="Postoperative Consciousness: "_CONS
- INTEG IF 'SRALL
- IF INTEG="N/A"
- GOTO COLOR
- +1 DO LINE(1)
- SET @SRG@(SRI)="Postoperative Skin Integrity: "_INTEG
- COLOR IF 'SRALL
- IF COLOR="N/A"
- GOTO NEXT
- +1 DO LINE(1)
- SET @SRG@(SRI)="Postoperative Skin Color: "_COLOR
- NEXT DO LASER^SRONRPT4
- +1 SET Y=$PIECE(SR(.7),"^",3)
- IF 'SRALL
- IF Y=""
- GOTO CS
- +2 SET Y=$SELECT(Y="Y":"YES",Y="N":"NO",1:"N/A")
- DO LINE(2)
- SET @SRG@(SRI)="Sequential Compression Device: "_Y
- CS SET SRLF=1
- SET SRLINE="Cell Saver(s): "
- IF '$ORDER(^SRF(SRTN,45,0))
- IF SRALL
- DO LINE(1)
- SET @SRG@(SRI)=SRLINE_"N/A"
- +1 IF $ORDER(^SRF(SRTN,45,0))
- DO LINE(1)
- SET @SRG@(SRI)=SRLINE
- DO SAVE
- +2 SET X=$PIECE($GET(^SRF(SRTN,46)),"^")
- if X=""
- SET X="N/A"
- IF 'SRALL
- IF X="N/A"
- SET SRLF=0
- +3 IF '$TEST
- DO LINE(2)
- SET @SRG@(SRI)="Devices: "_X
- +4 DO ORGDNR^SRONRPT4
- FLASH SET SRLF=1
- SET SRLINE="Immediate Use Steam Sterilization Episodes: "
- IF '$DATA(^SRF(SRTN,52))
- DO LINE(1)
- SET @SRG@(SRI)=SRLINE_"N/A"
- +1 IF $DATA(^SRF(SRTN,52))
- DO LINE(1)
- SET @SRG@(SRI)=SRLINE
- SET X=$GET(^SRF(SRTN,52))
- Begin DoDot:1
- +2 DO LINE(1)
- SET @SRG@(SRI)=" Contamination: "_$PIECE(X,"^")
- +3 DO LINE(1)
- SET @SRG@(SRI)=" SPS Processing/OR Management Issues: "_$PIECE(X,"^",2)
- +4 DO LINE(1)
- SET @SRG@(SRI)=" Emergency Case: "_$PIECE(X,"^",3)
- +5 DO LINE(1)
- SET @SRG@(SRI)=" No Better Option: "_$PIECE(X,"^",4)
- +6 DO LINE(1)
- SET @SRG@(SRI)=" Loaner or Short Notice Instrument: "_$PIECE(X,"^",5)
- +7 DO LINE(1)
- SET @SRG@(SRI)=" Decontamination of Instruments Contaminated During the Case: "_$PIECE(X,"^",6)
- End DoDot:1
- NCC SET SRLINE="Nursing Care Comments: "
- DO LINE(2)
- SET @SRG@(SRI)=SRLINE
- Begin DoDot:1
- +1 IF '$ORDER(^SRF(SRTN,7,0))
- SET @SRG@(SRI)=@SRG@(SRI)_"NO COMMENTS ENTERED"
- QUIT
- +2 SET SRLINE=0
- FOR
- SET SRLINE=$ORDER(^SRF(SRTN,7,SRLINE))
- if 'SRLINE
- QUIT
- SET X=^SRF(SRTN,7,SRLINE,0)
- DO COMM(X,2)
- End DoDot:1
- +3 QUIT
- SAVE ; cell saver(s)
- +1 NEW C,DISP,DNM,ID,INF,LOT,OP,SAL,SAV,SRCT,QTY,X,Y
- +2 SET SAV=0
- FOR
- SET SAV=$ORDER(^SRF(SRTN,45,SAV))
- if 'SAV
- QUIT
- Begin DoDot:1
- +3 SET X=^SRF(SRTN,45,SAV,0)
- SET ID=$PIECE(X,"^")
- SET SAL=$PIECE(X,"^",3)
- SET INF=$PIECE(X,"^",4)
- SET Y=$PIECE(X,"^",2)
- SET C=$PIECE(^DD(130.013,1,0),"^",2)
- if Y
- DO Y^DIQ
- SET OP=$SELECT(Y'="":Y,1:"N/A")
- +4 DO LINE(1)
- SET @SRG@(SRI)=" "_ID
- SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Amount Salvaged: "_$SELECT(SAL:SAL_" ml",1:"N/A")
- +5 DO LINE(1)
- SET @SRG@(SRI)=" Operator:"_OP
- SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Amount Reinfused: "_$SELECT(INF:INF_" ml",1:"N/A")
- +6 IF $ORDER(^SRF(SRTN,45,SAV,1,0))
- DO LINE(1)
- SET @SRG@(SRI)=" Disposables:"
- SET DISP=0
- FOR
- SET DISP=$ORDER(^SRF(SRTN,45,SAV,1,DISP))
- if 'DISP
- QUIT
- Begin DoDot:2
- +7 SET X=^SRF(SRTN,45,SAV,1,DISP,0)
- SET DNM=$PIECE(X,"^")
- SET LOT=$PIECE(X,"^",2)
- SET QTY=$PIECE(X,"^",3)
- DO LINE(1)
- SET @SRG@(SRI)=" "_DNM
- +8 DO LINE(1)
- SET @SRG@(SRI)=$$SPACE(8)_"Lot: "_LOT
- SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Quantity: "_QTY
- End DoDot:2
- +9 SET (SRCT,SRLINE)=0
- FOR
- SET SRLINE=$ORDER(^SRF(SRTN,45,SAV,2,SRLINE))
- if 'SRLINE
- QUIT
- SET SRCT=SRCT+1
- +10 if 'SRCT
- QUIT
- DO LINE(1)
- SET SRLINE=0
- SET SRL=4
- SET SRLINE=$ORDER(^SRF(SRTN,45,SAV,2,SRLINE))
- SET X=^SRF(SRTN,45,SAV,2,SRLINE,0)
- +11 IF SRCT=1
- IF $LENGTH(X)<67
- SET @SRG@(SRI)=" Comments: "_X
- QUIT
- +12 SET @SRG@(SRI)=" Comments:"
- DO COMM(X,SRL)
- +13 FOR
- SET SRLINE=$ORDER(^SRF(SRTN,45,SAV,2,SRLINE))
- if 'SRLINE
- QUIT
- SET X=^SRF(SRTN,45,SAV,2,SRLINE,0)
- DO COMM(X,SRL)
- End DoDot:1
- +14 QUIT
- N(SRL) NEW SRN
- IF $LENGTH(Y)>SRL
- SET SRN=$PIECE(Y,",")_","_$EXTRACT($PIECE(Y,",",2))_"."
- SET Y=SRN
- +1 QUIT
- COMM(X,NUM) ; output text
- +1 ; X = line of text to be processed
- +2 ; NUM = left margin
- +3 NEW I,J,K,Y,SRL
- SET SRL=80-NUM
- +4 IF $LENGTH(X)<(SRL+1)!($EXTRACT(X,1,SRL)'[" ")
- DO LINE(1)
- SET @SRG@(SRI)=$$SPACE(NUM)_X
- QUIT
- +5 SET K=1
- FOR
- Begin DoDot:1
- +6 FOR I=0:1:SRL-1
- SET J=SRL-I
- SET Y=$EXTRACT(X,J)
- IF Y=" "
- SET X(K)=$EXTRACT(X,1,J-1)
- SET X=$EXTRACT(X,J+1,$LENGTH(X))
- SET K=K+1
- QUIT
- End DoDot:1
- IF $LENGTH(X)<SRL+1
- SET X(K)=X
- QUIT
- +7 FOR I=1:1:K
- DO LINE(1)
- SET @SRG@(SRI)=$$SPACE(NUM)_X(I)
- +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
