SROAPRE2 ;BIR/MAM - EDIT PAGE 2 PREOP ;07/18/2011
;;3.0;Surgery;**38,47,125,153,166,176,182,184,193**;24 Jun 93;Build 2
D @EMILY Q
1 ; edit renal information
W ! K DIR S X=$P(SRAO(1),"^") I X'="" S DIR("B")=X
S DIR(0)="130,243",DIR("A")="RENAL" D ^DIR K DIR I $D(DUOUT) S SRSOUT=1 Q
I X="@" S SRCAT="Renal" D SURE Q:SRSOUT G:'SRYN 1 S $P(^SRF(SRTN,200),"^",37)="" S (SRAX,X)="" D NOREN Q
S SRAX=Y,$P(^SRF(SRTN,200),"^",37)=SRAX I Y["N" D NOREN Q
I Y["Y" D REN
Q
2 ; edit CNS information
W ! K DIR S X=$P(SRAO(2),"^") I X'="" S DIR("B")=X
S DIR(0)="130,210",DIR("A")="CENTRAL NERVOUS SYSTEM" D ^DIR K DIR I $D(DUOUT) S SRSOUT=1 Q
I X="@" S SRCAT="Central Nervous System" D SURE Q:SRSOUT G:'SRYN 2 S $P(^SRF(SRTN,200),"^",18)="",(SRAX,X)="" D NOCNS Q
S SRAX=Y,$P(^SRF(SRTN,200),"^",18)=SRAX I Y["N" D NOCNS Q
I Y["Y" D CNS
Q
3 ; edit nutritional/immune/other info
W ! K DIR S X=$P(SRAO(3),"^") I X'="" S DIR("B")=X
S DIR(0)="130,245",DIR("A")="NUTRITIONAL/IMMUNE/OTHER" D ^DIR K DIR I $D(DUOUT) S SRSOUT=1 Q
I X="@" S SRCAT="Nutritional/Immune/Other" D SURE Q:SRSOUT G:'SRYN 3 S $P(^SRF(SRTN,200),"^",44)="" S (SRAX,X)="" D NONUT Q
S SRAX=Y,$P(^SRF(SRTN,200),"^",44)=SRAX I Y["N" D NONUT Q
I Y["Y" D NUT
Q
REN ; renal
W ! K DR,DIE S DA=SRTN,DIE=130,DR="328T;211T" D ^DIE K DR
S SRACLR=0
Q
NOREN ; no renal problems
F I=38,39 S $P(^SRF(SRTN,200),"^",I)=SRAX
Q
CNS ; cns
W ! K DR,DIE S DIE=130,DA=SRTN,DR="332T;333T;400T;521T;522T;401T;662T;" D ^DIE K DR,DIE
S SRACLR=0
Q
NOCNS ; no CNS problems
F I=19,21,24,29 S $P(^SRF(SRTN,200),"^",I)=SRAX
F I=13,14 S $P(^SRF(SRTN,200.1),"^",I)=$S(SRAX="N":0,SRAX="NS":0,1:SRAX) ;p193 added condition SRAX="NS" to $SELECT statement.
S $P(^SRF(SRTN,210),"^")=0
Q
NUT ; nutritional/immune/other
W ! K DR,DIE S DIE=130,DA=SRTN,DR="338T;218T;339T;215T;216T;642T;217T;338.3T;338.2T;218.1T;269T;673T;674T;677T" D ^DIE K DA,DIE,DR
S SRACLR=0
Q
NONUT ; no nutritional/immune/other
F I=45:1:50 S $P(^SRF(SRTN,200),"^",I)=SRAX
F I=3,4,8 S $P(^SRF(SRTN,206),"^",I)=SRAX
I SRAX="N" S $P(^SRF(SRTN,200.1),"^",3)=$S($P($G(VADM(5)),"^")="M":"NA",1:"NO"),$P(^SRF(SRTN,200),"^",58)="N"
S:SRAX="" $P(^SRF(SRTN,200.1),"^",3)=""
F I=8,9 S $P(^SRF(SRTN,210),"^",I)="N"
S $P(^SRF(SRTN,210),"^",12)=0,$P(^SRF(SRTN,204),"^",17)=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
DEL W !!,?10,"Deleting all "_SRCAT_" information... "
Q
NO2ALL ; set all fields to NO
S SRAX="N",$P(^SRF(SRTN,200),"^",37)=SRAX D NOREN
S $P(^SRF(SRTN,200),"^",18)=SRAX D NOCNS
S $P(^SRF(SRTN,200),"^",44)=SRAX D NONUT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROAPRE2 2815 printed Dec 13, 2024@02:41:39 Page 2
SROAPRE2 ;BIR/MAM - EDIT PAGE 2 PREOP ;07/18/2011
+1 ;;3.0;Surgery;**38,47,125,153,166,176,182,184,193**;24 Jun 93;Build 2
+2 DO @EMILY
QUIT
1 ; edit renal information
+1 WRITE !
KILL DIR
SET X=$PIECE(SRAO(1),"^")
IF X'=""
SET DIR("B")=X
+2 SET DIR(0)="130,243"
SET DIR("A")="RENAL"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET SRSOUT=1
QUIT
+3 IF X="@"
SET SRCAT="Renal"
DO SURE
if SRSOUT
QUIT
if 'SRYN
GOTO 1
SET $PIECE(^SRF(SRTN,200),"^",37)=""
SET (SRAX,X)=""
DO NOREN
QUIT
+4 SET SRAX=Y
SET $PIECE(^SRF(SRTN,200),"^",37)=SRAX
IF Y["N"
DO NOREN
QUIT
+5 IF Y["Y"
DO REN
+6 QUIT
2 ; edit CNS information
+1 WRITE !
KILL DIR
SET X=$PIECE(SRAO(2),"^")
IF X'=""
SET DIR("B")=X
+2 SET DIR(0)="130,210"
SET DIR("A")="CENTRAL NERVOUS SYSTEM"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET SRSOUT=1
QUIT
+3 IF X="@"
SET SRCAT="Central Nervous System"
DO SURE
if SRSOUT
QUIT
if 'SRYN
GOTO 2
SET $PIECE(^SRF(SRTN,200),"^",18)=""
SET (SRAX,X)=""
DO NOCNS
QUIT
+4 SET SRAX=Y
SET $PIECE(^SRF(SRTN,200),"^",18)=SRAX
IF Y["N"
DO NOCNS
QUIT
+5 IF Y["Y"
DO CNS
+6 QUIT
3 ; edit nutritional/immune/other info
+1 WRITE !
KILL DIR
SET X=$PIECE(SRAO(3),"^")
IF X'=""
SET DIR("B")=X
+2 SET DIR(0)="130,245"
SET DIR("A")="NUTRITIONAL/IMMUNE/OTHER"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET SRSOUT=1
QUIT
+3 IF X="@"
SET SRCAT="Nutritional/Immune/Other"
DO SURE
if SRSOUT
QUIT
if 'SRYN
GOTO 3
SET $PIECE(^SRF(SRTN,200),"^",44)=""
SET (SRAX,X)=""
DO NONUT
QUIT
+4 SET SRAX=Y
SET $PIECE(^SRF(SRTN,200),"^",44)=SRAX
IF Y["N"
DO NONUT
QUIT
+5 IF Y["Y"
DO NUT
+6 QUIT
REN ; renal
+1 WRITE !
KILL DR,DIE
SET DA=SRTN
SET DIE=130
SET DR="328T;211T"
DO ^DIE
KILL DR
+2 SET SRACLR=0
+3 QUIT
NOREN ; no renal problems
+1 FOR I=38,39
SET $PIECE(^SRF(SRTN,200),"^",I)=SRAX
+2 QUIT
CNS ; cns
+1 WRITE !
KILL DR,DIE
SET DIE=130
SET DA=SRTN
SET DR="332T;333T;400T;521T;522T;401T;662T;"
DO ^DIE
KILL DR,DIE
+2 SET SRACLR=0
+3 QUIT
NOCNS ; no CNS problems
+1 FOR I=19,21,24,29
SET $PIECE(^SRF(SRTN,200),"^",I)=SRAX
+2 ;p193 added condition SRAX="NS" to $SELECT statement.
FOR I=13,14
SET $PIECE(^SRF(SRTN,200.1),"^",I)=$SELECT(SRAX="N":0,SRAX="NS":0,1:SRAX)
+3 SET $PIECE(^SRF(SRTN,210),"^")=0
+4 QUIT
NUT ; nutritional/immune/other
+1 WRITE !
KILL DR,DIE
SET DIE=130
SET DA=SRTN
SET DR="338T;218T;339T;215T;216T;642T;217T;338.3T;338.2T;218.1T;269T;673T;674T;677T"
DO ^DIE
KILL DA,DIE,DR
+2 SET SRACLR=0
+3 QUIT
NONUT ; no nutritional/immune/other
+1 FOR I=45:1:50
SET $PIECE(^SRF(SRTN,200),"^",I)=SRAX
+2 FOR I=3,4,8
SET $PIECE(^SRF(SRTN,206),"^",I)=SRAX
+3 IF SRAX="N"
SET $PIECE(^SRF(SRTN,200.1),"^",3)=$SELECT($PIECE($GET(VADM(5)),"^")="M":"NA",1:"NO")
SET $PIECE(^SRF(SRTN,200),"^",58)="N"
+4 if SRAX=""
SET $PIECE(^SRF(SRTN,200.1),"^",3)=""
+5 FOR I=8,9
SET $PIECE(^SRF(SRTN,210),"^",I)="N"
+6 SET $PIECE(^SRF(SRTN,210),"^",12)=0
SET $PIECE(^SRF(SRTN,204),"^",17)=1
+7 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
DEL WRITE !!,?10,"Deleting all "_SRCAT_" information... "
+1 QUIT
NO2ALL ; set all fields to NO
+1 SET SRAX="N"
SET $PIECE(^SRF(SRTN,200),"^",37)=SRAX
DO NOREN
+2 SET $PIECE(^SRF(SRTN,200),"^",18)=SRAX
DO NOCNS
+3 SET $PIECE(^SRF(SRTN,200),"^",44)=SRAX
DO NONUT
+4 QUIT
