SRONRPT3 ;BIR/ADM - NURSE INTRAOP REPORT ; [ 02/21/02 2:47 PM ]
;;3.0; Surgery ;**100**;24 Jun 93
;
;** 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 S SRLF=1,SRLINE="Laser Unit(s): " I '$O(^SRF(SRTN,44,0)),SRALL D LINE(1) S @SRG@(SRI)=SRLINE_"N/A"
I $O(^SRF(SRTN,44,0)) D LINE(1) S @SRG@(SRI)=SRLINE D LASER
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 G NCC
D LINE(2) S @SRG@(SRI)="Devices: "_X
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
LASER ; laser units
N C,DUR,ID,LAS,OP,PE,SRCT,WAT,X,Y
S LAS=0 F S LAS=$O(^SRF(SRTN,44,LAS)) Q:'LAS D
.S X=^SRF(SRTN,44,LAS,0),ID=$P(X,"^"),DUR=$P(X,"^",2),WAT=$P(X,"^",3),OP=$P(X,"^",4),PE=$P(X,"^",5)
.D LINE(1) S @SRG@(SRI)=" "_ID,@SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Duration: "_$S(DUR'="":DUR_" min.",1:"N/A")
.D LINE(1) S @SRG@(SRI)=" Wattage: "_$S(WAT'="":WAT,1:"N/A"),@SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Plume Evacuator: "_$S(PE="Y":"YES",PE="N":"NO",1:"N/A")
.S Y=OP,C=$P(^DD(130.0129,3,0),"^",2) D:Y Y^DIQ S:Y="" Y="N/A" D LINE(1) S @SRG@(SRI)=" Operator: "_Y
.S (SRCT,SRLINE)=0 F S SRLINE=$O(^SRF(SRTN,44,LAS,1,SRLINE)) Q:'SRLINE S SRCT=SRCT+1
.Q:'SRCT D LINE(1) S SRLINE=0,SRL=4,SRLINE=$O(^SRF(SRTN,44,LAS,1,SRLINE)),X=^SRF(SRTN,44,LAS,1,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,44,LAS,1,SRLINE)) Q:'SRLINE S X=^SRF(SRTN,44,LAS,1,SRLINE,0) D COMM(X,SRL)
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
SRONRPT3 ;BIR/ADM - NURSE INTRAOP REPORT ; [ 02/21/02 2:47 PM ]
+1 ;;3.0; Surgery ;**100**;24 Jun 93
+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
SET MOOD=$PIECE(SR(.8),"^")
SET CONS=$PIECE(SR(.8),"^",10)
SET INTEG=$PIECE(SR(.7),"^",6)
SET COLOR=$PIECE(SR(.7),"^",7)
+8 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")
+9 SET Y=COLOR
SET C=$PIECE(^DD(130,.77,0),"^",2)
IF Y'=""
DO Y^DIQ
SET COLOR=$SELECT(Y="":"N/A",1:Y)
+10 IF 'SRALL
IF MOOD="N/A"
GOTO CONS
+11 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 SET SRLF=1
SET SRLINE="Laser Unit(s): "
IF '$ORDER(^SRF(SRTN,44,0))
IF SRALL
DO LINE(1)
SET @SRG@(SRI)=SRLINE_"N/A"
+1 IF $ORDER(^SRF(SRTN,44,0))
DO LINE(1)
SET @SRG@(SRI)=SRLINE
DO LASER
+2 SET Y=$PIECE(SR(.7),"^",3)
IF 'SRALL
IF Y=""
GOTO CS
+3 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
GOTO NCC
+3 DO LINE(2)
SET @SRG@(SRI)="Devices: "_X
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
LASER ; laser units
+1 NEW C,DUR,ID,LAS,OP,PE,SRCT,WAT,X,Y
+2 SET LAS=0
FOR
SET LAS=$ORDER(^SRF(SRTN,44,LAS))
IF 'LAS
QUIT
Begin DoDot:1
+3 SET X=^SRF(SRTN,44,LAS,0)
SET ID=$PIECE(X,"^")
SET DUR=$PIECE(X,"^",2)
SET WAT=$PIECE(X,"^",3)
SET OP=$PIECE(X,"^",4)
SET PE=$PIECE(X,"^",5)
+4 DO LINE(1)
SET @SRG@(SRI)=" "_ID
SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Duration: "_$SELECT(DUR'="":DUR_" min.",1:"N/A")
+5 DO LINE(1)
SET @SRG@(SRI)=" Wattage: "_$SELECT(WAT'="":WAT,1:"N/A")
SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Plume Evacuator: "_$SELECT(PE="Y":"YES",PE="N":"NO",1:"N/A")
+6 SET Y=OP
SET C=$PIECE(^DD(130.0129,3,0),"^",2)
IF Y
DO Y^DIQ
IF Y=""
SET Y="N/A"
DO LINE(1)
SET @SRG@(SRI)=" Operator: "_Y
+7 SET (SRCT,SRLINE)=0
FOR
SET SRLINE=$ORDER(^SRF(SRTN,44,LAS,1,SRLINE))
IF 'SRLINE
QUIT
SET SRCT=SRCT+1
+8 IF 'SRCT
QUIT
DO LINE(1)
SET SRLINE=0
SET SRL=4
SET SRLINE=$ORDER(^SRF(SRTN,44,LAS,1,SRLINE))
SET X=^SRF(SRTN,44,LAS,1,SRLINE,0)
+9 IF SRCT=1
IF $LENGTH(X)<67
SET @SRG@(SRI)=" Comments: "_X
QUIT
+10 SET @SRG@(SRI)=" Comments:"
DO COMM(X,SRL)
+11 FOR
SET SRLINE=$ORDER(^SRF(SRTN,44,LAS,1,SRLINE))
IF 'SRLINE
QUIT
SET X=^SRF(SRTN,44,LAS,1,SRLINE,0)
DO COMM(X,SRL)
End DoDot:1
+12 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
