| 1 | SROAPRE1 ;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
 | 
|---|
| 4 | 1 ; 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
 | 
|---|
| 11 | 2 ; 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
 | 
|---|
| 18 | 3 ; 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
 | 
|---|
| 25 | GEN ; 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
 | 
|---|
| 39 | NOGEN ; 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
 | 
|---|
| 43 | PULM ; 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
 | 
|---|
| 47 | NOPULM ; no pulmonary problems
 | 
|---|
| 48 |  F I=10:1:12 S $P(^SRF(SRTN,200),"^",I)=SRAX
 | 
|---|
| 49 |  Q
 | 
|---|
| 50 | HEP ; hepatobiliary
 | 
|---|
| 51 |  K DR,DIE S DIE=130,DA=SRTN,DR="212////Y" D ^DIE K DR
 | 
|---|
| 52 |  S SRACLR=0
 | 
|---|
| 53 |  Q
 | 
|---|
| 54 | NOHEP ; no hepatobiliary problems
 | 
|---|
| 55 |  S $P(^SRF(SRTN,200),"^",15)=SRAX
 | 
|---|
| 56 |  Q
 | 
|---|
| 57 | RET W !! K DIR S DIR(0)="E" D ^DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1
 | 
|---|
| 58 |  Q
 | 
|---|
| 59 | SURE 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
 | 
|---|
| 61 | NO2ALL ; 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
 | 
|---|