source: WorldVistAEHR/trunk/r/SURGERY-SR/SROAPR2.m@ 770

Last change on this file since 770 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.1 KB
Line 
1SROAPR2 ;BIR/MAM - PAGE 2 PREOP SCREEN ;01/19/06
2 ;;3.0; Surgery ;**38,100,125,142,153**;24 Jun 93;Build 11
3 K SRA,SRAO
4START Q:SRSOUT D:SRACLR RET S SRACLR=0 K SRA,SRAO D ^SROAPS2
5ASK W !!,"Select Preoperative Information to Edit: " R X:DTIME I '$T!("^"[X) D CONCC^SROAPRE S SRSOUT=1 Q
6 S:X="a" X="A" S:X="n" X="N"
7 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
8 I '$D(SRAO(X)),(X'?1N1":"1N),(X'="A"),(X'="N") D HELP Q:SRSOUT G START
9 I X="A" S X="1:3"
10 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
11 I X="N" D G START
12 .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"
13 .D ^DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q
14 .I Y D NO2ALL^SROAPRE2
15 S SRPAGE="" D HDR^SROAUTL
16 I X?1N1":"1N D RANGE G START
17 I $D(SRAO(X)),+X=X S EMILY=X D G START
18 .I $$LOCK^SROUTL(SRTN) D ^SROAPRE2,UNLOCK^SROUTL(SRTN)
19 I $D(SRAO(X)) D G START
20 .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)
21 S SRSOUT=1 Q
22HELP W @IOF,!!!!,"Enter the number, number/letter combination, or range of numbers you want to",!,"edit. Examples of proper responses are listed below."
23 W !!,"1. Enter 'A' to update all information.",!!,"2. Enter 'N' to set all fields on this page to NO."
24 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)"
25 W !!,"4. Enter a number/letter combination to update a specific occurrence. (To ",!," update Impaired Sensorium, enter '2A')"
26 W !!,"5. Enter a range of numbers (2-3) separated by a ':' to enter all",!," Central Nervous System and Nutritional/Immune/Other information."
27 W !!,"Press <RET> to continue, or '^' to quit " R X:DTIME I '$T!(X["^") S SRSOUT=1
28 Q
29RANGE ; range of numbers
30 I $$LOCK^SROUTL(SRTN) D D UNLOCK^SROUTL(SRTN)
31 .F EMILY=1,2,3 D ^SROAPRE2 Q:SRSOUT
32 Q
33RET Q:SRSOUT W !!,"Press <RET> to continue, or '^' to quit " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q
34 Q
Note: See TracBrowser for help on using the repository browser.