- SRSCHUN ;BIR/ADM - MAKE UNREQUESTED OPERATION ; Jul 31, 2014@14:41
- ;;3.0;Surgery;**3,67,68,88,103,100,144,158,175,177,182,184,203**;24 Jun 93;Build 7
- MUST S SRLINE="" F I=1:1:80 S SRLINE=SRLINE_"="
- W @IOF W:$D(SRCC) !,?29,$S(SRSCON=1:"FIRST",1:"SECOND")_" CONCURRENT CASE" W !,?14,"SCHEDULE UNREQUESTED OPERATION: REQUIRED INFORMATION",!!,SRNM_" ("_$G(SRSSN)_")",?65,SREQDT,!,SRLINE,!
- ODP N SRSODP K DIR S DIR(0)="130,616",DIR("A")="Desired Procedure Date" D ^DIR K DIR I $D(DTOUT)!(X="^") S SRSOUT=1 G END
- I Y=""!(X["^")!(Y<SRSDATE) W !!,"The Desired Procedure Date MUST be entered and should be greater than or equal to date of operation. Enter '^' to exit.",! G ODP
- S SRSODP=+Y
- SURG ; surgeon
- K DIR S DIR(0)="130,.14",DIR("A")="Primary Surgeon" S:$D(SRSDOC)&('$D(SRSCON)!(+$G(SRSCON)=1)) DIR("B")=$P(^VA(200,SRSDOC,0),U) D ^DIR K DIR I $D(DTOUT)!(X="^") S SRSOUT=1 G END
- I Y=""!(X["^") W !!,"To create a surgical case, a surgeon MUST be selected. Enter '^' to exit.",! G SURG
- S SRSDOC=+Y
- CASE ; create case in SURGERY file
- K DA,DIC,DD,DO,DINUM,SRTN S X=SRSDPT,DIC="^SRF(",DIC(0)="L",DLAYGO=130 D FILE^DICN K DD,DO,DIC,DLAYGO S SRTN=+Y,SRLCK=$$LOCK^SROUTL(SRTN)
- S ^SRF(SRTN,8)=SRSITE("DIV"),^SRF(SRTN,"OP")=""
- D NOW^%DTC S SREQDAY=+$E(%,1,12),SRNOCON=1 K DR,DIE
- S DA=SRTN,DIE=130,DR=".09////"_SRSDATE_";.14////"_SRSDOC_";1.098////"_+SREQDAY_";1.099////"_DUZ_";Q;.02////"_SRSOR_";10////"_SRSDT1_";11////"_SRSDT2_";616////"_SRSODP_";612////"_SRSODP_";613////"_SREQDAY_";615////"_SREQDAY
- D ^DIE K DR
- ASURG ; attending surgeon
- K DA,DIC,DIQ,DR,SRY S DIC="^SRF(",DA=SRTN,DIQ="SRY",DIQ(0)="E",DR=.164 D EN^DIQ1 K DA,DIC,DIQ,DR
- I $G(SRY(130,SRTN,.164,"E"))'="" S SRATTND=SRY(130,SRTN,.164,"E") W !,"Attending Surgeon: "_SRATTND,! G SPEC
- K DIR S DIR(0)="130,.164",DIR("A")="Attending Surgeon" D ^DIR K DIR I $D(DTOUT)!(X="^") S SRSOUT=1 G DEL
- I Y=""!(X["^") W !!,"An Attending Surgeon must be entered when creating a case. Enter '^' to exit.",! G ASURG
- S SRATTND=+Y,DA=SRTN,DIE=130,DR=".164////"_SRATTND D ^DIE K DA,DIE,DR
- SPEC ; surgical specialty
- K DIR S DIR(0)="130,.04",DIR("A")="Surgical Specialty" D ^DIR K DIR I $D(DTOUT)!(X="^") S SRSOUT=1 G DEL
- I Y=""!(X["^") W !!,"To create a surgical case, a surgical specialty MUST be selected. Enter '^'",!,"to exit.",! G SPEC
- S SRSS=+Y
- OP ; principal operative procedure
- K DIR S DIR(0)="130,26",DIR("A")="Principal Operative Procedure" D ^DIR K DIR I $D(DTOUT)!(X="^") S SRSOUT=1 G DEL
- I X["^" W !!,"Principal procedure must not contain an up-arrow (^).",! G OP
- S SRSOP=Y I SRSOP="" G OP
- OPD ; Principal Preoperative Diagnosis
- K DIR S DIR(0)="130,32",DIR("A")="Principal Preoperative Diagnosis" D ^DIR K DIR I $D(DTOUT)!(X="^") S SRSOUT=1 G DEL
- I Y=""!(X["^") W !!,"A Principal Preoperative Diagnosis must be entered",!,"when creating a new case. Enter '^' to exit.",! G OPD
- I X[";" W !,"The Principal Preoperative Diagnosis cannot contain a semicolon (;).",!,"Please re-enter the Diagnosis, using commas in place of the semicolons." G OPD
- S SRSOPD=Y
- W !!,"The information entered into the Principal Preoperative Diagnosis field",!,"has been transferred into the Indications for Operation field.",!,"The Indications for Operation field can be updated later if necessary.",!
- W !!,"Press RETURN to continue " R X:DTIME
- ;
- PCPT ; Planned Principal Procedure Code (CPT)
- K DIR S DIR(0)="130,27",DIR("A")="Planned Principal Procedure Code" D ^DIR K DIR I $D(DTOUT)!(X="^") S SRSOUT=1 G DEL
- I Y=""!(X["^") W !!,"To make an operation request, Planned Principal Procedure Code field MUST be entered. Enter '^' to exit.",! G PCPT
- S SRCPT=$P(Y,"^")
- ;
- UPDATE ; update case in SURGERY file
- S DA=SRTN,DIE=130,DR="26////"_SRSOP_";68////"_SRSOP_";36////0;Q;.04////"_SRSS_";32////"_SRSOPD_";27////"_SRCPT D ^DIE
- D SPIN
- K DR,DA S DR="[SRO-NOCOMP]",DA=SRTN,DIE=130 D ^DIE K DR
- D ^SROXRET K SRNOCON
- OTHER ; other required fields
- S SRFLD=0 F S SRFLD=$O(^SRO(133,SRSITE,4,SRFLD)) Q:'SRFLD!(SRSOUT) D OTHDIR Q:SRSOUT
- I SRSOUT G DEL
- S SRSOPD(1)=SRSOPD D WP^DIE(130,SRTN_",",55,"A","SRSOPD")
- D:$G(SRLCK) UNLOCK^SROUTL(SRTN)
- S SROERR=SRTN D ^SROERR I $D(SRDUOUT) S SRSOUT=1
- I $D(SRCC),SRSCON=2 S DIE=130,DR="35////"_SRSCON(1),DA=SRTN D ^DIE K DR S DR="35////"_SRTN,DA=SRSCON(1),DIE=130 D ^DIE K DR,DA S SROERR=SRSCON(1) D ^SROERR0
- Q
- DEL S DA=SRTN,DIK="^SRF(" D ^DIK G END
- CON ; request concurrent case
- D MUST Q:SRSOUT S SRSCON(SRSCON,"DOC")=$P(^VA(200,SRSDOC,0),"^"),SRSCON(SRSCON,"SS")=$P(^SRO(137.45,SRSS,0),"^"),SRSCON(SRSCON,"OP")=$P(^SRF(SRTN,"OP"),"^"),SRSCON(SRSCON)=SRTN K DA
- Q
- OTHDIR ; call to reader for site specific required fields
- ;JAS - 08/05/14 - SR*3*177 - Modified this section for ICD-10
- K DIR,SREQ,SRY S FLD=$P(^SRO(133,SRSITE,4,SRFLD,0),"^") D FIELD^DID(130,FLD,"","TITLE","SRY") S DIR(0)="130,"_FLD,DIR("A")=SRY("TITLE") D DIRYN I $D(DTOUT)!($G(X)="^") S SRSOUT=1 Q
- I "^32.5^66^253^286^343^344^392^489^"[("^"_FLD_"^") I $G(X)="@"!($G(X)="") S X="^"
- I $G(Y)=""!(X["^") W !!,"It is mandatory that you provide this information before proceeding with this",!,"option.",! D ASK Q:SRSOUT G OTHDIR
- S SREQ(130,SRTN_",",FLD)=$P(Y,"^") D FILE^DIE("","SREQ","^TMP(""SR"",$J)")
- Q
- DIRYN ; call ^DIR if not FILE 80 or ICD-9 FILE 80 (added for SR*3.0*177)
- I "^32.5^66^253^286^343^344^392^489^"[("^"_FLD_"^") D Q
- . S SRPRMT=DIR("A")_" ",SRDEF=$$GET1^DIQ(130,SRTN,FLD)
- . D ICDSRCH^SROICD
- D ^DIR
- Q
- ASK K DIR S DIR(0)="Y",DIR("A")="Do you want to continue with this option ",DIR("B")="YES"
- S DIR("?")="Enter RETURN to continue with this option, or 'NO' to discontinue this option." D ^DIR S:'Y SRSOUT=1
- Q
- END D:$G(SRLCK) UNLOCK^SROUTL(SRTN)
- I '$D(SRCC),SRSOUT W !!,"No surgical case has been scheduled.",! S SRTN("OR")=SRSOR,SRTN("START")=SRSDT1,SRTN("END")=SRSDT2,SRSEDT=$E(SRSDT2,1,7) D ^SRSCG
- Q
- SPIN ; spinal level free-text
- I '$$SPIN^SRTOVRF(SRCPT) Q
- N SL
- K DIR S DIR(0)="130,136",DIR("A")="Spinal Level Comment" D ^DIR K DIR
- S SL=$P(Y,"^") I Y=""!$D(DTOUT)!$D(DUOUT) S SL=""
- S $P(^SRF(SRTN,1.1),"^",4)=SL
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRSCHUN 6093 printed Feb 19, 2025@00:13:47 Page 2
- SRSCHUN ;BIR/ADM - MAKE UNREQUESTED OPERATION ; Jul 31, 2014@14:41
- +1 ;;3.0;Surgery;**3,67,68,88,103,100,144,158,175,177,182,184,203**;24 Jun 93;Build 7
- MUST SET SRLINE=""
- FOR I=1:1:80
- SET SRLINE=SRLINE_"="
- +1 WRITE @IOF
- if $DATA(SRCC)
- WRITE !,?29,$SELECT(SRSCON=1:"FIRST",1:"SECOND")_" CONCURRENT CASE"
- WRITE !,?14,"SCHEDULE UNREQUESTED OPERATION: REQUIRED INFORMATION",!!,SRNM_" ("_$GET(SRSSN)_")",?65,SREQDT,!,SRLINE,!
- ODP NEW SRSODP
- KILL DIR
- SET DIR(0)="130,616"
- SET DIR("A")="Desired Procedure Date"
- DO ^DIR
- KILL DIR
- IF $DATA(DTOUT)!(X="^")
- SET SRSOUT=1
- GOTO END
- +1 IF Y=""!(X["^")!(Y<SRSDATE)
- WRITE !!,"The Desired Procedure Date MUST be entered and should be greater than or equal to date of operation. Enter '^' to exit.",!
- GOTO ODP
- +2 SET SRSODP=+Y
- SURG ; surgeon
- +1 KILL DIR
- SET DIR(0)="130,.14"
- SET DIR("A")="Primary Surgeon"
- if $DATA(SRSDOC)&('$DATA(SRSCON)!(+$GET(SRSCON)=1))
- SET DIR("B")=$PIECE(^VA(200,SRSDOC,0),U)
- DO ^DIR
- KILL DIR
- IF $DATA(DTOUT)!(X="^")
- SET SRSOUT=1
- GOTO END
- +2 IF Y=""!(X["^")
- WRITE !!,"To create a surgical case, a surgeon MUST be selected. Enter '^' to exit.",!
- GOTO SURG
- +3 SET SRSDOC=+Y
- CASE ; create case in SURGERY file
- +1 KILL DA,DIC,DD,DO,DINUM,SRTN
- SET X=SRSDPT
- SET DIC="^SRF("
- SET DIC(0)="L"
- SET DLAYGO=130
- DO FILE^DICN
- KILL DD,DO,DIC,DLAYGO
- SET SRTN=+Y
- SET SRLCK=$$LOCK^SROUTL(SRTN)
- +2 SET ^SRF(SRTN,8)=SRSITE("DIV")
- SET ^SRF(SRTN,"OP")=""
- +3 DO NOW^%DTC
- SET SREQDAY=+$EXTRACT(%,1,12)
- SET SRNOCON=1
- KILL DR,DIE
- +4 SET DA=SRTN
- SET DIE=130
- SET DR=".09////"_SRSDATE_";.14////"_SRSDOC_";1.098////"_+SREQDAY_";1.099////"_DUZ_";Q;.02////"_SRSOR_";10////"_SRSDT1_";11////"_SRSDT2_";616////"_SRSODP_";612////"_SRSODP_";613////"_SREQDAY_";615////"_SREQDAY
- +5 DO ^DIE
- KILL DR
- ASURG ; attending surgeon
- +1 KILL DA,DIC,DIQ,DR,SRY
- SET DIC="^SRF("
- SET DA=SRTN
- SET DIQ="SRY"
- SET DIQ(0)="E"
- SET DR=.164
- DO EN^DIQ1
- KILL DA,DIC,DIQ,DR
- +2 IF $GET(SRY(130,SRTN,.164,"E"))'=""
- SET SRATTND=SRY(130,SRTN,.164,"E")
- WRITE !,"Attending Surgeon: "_SRATTND,!
- GOTO SPEC
- +3 KILL DIR
- SET DIR(0)="130,.164"
- SET DIR("A")="Attending Surgeon"
- DO ^DIR
- KILL DIR
- IF $DATA(DTOUT)!(X="^")
- SET SRSOUT=1
- GOTO DEL
- +4 IF Y=""!(X["^")
- WRITE !!,"An Attending Surgeon must be entered when creating a case. Enter '^' to exit.",!
- GOTO ASURG
- +5 SET SRATTND=+Y
- SET DA=SRTN
- SET DIE=130
- SET DR=".164////"_SRATTND
- DO ^DIE
- KILL DA,DIE,DR
- SPEC ; surgical specialty
- +1 KILL DIR
- SET DIR(0)="130,.04"
- SET DIR("A")="Surgical Specialty"
- DO ^DIR
- KILL DIR
- IF $DATA(DTOUT)!(X="^")
- SET SRSOUT=1
- GOTO DEL
- +2 IF Y=""!(X["^")
- WRITE !!,"To create a surgical case, a surgical specialty MUST be selected. Enter '^'",!,"to exit.",!
- GOTO SPEC
- +3 SET SRSS=+Y
- OP ; principal operative procedure
- +1 KILL DIR
- SET DIR(0)="130,26"
- SET DIR("A")="Principal Operative Procedure"
- DO ^DIR
- KILL DIR
- IF $DATA(DTOUT)!(X="^")
- SET SRSOUT=1
- GOTO DEL
- +2 IF X["^"
- WRITE !!,"Principal procedure must not contain an up-arrow (^).",!
- GOTO OP
- +3 SET SRSOP=Y
- IF SRSOP=""
- GOTO OP
- OPD ; Principal Preoperative Diagnosis
- +1 KILL DIR
- SET DIR(0)="130,32"
- SET DIR("A")="Principal Preoperative Diagnosis"
- DO ^DIR
- KILL DIR
- IF $DATA(DTOUT)!(X="^")
- SET SRSOUT=1
- GOTO DEL
- +2 IF Y=""!(X["^")
- WRITE !!,"A Principal Preoperative Diagnosis must be entered",!,"when creating a new case. Enter '^' to exit.",!
- GOTO OPD
- +3 IF X[";"
- WRITE !,"The Principal Preoperative Diagnosis cannot contain a semicolon (;).",!,"Please re-enter the Diagnosis, using commas in place of the semicolons."
- GOTO OPD
- +4 SET SRSOPD=Y
- +5 WRITE !!,"The information entered into the Principal Preoperative Diagnosis field",!,"has been transferred into the Indications for Operation field.",!,"The Indications for Operation field can be updated later if necessary.",!
- +6 WRITE !!,"Press RETURN to continue "
- READ X:DTIME
- +7 ;
- PCPT ; Planned Principal Procedure Code (CPT)
- +1 KILL DIR
- SET DIR(0)="130,27"
- SET DIR("A")="Planned Principal Procedure Code"
- DO ^DIR
- KILL DIR
- IF $DATA(DTOUT)!(X="^")
- SET SRSOUT=1
- GOTO DEL
- +2 IF Y=""!(X["^")
- WRITE !!,"To make an operation request, Planned Principal Procedure Code field MUST be entered. Enter '^' to exit.",!
- GOTO PCPT
- +3 SET SRCPT=$PIECE(Y,"^")
- +4 ;
- UPDATE ; update case in SURGERY file
- +1 SET DA=SRTN
- SET DIE=130
- SET DR="26////"_SRSOP_";68////"_SRSOP_";36////0;Q;.04////"_SRSS_";32////"_SRSOPD_";27////"_SRCPT
- DO ^DIE
- +2 DO SPIN
- +3 KILL DR,DA
- SET DR="[SRO-NOCOMP]"
- SET DA=SRTN
- SET DIE=130
- DO ^DIE
- KILL DR
- +4 DO ^SROXRET
- KILL SRNOCON
- OTHER ; other required fields
- +1 SET SRFLD=0
- FOR
- SET SRFLD=$ORDER(^SRO(133,SRSITE,4,SRFLD))
- if 'SRFLD!(SRSOUT)
- QUIT
- DO OTHDIR
- if SRSOUT
- QUIT
- +2 IF SRSOUT
- GOTO DEL
- +3 SET SRSOPD(1)=SRSOPD
- DO WP^DIE(130,SRTN_",",55,"A","SRSOPD")
- +4 if $GET(SRLCK)
- DO UNLOCK^SROUTL(SRTN)
- +5 SET SROERR=SRTN
- DO ^SROERR
- IF $DATA(SRDUOUT)
- SET SRSOUT=1
- +6 IF $DATA(SRCC)
- IF SRSCON=2
- SET DIE=130
- SET DR="35////"_SRSCON(1)
- SET DA=SRTN
- DO ^DIE
- KILL DR
- SET DR="35////"_SRTN
- SET DA=SRSCON(1)
- SET DIE=130
- DO ^DIE
- KILL DR,DA
- SET SROERR=SRSCON(1)
- DO ^SROERR0
- +7 QUIT
- DEL SET DA=SRTN
- SET DIK="^SRF("
- DO ^DIK
- GOTO END
- CON ; request concurrent case
- +1 DO MUST
- if SRSOUT
- QUIT
- SET SRSCON(SRSCON,"DOC")=$PIECE(^VA(200,SRSDOC,0),"^")
- SET SRSCON(SRSCON,"SS")=$PIECE(^SRO(137.45,SRSS,0),"^")
- SET SRSCON(SRSCON,"OP")=$PIECE(^SRF(SRTN,"OP"),"^")
- SET SRSCON(SRSCON)=SRTN
- KILL DA
- +2 QUIT
- OTHDIR ; call to reader for site specific required fields
- +1 ;JAS - 08/05/14 - SR*3*177 - Modified this section for ICD-10
- +2 KILL DIR,SREQ,SRY
- SET FLD=$PIECE(^SRO(133,SRSITE,4,SRFLD,0),"^")
- DO FIELD^DID(130,FLD,"","TITLE","SRY")
- SET DIR(0)="130,"_FLD
- SET DIR("A")=SRY("TITLE")
- DO DIRYN
- IF $DATA(DTOUT)!($GET(X)="^")
- SET SRSOUT=1
- QUIT
- +3 IF "^32.5^66^253^286^343^344^392^489^"[("^"_FLD_"^")
- IF $GET(X)="@"!($GET(X)="")
- SET X="^"
- +4 IF $GET(Y)=""!(X["^")
- WRITE !!,"It is mandatory that you provide this information before proceeding with this",!,"option.",!
- DO ASK
- if SRSOUT
- QUIT
- GOTO OTHDIR
- +5 SET SREQ(130,SRTN_",",FLD)=$PIECE(Y,"^")
- DO FILE^DIE("","SREQ","^TMP(""SR"",$J)")
- +6 QUIT
- DIRYN ; call ^DIR if not FILE 80 or ICD-9 FILE 80 (added for SR*3.0*177)
- +1 IF "^32.5^66^253^286^343^344^392^489^"[("^"_FLD_"^")
- Begin DoDot:1
- +2 SET SRPRMT=DIR("A")_" "
- SET SRDEF=$$GET1^DIQ(130,SRTN,FLD)
- +3 DO ICDSRCH^SROICD
- End DoDot:1
- QUIT
- +4 DO ^DIR
- +5 QUIT
- ASK KILL DIR
- SET DIR(0)="Y"
- SET DIR("A")="Do you want to continue with this option "
- SET DIR("B")="YES"
- +1 SET DIR("?")="Enter RETURN to continue with this option, or 'NO' to discontinue this option."
- DO ^DIR
- if 'Y
- SET SRSOUT=1
- +2 QUIT
- END if $GET(SRLCK)
- DO UNLOCK^SROUTL(SRTN)
- +1 IF '$DATA(SRCC)
- IF SRSOUT
- WRITE !!,"No surgical case has been scheduled.",!
- SET SRTN("OR")=SRSOR
- SET SRTN("START")=SRSDT1
- SET SRTN("END")=SRSDT2
- SET SRSEDT=$EXTRACT(SRSDT2,1,7)
- DO ^SRSCG
- +2 QUIT
- SPIN ; spinal level free-text
- +1 IF '$$SPIN^SRTOVRF(SRCPT)
- QUIT
- +2 NEW SL
- +3 KILL DIR
- SET DIR(0)="130,136"
- SET DIR("A")="Spinal Level Comment"
- DO ^DIR
- KILL DIR
- +4 SET SL=$PIECE(Y,"^")
- IF Y=""!$DATA(DTOUT)!$DATA(DUOUT)
- SET SL=""
- +5 SET $PIECE(^SRF(SRTN,1.1),"^",4)=SL
- +6 QUIT