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