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

SROAPRE1.m

Go to the documentation of this file.
  1. SROAPRE1 ;BIR/MAM - EDIT PAGE 1 PREOP ;08/11/2011
  1. ;;3.0;Surgery;**38,47,125,135,141,166,174,176,182,184**;24 Jun 93;Build 35
  1. K DA D @EMILY Q
  1. 1 ; edit general information
  1. W ! K DIR S X=$P(SRAO(1),"^") I X'="" S DIR("B")=X
  1. S DIR(0)="130,402",DIR("A")="GENERAL" D ^DIR K DIR I $D(DUOUT) S SRSOUT=1 Q
  1. I X="@" S SRCAT="General" D SURE Q:SRSOUT G:'SRYN 1 S (SRAX,X)="",$P(^SRF(SRTN,200),"^")="" D NOGEN Q
  1. S SRAX=Y,$P(^SRF(SRTN,200),"^")=SRAX I Y["N" D NOGEN Q
  1. I Y["Y" D GEN
  1. Q
  1. 2 ; edit pulmonary information
  1. W ! K DIR S X=$P(SRAO(2),"^") I X'="" S DIR("B")=X
  1. S DIR(0)="130,241",DIR("A")="PULMONARY" D ^DIR K DIR I $D(DUOUT) S SRSOUT=1 Q
  1. I X="@" S SRCAT="Pulmonary" D SURE Q:SRSOUT G:'SRYN 2 S (SRAX,X)="",$P(^SRF(SRTN,200),"^",9)="" D NOPULM Q
  1. S SRAX=Y,$P(^SRF(SRTN,200),"^",9)=SRAX I Y["N" D NOPULM Q
  1. I Y["Y" D PULM
  1. Q
  1. 3 ; edit hepatobiliary information
  1. W ! K DIR S X=$P(SRAO(3),"^") I X'="" S DIR("B")=X
  1. S DIR(0)="130,244",DIR("A")="HEPATOBILIARY" D ^DIR K DIR I $D(DUOUT) S SRSOUT=1 Q
  1. I X="@" S SRCAT="Hepatobiliary" D SURE Q:SRSOUT G:'SRYN 3 S (SRAX,X)="",$P(^SRF(SRTN,200),"^",13)="" D NOHEP Q
  1. S SRAX=Y,$P(^SRF(SRTN,200),"^",13)=SRAX I Y["N" D NOHEP Q
  1. I Y["Y" D HEP
  1. Q
  1. GEN ; general
  1. N SRUP,SRUP1 S SRUP=""
  1. W ! K DR,DIE S DA=SRTN,DIE=130,DR="236T;237T;519T;520T;517T;518T;246T;618T;325T;237.1T" D ^DIE K DIE,DR I $D(Y) Q
  1. S SRUP1="238T" S SRUP1=$S($P($G(^SRF(SRTN,200.1)),"^",8)=3:"667T;"_SRUP1,1:SRUP1) D
  1. .I SRUP1="238T" S $P(^SRF(SRTN,200.1),"^",15)=""
  1. .K DR,DIE S DA=SRTN,DIE=130,DR=SRUP1 D ^DIE K DIE,DR I $D(Y) Q
  1. K DIR S DA=SRTN,DIR(0)="130,492",DIR("A")="Functional Health Status at Evaluation for Surgery" D ^DIR K DIR D
  1. .I $D(DTOUT)!$D(DUOUT) Q
  1. .I X="@" K DIE,DR S DIE=130,DR="492///@" D ^DIE K DA,DIE,DR Q
  1. .K DIE,DR S DIE=130,DR="492////"_Y D ^DIE K DA,DIE,DR
  1. W ! K DR,DIE S DA=SRTN,DIE=130,DR="670T;671T" D ^DIE K DIE,DR I $D(Y) Q
  1. S SRACLR=0
  1. Q
  1. NOGEN ; no general problems
  1. S $P(^SRF(SRTN,200),"^",6)=$S(X="":"",1:1) F I=2,4,7 S $P(^SRF(SRTN,200),"^",I)=SRAX
  1. S $P(^SRF(SRTN,200.1),"^",2)=$S(X="":"",X="NS":"NS",1:1)
  1. S $P(^SRF(SRTN,200.1),"^",8)=$S(X="":"",X="NS":"NS",1:1)
  1. S $P(^SRF(SRTN,200.1),"^",15)=$S(X="":"",1:4)
  1. S $P(^SRF(SRTN,200),"^",55)=$S(X="":"",1:1)
  1. F I=9,11,12 S $P(^SRF(SRTN,200.1),"^",I)=$S(SRAX="N":1,1:"")
  1. S $P(^SRF(SRTN,200.1),"^",10)=$S(SRAX="N":"NA",1:"")
  1. S $P(^SRF(SRTN,210),"^",5)=1,$P(^SRF(SRTN,210),"^",6)=1
  1. Q
  1. PULM ; pulmonary
  1. W ! K DR,DIE S DA=SRTN,DIE=130,DR="204T;203T;326T" D ^DIE K DR
  1. S SRACLR=0
  1. Q
  1. NOPULM ; no pulmonary problems
  1. F I=10:1:12 S $P(^SRF(SRTN,200),"^",I)=SRAX
  1. Q
  1. HEP ; hepatobiliary
  1. K DR,DIE S DIE=130,DA=SRTN,DR="212////Y" D ^DIE K DR
  1. S SRACLR=0
  1. Q
  1. NOHEP ; no hepatobiliary problems
  1. S $P(^SRF(SRTN,200),"^",15)=SRAX
  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
  1. NO2ALL ; set all fields to NO
  1. S SRAX="N",$P(^SRF(SRTN,200),"^")=SRAX D NOGEN
  1. S $P(^SRF(SRTN,200),"^",9)=SRAX D NOPULM
  1. S $P(^SRF(SRTN,200),"^",13)=SRAX D NOHEP
  1. S $P(^SRF(SRTN,200.1),"^")=SRAX D NOGAST^SROAPR1A
  1. S $P(^SRF(SRTN,200),"^",30)=SRAX D NOCARD^SROAPR1A
  1. S $P(^SRF(SRTN,200),"^",40)=SRAX D NOVAS^SROAPR1A
  1. Q
  1. CHK518 ; check entries of the Tobacco Use Timeframe field (#518) based on the value of the Tobacco Use field.
  1. S DA=$S($G(SRTN):SRTN,1:DA)
  1. I "123"[X,($P($G(^SRF(DA,200.1)),"^",9)<3) D EN^DDIOL("Invalid entry as the TOBACCO USE value is less than three.","","!?2,$C(7)") K X Q
  1. I X="NA",($P($G(^SRF(DA,200.1)),"^",9)>2) D EN^DDIOL("Invalid entry as the TOBACCO USE value is greater than two.","","!?2,$C(7)") K X Q
  1. Q