SROAPR1A ;B'HAM ISC/MAM - EDIT PREOP INFO ; [ 03/16/04 2:44 PM ]
;;3.0; Surgery ;**38,125**;24 Jun 93
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="396T;394T;220T;266T;395T;208T" D ^DIE K DR
S SRACLR=0
Q
NOCARD ; no cardiac problems
F I=31:1:36 S $P(^SRF(SRTN,200),"^",I)=SRAX
Q
VAS ; vascular
W ! K DR,DIE S DA=SRTN,DIE=130,DR="329T;330T" D ^DIE K DR
S SRACLR=0
Q
NOVAS ; no vascular problems
F I=41,42 S $P(^SRF(SRTN,200),"^",I)=SRAX
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
SROAPR1A ;B'HAM ISC/MAM - EDIT PREOP INFO ; [ 03/16/04 2:44 PM ]
+1 ;;3.0; Surgery ;**38,125**;24 Jun 93
+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="396T;394T;220T;266T;395T;208T"
DO ^DIE
KILL DR
+2 SET SRACLR=0
+3 QUIT
NOCARD ; no cardiac problems
+1 FOR I=31:1:36
SET $PIECE(^SRF(SRTN,200),"^",I)=SRAX
+2 QUIT
VAS ; vascular
+1 WRITE !
KILL DR,DIE
SET DA=SRTN
SET DIE=130
SET DR="329T;330T"
DO ^DIE
KILL DR
+2 SET SRACLR=0
+3 QUIT
NOVAS ; no vascular problems
+1 FOR I=41,42
SET $PIECE(^SRF(SRTN,200),"^",I)=SRAX
+2 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
