source: WorldVistAEHR/trunk/r/SURGERY-SR/SROAPRE2.m@ 1351

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

revised back to 6/30/08 version

File size: 2.4 KB
RevLine 
[623]1SROAPRE2 ;BIR/MAM - EDIT PAGE 2 PREOP ;06/27/06
2 ;;3.0; Surgery ;**38,47,125,153**;24 Jun 93;Build 11
3 D @EMILY Q
41 ; edit renal information
5 W ! K DIR S X=$P(SRAO(1),"^") I X'="" S DIR("B")=X
6 S DIR(0)="130,243",DIR("A")="RENAL" D ^DIR K DIR I $D(DUOUT) S SRSOUT=1 Q
7 I X="@" S SRCAT="Renal" D SURE Q:SRSOUT G:'SRYN 1 S $P(^SRF(SRTN,200),"^",37)="" S (SRAX,X)="" D NOREN Q
8 S SRAX=Y,$P(^SRF(SRTN,200),"^",37)=SRAX I Y["N" D NOREN Q
9 I Y["Y" D REN
10 Q
112 ; edit CNS information
12 W ! K DIR S X=$P(SRAO(2),"^") I X'="" S DIR("B")=X
13 S DIR(0)="130,210",DIR("A")="CENTRAL NERVOUS SYSTEM" D ^DIR K DIR I $D(DUOUT) S SRSOUT=1 Q
14 I X="@" S SRCAT="Central Nervous System" D SURE Q:SRSOUT G:'SRYN 2 S $P(^SRF(SRTN,200),"^",18)="" S (SRAX,X)="" D NOCNS Q
15 S SRAX=Y,$P(^SRF(SRTN,200),"^",18)=SRAX I Y["N" D NOCNS Q
16 I Y["Y" D CNS
17 Q
183 ; edit nutritional/immune/other info
19 W ! K DIR S X=$P(SRAO(3),"^") I X'="" S DIR("B")=X
20 S DIR(0)="130,245",DIR("A")="NUTRITIONAL/IMMUNE/OTHER" D ^DIR K DIR I $D(DUOUT) S SRSOUT=1 Q
21 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
22 S SRAX=Y,$P(^SRF(SRTN,200),"^",44)=SRAX I Y["N" D NONUT Q
23 I Y["Y" D NUT
24 Q
25REN ; renal
26 W ! K DR,DIE S DA=SRTN,DIE=130,DR="328T;211T" D ^DIE K DR
27 S SRACLR=0
28 Q
29NOREN ; no renal problems
30 F I=38,39 S $P(^SRF(SRTN,200),"^",I)=SRAX
31 Q
32CNS ; cns
33 W ! K DR,DIE S DIE=130,DA=SRTN,DR="332T;333T;400T;334T;335T;336T;401T;399T;398T;" D ^DIE K DR,DIE
34 S SRACLR=0
35 Q
36NOCNS ; no CNS problems
37 F I=19,21:1:27,29 S $P(^SRF(SRTN,200),"^",I)=SRAX
38 Q
39NUT ; nutritional/immune/other
40 W ! K DR,DIE S DIE=130,DA=SRTN,DR="338T;218T;339T;215T;216T;217T;338.1T;338.2T;218.1T;269T" D ^DIE K DA,DIE,DR
41 S SRACLR=0
42 Q
43NONUT ; no nutritional/immune/other
44 F I=45:1:50 S $P(^SRF(SRTN,200),"^",I)=SRAX
45 F I=3,4,8 S $P(^SRF(SRTN,206),"^",I)=SRAX
46 S:SRAX="N" $P(^SRF(SRTN,200.1),"^",3)=$S($P($G(VADM(5)),"^")="M":"NA",1:"NO")
47 S:SRAX="" $P(^SRF(SRTN,200.1),"^",3)=""
48 Q
49RET W !! K DIR S DIR(0)="E" D ^DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1
50 Q
51SURE 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
52 Q
53DEL W !!,?10,"Deleting all "_SRCAT_" information... "
54 Q
55NO2ALL ; set all fields to NO
56 S SRAX="N",$P(^SRF(SRTN,200),"^",37)=SRAX D NOREN
57 S $P(^SRF(SRTN,200),"^",18)=SRAX D NOCNS
58 S $P(^SRF(SRTN,200),"^",44)=SRAX D NONUT
59 Q
Note: See TracBrowser for help on using the repository browser.