SROANR1 ;BIR/ADM - ANESTHESIA REPORT ; [ 09/09/03 12:45 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.
;
N C,SRLINE,SRT,X,Y
S X=$P(SR(.3),"^",7) I X'="" D LINE(2) S @SRG@(SRI)="Min Intraoperative Temp: "_X
I $O(^SRF(SRTN,27,0)) D LINE(2) S @SRG@(SRI)="Monitors:" D MON
I $O(^SRF(SRTN,4,0)) D LINE(2) S @SRG@(SRI)="Blood Replacement Fluids:" D REP
D LINE(2) S Y=$P(SR(.2),"^",5) S:Y'="" Y=Y_" ml" S @SRG@(SRI)="Intraoperative Blood Loss: "_Y
S Y=$P(SR(.2),"^",16) S:Y'="" Y=Y_" ml" S @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Urine Output: "_Y
D LINE(1) S @SRG@(SRI)="PAC(U) Admit Score: "_$P(SR(1.1),"^"),@SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"PAC(U) Discharge Score: "_$P(SR(1.1),"^",2)
I $O(^SRF(SRTN,5,0)) D LINE(2) S @SRG@(SRI)="General Comments:" S SRLINE=0 D
.F S SRLINE=$O(^SRF(SRTN,5,SRLINE)) Q:'SRLINE S X=^SRF(SRTN,5,SRLINE,0) D COMM(X,2)
NOTE S Y=$P(SR(1.1),"^",9) D:Y D^DIQ S SRT=$S(Y'="":$P(Y,"@")_" "_$P(Y,"@",2),1:"") D LINE(2) S @SRG@(SRI)="Postop Anesthesia Note Date/Time: "_SRT
I $O(^SRF(SRTN,48,0)) D LINE(1) S @SRG@(SRI)="Postop Anesthesia Note:" S SRLINE=0 D
.F S SRLINE=$O(^SRF(SRTN,48,SRLINE)) Q:'SRLINE S X=^SRF(SRTN,48,SRLINE,0) D COMM(X,2)
Q
N(SRL) N SRN I $L(Y)>SRL S SRN=$P(Y,",")_","_$E($P(Y,",",2))_".",Y=SRN
Q
MON ; monitors
N C,MON,SRM,SRT,Y
S MON=0 F S MON=$O(^SRF(SRTN,27,MON)) Q:'MON S SRM=^SRF(SRTN,27,MON,0) D
.S Y=$P(SRM,"^"),C=$P(^DD(130.41,.01,0),"^",2) D:Y'="" Y^DIQ D LINE(1) S @SRG@(SRI)=" "_Y
.S Y=$P(SRM,"^",4),C=$P(^DD(130.41,3,0),"^",2) D:Y'="" Y^DIQ,N(27) S:Y="" Y="N/A" S @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Applied By: "_Y
.S Y=$P(SRM,"^",2) D:Y D^DIQ S SRT=$S(Y'="":$P(Y,"@")_" "_$P(Y,"@",2),1:"N/A") D LINE(1) S @SRG@(SRI)=" Installed: "_SRT
.S Y=$P(SRM,"^",3) D:Y D^DIQ S SRT=$S(Y'="":$P(Y,"@")_" "_$P(Y,"@",2),1:"N/A") S @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Removed: "_SRT
Q
REP ; blood replacement fluids
N C,REP,SRLINE,SRX,X,Y
S REP=0 F S REP=$O(^SRF(SRTN,4,REP)) Q:'REP S SRX=^SRF(SRTN,4,REP,0) D
.S Y=$P(SRX,"^"),C=$P(^DD(130.04,.01,0),"^",2) D:Y'="" Y^DIQ D LINE(1) S @SRG@(SRI)=" "_Y
.S Y=$P(SRX,"^",2),Y=$S(Y="":"N/A",1:Y_" ml"),@SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Quantity: "_Y
.S Y=$P(SRX,"^",4),Y=$S(Y="":"N/A",1:Y) D LINE(1) S @SRG@(SRI)=" Source ID: "_Y
.S Y=$P(SRX,"^",5),Y=$S(Y="":"N/A",1:Y) D LINE(1) S @SRG@(SRI)=" VA ID: "_Y
Q
COMM(X,NUM) ; output word-processing 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
F J=1:1:NUM S SRI=SRI+1,@SRG@(SRI)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROANR1 3162 printed Nov 22, 2024@17:51:12 Page 2
SROANR1 ;BIR/ADM - ANESTHESIA REPORT ; [ 09/09/03 12:45 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 NEW C,SRLINE,SRT,X,Y
+8 SET X=$PIECE(SR(.3),"^",7)
IF X'=""
DO LINE(2)
SET @SRG@(SRI)="Min Intraoperative Temp: "_X
+9 IF $ORDER(^SRF(SRTN,27,0))
DO LINE(2)
SET @SRG@(SRI)="Monitors:"
DO MON
+10 IF $ORDER(^SRF(SRTN,4,0))
DO LINE(2)
SET @SRG@(SRI)="Blood Replacement Fluids:"
DO REP
+11 DO LINE(2)
SET Y=$PIECE(SR(.2),"^",5)
if Y'=""
SET Y=Y_" ml"
SET @SRG@(SRI)="Intraoperative Blood Loss: "_Y
+12 SET Y=$PIECE(SR(.2),"^",16)
if Y'=""
SET Y=Y_" ml"
SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Urine Output: "_Y
+13 DO LINE(1)
SET @SRG@(SRI)="PAC(U) Admit Score: "_$PIECE(SR(1.1),"^")
SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"PAC(U) Discharge Score: "_$PIECE(SR(1.1),"^",2)
+14 IF $ORDER(^SRF(SRTN,5,0))
DO LINE(2)
SET @SRG@(SRI)="General Comments:"
SET SRLINE=0
Begin DoDot:1
+15 FOR
SET SRLINE=$ORDER(^SRF(SRTN,5,SRLINE))
if 'SRLINE
QUIT
SET X=^SRF(SRTN,5,SRLINE,0)
DO COMM(X,2)
End DoDot:1
NOTE SET Y=$PIECE(SR(1.1),"^",9)
if Y
DO D^DIQ
SET SRT=$SELECT(Y'="":$PIECE(Y,"@")_" "_$PIECE(Y,"@",2),1:"")
DO LINE(2)
SET @SRG@(SRI)="Postop Anesthesia Note Date/Time: "_SRT
+1 IF $ORDER(^SRF(SRTN,48,0))
DO LINE(1)
SET @SRG@(SRI)="Postop Anesthesia Note:"
SET SRLINE=0
Begin DoDot:1
+2 FOR
SET SRLINE=$ORDER(^SRF(SRTN,48,SRLINE))
if 'SRLINE
QUIT
SET X=^SRF(SRTN,48,SRLINE,0)
DO COMM(X,2)
End DoDot:1
+3 QUIT
N(SRL) NEW SRN
IF $LENGTH(Y)>SRL
SET SRN=$PIECE(Y,",")_","_$EXTRACT($PIECE(Y,",",2))_"."
SET Y=SRN
+1 QUIT
MON ; monitors
+1 NEW C,MON,SRM,SRT,Y
+2 SET MON=0
FOR
SET MON=$ORDER(^SRF(SRTN,27,MON))
if 'MON
QUIT
SET SRM=^SRF(SRTN,27,MON,0)
Begin DoDot:1
+3 SET Y=$PIECE(SRM,"^")
SET C=$PIECE(^DD(130.41,.01,0),"^",2)
if Y'=""
DO Y^DIQ
DO LINE(1)
SET @SRG@(SRI)=" "_Y
+4 SET Y=$PIECE(SRM,"^",4)
SET C=$PIECE(^DD(130.41,3,0),"^",2)
if Y'=""
DO Y^DIQ
DO N(27)
if Y=""
SET Y="N/A"
SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Applied By: "_Y
+5 SET Y=$PIECE(SRM,"^",2)
if Y
DO D^DIQ
SET SRT=$SELECT(Y'="":$PIECE(Y,"@")_" "_$PIECE(Y,"@",2),1:"N/A")
DO LINE(1)
SET @SRG@(SRI)=" Installed: "_SRT
+6 SET Y=$PIECE(SRM,"^",3)
if Y
DO D^DIQ
SET SRT=$SELECT(Y'="":$PIECE(Y,"@")_" "_$PIECE(Y,"@",2),1:"N/A")
SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Removed: "_SRT
End DoDot:1
+7 QUIT
REP ; blood replacement fluids
+1 NEW C,REP,SRLINE,SRX,X,Y
+2 SET REP=0
FOR
SET REP=$ORDER(^SRF(SRTN,4,REP))
if 'REP
QUIT
SET SRX=^SRF(SRTN,4,REP,0)
Begin DoDot:1
+3 SET Y=$PIECE(SRX,"^")
SET C=$PIECE(^DD(130.04,.01,0),"^",2)
if Y'=""
DO Y^DIQ
DO LINE(1)
SET @SRG@(SRI)=" "_Y
+4 SET Y=$PIECE(SRX,"^",2)
SET Y=$SELECT(Y="":"N/A",1:Y_" ml")
SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Quantity: "_Y
+5 SET Y=$PIECE(SRX,"^",4)
SET Y=$SELECT(Y="":"N/A",1:Y)
DO LINE(1)
SET @SRG@(SRI)=" Source ID: "_Y
+6 SET Y=$PIECE(SRX,"^",5)
SET Y=$SELECT(Y="":"N/A",1:Y)
DO LINE(1)
SET @SRG@(SRI)=" VA ID: "_Y
End DoDot:1
+7 QUIT
COMM(X,NUM) ; output word-processing 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 FOR J=1:1:NUM
SET SRI=SRI+1
SET @SRG@(SRI)=""
+2 QUIT
