- SROAPRE ;BIR/MAM - PREOPERATIVE INFO ;10/04/10
- ;;3.0;Surgery;**38,47,55,88,100,125,142,166,174,182,184**;24 Jun 93;Build 35
- I '$D(SRTN) W !!,"A Surgery Risk Assessment must be selected prior to using this option.",!!,"Press <RET> to continue " R X:DTIME G END
- S (SRSOUT,SRACLR)=0,SRSUPCPT=1 D ^SROAUTL,DUP^SROAUTL G:SRSOUT END
- START D:SRACLR RET G:SRSOUT END S SRACLR=0 K SRA,SRAO D ^SROAPS1
- ASK W !,"Select Preoperative Information to Edit: " R X:DTIME I '$T!(X["^") D CONCC G END
- S:X="" X="+1" 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'?.N1":".N),(X'="A"),(X'="N"),(X'="+1") D HELP G:SRSOUT END G START
- I X="+1" D CONCC,^SROAPR2 G START
- I X="A" S X="1:6"
- I X?.N1":".N S Y=$E(X),Z=$P(X,":",2) I Y<1!(Z>6)!(Y>Z) D HELP G:SRSOUT END G START
- I X="N" D G:SRSOUT END 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^SROAPRE1
- S SRPAGE="" D HDR^SROAUTL
- I X?.N1":".N D RANGE G START
- I $D(SRAO(X)),+X=X S EMILY=X D G START
- .I $$LOCK^SROUTL(SRTN) W ! D:EMILY<4 ^SROAPRE1 D:EMILY>3 ^SROAPR1A D UNLOCK^SROUTL(SRTN)
- I $D(SRAO(X)),$$LOCK^SROUTL(SRTN) D D UNLOCK^SROUTL(SRTN)
- .S SRX=X I $P(SRAO(X),"^",2)=485 D ^SROACL2 S SRAO(SRX)=Y K DR,DIE S DA=SRTN,DR="485///"_$P(SRAO(SRX),"^"),DIE=130 D ^DIE K DR Q
- .S SRX=X W ! K DR,DIE S DA=SRTN,DR=$P(SRAO(X),"^",2)_"T",DIE=130 D ^DIE K DR
- .I $P(SRAO(SRX),"^",2)=237.1 D F667
- G START
- END I '$D(SREQST) W @IOF D ^SRSKILL
- 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-6) to update the information in that group. (For",!," example, enter '5' to update all cardiac information)"
- W !!,"4. Enter a number/letter combination to update a specific occurrence. (To ",!," update Current Pneumonia, enter '2C'.)"
- W !!,"5. Enter a range of numbers (1-6) separated by a ':' to enter a range of",!," occurrences. (For example, enter '2:4' to enter all pulmonary,",!," hepatobiliary, and gastrointestinal information)"
- W !!,"6. Press <RET> to continue to page 2 of this option."
- 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)
- .S SHEMP=$P(X,":"),CURLEY=$P(X,":",2) W:SHEMP<9 ! F EMILY=SHEMP:1:CURLEY Q:SRSOUT D:EMILY<4 ^SROAPRE1 D:EMILY>3 ^SROAPR1A
- Q
- RET Q:SRSOUT W !!,"Press <RET> to continue, or '^' to quit " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q
- Q
- CONCC ; check for concurrent case and update if one exists
- S SRCON=$P($G(^SRF(SRTN,"CON")),"^") Q:'SRCON
- Q:$P($G(^SRF(SRCON,"RA")),"^",2)="C"
- S SRI="" F S SRI=$O(SRAO(SRI)) Q:SRI="" S SRZ=$P(SRAO(SRI),"^",2) K DA,DIC,DIQ,DR,SRY D
- .S DA=SRTN,DR=SRZ,DIC="^SRF(",DIQ="SRY",DIQ(0)="I" D EN^DIQ1 S SRX=SRY(130,SRTN,SRZ,"I") S:SRX="" SRX="@"
- .I $$LOCK^SROUTL(SRTN) K DA,DIE,DR S DA=SRCON,DIE=130,DR=SRZ_"////"_SRX D ^DIE K DR D UNLOCK^SROUTL(SRTN)
- Q
- F667 ; editing the Sleep Apnea-Compliance field
- I $P(^SRF(SRTN,200.1),"^",8)'=3 S $P(^SRF(SRTN,200.1),"^",15)="" Q
- S SRX="1K" W ! K DR,DIE S DA=SRTN,DR=$P(SRAO(SRX),"^",2)_"T",DIE=130 D ^DIE K DR,DIE
- Q
- CHK667 ;check entries of the Sleep Apnea-Compliance field based on the value of the Preop Sleep Apnea field.
- S SRTN=$S($G(SRTN):SRTN,1:DA)
- I $P(^SRF(SRTN,200.1),"^",8)'=3 D K X Q
- .W !!,"Warning: Sleep Apnea-Compliance field can ONLY be edited if the value of the"
- .W !,?9,"'Preop Sleep Apnea' field is set to '3-LEVEL 3'."
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROAPRE 3880 printed Feb 19, 2025@00:08:07 Page 2
- SROAPRE ;BIR/MAM - PREOPERATIVE INFO ;10/04/10
- +1 ;;3.0;Surgery;**38,47,55,88,100,125,142,166,174,182,184**;24 Jun 93;Build 35
- +2 IF '$DATA(SRTN)
- WRITE !!,"A Surgery Risk Assessment must be selected prior to using this option.",!!,"Press <RET> to continue "
- READ X:DTIME
- GOTO END
- +3 SET (SRSOUT,SRACLR)=0
- SET SRSUPCPT=1
- DO ^SROAUTL
- DO DUP^SROAUTL
- if SRSOUT
- GOTO END
- START if SRACLR
- DO RET
- if SRSOUT
- GOTO END
- SET SRACLR=0
- KILL SRA,SRAO
- DO ^SROAPS1
- ASK WRITE !,"Select Preoperative Information to Edit: "
- READ X:DTIME
- IF '$TEST!(X["^")
- DO CONCC
- GOTO END
- +1 if X=""
- SET X="+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'?.N1":".N)
- IF (X'="A")
- IF (X'="N")
- IF (X'="+1")
- DO HELP
- if SRSOUT
- GOTO END
- GOTO START
- +4 IF X="+1"
- DO CONCC
- DO ^SROAPR2
- GOTO START
- +5 IF X="A"
- SET X="1:6"
- +6 IF X?.N1":".N
- SET Y=$EXTRACT(X)
- SET Z=$PIECE(X,":",2)
- IF Y<1!(Z>6)!(Y>Z)
- DO HELP
- if SRSOUT
- GOTO END
- GOTO START
- +7 IF X="N"
- Begin DoDot:1
- +8 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"
- +9 DO ^DIR
- IF $DATA(DTOUT)!$DATA(DUOUT)
- SET SRSOUT=1
- QUIT
- +10 IF Y
- DO NO2ALL^SROAPRE1
- End DoDot:1
- if SRSOUT
- GOTO END
- GOTO START
- +11 SET SRPAGE=""
- DO HDR^SROAUTL
- +12 IF X?.N1":".N
- DO RANGE
- GOTO START
- +13 IF $DATA(SRAO(X))
- IF +X=X
- SET EMILY=X
- Begin DoDot:1
- +14 IF $$LOCK^SROUTL(SRTN)
- WRITE !
- if EMILY<4
- DO ^SROAPRE1
- if EMILY>3
- DO ^SROAPR1A
- DO UNLOCK^SROUTL(SRTN)
- End DoDot:1
- GOTO START
- +15 IF $DATA(SRAO(X))
- IF $$LOCK^SROUTL(SRTN)
- Begin DoDot:1
- +16 SET SRX=X
- IF $PIECE(SRAO(X),"^",2)=485
- DO ^SROACL2
- SET SRAO(SRX)=Y
- KILL DR,DIE
- SET DA=SRTN
- SET DR="485///"_$PIECE(SRAO(SRX),"^")
- SET DIE=130
- DO ^DIE
- KILL DR
- QUIT
- +17 SET SRX=X
- WRITE !
- KILL DR,DIE
- SET DA=SRTN
- SET DR=$PIECE(SRAO(X),"^",2)_"T"
- SET DIE=130
- DO ^DIE
- KILL DR
- +18 IF $PIECE(SRAO(SRX),"^",2)=237.1
- DO F667
- End DoDot:1
- DO UNLOCK^SROUTL(SRTN)
- +19 GOTO START
- END IF '$DATA(SREQST)
- WRITE @IOF
- DO ^SRSKILL
- +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-6) to update the information in that group. (For",!," example, enter '5' to update all cardiac information)"
- +3 WRITE !!,"4. Enter a number/letter combination to update a specific occurrence. (To ",!," update Current Pneumonia, enter '2C'.)"
- +4 WRITE !!,"5. Enter a range of numbers (1-6) separated by a ':' to enter a range of",!," occurrences. (For example, enter '2:4' to enter all pulmonary,",!," hepatobiliary, and gastrointestinal information)"
- +5 WRITE !!,"6. Press <RET> to continue to page 2 of this option."
- +6 WRITE !!,"Press <RET> to continue, or '^' to quit "
- READ X:DTIME
- IF '$TEST!(X["^")
- SET SRSOUT=1
- +7 QUIT
- RANGE ; range of numbers
- +1 IF $$LOCK^SROUTL(SRTN)
- Begin DoDot:1
- +2 SET SHEMP=$PIECE(X,":")
- SET CURLEY=$PIECE(X,":",2)
- if SHEMP<9
- WRITE !
- FOR EMILY=SHEMP:1:CURLEY
- if SRSOUT
- QUIT
- if EMILY<4
- DO ^SROAPRE1
- if EMILY>3
- DO ^SROAPR1A
- 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
- CONCC ; check for concurrent case and update if one exists
- +1 SET SRCON=$PIECE($GET(^SRF(SRTN,"CON")),"^")
- if 'SRCON
- QUIT
- +2 if $PIECE($GET(^SRF(SRCON,"RA")),"^",2)="C"
- QUIT
- +3 SET SRI=""
- FOR
- SET SRI=$ORDER(SRAO(SRI))
- if SRI=""
- QUIT
- SET SRZ=$PIECE(SRAO(SRI),"^",2)
- KILL DA,DIC,DIQ,DR,SRY
- Begin DoDot:1
- +4 SET DA=SRTN
- SET DR=SRZ
- SET DIC="^SRF("
- SET DIQ="SRY"
- SET DIQ(0)="I"
- DO EN^DIQ1
- SET SRX=SRY(130,SRTN,SRZ,"I")
- if SRX=""
- SET SRX="@"
- +5 IF $$LOCK^SROUTL(SRTN)
- KILL DA,DIE,DR
- SET DA=SRCON
- SET DIE=130
- SET DR=SRZ_"////"_SRX
- DO ^DIE
- KILL DR
- DO UNLOCK^SROUTL(SRTN)
- End DoDot:1
- +6 QUIT
- F667 ; editing the Sleep Apnea-Compliance field
- +1 IF $PIECE(^SRF(SRTN,200.1),"^",8)'=3
- SET $PIECE(^SRF(SRTN,200.1),"^",15)=""
- QUIT
- +2 SET SRX="1K"
- WRITE !
- KILL DR,DIE
- SET DA=SRTN
- SET DR=$PIECE(SRAO(SRX),"^",2)_"T"
- SET DIE=130
- DO ^DIE
- KILL DR,DIE
- +3 QUIT
- CHK667 ;check entries of the Sleep Apnea-Compliance field based on the value of the Preop Sleep Apnea field.
- +1 SET SRTN=$SELECT($GET(SRTN):SRTN,1:DA)
- +2 IF $PIECE(^SRF(SRTN,200.1),"^",8)'=3
- Begin DoDot:1
- +3 WRITE !!,"Warning: Sleep Apnea-Compliance field can ONLY be edited if the value of the"
- +4 WRITE !,?9,"'Preop Sleep Apnea' field is set to '3-LEVEL 3'."
- End DoDot:1
- KILL X
- QUIT
- +5 QUIT