- 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 Feb 19, 2025@00:08:05 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