- 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 Feb 19, 2025@00:07:43 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
