- 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 Feb 19, 2025@00:08:08 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