- SROANR ;BIR/ADM - ANESTHESIA REPORT ; [ 02/14/04 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.
- ;
- D:'$D(SRTN) ^SROPS Q:'$D(SRTN)
- D RPT(SRTN)
- Q
- RPT(SRTN) ; send text of anesthesia report to ^TMP
- N ANE,C,DFN,J,JJ,SR,SRCASE,SRG,SRI,SRL,SRN,SROR,X,Y K ^TMP("SRANE",$J)
- S SRCASE=SRTN,SRG="^TMP(""SRANE"",$J,SRCASE)",SRI=0
- I $P($G(^SRF(SRTN,30)),"^")!$P($G(^SRF(SRTN,31)),"^",8) D LINE(1) S @SRG@(SRI)=" * * "_$S($P($G(^SRF(SRTN,"NON")),"^")="Y":"PROCEDURE",1:"OPERATION")_" ABORTED * *" D LINE(1)
- F SRN=0:.1:1.1,"NON" S SR(SRN)=$G(^SRF(SRTN,SRN))
- S SROR="NOT ENTERED" S X=$P(SR(0),"^",2) I X S X=$P(^SRS(X,0),"^"),X=$P(^SC(X,0),"^"),SROR=$E(X,1,24)
- I $P(SR("NON"),"^")="Y" S X=$P(SR("NON"),"^",2) I X S X=$P(^SC(X,0),"^"),SROR=X
- D LINE(1) S @SRG@(SRI)=$S($P(SR("NON"),"^")="Y":"Location: ",1:"Operating Room: ")_SROR
- S Y=$P(SR(.3),"^"),C=$P(^DD(130,.31,0),"^",2) D:Y'="" Y^DIQ,N(25) S:Y="" Y="* NOT ENTERED *" D LINE(2) S @SRG@(SRI)="Anesthetist: "_Y
- S Y=$P(SR(.3),"^",2),C=$P(^DD(130,.32,0),"^",2) D:Y'="" Y^DIQ,N(24) S @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Relief Anesth: "_Y
- S Y=$P(SR(.3),"^",4),C=$P(^DD(130,.34,0),"^",2) D:Y'="" Y^DIQ,N(20) D LINE(1) S @SRG@(SRI)="Anesthesiologist: "_Y
- S Y=$P(SR(.3),"^",3),C=$P(^DD(130,.33,0),"^",2) D:Y'="" Y^DIQ,N(20) S @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Assist Anesth: "_Y
- S Y=$P(SR(.3),"^",6),C=$P(^DD(130,.345,0),"^",2) D:Y'="" Y^DIQ D LINE(1) S @SRG@(SRI)="Attending Code: "_Y
- D TIMES
- S Y=$P(SR(1.1),"^",3),C=$P(^DD(130,1.13,0),"^",2) D:Y'="" Y^DIQ S:Y="" Y="* NOT ENTERED *" D LINE(2) S @SRG@(SRI)="ASA Class: "_Y
- S Y=$P(SR(.4),"^",6),C=$P(^DD(130,.46,0),"^",2) D:Y'="" Y^DIQ S:Y="" Y="* NOT ENTERED *" D LINE(2) S @SRG@(SRI)="Operation Disposition: "_Y
- D TECH^SROANR0
- D PRIN I $O(^SRF(SRTN,13,0)) D OTHER
- I $O(^SRF(SRTN,22,0)) D LINE(2) S @SRG@(SRI)="Medications:" D MED^SROANR0
- D ^SROANR1
- Q
- N(SRL) N SRN I $L(Y)>SRL S SRN=$P(Y,",")_","_$E($P(Y,",",2))_".",Y=SRN
- Q
- TIMES ; anesthesia start and end times
- N AB,AE,OB,OE
- S AB="* NOT ENTERED *",Y=$P(SR(.2),"^") I Y D D^DIQ S AB=$P(Y,"@")_" "_$P(Y,"@",2)
- S AE="* NOT ENTERED *",Y=$P(SR(.2),"^",4) I Y D D^DIQ S AE=$P(Y,"@")_" "_$P(Y,"@",2)
- D LINE(2) S @SRG@(SRI)="Anes Begin: "_AB S @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Anes End: "_AE
- Q
- PRIN ; principal procedure information
- N CNT,I,LOOP,M,MM,MMM,SRJ,SROPER,SROPS,SRX,SRY,SRZ,X,Z
- D LINE(2) S @SRG@(SRI)="Procedure(s) Performed:"
- PRIN2 S SROPER=$P(^SRF(SRTN,"OP"),"^")
- S SROPER="Principal: "_SROPER
- S:$L(SROPER)<74 SROPS(1)=SROPER I $L(SROPER)>73 S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM=""
- F I=1:1 Q:'$D(SROPS(I)) D LINE(1) S @SRG@(SRI)=$S(I=1:"",1:" ")_SROPS(I)
- Q
- LOOP ; break procedure if greater than 74 characters
- S SROPS(M)="" F LOOP=1:1 S MM=$P(SROPER," "),MMM=$P(SROPER," ",2,200) Q:MMM="" Q:$L(SROPS(M))+$L(MM)'<74 S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM
- Q
- OTHER ; other procedures
- N CNT,OTH,OTHER,SRJ,SRX,SRY,SRZ,Z
- S (OTH,CNT)=0 F S OTH=$O(^SRF(SRTN,13,OTH)) Q:'OTH S CNT=CNT+1 D OTH
- Q
- OTH S OTHER=$P(^SRF(SRTN,13,OTH,0),"^")
- D LINE(1) S @SRG@(SRI)="Other: "_OTHER
- 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[HSROANR 3524 printed Feb 19, 2025@00:07:41 Page 2
- SROANR ;BIR/ADM - ANESTHESIA REPORT ; [ 02/14/04 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 if '$DATA(SRTN)
- DO ^SROPS
- if '$DATA(SRTN)
- QUIT
- +8 DO RPT(SRTN)
- +9 QUIT
- RPT(SRTN) ; send text of anesthesia report to ^TMP
- +1 NEW ANE,C,DFN,J,JJ,SR,SRCASE,SRG,SRI,SRL,SRN,SROR,X,Y
- KILL ^TMP("SRANE",$JOB)
- +2 SET SRCASE=SRTN
- SET SRG="^TMP(""SRANE"",$J,SRCASE)"
- SET SRI=0
- +3 IF $PIECE($GET(^SRF(SRTN,30)),"^")!$PIECE($GET(^SRF(SRTN,31)),"^",8)
- DO LINE(1)
- SET @SRG@(SRI)=" * * "_$SELECT($PIECE($GET(^SRF(SRTN,"NON")),"^")="Y":"PROCEDURE",1:"OPERATION")_" ABORTED * *"
- DO LINE(1)
- +4 FOR SRN=0:.1:1.1,"NON"
- SET SR(SRN)=$GET(^SRF(SRTN,SRN))
- +5 SET SROR="NOT ENTERED"
- SET X=$PIECE(SR(0),"^",2)
- IF X
- SET X=$PIECE(^SRS(X,0),"^")
- SET X=$PIECE(^SC(X,0),"^")
- SET SROR=$EXTRACT(X,1,24)
- +6 IF $PIECE(SR("NON"),"^")="Y"
- SET X=$PIECE(SR("NON"),"^",2)
- IF X
- SET X=$PIECE(^SC(X,0),"^")
- SET SROR=X
- +7 DO LINE(1)
- SET @SRG@(SRI)=$SELECT($PIECE(SR("NON"),"^")="Y":"Location: ",1:"Operating Room: ")_SROR
- +8 SET Y=$PIECE(SR(.3),"^")
- SET C=$PIECE(^DD(130,.31,0),"^",2)
- if Y'=""
- DO Y^DIQ
- DO N(25)
- if Y=""
- SET Y="* NOT ENTERED *"
- DO LINE(2)
- SET @SRG@(SRI)="Anesthetist: "_Y
- +9 SET Y=$PIECE(SR(.3),"^",2)
- SET C=$PIECE(^DD(130,.32,0),"^",2)
- if Y'=""
- DO Y^DIQ
- DO N(24)
- SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Relief Anesth: "_Y
- +10 SET Y=$PIECE(SR(.3),"^",4)
- SET C=$PIECE(^DD(130,.34,0),"^",2)
- if Y'=""
- DO Y^DIQ
- DO N(20)
- DO LINE(1)
- SET @SRG@(SRI)="Anesthesiologist: "_Y
- +11 SET Y=$PIECE(SR(.3),"^",3)
- SET C=$PIECE(^DD(130,.33,0),"^",2)
- if Y'=""
- DO Y^DIQ
- DO N(20)
- SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Assist Anesth: "_Y
- +12 SET Y=$PIECE(SR(.3),"^",6)
- SET C=$PIECE(^DD(130,.345,0),"^",2)
- if Y'=""
- DO Y^DIQ
- DO LINE(1)
- SET @SRG@(SRI)="Attending Code: "_Y
- +13 DO TIMES
- +14 SET Y=$PIECE(SR(1.1),"^",3)
- SET C=$PIECE(^DD(130,1.13,0),"^",2)
- if Y'=""
- DO Y^DIQ
- if Y=""
- SET Y="* NOT ENTERED *"
- DO LINE(2)
- SET @SRG@(SRI)="ASA Class: "_Y
- +15 SET Y=$PIECE(SR(.4),"^",6)
- SET C=$PIECE(^DD(130,.46,0),"^",2)
- if Y'=""
- DO Y^DIQ
- if Y=""
- SET Y="* NOT ENTERED *"
- DO LINE(2)
- SET @SRG@(SRI)="Operation Disposition: "_Y
- +16 DO TECH^SROANR0
- +17 DO PRIN
- IF $ORDER(^SRF(SRTN,13,0))
- DO OTHER
- +18 IF $ORDER(^SRF(SRTN,22,0))
- DO LINE(2)
- SET @SRG@(SRI)="Medications:"
- DO MED^SROANR0
- +19 DO ^SROANR1
- +20 QUIT
- N(SRL) NEW SRN
- IF $LENGTH(Y)>SRL
- SET SRN=$PIECE(Y,",")_","_$EXTRACT($PIECE(Y,",",2))_"."
- SET Y=SRN
- +1 QUIT
- TIMES ; anesthesia start and end times
- +1 NEW AB,AE,OB,OE
- +2 SET AB="* NOT ENTERED *"
- SET Y=$PIECE(SR(.2),"^")
- IF Y
- DO D^DIQ
- SET AB=$PIECE(Y,"@")_" "_$PIECE(Y,"@",2)
- +3 SET AE="* NOT ENTERED *"
- SET Y=$PIECE(SR(.2),"^",4)
- IF Y
- DO D^DIQ
- SET AE=$PIECE(Y,"@")_" "_$PIECE(Y,"@",2)
- +4 DO LINE(2)
- SET @SRG@(SRI)="Anes Begin: "_AB
- SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Anes End: "_AE
- +5 QUIT
- PRIN ; principal procedure information
- +1 NEW CNT,I,LOOP,M,MM,MMM,SRJ,SROPER,SROPS,SRX,SRY,SRZ,X,Z
- +2 DO LINE(2)
- SET @SRG@(SRI)="Procedure(s) Performed:"
- PRIN2 SET SROPER=$PIECE(^SRF(SRTN,"OP"),"^")
- +1 SET SROPER="Principal: "_SROPER
- +2 if $LENGTH(SROPER)<74
- SET SROPS(1)=SROPER
- IF $LENGTH(SROPER)>73
- SET SROPER=SROPER_" "
- FOR M=1:1
- DO LOOP
- if MMM=""
- QUIT
- +3 FOR I=1:1
- if '$DATA(SROPS(I))
- QUIT
- DO LINE(1)
- SET @SRG@(SRI)=$SELECT(I=1:"",1:" ")_SROPS(I)
- +4 QUIT
- LOOP ; break procedure if greater than 74 characters
- +1 SET SROPS(M)=""
- FOR LOOP=1:1
- SET MM=$PIECE(SROPER," ")
- SET MMM=$PIECE(SROPER," ",2,200)
- if MMM=""
- QUIT
- if $LENGTH(SROPS(M))+$LENGTH(MM)'<74
- QUIT
- SET SROPS(M)=SROPS(M)_MM_" "
- SET SROPER=MMM
- +2 QUIT
- OTHER ; other procedures
- +1 NEW CNT,OTH,OTHER,SRJ,SRX,SRY,SRZ,Z
- +2 SET (OTH,CNT)=0
- FOR
- SET OTH=$ORDER(^SRF(SRTN,13,OTH))
- if 'OTH
- QUIT
- SET CNT=CNT+1
- DO OTH
- +3 QUIT
- OTH SET OTHER=$PIECE(^SRF(SRTN,13,OTH,0),"^")
- +1 DO LINE(1)
- SET @SRG@(SRI)="Other: "_OTHER
- +2 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