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 Oct 16, 2024@18:45:53 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
