SROMENU ;BIR/MAM - OPERATION MENU OPTIONS ;27 Sep 2013 1:03 PM
;;3.0;Surgery;**52,67,69,104,107,100,134,175,177,182,184,205**;24 Jun 93;Build 12
TECH ; sromen-anes tech
G:'$G(SRTN) NO D ^SROLOCK G:SROLOCK END
N SRLCK S SRLCK=$$LOCK^SROUTL(SRTN) I 'SRLCK G END
K DR,SRODR S DR="[SROMEN-ANES TECH]",DIE=130,DA=SRTN D ^DIE I $D(SRODR) D ^SROCON1
G END
OP ; sromen-op
D RT K SRODR
G:'$G(SRTN) NO D ^SROLOCK I SROLOCK S Q3("VIEW")=""
N SRLCK S SRLCK=$$LOCK^SROUTL(SRTN) I 'SRLCK G END
; RBD - 10/15/13 - PATCH 177 - Code Set labeling issue fixed.
N SRICDV S SRICDV=$$ICDSTR^SROICD(SRTN)
; End 177
K ^TMP("SR182",$J) ; set by 'AO' x-ref
;
;;**hard set of POSSIBLE ITEM RETENTION (#630) field in SURGERY (#130) file disabled in SR*3.0*205
;S:$P($G(^SRF(SRTN,25)),"^",6)="" $P(^SRF(SRTN,25),"^",6)="Y"
;
K DR S SRDTIME=DTIME,DTIME=3600,DIE=130,DR="[SROMEN-OPER]",DA=SRTN,ST="OPERATION"_$S(SROLOCK:" **LOCKED",1:"") D EN2^SROVAR,^SRCUSS S DTIME=SRDTIME I $D(Q3("VIEW")) K Q3("VIEW") G END
D WSXR^SRTOVRF(SRTN)
I '$P(^SRF(SRTN,0),"^",20) D ^SROPCE1
I $D(SRODR) D ^SROCON1
S SROERR=SRTN G END
COMP ; sromen-comp
K SRODR
G:'$G(SRTN) NO D ^SROLOCK G:SROLOCK END
N SRLCK S SRLCK=$$LOCK^SROUTL(SRTN) I 'SRLCK G END
K DR W @IOF,! S DIE=130,DA=SRTN,DR="[SROMEN-COMP]" D ^DIE
I $D(SRODR) D ^SROCON1
G END
SHORT ; sromen-out
D RT K SRODR
G:'$G(SRTN) NO
; RBD - 10/15/13 - PATCH 177 - Code set labeling issue fixed.
N SRICDV S SRICDV=$$ICDSTR^SROICD(SRTN)
; End 177
D ^SROLOCK I SROLOCK S Q3("VIEW")=""
N SRLCK S SRLCK=$$LOCK^SROUTL(SRTN) I 'SRLCK G END
K ^TMP("SR182",$J) ; set by 'AO' x-ref
K DR S SRDTIME=DTIME,DTIME=3600,DIE=130,DA=SRTN,DR="[SROMEN-OUT]",ST="SHORT SCREEN"_$S(SROLOCK:" **LOCKED",1:"") D EN2^SROVAR,^SRCUSS S DTIME=SRDTIME I $D(Q3("VIEW")) K Q3("VIEW") G END
D WSXR^SRTOVRF(SRTN)
I '$P(^SRF(SRTN,0),"^",20) D ^SROPCE1
I $D(SRODR) D ^SROCON1
S SROERR=SRTN G END
VERF ; Time Out Verified Utilizing Checklist
D RT K SRODR
G:'$G(SRTN) NO D ^SROLOCK I SROLOCK S Q3("VIEW")=""
N SRLCK S SRLCK=$$LOCK^SROUTL(SRTN) I 'SRLCK G END
K DR S SRDTIME=DTIME,DTIME=3600,DIE=130,DA=SRTN,DR="[SROMEN-VERF]",ST="TIME OUT CHECKLIST-1"_$S(SROLOCK:" **LOCKED",1:"") D EN2^SROVAR,^SRCUSS S DTIME=SRDTIME I $D(Q3("VIEW")) K Q3("VIEW") G END
I $$VER1^SRTOVRF(SRTN) K DR S SRDTIME=DTIME,DTIME=3600,DIE=130,DA=SRTN,DR="[SROMEN-VERF1]",ST="TIME OUT CHECKLIST-2"_$S(SROLOCK:" **LOCKED",1:"") D EN2^SROVAR,^SRCUSS S DTIME=SRDTIME I $D(Q3("VIEW")) K Q3("VIEW") G END
I $$VER2^SRTOVRF(SRTN) K DR S SRDTIME=DTIME,DTIME=3600,DIE=130,DA=SRTN,DR="[SROMEN-VERF2]",ST="TIME OUT CHECKLIST-3"_$S(SROLOCK:" **LOCKED",1:"") D EN2^SROVAR,^SRCUSS S DTIME=SRDTIME I $D(Q3("VIEW")) K Q3("VIEW") G END
I $D(SRODR) D ^SROCON1
S SROERR=SRTN G END
PACU ; sromen-pacu
D RT K SRODR
G:'$G(SRTN) NO D ^SROLOCK I SROLOCK S Q3("VIEW")=""
N SRLCK S SRLCK=$$LOCK^SROUTL(SRTN) I 'SRLCK G END
K DR S DIE=130,DA=SRTN,ST="PACU"_$S(SROLOCK:" **LOCKED",1:""),DR="[SROMEN-PACU]" D EN2^SROVAR,^SRCUSS I $D(Q3("VIEW")) K Q3("VIEW") G END
I $D(SRODR) D ^SROCON1
S SROERR=SRTN D ^SROERR0
G END
POST ; sromen-post
; JAS - 11/13/13 - PATCH 177 - Added next line to fix code set labeling issue.
K SRICDV S SRICDV=$$ICDSTR^SROICD(SRTN)
D RT K SRODR
G:'$G(SRTN) NO D ^SROLOCK I SROLOCK S Q3("VIEW")=""
N SRLCK S SRLCK=$$LOCK^SROUTL(SRTN) I 'SRLCK G END
K DR S SRDTIME=DTIME,DTIME=3600,DIE=130,DA=SRTN,ST="POST OPERATION"_$S(SROLOCK:" **LOCKED",1:""),DR="[SROMEN-POST]" D EN2^SROVAR,^SRCUSS S DTIME=SRDTIME I $D(Q3("VIEW")) K Q3("VIEW") G END
I '$P(^SRF(SRTN,0),"^",20) D ^SROPCE1
I $D(SRODR) D ^SROCON1
S SROERR=SRTN G END
REF ; sromen-refer
K SRODR
G:'$G(SRTN) NO D ^SROLOCK G:SROLOCK END
N SRLCK S SRLCK=$$LOCK^SROUTL(SRTN) I 'SRLCK G END
W @IOF K DR S DIE=130,DA=SRTN,DR="[SROMEN-REFER]" W !! D ^DIE
I $D(SRODR) D ^SROCON1
G END
STAFF ; sromen-staff
D RT K SRODR
G:'$G(SRTN) NO D ^SROLOCK I SROLOCK S Q3("VIEW")=""
N SRLCK S SRLCK=$$LOCK^SROUTL(SRTN) I 'SRLCK G END
K DR S SRDTIME=DTIME,DTIME=3600,DIE=130,DA=SRTN,ST="SURGICAL STAFF"_$S(SROLOCK:" **LOCKED",1:""),DR="[SROMEN-STAFF]" D EN2^SROVAR,^SRCUSS S DTIME=SRDTIME I $D(Q3("VIEW")) K Q3("VIEW") G END
I '$P(^SRF(SRTN,0),"^",20) D ^SROPCE1
I $D(SRODR) D ^SROCON1
S SROERR=SRTN G END
START ; sromen-start
D RT K SRODR
G:'$G(SRTN) NO
; RBD - 10/15/13 - PATCH 177 - Code set labeling issue fixed.
N SRICDV S SRICDV=$$ICDSTR^SROICD(SRTN)
; End 177
D ^SROLOCK I SROLOCK S Q3("VIEW")=""
N SRLCK S SRLCK=$$LOCK^SROUTL(SRTN) I 'SRLCK G END
D HWT^SROACL2 ; SR*3*184 change - retrieve height & weight from vital
K DR S SRDTIME=DTIME,DTIME=3600,DIE=130,DA=SRTN,ST="STARTUP"_$S(SROLOCK:" **LOCKED",1:""),DR="[SROMEN-START]" D EN2^SROVAR,^SRCUSS S DTIME=SRDTIME I $D(Q3("VIEW")) K Q3("VIEW") G END
I '$P(^SRF(SRTN,0),"^",20) D ^SROPCE1
I $D(SRODR) D ^SROCON1
S SROERR=SRTN G END
REV ; review request information (request menu)
K SRNEWOP D ^SROPS D RT G:'$G(SRTN) END
N SRICDV S SRICDV=$$ICDSTR^SROICD(SRTN)
K Y,DR S Q3("VIEW")="",ST="REVIEW REQUEST",DIC=130,DA=SRTN,DR="[SRSREQV]" D EN2^SROVAR,^SRCUSS K DR,SRTN
G END
NO ;
W !!,"An operative procedure must be selected to use this option.",!
W !!,"Press RETURN to continue " R X:DTIME
END ;
I $D(SROERR) D ^SROERR0
I $G(SRTN) D UNLOCK^SROUTL(SRTN)
K SRDTIME D ^SRSKILL W @IOF
Q
RT ; start RT logging
I $G(SRTN),$D(XRTL) S XRTN="SROMENU" D T0^%ZOSV
Q
AB ; sromen-abort
D RT K SRODR
G:'$G(SRTN) NO D ^SROLOCK G:SROLOCK END
D ABORT^SRSCAN0 D END K DR,SRTN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROMENU 5599 printed Oct 16, 2024@18:44:46 Page 2
+1 ;;3.0;Surgery;**52,67,69,104,107,100,134,175,177,182,184,205**;24 Jun 93;Build 12
TECH ; sromen-anes tech
+1 if '$GET(SRTN)
GOTO NO
DO ^SROLOCK
if SROLOCK
GOTO END
+2 NEW SRLCK
SET SRLCK=$$LOCK^SROUTL(SRTN)
IF 'SRLCK
GOTO END
+3 KILL DR,SRODR
SET DR="[SROMEN-ANES TECH]"
SET DIE=130
SET DA=SRTN
DO ^DIE
IF $DATA(SRODR)
DO ^SROCON1
+4 GOTO END
OP ; sromen-op
+1 DO RT
KILL SRODR
+2 if '$GET(SRTN)
GOTO NO
DO ^SROLOCK
IF SROLOCK
SET Q3("VIEW")=""
+3 NEW SRLCK
SET SRLCK=$$LOCK^SROUTL(SRTN)
IF 'SRLCK
GOTO END
+4 ; RBD - 10/15/13 - PATCH 177 - Code Set labeling issue fixed.
+5 NEW SRICDV
SET SRICDV=$$ICDSTR^SROICD(SRTN)
+6 ; End 177
+7 ; set by 'AO' x-ref
KILL ^TMP("SR182",$JOB)
+8 ;
+9 ;;**hard set of POSSIBLE ITEM RETENTION (#630) field in SURGERY (#130) file disabled in SR*3.0*205
+10 ;S:$P($G(^SRF(SRTN,25)),"^",6)="" $P(^SRF(SRTN,25),"^",6)="Y"
+11 ;
+12 KILL DR
SET SRDTIME=DTIME
SET DTIME=3600
SET DIE=130
SET DR="[SROMEN-OPER]"
SET DA=SRTN
SET ST="OPERATION"_$SELECT(SROLOCK:" **LOCKED",1:"")
DO EN2^SROVAR
DO ^SRCUSS
SET DTIME=SRDTIME
IF $DATA(Q3("VIEW"))
KILL Q3("VIEW")
GOTO END
+13 DO WSXR^SRTOVRF(SRTN)
+14 IF '$PIECE(^SRF(SRTN,0),"^",20)
DO ^SROPCE1
+15 IF $DATA(SRODR)
DO ^SROCON1
+16 SET SROERR=SRTN
GOTO END
COMP ; sromen-comp
+1 KILL SRODR
+2 if '$GET(SRTN)
GOTO NO
DO ^SROLOCK
if SROLOCK
GOTO END
+3 NEW SRLCK
SET SRLCK=$$LOCK^SROUTL(SRTN)
IF 'SRLCK
GOTO END
+4 KILL DR
WRITE @IOF,!
SET DIE=130
SET DA=SRTN
SET DR="[SROMEN-COMP]"
DO ^DIE
+5 IF $DATA(SRODR)
DO ^SROCON1
+6 GOTO END
SHORT ; sromen-out
+1 DO RT
KILL SRODR
+2 if '$GET(SRTN)
GOTO NO
+3 ; RBD - 10/15/13 - PATCH 177 - Code set labeling issue fixed.
+4 NEW SRICDV
SET SRICDV=$$ICDSTR^SROICD(SRTN)
+5 ; End 177
+6 DO ^SROLOCK
IF SROLOCK
SET Q3("VIEW")=""
+7 NEW SRLCK
SET SRLCK=$$LOCK^SROUTL(SRTN)
IF 'SRLCK
GOTO END
+8 ; set by 'AO' x-ref
KILL ^TMP("SR182",$JOB)
+9 KILL DR
SET SRDTIME=DTIME
SET DTIME=3600
SET DIE=130
SET DA=SRTN
SET DR="[SROMEN-OUT]"
SET ST="SHORT SCREEN"_$SELECT(SROLOCK:" **LOCKED",1:"")
DO EN2^SROVAR
DO ^SRCUSS
SET DTIME=SRDTIME
IF $DATA(Q3("VIEW"))
KILL Q3("VIEW")
GOTO END
+10 DO WSXR^SRTOVRF(SRTN)
+11 IF '$PIECE(^SRF(SRTN,0),"^",20)
DO ^SROPCE1
+12 IF $DATA(SRODR)
DO ^SROCON1
+13 SET SROERR=SRTN
GOTO END
VERF ; Time Out Verified Utilizing Checklist
+1 DO RT
KILL SRODR
+2 if '$GET(SRTN)
GOTO NO
DO ^SROLOCK
IF SROLOCK
SET Q3("VIEW")=""
+3 NEW SRLCK
SET SRLCK=$$LOCK^SROUTL(SRTN)
IF 'SRLCK
GOTO END
+4 KILL DR
SET SRDTIME=DTIME
SET DTIME=3600
SET DIE=130
SET DA=SRTN
SET DR="[SROMEN-VERF]"
SET ST="TIME OUT CHECKLIST-1"_$SELECT(SROLOCK:" **LOCKED",1:"")
DO EN2^SROVAR
DO ^SRCUSS
SET DTIME=SRDTIME
IF $DATA(Q3("VIEW"))
KILL Q3("VIEW")
GOTO END
+5 IF $$VER1^SRTOVRF(SRTN)
KILL DR
SET SRDTIME=DTIME
SET DTIME=3600
SET DIE=130
SET DA=SRTN
SET DR="[SROMEN-VERF1]"
SET ST="TIME OUT CHECKLIST-2"_$SELECT(SROLOCK:" **LOCKED",1:"")
DO EN2^SROVAR
DO ^SRCUSS
SET DTIME=SRDTIME
IF $DATA(Q3("VIEW"))
KILL Q3("VIEW")
GOTO END
+6 IF $$VER2^SRTOVRF(SRTN)
KILL DR
SET SRDTIME=DTIME
SET DTIME=3600
SET DIE=130
SET DA=SRTN
SET DR="[SROMEN-VERF2]"
SET ST="TIME OUT CHECKLIST-3"_$SELECT(SROLOCK:" **LOCKED",1:"")
DO EN2^SROVAR
DO ^SRCUSS
SET DTIME=SRDTIME
IF $DATA(Q3("VIEW"))
KILL Q3("VIEW")
GOTO END
+7 IF $DATA(SRODR)
DO ^SROCON1
+8 SET SROERR=SRTN
GOTO END
PACU ; sromen-pacu
+1 DO RT
KILL SRODR
+2 if '$GET(SRTN)
GOTO NO
DO ^SROLOCK
IF SROLOCK
SET Q3("VIEW")=""
+3 NEW SRLCK
SET SRLCK=$$LOCK^SROUTL(SRTN)
IF 'SRLCK
GOTO END
+4 KILL DR
SET DIE=130
SET DA=SRTN
SET ST="PACU"_$SELECT(SROLOCK:" **LOCKED",1:"")
SET DR="[SROMEN-PACU]"
DO EN2^SROVAR
DO ^SRCUSS
IF $DATA(Q3("VIEW"))
KILL Q3("VIEW")
GOTO END
+5 IF $DATA(SRODR)
DO ^SROCON1
+6 SET SROERR=SRTN
DO ^SROERR0
+7 GOTO END
POST ; sromen-post
+1 ; JAS - 11/13/13 - PATCH 177 - Added next line to fix code set labeling issue.
+2 KILL SRICDV
SET SRICDV=$$ICDSTR^SROICD(SRTN)
+3 DO RT
KILL SRODR
+4 if '$GET(SRTN)
GOTO NO
DO ^SROLOCK
IF SROLOCK
SET Q3("VIEW")=""
+5 NEW SRLCK
SET SRLCK=$$LOCK^SROUTL(SRTN)
IF 'SRLCK
GOTO END
+6 KILL DR
SET SRDTIME=DTIME
SET DTIME=3600
SET DIE=130
SET DA=SRTN
SET ST="POST OPERATION"_$SELECT(SROLOCK:" **LOCKED",1:"")
SET DR="[SROMEN-POST]"
DO EN2^SROVAR
DO ^SRCUSS
SET DTIME=SRDTIME
IF $DATA(Q3("VIEW"))
KILL Q3("VIEW")
GOTO END
+7 IF '$PIECE(^SRF(SRTN,0),"^",20)
DO ^SROPCE1
+8 IF $DATA(SRODR)
DO ^SROCON1
+9 SET SROERR=SRTN
GOTO END
REF ; sromen-refer
+1 KILL SRODR
+2 if '$GET(SRTN)
GOTO NO
DO ^SROLOCK
if SROLOCK
GOTO END
+3 NEW SRLCK
SET SRLCK=$$LOCK^SROUTL(SRTN)
IF 'SRLCK
GOTO END
+4 WRITE @IOF
KILL DR
SET DIE=130
SET DA=SRTN
SET DR="[SROMEN-REFER]"
WRITE !!
DO ^DIE
+5 IF $DATA(SRODR)
DO ^SROCON1
+6 GOTO END
STAFF ; sromen-staff
+1 DO RT
KILL SRODR
+2 if '$GET(SRTN)
GOTO NO
DO ^SROLOCK
IF SROLOCK
SET Q3("VIEW")=""
+3 NEW SRLCK
SET SRLCK=$$LOCK^SROUTL(SRTN)
IF 'SRLCK
GOTO END
+4 KILL DR
SET SRDTIME=DTIME
SET DTIME=3600
SET DIE=130
SET DA=SRTN
SET ST="SURGICAL STAFF"_$SELECT(SROLOCK:" **LOCKED",1:"")
SET DR="[SROMEN-STAFF]"
DO EN2^SROVAR
DO ^SRCUSS
SET DTIME=SRDTIME
IF $DATA(Q3("VIEW"))
KILL Q3("VIEW")
GOTO END
+5 IF '$PIECE(^SRF(SRTN,0),"^",20)
DO ^SROPCE1
+6 IF $DATA(SRODR)
DO ^SROCON1
+7 SET SROERR=SRTN
GOTO END
START ; sromen-start
+1 DO RT
KILL SRODR
+2 if '$GET(SRTN)
GOTO NO
+3 ; RBD - 10/15/13 - PATCH 177 - Code set labeling issue fixed.
+4 NEW SRICDV
SET SRICDV=$$ICDSTR^SROICD(SRTN)
+5 ; End 177
+6 DO ^SROLOCK
IF SROLOCK
SET Q3("VIEW")=""
+7 NEW SRLCK
SET SRLCK=$$LOCK^SROUTL(SRTN)
IF 'SRLCK
GOTO END
+8 ; SR*3*184 change - retrieve height & weight from vital
DO HWT^SROACL2
+9 KILL DR
SET SRDTIME=DTIME
SET DTIME=3600
SET DIE=130
SET DA=SRTN
SET ST="STARTUP"_$SELECT(SROLOCK:" **LOCKED",1:"")
SET DR="[SROMEN-START]"
DO EN2^SROVAR
DO ^SRCUSS
SET DTIME=SRDTIME
IF $DATA(Q3("VIEW"))
KILL Q3("VIEW")
GOTO END
+10 IF '$PIECE(^SRF(SRTN,0),"^",20)
DO ^SROPCE1
+11 IF $DATA(SRODR)
DO ^SROCON1
+12 SET SROERR=SRTN
GOTO END
REV ; review request information (request menu)
+1 KILL SRNEWOP
DO ^SROPS
DO RT
if '$GET(SRTN)
GOTO END
+2 NEW SRICDV
SET SRICDV=$$ICDSTR^SROICD(SRTN)
+3 KILL Y,DR
SET Q3("VIEW")=""
SET ST="REVIEW REQUEST"
SET DIC=130
SET DA=SRTN
SET DR="[SRSREQV]"
DO EN2^SROVAR
DO ^SRCUSS
KILL DR,SRTN
+4 GOTO END
NO ;
+1 WRITE !!,"An operative procedure must be selected to use this option.",!
+2 WRITE !!,"Press RETURN to continue "
READ X:DTIME
END ;
+1 IF $DATA(SROERR)
DO ^SROERR0
+2 IF $GET(SRTN)
DO UNLOCK^SROUTL(SRTN)
+3 KILL SRDTIME
DO ^SRSKILL
WRITE @IOF
+4 QUIT
RT ; start RT logging
+1 IF $GET(SRTN)
IF $DATA(XRTL)
SET XRTN="SROMENU"
DO T0^%ZOSV
+2 QUIT
AB ; sromen-abort
+1 DO RT
KILL SRODR
+2 if '$GET(SRTN)
GOTO NO
DO ^SROLOCK
if SROLOCK
GOTO END
+3 DO ABORT^SRSCAN0
DO END
KILL DR,SRTN
