- SROAPRE1 ;BIR/MAM - EDIT PAGE 1 PREOP ;11/26/07
- ;;3.0; Surgery ;**38,47,125,135,141,166**;24 Jun 93;Build 6
- 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 S SRUP=""
- W ! K DR,DIE S DA=SRTN,DIE=130,DR="236T;237T;346T;202T;246T;325T;238T" 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
- S SRACLR=0
- Q
- NOGEN ; no general problems
- S $P(^SRF(SRTN,200),"^",6)=$S(X="":"",1:1) F I=2,3,4,7 S $P(^SRF(SRTN,200),"^",I)=SRAX
- S $P(^SRF(SRTN,200.1),"^",2)=$S(X="":"",X="NS":"NS",1: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
- SROAPRE1 ;BIR/MAM - EDIT PAGE 1 PREOP ;11/26/07
- +1 ;;3.0; Surgery ;**38,47,125,135,141,166**;24 Jun 93;Build 6
- +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
- SET SRUP=""
- +2 WRITE !
- KILL DR,DIE
- SET DA=SRTN
- SET DIE=130
- SET DR="236T;237T;346T;202T;246T;325T;238T"
- DO ^DIE
- KILL DIE,DR
- IF $DATA(Y)
- QUIT
- +3 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
- +4 IF $DATA(DTOUT)!$DATA(DUOUT)
- QUIT
- +5 IF X="@"
- KILL DIE,DR
- SET DIE=130
- SET DR="492///@"
- DO ^DIE
- KILL DA,DIE,DR
- QUIT
- +6 KILL DIE,DR
- SET DIE=130
- SET DR="492////"_Y
- DO ^DIE
- KILL DA,DIE,DR
- End DoDot:1
- +7 SET SRACLR=0
- +8 QUIT
- NOGEN ; no general problems
- +1 SET $PIECE(^SRF(SRTN,200),"^",6)=$SELECT(X="":"",1:1)
- FOR I=2,3,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 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
