SROAOP.m

SROAOP ;BIR/MAM - ENTER OPERATION INFO ;06/25/10

 ;;3.0;Surgery;**19,38,47,63,67,81,86,97,100,125,142,153,160,166,171,174,200**;24 Jun 93;Build 9

 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=14 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'=4,(MM'=5),(MM'=6) 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 '7:9' 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=4 D DISP^SROAUTL0 Q

 I EMILY=11 D ANES Q

 I EMILY=5 D ^SROTHER Q

 I EMILY=6 D CONCUR Q

 I EMILY=7,SRASEL[":",($P(SRASEL,":")'=7) 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 Procedure: An additional operative procedure performed by a"

 W !,"different surgical team (i.e., a different specialty/service) under the"

 W !,"same anesthetic which has a CPT code different from that of the Principal"

 W !,"Operative Procedure (e.g., fixation of a femur fracture in a patient"

 W !,"undergoing a laparotomy for trauma). This field should be verified and,"

 W !,"if need be, report discrepancies to the official CPT coder for surgery."

 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(11),"^")="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,DA(1)=SRTN,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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SROAOP   4359     printed  Feb 19, 2025@00:07:49                                                                                                                                                                                                      Page 2

SROAOP    ;BIR/MAM - ENTER OPERATION INFO ;06/25/10

 +1       ;;3.0;Surgery;**19,38,47,63,67,81,86,97,100,125,142,153,160,166,171,174,200**;24 Jun 93;Build 9

 +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=14

           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'=4

               IF (MM'=5)

                   IF (MM'=6)

                       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 '7:9' 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=4

               DO DISP^SROAUTL0

               QUIT 

 +2        IF EMILY=11

               DO ANES

               QUIT 

 +3        IF EMILY=5

               DO ^SROTHER

               QUIT 

 +4        IF EMILY=6

               DO CONCUR

               QUIT 

 +5        IF EMILY=7

               IF SRASEL[":"

                   IF ($PIECE(SRASEL,":")'=7)

                       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 Procedure: An additional operative procedure performed by a"

 +5        WRITE !,"different surgical team (i.e., a different specialty/service) under the"

 +6        WRITE !,"same anesthetic which has a CPT code different from that of the Principal"

 +7        WRITE !,"Operative Procedure (e.g., fixation of a femur fracture in a patient"

 +8        WRITE !,"undergoing a laparotomy for trauma). This field should be verified and,"

 +9        WRITE !,"if need be, report discrepancies to the official CPT coder for surgery."

 +10       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)

 +11       IF $DATA(SRCSTAT)

               WRITE !!,?22,SRCSTAT

 +12       WRITE !!,"Press ENTER to continue "

           READ X:DTIME

 +13       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(11),"^")="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 DA(1)=SRTN

                       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