SROAOP ;BIR/MAM - ENTER OPERATION INFO ;11/27/07
;;3.0; Surgery ;**19,38,47,63,67,81,86,97,100,125,142,153,160,166**;24 Jun 93;Build 6
I '$D(SRTN) W !!,"A Surgery Risk Assessment must be selected prior to using this option.",!!,"Press <RET> to continue " R X:DTIME G END
S SRSOUT=0,SRSUPCPT=1 D ^SROAUTL
START G:SRSOUT END K SRAOTH,SRACON D ^SROAOP1
ASK W !!,"Select Operative Information to Edit: " R SRASEL:DTIME I '$T!(SRASEL["^") S SRSOUT=1 G END
I SRASEL="" G END
S SRN=13 S:SRASEL="a" SRASEL="A" I '$D(SRAO(SRASEL)),(SRASEL'?.N1":".N),(SRASEL'="A") D HELP G:SRSOUT END G START
I SRASEL="A" S SRASEL="1:"_SRN
I SRASEL?.N1":".N S Y=$E(SRASEL),Z=$P(SRASEL,":",2) I Y<1!(Z>SRN)!(Y>Z) D HELP G:SRSOUT END G START
S MM=$E(SRASEL) I MM'=3,(MM'=4),(MM'=5) S SRHDR(.5)=SRDOC D HDR^SROAUTL
I SRASEL?.N1":".N D RANGE G START
Q:'$D(SRAO(SRASEL))
S EMILY=SRASEL D G START
.I $$LOCK^SROUTL(SRTN) D ONE,UNLOCK^SROUTL(SRTN)
END I $D(SRSOUT),'SRSOUT D ^SROAOP2
I $D(SRTN) S SROERR=SRTN D ^SROERR0
W @IOF D ^SRSKILL
Q
HELP W @IOF,!!!!,"Enter the number or range of numbers you want to edit. Examples of proper"
W !,"responses are listed below.",!!,"1. Enter 'A' to update all information."
W !!,"2. Enter a number (1-"_SRN_") to update the information in that field. (For"
W !," example, enter '2' to update Principal Operation.)"
W !!,"3. Enter a range of numbers (1-"_SRN_") separated by a ':' to enter a range of"
W !," information. (For example, enter '6:8' to update PGY of Primary Surgeon,"
W !," Surgical Priority and Wound Classification.)",!
PRESS K DIR S DIR(0)="E" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1
Q
RANGE ; range of numbers
I $$LOCK^SROUTL(SRTN) D D UNLOCK^SROUTL(SRTN)
.S SHEMP=$P(SRASEL,":"),CURLEY=$P(SRASEL,":",2) F EMILY=SHEMP:1:CURLEY Q:SRSOUT D ONE
Q
ONE ; edit one item
I EMILY=3 D DISP^SROAUTL0 Q
I EMILY=10 D ANES Q
I EMILY=4 D ^SROTHER Q
I EMILY=5 D CONCUR Q
I EMILY=6,SRASEL[":",($P(SRASEL,":")'=6) S SRPAGE="" S SRHDR(.5)=SRDOC D HDR^SROAUTL
K DR,DIE S DA=SRTN,DR=$P(SRAO(EMILY),"^",2)_"T",DIE=130 D ^DIE K DR I $D(Y) S SRSOUT=1
I EMILY=2 D ^SROAUTL
Q
RET Q:SRSOUT W !!,"Press ENTER to continue, or '^' to quit " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q
Q
CONCUR ; concurrent case information
N SRPROC,SRCSTAT S SRLINE="" F I=1:1:80 S SRLINE=SRLINE_"-"
S CON=$P($G(^SRF(SRTN,"CON")),"^") I CON,($P($G(^SRF(CON,30)),"^")!($P($G(^SRF(CON,31)),"^",8))) S CON=""
S SRPAGE="" D HDR^SROAUTL
W !,"Concurrent case information cannot be updated using the Risk Assessment"
W !,"Module. To update the CPT code of a concurrent case, please use an option"
W !,"contained within the CPT/ICD9 Coding Menu."
I CON D CC W !!,"Concurrent Procedure: ",?22,SROPS(1) I $D(SROPS(2)) W !,?22,SROPS(2) I $D(SROPS(3)) W !,?22,SROPS(3) I $D(SROPS(4)) W !,?22,SROPS(4)
I $D(SRCSTAT) W !!,?22,SRCSTAT
W !!,"Press ENTER to continue " R X:DTIME
Q
CC ; list concurrent procedure
N SRTN,SRL,SRZ S SRCSTAT=">> Coding "_$S($P($G(^SRO(136,CON,10)),"^"):"",1:"Not ")_"Complete <<"
S SRL=55,SRTN=CON D CPTS^SROAUTL0
I SRPROC(1)="NOT ENTERED"!'$D(SRPROC(1)) S SRPROC(1)="CPT NOT ENTERED" K SRCSTAT
S SROPER=$P(^SRF(CON,"OP"),"^")_" (" F I=1:1 Q:'$D(SRPROC(I)) S SROPER=SROPER_SRPROC(I)
S SROPER=SROPER_")"
K SROPS,MM,MMM S:$L(SROPER)<57 SROPS(1)=SROPER
I $L(SROPER)>56 S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM=""
Q
LOOP ; break procedures
S SROPS(M)="" F LOOP=1:1 S MM=$P(SROPER," "),MMM=$P(SROPER," ",2,200) Q:MMM="" Q:$L(SROPS(M))+$L(MM)'<57 S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM
Q
ANES N SRANE,SRNEW
I $P(SRAO(10),"^")="NOT ENTERED",'$O(^SRF(SRTN,6,0)) D Q
.K DIR S DIR("A")="Select ANESTHESIA TECHNIQUE: ",DIR(0)="130.06,.01OA" D ^DIR K DIR S SRANE=Y I $D(DTOUT)!$D(DUOUT)!(Y="") Q
.K DD,DO S DIC="^SRF(SRTN,6,",X=SRANE,DIC(0)="L" D FILE^DICN K DIC,DD,DO I '+Y Q
.S SRNEW=+Y
.K DA,DIE,DR S DA=SRNEW,DA(1)=SRTN,DIE="^SRF(SRTN,6,",DR=".05T;42T" D ^DIE
K DR,DIE,DA S DA=SRTN,DR=".37T",DR(2,130.06)=".01T;.05T;42T",DIE=130 D ^DIE K DR
Q
SROAOP ;BIR/MAM - ENTER OPERATION INFO ;11/27/07
+1 ;;3.0; Surgery ;**19,38,47,63,67,81,86,97,100,125,142,153,160,166**;24 Jun 93;Build 6
+2 IF '$DATA(SRTN)
WRITE !!,"A Surgery Risk Assessment must be selected prior to using this option.",!!,"Press <RET> to continue "
READ X:DTIME
GOTO END
+3 SET SRSOUT=0
SET SRSUPCPT=1
DO ^SROAUTL
START IF SRSOUT
GOTO END
KILL SRAOTH,SRACON
DO ^SROAOP1
ASK WRITE !!,"Select Operative Information to Edit: "
READ SRASEL:DTIME
IF '$TEST!(SRASEL["^")
SET SRSOUT=1
GOTO END
+1 IF SRASEL=""
GOTO END
+2 SET SRN=13
IF SRASEL="a"
SET SRASEL="A"
IF '$DATA(SRAO(SRASEL))
IF (SRASEL'?.N1":".N)
IF (SRASEL'="A")
DO HELP
IF SRSOUT
GOTO END
GOTO START
+3 IF SRASEL="A"
SET SRASEL="1:"_SRN
+4 IF SRASEL?.N1":".N
SET Y=$EXTRACT(SRASEL)
SET Z=$PIECE(SRASEL,":",2)
IF Y<1!(Z>SRN)!(Y>Z)
DO HELP
IF SRSOUT
GOTO END
GOTO START
+5 SET MM=$EXTRACT(SRASEL)
IF MM'=3
IF (MM'=4)
IF (MM'=5)
SET SRHDR(.5)=SRDOC
DO HDR^SROAUTL
+6 IF SRASEL?.N1":".N
DO RANGE
GOTO START
+7 IF '$DATA(SRAO(SRASEL))
QUIT
+8 SET EMILY=SRASEL
Begin DoDot:1
+9 IF $$LOCK^SROUTL(SRTN)
DO ONE
DO UNLOCK^SROUTL(SRTN)
End DoDot:1
GOTO START
END IF $DATA(SRSOUT)
IF 'SRSOUT
DO ^SROAOP2
+1 IF $DATA(SRTN)
SET SROERR=SRTN
DO ^SROERR0
+2 WRITE @IOF
DO ^SRSKILL
+3 QUIT
HELP WRITE @IOF,!!!!,"Enter the number or range of numbers you want to edit. Examples of proper"
+1 WRITE !,"responses are listed below.",!!,"1. Enter 'A' to update all information."
+2 WRITE !!,"2. Enter a number (1-"_SRN_") to update the information in that field. (For"
+3 WRITE !," example, enter '2' to update Principal Operation.)"
+4 WRITE !!,"3. Enter a range of numbers (1-"_SRN_") separated by a ':' to enter a range of"
+5 WRITE !," information. (For example, enter '6:8' to update PGY of Primary Surgeon,"
+6 WRITE !," Surgical Priority and Wound Classification.)",!
PRESS KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRSOUT=1
+1 QUIT
RANGE ; range of numbers
+1 IF $$LOCK^SROUTL(SRTN)
Begin DoDot:1
+2 SET SHEMP=$PIECE(SRASEL,":")
SET CURLEY=$PIECE(SRASEL,":",2)
FOR EMILY=SHEMP:1:CURLEY
IF SRSOUT
QUIT
DO ONE
End DoDot:1
DO UNLOCK^SROUTL(SRTN)
+3 QUIT
ONE ; edit one item
+1 IF EMILY=3
DO DISP^SROAUTL0
QUIT
+2 IF EMILY=10
DO ANES
QUIT
+3 IF EMILY=4
DO ^SROTHER
QUIT
+4 IF EMILY=5
DO CONCUR
QUIT
+5 IF EMILY=6
IF SRASEL[":"
IF ($PIECE(SRASEL,":")'=6)
SET SRPAGE=""
SET SRHDR(.5)=SRDOC
DO HDR^SROAUTL
+6 KILL DR,DIE
SET DA=SRTN
SET DR=$PIECE(SRAO(EMILY),"^",2)_"T"
SET DIE=130
DO ^DIE
KILL DR
IF $DATA(Y)
SET SRSOUT=1
+7 IF EMILY=2
DO ^SROAUTL
+8 QUIT
RET IF SRSOUT
QUIT
WRITE !!,"Press ENTER to continue, or '^' to quit "
READ X:DTIME
IF '$TEST!(X["^")
SET SRSOUT=1
QUIT
+1 QUIT
CONCUR ; concurrent case information
+1 NEW SRPROC,SRCSTAT
SET SRLINE=""
FOR I=1:1:80
SET SRLINE=SRLINE_"-"
+2 SET CON=$PIECE($GET(^SRF(SRTN,"CON")),"^")
IF CON
IF ($PIECE($GET(^SRF(CON,30)),"^")!($PIECE($GET(^SRF(CON,31)),"^",8)))
SET CON=""
+3 SET SRPAGE=""
DO HDR^SROAUTL
+4 WRITE !,"Concurrent case information cannot be updated using the Risk Assessment"
+5 WRITE !,"Module. To update the CPT code of a concurrent case, please use an option"
+6 WRITE !,"contained within the CPT/ICD9 Coding Menu."
+7 IF CON
DO CC
WRITE !!,"Concurrent Procedure: ",?22,SROPS(1)
IF $DATA(SROPS(2))
WRITE !,?22,SROPS(2)
IF $DATA(SROPS(3))
WRITE !,?22,SROPS(3)
IF $DATA(SROPS(4))
WRITE !,?22,SROPS(4)
+8 IF $DATA(SRCSTAT)
WRITE !!,?22,SRCSTAT
+9 WRITE !!,"Press ENTER to continue "
READ X:DTIME
+10 QUIT
CC ; list concurrent procedure
+1 NEW SRTN,SRL,SRZ
SET SRCSTAT=">> Coding "_$SELECT($PIECE($GET(^SRO(136,CON,10)),"^"):"",1:"Not ")_"Complete <<"
+2 SET SRL=55
SET SRTN=CON
DO CPTS^SROAUTL0
+3 IF SRPROC(1)="NOT ENTERED"!'$DATA(SRPROC(1))
SET SRPROC(1)="CPT NOT ENTERED"
KILL SRCSTAT
+4 SET SROPER=$PIECE(^SRF(CON,"OP"),"^")_" ("
FOR I=1:1
IF '$DATA(SRPROC(I))
QUIT
SET SROPER=SROPER_SRPROC(I)
+5 SET SROPER=SROPER_")"
+6 KILL SROPS,MM,MMM
IF $LENGTH(SROPER)<57
SET SROPS(1)=SROPER
+7 IF $LENGTH(SROPER)>56
SET SROPER=SROPER_" "
FOR M=1:1
DO LOOP
IF MMM=""
QUIT
+8 QUIT
LOOP ; break procedures
+1 SET SROPS(M)=""
FOR LOOP=1:1
SET MM=$PIECE(SROPER," ")
SET MMM=$PIECE(SROPER," ",2,200)
IF MMM=""
QUIT
IF $LENGTH(SROPS(M))+$LENGTH(MM)'<57
QUIT
SET SROPS(M)=SROPS(M)_MM_" "
SET SROPER=MMM
+2 QUIT
ANES NEW SRANE,SRNEW
+1 IF $PIECE(SRAO(10),"^")="NOT ENTERED"
IF '$ORDER(^SRF(SRTN,6,0))
Begin DoDot:1
+2 KILL DIR
SET DIR("A")="Select ANESTHESIA TECHNIQUE: "
SET DIR(0)="130.06,.01OA"
DO ^DIR
KILL DIR
SET SRANE=Y
IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
QUIT
+3 KILL DD,DO
SET DIC="^SRF(SRTN,6,"
SET X=SRANE
SET DIC(0)="L"
DO FILE^DICN
KILL DIC,DD,DO
IF '+Y
QUIT
+4 SET SRNEW=+Y
+5 KILL DA,DIE,DR
SET DA=SRNEW
SET DA(1)=SRTN
SET DIE="^SRF(SRTN,6,"
SET DR=".05T;42T"
DO ^DIE
End DoDot:1
QUIT
+6 KILL DR,DIE,DA
SET DA=SRTN
SET DR=".37T"
SET DR(2,130.06)=".01T;.05T;42T"
SET DIE=130
DO ^DIE
KILL DR
+7 QUIT
