SROAPR1A ;B'HAM ISC/MAM - EDIT PREOP INFO ; [ 03/16/04 2:44 PM ]
;;3.0;Surgery;**38,125,182,184**;24 Jun 93;Build 35
K DA D @EMILY Q
4 ; edit gastrointestinal information
W ! K DIR S X=$P(SRAO(4),"^") I X'="" S DIR("B")=X
S DIR(0)="130,486",DIR("A")="GASTROINTESTINAL" D ^DIR K DIR I $D(DUOUT) S SRSOUT=1 Q
I X="@" S SRCAT="Gastrointestinal" D SURE Q:SRSOUT G:'SRYN 4 S (SRAX,X)="",$P(^SRF(SRTN,200.1),"^")="" D NOGAST Q
S SRAX=Y,$P(^SRF(SRTN,200.1),"^")=SRAX I Y["N" D NOGAST Q
I Y["Y" D GAST
Q
5 ; edit cardiac information
W ! K DIR S X=$P(SRAO(5),"^") I X'="" S DIR("B")=X
S DIR(0)="130,242",DIR("A")="CARDIAC" D ^DIR K DIR I $D(DUOUT) S SRSOUT=1 Q
I X="@" S SRCAT="Cardiac" D SURE Q:SRSOUT G:'SRYN 5 S (SRAX,X)="",$P(^SRF(SRTN,200),"^",30)="" D NOCARD Q
S SRAX=Y,$P(^SRF(SRTN,200),"^",30)=SRAX I Y["N" D NOCARD Q
I Y["Y" D CARD
Q
6 ; edit vascular information
W ! K DIR S X=$P(SRAO(6),"^") I X'="" S DIR("B")=X
S DIR(0)="130,206",DIR("A")="VASCULAR" D ^DIR K DIR I $D(DUOUT) S SRSOUT=1 Q
I X="@" S SRCAT="Vascular" D SURE Q:SRSOUT G:'SRYN 6 S $P(^SRF(SRTN,200),"^",40)="" S (SRAX,X)="" D NOVAS Q
S SRAX=Y,$P(^SRF(SRTN,200),"^",40)=SRAX I Y["N" D NOVAS Q
I Y["Y" D VAS
Q
GAST ; gastointectinal
K DIE S DA=SRTN,DIE=130,DR="213////Y" D ^DIE K DR
S SRACLR=0
Q
NOGAST ; no gastointectinal problems
S $P(^SRF(SRTN,200),"^",16)=SRAX
Q
CARD ; cardiac
W ! K DR,DIE S DA=SRTN,DIE=130,DR="423T;205T;640T" D ^DIE K DR
S X="5D" D ^SROACL2 S SRYY=Y D
.K DR,DIE S DA=SRTN,DR="485///"_$P(SRYY,"^"),DIE=130 D ^DIE K DR
W ! K DR,DIE S DA=SRTN,DIE=130,DR="267T;643T;641T" D ^DIE K DR
S SRACLR=0
Q
NOCARD ; no cardiac problems
F I=32,36 S $P(^SRF(SRTN,200),"^",I)=SRAX
S $P(^SRF(SRTN,207),"^",29)=0,$P(^SRF(SRTN,206),"^",18)="N"
S $P(^SRF(SRTN,206),"^",42)=0
S $P(^SRF(SRTN,206),"^",14)=0
S $P(^SRF(SRTN,200),"^",56)=1,$P(^SRF(SRTN,200),"^",57)=1
S $P(^SRF(SRTN,200),"^",59)=1
Q
VAS ; vascular
W ! K DR,DIE S DA=SRTN,DIE=130,DR="265T;330T" D ^DIE K DR
S SRACLR=0
Q
NOVAS ; no vascular problems
S $P(^SRF(SRTN,200),"^",42)=SRAX
S $P(^SRF(SRTN,206),"^",16)=1
Q
RET W !! K DIR S DIR(0)="E" D ^DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1
Q
SURE W ! K DIR S DIR("A")=" Sure you want to delete all "_SRCAT_" information ? ",DIR("B")="NO",DIR(0)="YA" D ^DIR K DIR S SRYN=Y I $D(DTOUT)!$D(DUOUT) S SRSOUT=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROAPR1A 2389 printed Dec 13, 2024@02:41:35 Page 2
SROAPR1A ;B'HAM ISC/MAM - EDIT PREOP INFO ; [ 03/16/04 2:44 PM ]
+1 ;;3.0;Surgery;**38,125,182,184**;24 Jun 93;Build 35
+2 KILL DA
DO @EMILY
QUIT
4 ; edit gastrointestinal information
+1 WRITE !
KILL DIR
SET X=$PIECE(SRAO(4),"^")
IF X'=""
SET DIR("B")=X
+2 SET DIR(0)="130,486"
SET DIR("A")="GASTROINTESTINAL"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET SRSOUT=1
QUIT
+3 IF X="@"
SET SRCAT="Gastrointestinal"
DO SURE
if SRSOUT
QUIT
if 'SRYN
GOTO 4
SET (SRAX,X)=""
SET $PIECE(^SRF(SRTN,200.1),"^")=""
DO NOGAST
QUIT
+4 SET SRAX=Y
SET $PIECE(^SRF(SRTN,200.1),"^")=SRAX
IF Y["N"
DO NOGAST
QUIT
+5 IF Y["Y"
DO GAST
+6 QUIT
5 ; edit cardiac information
+1 WRITE !
KILL DIR
SET X=$PIECE(SRAO(5),"^")
IF X'=""
SET DIR("B")=X
+2 SET DIR(0)="130,242"
SET DIR("A")="CARDIAC"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET SRSOUT=1
QUIT
+3 IF X="@"
SET SRCAT="Cardiac"
DO SURE
if SRSOUT
QUIT
if 'SRYN
GOTO 5
SET (SRAX,X)=""
SET $PIECE(^SRF(SRTN,200),"^",30)=""
DO NOCARD
QUIT
+4 SET SRAX=Y
SET $PIECE(^SRF(SRTN,200),"^",30)=SRAX
IF Y["N"
DO NOCARD
QUIT
+5 IF Y["Y"
DO CARD
+6 QUIT
6 ; edit vascular information
+1 WRITE !
KILL DIR
SET X=$PIECE(SRAO(6),"^")
IF X'=""
SET DIR("B")=X
+2 SET DIR(0)="130,206"
SET DIR("A")="VASCULAR"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET SRSOUT=1
QUIT
+3 IF X="@"
SET SRCAT="Vascular"
DO SURE
if SRSOUT
QUIT
if 'SRYN
GOTO 6
SET $PIECE(^SRF(SRTN,200),"^",40)=""
SET (SRAX,X)=""
DO NOVAS
QUIT
+4 SET SRAX=Y
SET $PIECE(^SRF(SRTN,200),"^",40)=SRAX
IF Y["N"
DO NOVAS
QUIT
+5 IF Y["Y"
DO VAS
+6 QUIT
GAST ; gastointectinal
+1 KILL DIE
SET DA=SRTN
SET DIE=130
SET DR="213////Y"
DO ^DIE
KILL DR
+2 SET SRACLR=0
+3 QUIT
NOGAST ; no gastointectinal problems
+1 SET $PIECE(^SRF(SRTN,200),"^",16)=SRAX
+2 QUIT
CARD ; cardiac
+1 WRITE !
KILL DR,DIE
SET DA=SRTN
SET DIE=130
SET DR="423T;205T;640T"
DO ^DIE
KILL DR
+2 SET X="5D"
DO ^SROACL2
SET SRYY=Y
Begin DoDot:1
+3 KILL DR,DIE
SET DA=SRTN
SET DR="485///"_$PIECE(SRYY,"^")
SET DIE=130
DO ^DIE
KILL DR
End DoDot:1
+4 WRITE !
KILL DR,DIE
SET DA=SRTN
SET DIE=130
SET DR="267T;643T;641T"
DO ^DIE
KILL DR
+5 SET SRACLR=0
+6 QUIT
NOCARD ; no cardiac problems
+1 FOR I=32,36
SET $PIECE(^SRF(SRTN,200),"^",I)=SRAX
+2 SET $PIECE(^SRF(SRTN,207),"^",29)=0
SET $PIECE(^SRF(SRTN,206),"^",18)="N"
+3 SET $PIECE(^SRF(SRTN,206),"^",42)=0
+4 SET $PIECE(^SRF(SRTN,206),"^",14)=0
+5 SET $PIECE(^SRF(SRTN,200),"^",56)=1
SET $PIECE(^SRF(SRTN,200),"^",57)=1
+6 SET $PIECE(^SRF(SRTN,200),"^",59)=1
+7 QUIT
VAS ; vascular
+1 WRITE !
KILL DR,DIE
SET DA=SRTN
SET DIE=130
SET DR="265T;330T"
DO ^DIE
KILL DR
+2 SET SRACLR=0
+3 QUIT
NOVAS ; no vascular problems
+1 SET $PIECE(^SRF(SRTN,200),"^",42)=SRAX
+2 SET $PIECE(^SRF(SRTN,206),"^",16)=1
+3 QUIT
RET WRITE !!
KILL DIR
SET DIR(0)="E"
DO ^DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRSOUT=1
+1 QUIT
SURE WRITE !
KILL DIR
SET DIR("A")=" Sure you want to delete all "_SRCAT_" information ? "
SET DIR("B")="NO"
SET DIR(0)="YA"
DO ^DIR
KILL DIR
SET SRYN=Y
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRSOUT=1
+1 QUIT
