source: WorldVistAEHR/trunk/r/SURGERY-SR/SROAPRE1.m@ 691

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

revised back to 6/30/08 version

File size: 2.9 KB
Line 
1SROAPRE1 ;B'HAM ISC/MAM - EDIT PAGE 1 PREOP ;01/05/05
2 ;;3.0; Surgery ;**38,47,125,135,141**;24 Jun 93
3 K DA D @EMILY Q
41 ; edit general information
5 W ! K DIR S X=$P(SRAO(1),"^") I X'="" S DIR("B")=X
6 S DIR(0)="130,402",DIR("A")="GENERAL" D ^DIR K DIR I $D(DUOUT) S SRSOUT=1 Q
7 I X="@" S SRCAT="General" D SURE Q:SRSOUT G:'SRYN 1 S (SRAX,X)="",$P(^SRF(SRTN,200),"^")="" D NOGEN Q
8 S SRAX=Y,$P(^SRF(SRTN,200),"^")=SRAX I Y["N" D NOGEN Q
9 I Y["Y" D GEN
10 Q
112 ; edit pulmonary information
12 W ! K DIR S X=$P(SRAO(2),"^") I X'="" S DIR("B")=X
13 S DIR(0)="130,241",DIR("A")="PULMONARY" D ^DIR K DIR I $D(DUOUT) S SRSOUT=1 Q
14 I X="@" S SRCAT="Pulmonary" D SURE Q:SRSOUT G:'SRYN 2 S (SRAX,X)="",$P(^SRF(SRTN,200),"^",9)="" D NOPULM Q
15 S SRAX=Y,$P(^SRF(SRTN,200),"^",9)=SRAX I Y["N" D NOPULM Q
16 I Y["Y" D PULM
17 Q
183 ; edit hepatobiliary information
19 W ! K DIR S X=$P(SRAO(3),"^") I X'="" S DIR("B")=X
20 S DIR(0)="130,244",DIR("A")="HEPATOBILIARY" D ^DIR K DIR I $D(DUOUT) S SRSOUT=1 Q
21 I X="@" S SRCAT="Hepatobiliary" D SURE Q:SRSOUT G:'SRYN 3 S (SRAX,X)="",$P(^SRF(SRTN,200),"^",13)="" D NOHEP Q
22 S SRAX=Y,$P(^SRF(SRTN,200),"^",13)=SRAX I Y["N" D NOHEP Q
23 I Y["Y" D HEP
24 Q
25GEN ; general
26 N SRUP S SRUP=""
27 W ! K DR,DIE S DA=SRTN,DIE=130,DR="236T;237T;346T;202T;202.1T;246T;325T;238T" D ^DIE K DIE,DR I $D(Y) Q
28 K DIR S DA=SRTN,DIR(0)="130,240",DIR("A")="Functional Health Status Prior to Current Illness" D ^DIR K DIR D Q:SRUP
29 .I $D(DTOUT) Q
30 .I $D(DUOUT) S SRUP=1 Q
31 .I X="@" K DIE,DR S DIE=130,DR="240///@" D ^DIE K DA,DIE,DR Q
32 .K DIE,DR S DIE=130,DR="240////"_Y D ^DIE K DA,DIE,DR
33 S DA=SRTN,DIR(0)="130,492",DIR("A")="Functional Health Status at Evaluation for Surgery" D ^DIR K DIR D
34 .I $D(DTOUT)!$D(DUOUT) Q
35 .I X="@" K DIE,DR S DIE=130,DR="492///@" D ^DIE K DA,DIE,DR Q
36 .K DIE,DR S DIE=130,DR="492////"_Y D ^DIE K DA,DIE,DR
37 S SRACLR=0
38 Q
39NOGEN ; no general problems
40 S $P(^SRF(SRTN,200),"^",6)=$S(X="":"",1:1) F I=2,3,4,7 S $P(^SRF(SRTN,200),"^",I)=SRAX
41 S $P(^SRF(SRTN,200),"^",8)=$S(X="":"",X="NS":"NS",1:1),$P(^SRF(SRTN,208),"^",9)=$S(X="":"",X="NS":"NS",1:0),$P(^SRF(SRTN,200.1),"^",2)=$S(X="":"",X="NS":"NS",1:1)
42 Q
43PULM ; pulmonary
44 W ! K DR,DIE S DA=SRTN,DIE=130,DR="204T;203T;326T" D ^DIE K DR
45 S SRACLR=0
46 Q
47NOPULM ; no pulmonary problems
48 F I=10:1:12 S $P(^SRF(SRTN,200),"^",I)=SRAX
49 Q
50HEP ; hepatobiliary
51 K DR,DIE S DIE=130,DA=SRTN,DR="212////Y" D ^DIE K DR
52 S SRACLR=0
53 Q
54NOHEP ; no hepatobiliary problems
55 S $P(^SRF(SRTN,200),"^",15)=SRAX
56 Q
57RET W !! K DIR S DIR(0)="E" D ^DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1
58 Q
59SURE 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
60 Q
61NO2ALL ; set all fields to NO
62 S SRAX="N",$P(^SRF(SRTN,200),"^")=SRAX D NOGEN
63 S $P(^SRF(SRTN,200),"^",9)=SRAX D NOPULM
64 S $P(^SRF(SRTN,200),"^",13)=SRAX D NOHEP
65 S $P(^SRF(SRTN,200.1),"^")=SRAX D NOGAST^SROAPR1A
66 S $P(^SRF(SRTN,200),"^",30)=SRAX D NOCARD^SROAPR1A
67 S $P(^SRF(SRTN,200),"^",40)=SRAX D NOVAS^SROAPR1A
68 Q
Note: See TracBrowser for help on using the repository browser.