- SROPRIN ;B'HAM ISC/MAM - PRINCIPAL ANESTHESIA TECHNIQUE; 5 Jan 1989 8:31 AM
- ;;3.0; Surgery ;**22,26,32,38**;24 Jun 93
- PRIN I $P(^SRF(SRTN,6,SRT,0),"^",3)="Y" S SRTECH=$P(^SRF(SRTN,6,SRT,0),"^"),SRZ=1 Q
- I SRT=$O(^SRF(SRTN,6,0)),'$O(^SRF(SRTN,6,SRT)) S SRTECH=$P(^SRF(SRTN,6,SRT,0),"^"),SRZ=1
- Q
- CHECK ; check for already existing Principal Technique
- Q:$E(X)="N"
- S (SRPT,SRT)=0 F S SRT=$O(^SRF(DA(1),6,SRT)) Q:'SRT!SRPT I SRT'=DA,$P(^(SRT,0),"^",3)="Y" W *7,!!,"An anesthesia technique has already been selected as 'PRINCIPAL' technique.",! S SRPT=1 K X
- K SRPT,SRT
- Q
- TECH ; entry from reports to get principal technique
- K SRTECH,SRZ S SRT=0 F S SRT=$O(^SRF(SRTN,6,SRT)) Q:'SRT D PRIN Q:$D(SRZ)
- I $D(SRTECH) D ANES
- I '$D(SRTECH) S SRTECH="NOT ENTERED"
- Q
- ANES ; anesthesia technique
- N C
- S Y=SRTECH,C=$P(^DD(130.06,.01,0),"^",2) D Y^DIQ S SRTECH=Y
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROPRIN 882 printed Jan 18, 2025@03:46:25 Page 2
- SROPRIN ;B'HAM ISC/MAM - PRINCIPAL ANESTHESIA TECHNIQUE; 5 Jan 1989 8:31 AM
- +1 ;;3.0; Surgery ;**22,26,32,38**;24 Jun 93
- PRIN IF $PIECE(^SRF(SRTN,6,SRT,0),"^",3)="Y"
- SET SRTECH=$PIECE(^SRF(SRTN,6,SRT,0),"^")
- SET SRZ=1
- QUIT
- +1 IF SRT=$ORDER(^SRF(SRTN,6,0))
- IF '$ORDER(^SRF(SRTN,6,SRT))
- SET SRTECH=$PIECE(^SRF(SRTN,6,SRT,0),"^")
- SET SRZ=1
- +2 QUIT
- CHECK ; check for already existing Principal Technique
- +1 if $EXTRACT(X)="N"
- QUIT
- +2 SET (SRPT,SRT)=0
- FOR
- SET SRT=$ORDER(^SRF(DA(1),6,SRT))
- if 'SRT!SRPT
- QUIT
- IF SRT'=DA
- IF $PIECE(^(SRT,0),"^",3)="Y"
- WRITE *7,!!,"An anesthesia technique has already been selected as 'PRINCIPAL' technique.",!
- SET SRPT=1
- KILL X
- +3 KILL SRPT,SRT
- +4 QUIT
- TECH ; entry from reports to get principal technique
- +1 KILL SRTECH,SRZ
- SET SRT=0
- FOR
- SET SRT=$ORDER(^SRF(SRTN,6,SRT))
- if 'SRT
- QUIT
- DO PRIN
- if $DATA(SRZ)
- QUIT
- +2 IF $DATA(SRTECH)
- DO ANES
- +3 IF '$DATA(SRTECH)
- SET SRTECH="NOT ENTERED"
- +4 QUIT
- ANES ; anesthesia technique
- +1 NEW C
- +2 SET Y=SRTECH
- SET C=$PIECE(^DD(130.06,.01,0),"^",2)
- DO Y^DIQ
- SET SRTECH=Y
- +3 QUIT