- 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 Mar 13, 2025@21:46:51 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
