SROPRIN.m

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

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