- 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 Jan 18, 2025@03:45:17 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