source: WorldVistAEHR/trunk/r/SURGERY-SR/SROAPR1A.m@ 1006

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

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1SROAPR1A ;B'HAM ISC/MAM - EDIT PREOP INFO ; [ 03/16/04 2:44 PM ]
2 ;;3.0; Surgery ;**38,125**;24 Jun 93
3 K DA D @EMILY Q
44 ; edit gastrointestinal information
5 W ! K DIR S X=$P(SRAO(4),"^") I X'="" S DIR("B")=X
6 S DIR(0)="130,486",DIR("A")="GASTROINTESTINAL" D ^DIR K DIR I $D(DUOUT) S SRSOUT=1 Q
7 I X="@" S SRCAT="Gastrointestinal" D SURE Q:SRSOUT G:'SRYN 4 S (SRAX,X)="",$P(^SRF(SRTN,200.1),"^")="" D NOGAST Q
8 S SRAX=Y,$P(^SRF(SRTN,200.1),"^")=SRAX I Y["N" D NOGAST Q
9 I Y["Y" D GAST
10 Q
115 ; edit cardiac information
12 W ! K DIR S X=$P(SRAO(5),"^") I X'="" S DIR("B")=X
13 S DIR(0)="130,242",DIR("A")="CARDIAC" D ^DIR K DIR I $D(DUOUT) S SRSOUT=1 Q
14 I X="@" S SRCAT="Cardiac" D SURE Q:SRSOUT G:'SRYN 5 S (SRAX,X)="",$P(^SRF(SRTN,200),"^",30)="" D NOCARD Q
15 S SRAX=Y,$P(^SRF(SRTN,200),"^",30)=SRAX I Y["N" D NOCARD Q
16 I Y["Y" D CARD
17 Q
186 ; edit vascular information
19 W ! K DIR S X=$P(SRAO(6),"^") I X'="" S DIR("B")=X
20 S DIR(0)="130,206",DIR("A")="VASCULAR" D ^DIR K DIR I $D(DUOUT) S SRSOUT=1 Q
21 I X="@" S SRCAT="Vascular" D SURE Q:SRSOUT G:'SRYN 6 S $P(^SRF(SRTN,200),"^",40)="" S (SRAX,X)="" D NOVAS Q
22 S SRAX=Y,$P(^SRF(SRTN,200),"^",40)=SRAX I Y["N" D NOVAS Q
23 I Y["Y" D VAS
24 Q
25GAST ; gastointectinal
26 K DIE S DA=SRTN,DIE=130,DR="213////Y" D ^DIE K DR
27 S SRACLR=0
28 Q
29NOGAST ; no gastointectinal problems
30 S $P(^SRF(SRTN,200),"^",16)=SRAX
31 Q
32CARD ; cardiac
33 W ! K DR,DIE S DA=SRTN,DIE=130,DR="396T;394T;220T;266T;395T;208T" D ^DIE K DR
34 S SRACLR=0
35 Q
36NOCARD ; no cardiac problems
37 F I=31:1:36 S $P(^SRF(SRTN,200),"^",I)=SRAX
38 Q
39VAS ; vascular
40 W ! K DR,DIE S DA=SRTN,DIE=130,DR="329T;330T" D ^DIE K DR
41 S SRACLR=0
42 Q
43NOVAS ; no vascular problems
44 F I=41,42 S $P(^SRF(SRTN,200),"^",I)=SRAX
45 Q
46RET W !! K DIR S DIR(0)="E" D ^DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1
47 Q
48SURE 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
49 Q
Note: See TracBrowser for help on using the repository browser.