SROAPR2 ;BIR/MAM - PAGE 2 PREOP SCREEN ;01/19/06
;;3.0; Surgery ;**38,100,125,142,153**;24 Jun 93;Build 11
K SRA,SRAO
START Q:SRSOUT D:SRACLR RET S SRACLR=0 K SRA,SRAO D ^SROAPS2
ASK W !!,"Select Preoperative Information to Edit: " R X:DTIME I '$T!("^"[X) D CONCC^SROAPRE S SRSOUT=1 Q
S:X="a" X="A" S:X="n" X="N"
I $L(X)=2,'$D(SRAO(X)),X?1N1A S Z=$E(X,2),Z=$TR(Z,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") I $D(SRAO($E(X)_Z)) S X=$E(X)_Z
I '$D(SRAO(X)),(X'?1N1":"1N),(X'="A"),(X'="N") D HELP Q:SRSOUT G START
I X="A" S X="1:3"
I X?1N1":"1N S Y=$E(X),Z=$P(X,":",2) I Y<1!(Z>3)!(Y>Z) D HELP Q:SRSOUT G START
I X="N" D G START
.W ! K DIR S DIR(0)="Y",DIR("B")="NO",DIR("A")="Are you sure you want to set all fields on this page to NO"
.D ^DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q
.I Y D NO2ALL^SROAPRE2
S SRPAGE="" D HDR^SROAUTL
I X?1N1":"1N D RANGE G START
I $D(SRAO(X)),+X=X S EMILY=X D G START
.I $$LOCK^SROUTL(SRTN) D ^SROAPRE2,UNLOCK^SROUTL(SRTN)
I $D(SRAO(X)) D G START
.I $$LOCK^SROUTL(SRTN) W !! S DA=SRTN,DIE=130,DR=$P(SRAO(X),"^",2)_"T" D ^DIE K DA,DIE,DR D UNLOCK^SROUTL(SRTN)
S SRSOUT=1 Q
HELP W @IOF,!!!!,"Enter the number, number/letter combination, or range of numbers you want to",!,"edit. Examples of proper responses are listed below."
W !!,"1. Enter 'A' to update all information.",!!,"2. Enter 'N' to set all fields on this page to NO."
W !!,"3. Enter a number (1-3) to update the information in that group. (For",!," example, enter '2' to update all Central Nervous System information)"
W !!,"4. Enter a number/letter combination to update a specific occurrence. (To ",!," update Impaired Sensorium, enter '2A')"
W !!,"5. Enter a range of numbers (2-3) separated by a ':' to enter all",!," Central Nervous System and Nutritional/Immune/Other information."
W !!,"Press <RET> to continue, or '^' to quit " R X:DTIME I '$T!(X["^") S SRSOUT=1
Q
RANGE ; range of numbers
I $$LOCK^SROUTL(SRTN) D D UNLOCK^SROUTL(SRTN)
.F EMILY=1,2,3 D ^SROAPRE2 Q:SRSOUT
Q
RET Q:SRSOUT W !!,"Press <RET> to continue, or '^' to quit " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROAPR2 2162 printed Sep 23, 2025@20:18:02 Page 2
SROAPR2 ;BIR/MAM - PAGE 2 PREOP SCREEN ;01/19/06
+1 ;;3.0; Surgery ;**38,100,125,142,153**;24 Jun 93;Build 11
+2 KILL SRA,SRAO
START if SRSOUT
QUIT
if SRACLR
DO RET
SET SRACLR=0
KILL SRA,SRAO
DO ^SROAPS2
ASK WRITE !!,"Select Preoperative Information to Edit: "
READ X:DTIME
IF '$TEST!("^"[X)
DO CONCC^SROAPRE
SET SRSOUT=1
QUIT
+1 if X="a"
SET X="A"
if X="n"
SET X="N"
+2 IF $LENGTH(X)=2
IF '$DATA(SRAO(X))
IF X?1N1A
SET Z=$EXTRACT(X,2)
SET Z=$TRANSLATE(Z,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
IF $DATA(SRAO($EXTRACT(X)_Z))
SET X=$EXTRACT(X)_Z
+3 IF '$DATA(SRAO(X))
IF (X'?1N1":"1N)
IF (X'="A")
IF (X'="N")
DO HELP
if SRSOUT
QUIT
GOTO START
+4 IF X="A"
SET X="1:3"
+5 IF X?1N1":"1N
SET Y=$EXTRACT(X)
SET Z=$PIECE(X,":",2)
IF Y<1!(Z>3)!(Y>Z)
DO HELP
if SRSOUT
QUIT
GOTO START
+6 IF X="N"
Begin DoDot:1
+7 WRITE !
KILL DIR
SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("A")="Are you sure you want to set all fields on this page to NO"
+8 DO ^DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRSOUT=1
QUIT
+9 IF Y
DO NO2ALL^SROAPRE2
End DoDot:1
GOTO START
+10 SET SRPAGE=""
DO HDR^SROAUTL
+11 IF X?1N1":"1N
DO RANGE
GOTO START
+12 IF $DATA(SRAO(X))
IF +X=X
SET EMILY=X
Begin DoDot:1
+13 IF $$LOCK^SROUTL(SRTN)
DO ^SROAPRE2
DO UNLOCK^SROUTL(SRTN)
End DoDot:1
GOTO START
+14 IF $DATA(SRAO(X))
Begin DoDot:1
+15 IF $$LOCK^SROUTL(SRTN)
WRITE !!
SET DA=SRTN
SET DIE=130
SET DR=$PIECE(SRAO(X),"^",2)_"T"
DO ^DIE
KILL DA,DIE,DR
DO UNLOCK^SROUTL(SRTN)
End DoDot:1
GOTO START
+16 SET SRSOUT=1
QUIT
HELP WRITE @IOF,!!!!,"Enter the number, number/letter combination, or range of numbers you want to",!,"edit. Examples of proper responses are listed below."
+1 WRITE !!,"1. Enter 'A' to update all information.",!!,"2. Enter 'N' to set all fields on this page to NO."
+2 WRITE !!,"3. Enter a number (1-3) to update the information in that group. (For",!," example, enter '2' to update all Central Nervous System information)"
+3 WRITE !!,"4. Enter a number/letter combination to update a specific occurrence. (To ",!," update Impaired Sensorium, enter '2A')"
+4 WRITE !!,"5. Enter a range of numbers (2-3) separated by a ':' to enter all",!," Central Nervous System and Nutritional/Immune/Other information."
+5 WRITE !!,"Press <RET> to continue, or '^' to quit "
READ X:DTIME
IF '$TEST!(X["^")
SET SRSOUT=1
+6 QUIT
RANGE ; range of numbers
+1 IF $$LOCK^SROUTL(SRTN)
Begin DoDot:1
+2 FOR EMILY=1,2,3
DO ^SROAPRE2
if SRSOUT
QUIT
End DoDot:1
DO UNLOCK^SROUTL(SRTN)
+3 QUIT
RET if SRSOUT
QUIT
WRITE !!,"Press <RET> to continue, or '^' to quit "
READ X:DTIME
IF '$TEST!(X["^")
SET SRSOUT=1
QUIT
+1 QUIT
