SROANR0 ;BIR/ADM - ANESTHESIA REPORT ; [ 06/28/04 12:45 PM ]
;;3.0; Surgery ;**100,131**;24 Jun 93
;
;** NOTICE: This routine is part of an implementation of a nationally
;** controlled procedure. Local modifications to this routine
;** are prohibited.
;
TECH D LINE(2) S @SRG@(SRI)="Anesthesia Technique(s): " D
.I '$O(^SRF(SRTN,6,0)) S @SRG@(SRI)=@SRG@(SRI)_"* NOT ENTERED *" Q
.S ANE=0 F S ANE=$O(^SRF(SRTN,6,ANE)) Q:'ANE D ANE
Q
ANE ; print anesthesia technique
N A,AGNT,C,CNT
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)=Y D AGENT
D INFO
Q
AGENT ; print agents
Q:$P(A,"^")="N"
D LINE(1) S @SRG@(SRI)=" Agent: " I '$O(^SRF(SRTN,6,ANE,1,0)) S @SRG@(SRI)=@SRG@(SRI)_"NONE ENTERED" Q
S (AGNT,CNT)=0 F S AGNT=$O(^SRF(SRTN,6,ANE,1,AGNT)) Q:'AGNT S CNT=CNT+1 D
.S Y=$P(^SRF(SRTN,6,ANE,1,AGNT,0),"^"),C=$P(^DD(130.47,.01,0),"^",2) D Y^DIQ
.D:CNT>1 LINE(1) S @SRG@(SRI)=@SRG@(SRI)_$$SPACE(13)_Y
.;; SR*3*131 ADDED LOGIC TO INCLUDE DOSE
.S Y=$P(^SRF(SRTN,6,ANE,1,AGNT,0),"^",2) I Y'="" S @SRG@(SRI)=@SRG@(SRI)_" "_Y_" mg"
Q
INFO ; anesthesia technique information
N C,SRFLG,I,S,X,Y F I=2,3,8 S S(I)=$G(^SRF(SRTN,6,ANE,I))
I $P(S(8),"^")="Y" D LINE(1) S @SRG@(SRI)=" MONITORED ANESTHESIA CARE"
I $P(S(8),"^",2)'="" D LINE(1) S @SRG@(SRI)=" Intubated: "_$S($P(S(8),"^",2)="Y":"YES",1:"NO")
S S=^SRF(SRTN,6,ANE,0),(Y,SRFLG)=$P(S,"^",5),C=$P(^DD(130.06,3,0),"^",2) D:Y'="" Y^DIQ I Y'="" D LINE(1) S @SRG@(SRI)=" Approach: "_Y
I $P(S,"^",6)'="" S Y=$P(S,"^",6),C=$P(^DD(130.06,4,0),"^",2) D:Y'="" Y^DIQ I Y'="" D:SRFLG="" LINE(1) S @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Route: "_Y
S Y=$P(S,"^",7),C=$P(^DD(130.06,5,0),"^",2) D:Y'="" Y^DIQ I Y'="" D LINE(1) S @SRG@(SRI)=" Laryngoscope Type: "_Y
S Y=$P(S,"^",8),C=$P(^DD(130.06,6,0),"^",2) D:Y'="" Y^DIQ I Y'="" D LINE(1) S @SRG@(SRI)=" Laryngoscope Size: "_Y
S (Y,SRFLG)=$P(S,"^",9),C=$P(^DD(130.06,7,0),"^",2) D:Y'="" Y^DIQ I Y'="" D LINE(1) S @SRG@(SRI)=" Stylet Used: "_Y
S Y=$P(S,"^",10),C=$P(^DD(130.06,8,0),"^",2) D:Y'="" Y^DIQ I Y'="" D:SRFLG="" LINE(1) S @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Lidocaine Topical: "_Y
S Y=$P(S,"^",11),C=$P(^DD(130.06,9,0),"^",2) D:Y'="" Y^DIQ I Y'="" D LINE(1) S @SRG@(SRI)=" Lidocaine IV: "_Y
S (Y,SRFLG)=$P(S,"^",12),C=$P(^DD(130.06,10,0),"^",2) D:Y'="" Y^DIQ I Y'="" D LINE(1) S @SRG@(SRI)=" Tube Type: "_Y
I $P(S,"^",13) D:SRFLG="" LINE(1) S @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Tube Size: "_$P(S,"^",13)
S Y=$P(S,"^",14),C=$P(^DD(130.06,12,0),"^",2) D:Y'="" Y^DIQ I Y'="" D LINE(1) S @SRG@(SRI)=" Trauma: "_Y
S (Y,SRFLG)=$P(S,"^",23),C=$P(^DD(130.06,21,0),"^",2) D:Y'="" Y^DIQ I Y'="" D LINE(1) S @SRG@(SRI)=" Extubated In: "_Y
S Y=$P($G(^SRF(SRTN,6,ANE,6)),"^"),C=$P(^DD(130.06,39,0),"^",2) D:Y'="" Y^DIQ I Y'="" D:SRFLG="" LINE(1) S @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Extubated By: "_$S($L(Y)>25:$P(Y,",")_","_$P(Y,",",2)_".",1:Y)
I $P(S,"^",24)="Y" D LINE(1) S @SRG@(SRI)=" Reintubated within 8 Hours: YES"
I $P(S,"^",19)="Y" D LINE(1) S @SRG@(SRI)=" Heat, Moisture Exchanger Used: YES"
I $P(S,"^",20)="Y" D LINE(1) S @SRG@(SRI)=" Bacteria Filter in Circuit: YES"
S (Y,SRFLG)=$P(S(2),"^") I Y'="" D LINE(1) S @SRG@(SRI)=" Continuous: "_$S(Y="Y":"YES",1:"NO")
S Y=$P(S(2),"^",2) I Y'="" S Y=$S(Y=1:"HYPERBARIC",Y=2:"HYPOBARIC",1:"ISOBARIC") D:SRFLG="" LINE(1) S @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Baricity: "_Y
S (Y,SRFLG)=$P(S(2),"^",3),C=$P(^DD(130.06,27,0),"^",2) D:Y'="" Y^DIQ I Y'="" D LINE(1) S @SRG@(SRI)=" Puncture Site: "_Y
S Y=$P(S(2),"^",5),C=$P(^DD(130.06,29,0),"^",2) D:Y'="" Y^DIQ I Y'="" D:SRFLG="" LINE(1) S @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Needle Size: "_Y
S (Y,SRFLG)=$P(S(8),"^",3),C=$P(^DD(130.06,43,0),"^",2) I Y'="" D Y^DIQ D LINE(1) S @SRG@(SRI)=" Level: "_Y
Q
MED ; medications
N ADBY,ADM,C,CNT,COMMENT,DOSE,MED,MM,ORBY,ROUTE,TIME,X,Y
S (CNT,MED)=0 F S MED=$O(^SRF(SRTN,22,MED)) Q:'MED S CNT=CNT+1 D
.S Y=$P(^SRF(SRTN,22,MED,0),"^"),C=$P(^DD(130.33,.01,0),"^",2) D Y^DIQ,LINE(1) S @SRG@(SRI)=" "_Y,ADM=0 F S ADM=$O(^SRF(SRTN,22,MED,1,ADM)) Q:'ADM D
..S MM=^SRF(SRTN,22,MED,1,ADM,0),Y=$P(MM,"^") D D^DIQ S TIME=$P(Y,"@")_" "_$P(Y,"@",2)
..S DOSE=$P(MM,"^",2),X=$P(MM,"^",3) S:X="" ORBY="N/A" I X S Y=$P(^VA(200,X,0),"^") D N(20) S ORBY=Y
..S X=$P(MM,"^",4) S:X="" ADBY="N/A" I X S Y=$P(^VA(200,X,0),"^") D N(29) S ADBY=Y
..S Y=$P(MM,"^",5),C=$P(^DD(130.34,4,0),"^",2) D:Y'="" Y^DIQ S ROUTE=Y
..S COMMENT=$P(MM,"^",6) S:COMMENT="" COMMENT="N/A"
..D LINE(1) S @SRG@(SRI)=" Time Administered: "_TIME D LINE(1) S @SRG@(SRI)=" Route: "_ROUTE,@SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Dosage: "_DOSE
..D LINE(1) S @SRG@(SRI)=" Ordered By: "_ORBY S @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Admin By: "_ADBY
..D LINE(1) S @SRG@(SRI)=" Comments: "_COMMENT
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
F J=1:1:NUM S SRI=SRI+1,@SRG@(SRI)=""
Q
SROANR0 ;BIR/ADM - ANESTHESIA REPORT ; [ 06/28/04 12:45 PM ]
+1 ;;3.0; Surgery ;**100,131**;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 ;
TECH DO LINE(2)
SET @SRG@(SRI)="Anesthesia Technique(s): "
Begin DoDot:1
+1 IF '$ORDER(^SRF(SRTN,6,0))
SET @SRG@(SRI)=@SRG@(SRI)_"* NOT ENTERED *"
QUIT
+2 SET ANE=0
FOR
SET ANE=$ORDER(^SRF(SRTN,6,ANE))
IF 'ANE
QUIT
DO ANE
End DoDot:1
+3 QUIT
ANE ; print anesthesia technique
+1 NEW A,AGNT,C,CNT
+2 SET A=^SRF(SRTN,6,ANE,0)
SET Y=$PIECE(A,"^")
SET C=$PIECE(^DD(130.06,.01,0),"^",2)
IF Y'=""
DO Y^DIQ
DO LINE(1)
SET Y=Y_$SELECT($PIECE(A,"^",3)="Y":" (PRINCIPAL)",1:"")
SET @SRG@(SRI)=Y
DO AGENT
+3 DO INFO
+4 QUIT
AGENT ; print agents
+1 IF $PIECE(A,"^")="N"
QUIT
+2 DO LINE(1)
SET @SRG@(SRI)=" Agent: "
IF '$ORDER(^SRF(SRTN,6,ANE,1,0))
SET @SRG@(SRI)=@SRG@(SRI)_"NONE ENTERED"
QUIT
+3 SET (AGNT,CNT)=0
FOR
SET AGNT=$ORDER(^SRF(SRTN,6,ANE,1,AGNT))
IF 'AGNT
QUIT
SET CNT=CNT+1
Begin DoDot:1
+4 SET Y=$PIECE(^SRF(SRTN,6,ANE,1,AGNT,0),"^")
SET C=$PIECE(^DD(130.47,.01,0),"^",2)
DO Y^DIQ
+5 IF CNT>1
DO LINE(1)
SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(13)_Y
+6 ;; SR*3*131 ADDED LOGIC TO INCLUDE DOSE
+7 SET Y=$PIECE(^SRF(SRTN,6,ANE,1,AGNT,0),"^",2)
IF Y'=""
SET @SRG@(SRI)=@SRG@(SRI)_" "_Y_" mg"
End DoDot:1
+8 QUIT
INFO ; anesthesia technique information
+1 NEW C,SRFLG,I,S,X,Y
FOR I=2,3,8
SET S(I)=$GET(^SRF(SRTN,6,ANE,I))
+2 IF $PIECE(S(8),"^")="Y"
DO LINE(1)
SET @SRG@(SRI)=" MONITORED ANESTHESIA CARE"
+3 IF $PIECE(S(8),"^",2)'=""
DO LINE(1)
SET @SRG@(SRI)=" Intubated: "_$SELECT($PIECE(S(8),"^",2)="Y":"YES",1:"NO")
+4 SET S=^SRF(SRTN,6,ANE,0)
SET (Y,SRFLG)=$PIECE(S,"^",5)
SET C=$PIECE(^DD(130.06,3,0),"^",2)
IF Y'=""
DO Y^DIQ
IF Y'=""
DO LINE(1)
SET @SRG@(SRI)=" Approach: "_Y
+5 IF $PIECE(S,"^",6)'=""
SET Y=$PIECE(S,"^",6)
SET C=$PIECE(^DD(130.06,4,0),"^",2)
IF Y'=""
DO Y^DIQ
IF Y'=""
IF SRFLG=""
DO LINE(1)
SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Route: "_Y
+6 SET Y=$PIECE(S,"^",7)
SET C=$PIECE(^DD(130.06,5,0),"^",2)
IF Y'=""
DO Y^DIQ
IF Y'=""
DO LINE(1)
SET @SRG@(SRI)=" Laryngoscope Type: "_Y
+7 SET Y=$PIECE(S,"^",8)
SET C=$PIECE(^DD(130.06,6,0),"^",2)
IF Y'=""
DO Y^DIQ
IF Y'=""
DO LINE(1)
SET @SRG@(SRI)=" Laryngoscope Size: "_Y
+8 SET (Y,SRFLG)=$PIECE(S,"^",9)
SET C=$PIECE(^DD(130.06,7,0),"^",2)
IF Y'=""
DO Y^DIQ
IF Y'=""
DO LINE(1)
SET @SRG@(SRI)=" Stylet Used: "_Y
+9 SET Y=$PIECE(S,"^",10)
SET C=$PIECE(^DD(130.06,8,0),"^",2)
IF Y'=""
DO Y^DIQ
IF Y'=""
IF SRFLG=""
DO LINE(1)
SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Lidocaine Topical: "_Y
+10 SET Y=$PIECE(S,"^",11)
SET C=$PIECE(^DD(130.06,9,0),"^",2)
IF Y'=""
DO Y^DIQ
IF Y'=""
DO LINE(1)
SET @SRG@(SRI)=" Lidocaine IV: "_Y
+11 SET (Y,SRFLG)=$PIECE(S,"^",12)
SET C=$PIECE(^DD(130.06,10,0),"^",2)
IF Y'=""
DO Y^DIQ
IF Y'=""
DO LINE(1)
SET @SRG@(SRI)=" Tube Type: "_Y
+12 IF $PIECE(S,"^",13)
IF SRFLG=""
DO LINE(1)
SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Tube Size: "_$PIECE(S,"^",13)
+13 SET Y=$PIECE(S,"^",14)
SET C=$PIECE(^DD(130.06,12,0),"^",2)
IF Y'=""
DO Y^DIQ
IF Y'=""
DO LINE(1)
SET @SRG@(SRI)=" Trauma: "_Y
+14 SET (Y,SRFLG)=$PIECE(S,"^",23)
SET C=$PIECE(^DD(130.06,21,0),"^",2)
IF Y'=""
DO Y^DIQ
IF Y'=""
DO LINE(1)
SET @SRG@(SRI)=" Extubated In: "_Y
+15 SET Y=$PIECE($GET(^SRF(SRTN,6,ANE,6)),"^")
SET C=$PIECE(^DD(130.06,39,0),"^",2)
IF Y'=""
DO Y^DIQ
IF Y'=""
IF SRFLG=""
DO LINE(1)
SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Extubated By: "_$SELECT($LENGTH(Y)>25:$PIECE(Y,",")_","_$PIECE(Y,",",2)_".",1:Y)
+16 IF $PIECE(S,"^",24)="Y"
DO LINE(1)
SET @SRG@(SRI)=" Reintubated within 8 Hours: YES"
+17 IF $PIECE(S,"^",19)="Y"
DO LINE(1)
SET @SRG@(SRI)=" Heat, Moisture Exchanger Used: YES"
+18 IF $PIECE(S,"^",20)="Y"
DO LINE(1)
SET @SRG@(SRI)=" Bacteria Filter in Circuit: YES"
+19 SET (Y,SRFLG)=$PIECE(S(2),"^")
IF Y'=""
DO LINE(1)
SET @SRG@(SRI)=" Continuous: "_$SELECT(Y="Y":"YES",1:"NO")
+20 SET Y=$PIECE(S(2),"^",2)
IF Y'=""
SET Y=$SELECT(Y=1:"HYPERBARIC",Y=2:"HYPOBARIC",1:"ISOBARIC")
IF SRFLG=""
DO LINE(1)
SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Baricity: "_Y
+21 SET (Y,SRFLG)=$PIECE(S(2),"^",3)
SET C=$PIECE(^DD(130.06,27,0),"^",2)
IF Y'=""
DO Y^DIQ
IF Y'=""
DO LINE(1)
SET @SRG@(SRI)=" Puncture Site: "_Y
+22 SET Y=$PIECE(S(2),"^",5)
SET C=$PIECE(^DD(130.06,29,0),"^",2)
IF Y'=""
DO Y^DIQ
IF Y'=""
IF SRFLG=""
DO LINE(1)
SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Needle Size: "_Y
+23 SET (Y,SRFLG)=$PIECE(S(8),"^",3)
SET C=$PIECE(^DD(130.06,43,0),"^",2)
IF Y'=""
DO Y^DIQ
DO LINE(1)
SET @SRG@(SRI)=" Level: "_Y
+24 QUIT
MED ; medications
+1 NEW ADBY,ADM,C,CNT,COMMENT,DOSE,MED,MM,ORBY,ROUTE,TIME,X,Y
+2 SET (CNT,MED)=0
FOR
SET MED=$ORDER(^SRF(SRTN,22,MED))
IF 'MED
QUIT
SET CNT=CNT+1
Begin DoDot:1
+3 SET Y=$PIECE(^SRF(SRTN,22,MED,0),"^")
SET C=$PIECE(^DD(130.33,.01,0),"^",2)
DO Y^DIQ
DO LINE(1)
SET @SRG@(SRI)=" "_Y
SET ADM=0
FOR
SET ADM=$ORDER(^SRF(SRTN,22,MED,1,ADM))
IF 'ADM
QUIT
Begin DoDot:2
+4 SET MM=^SRF(SRTN,22,MED,1,ADM,0)
SET Y=$PIECE(MM,"^")
DO D^DIQ
SET TIME=$PIECE(Y,"@")_" "_$PIECE(Y,"@",2)
+5 SET DOSE=$PIECE(MM,"^",2)
SET X=$PIECE(MM,"^",3)
IF X=""
SET ORBY="N/A"
IF X
SET Y=$PIECE(^VA(200,X,0),"^")
DO N(20)
SET ORBY=Y
+6 SET X=$PIECE(MM,"^",4)
IF X=""
SET ADBY="N/A"
IF X
SET Y=$PIECE(^VA(200,X,0),"^")
DO N(29)
SET ADBY=Y
+7 SET Y=$PIECE(MM,"^",5)
SET C=$PIECE(^DD(130.34,4,0),"^",2)
IF Y'=""
DO Y^DIQ
SET ROUTE=Y
+8 SET COMMENT=$PIECE(MM,"^",6)
IF COMMENT=""
SET COMMENT="N/A"
+9 DO LINE(1)
SET @SRG@(SRI)=" Time Administered: "_TIME
DO LINE(1)
SET @SRG@(SRI)=" Route: "_ROUTE
SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Dosage: "_DOSE
+10 DO LINE(1)
SET @SRG@(SRI)=" Ordered By: "_ORBY
SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Admin By: "_ADBY
+11 DO LINE(1)
SET @SRG@(SRI)=" Comments: "_COMMENT
End DoDot:2
End DoDot:1
+12 QUIT
N(SRL) NEW SRN
IF $LENGTH(Y)>SRL
SET SRN=$PIECE(Y,",")_","_$EXTRACT($PIECE(Y,",",2))_"."
SET Y=SRN
+1 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
