Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SROAPR1A

SROAPR1A.m

Go to the documentation of this file.
  1. SROAPR1A ;B'HAM ISC/MAM - EDIT PREOP INFO ; [ 03/16/04 2:44 PM ]
  1. ;;3.0;Surgery;**38,125,182,184**;24 Jun 93;Build 35
  1. K DA D @EMILY Q
  1. 4 ; edit gastrointestinal information
  1. W ! K DIR S X=$P(SRAO(4),"^") I X'="" S DIR("B")=X
  1. S DIR(0)="130,486",DIR("A")="GASTROINTESTINAL" D ^DIR K DIR I $D(DUOUT) S SRSOUT=1 Q
  1. I X="@" S SRCAT="Gastrointestinal" D SURE Q:SRSOUT G:'SRYN 4 S (SRAX,X)="",$P(^SRF(SRTN,200.1),"^")="" D NOGAST Q
  1. S SRAX=Y,$P(^SRF(SRTN,200.1),"^")=SRAX I Y["N" D NOGAST Q
  1. I Y["Y" D GAST
  1. Q
  1. 5 ; edit cardiac information
  1. W ! K DIR S X=$P(SRAO(5),"^") I X'="" S DIR("B")=X
  1. S DIR(0)="130,242",DIR("A")="CARDIAC" D ^DIR K DIR I $D(DUOUT) S SRSOUT=1 Q
  1. I X="@" S SRCAT="Cardiac" D SURE Q:SRSOUT G:'SRYN 5 S (SRAX,X)="",$P(^SRF(SRTN,200),"^",30)="" D NOCARD Q
  1. S SRAX=Y,$P(^SRF(SRTN,200),"^",30)=SRAX I Y["N" D NOCARD Q
  1. I Y["Y" D CARD
  1. Q
  1. 6 ; edit vascular information
  1. W ! K DIR S X=$P(SRAO(6),"^") I X'="" S DIR("B")=X
  1. S DIR(0)="130,206",DIR("A")="VASCULAR" D ^DIR K DIR I $D(DUOUT) S SRSOUT=1 Q
  1. I X="@" S SRCAT="Vascular" D SURE Q:SRSOUT G:'SRYN 6 S $P(^SRF(SRTN,200),"^",40)="" S (SRAX,X)="" D NOVAS Q
  1. S SRAX=Y,$P(^SRF(SRTN,200),"^",40)=SRAX I Y["N" D NOVAS Q
  1. I Y["Y" D VAS
  1. Q
  1. GAST ; gastointectinal
  1. K DIE S DA=SRTN,DIE=130,DR="213////Y" D ^DIE K DR
  1. S SRACLR=0
  1. Q
  1. NOGAST ; no gastointectinal problems
  1. S $P(^SRF(SRTN,200),"^",16)=SRAX
  1. Q
  1. CARD ; cardiac
  1. W ! K DR,DIE S DA=SRTN,DIE=130,DR="423T;205T;640T" D ^DIE K DR
  1. S X="5D" D ^SROACL2 S SRYY=Y D
  1. .K DR,DIE S DA=SRTN,DR="485///"_$P(SRYY,"^"),DIE=130 D ^DIE K DR
  1. W ! K DR,DIE S DA=SRTN,DIE=130,DR="267T;643T;641T" D ^DIE K DR
  1. S SRACLR=0
  1. Q
  1. NOCARD ; no cardiac problems
  1. F I=32,36 S $P(^SRF(SRTN,200),"^",I)=SRAX
  1. S $P(^SRF(SRTN,207),"^",29)=0,$P(^SRF(SRTN,206),"^",18)="N"
  1. S $P(^SRF(SRTN,206),"^",42)=0
  1. S $P(^SRF(SRTN,206),"^",14)=0
  1. S $P(^SRF(SRTN,200),"^",56)=1,$P(^SRF(SRTN,200),"^",57)=1
  1. S $P(^SRF(SRTN,200),"^",59)=1
  1. Q
  1. VAS ; vascular
  1. W ! K DR,DIE S DA=SRTN,DIE=130,DR="265T;330T" D ^DIE K DR
  1. S SRACLR=0
  1. Q
  1. NOVAS ; no vascular problems
  1. S $P(^SRF(SRTN,200),"^",42)=SRAX
  1. S $P(^SRF(SRTN,206),"^",16)=1
  1. Q
  1. RET W !! K DIR S DIR(0)="E" D ^DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1
  1. Q
  1. 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
  1. Q