Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SROMENU

SROMENU.m

Go to the documentation of this file.
  1. SROMENU ;BIR/MAM - OPERATION MENU OPTIONS ;27 Sep 2013 1:03 PM
  1. ;;3.0;Surgery;**52,67,69,104,107,100,134,175,177,182,184,205**;24 Jun 93;Build 12
  1. TECH ; sromen-anes tech
  1. G:'$G(SRTN) NO D ^SROLOCK G:SROLOCK END
  1. N SRLCK S SRLCK=$$LOCK^SROUTL(SRTN) I 'SRLCK G END
  1. K DR,SRODR S DR="[SROMEN-ANES TECH]",DIE=130,DA=SRTN D ^DIE I $D(SRODR) D ^SROCON1
  1. G END
  1. OP ; sromen-op
  1. D RT K SRODR
  1. G:'$G(SRTN) NO D ^SROLOCK I SROLOCK S Q3("VIEW")=""
  1. N SRLCK S SRLCK=$$LOCK^SROUTL(SRTN) I 'SRLCK G END
  1. ; RBD - 10/15/13 - PATCH 177 - Code Set labeling issue fixed.
  1. N SRICDV S SRICDV=$$ICDSTR^SROICD(SRTN)
  1. ; End 177
  1. K ^TMP("SR182",$J) ; set by 'AO' x-ref
  1. ;
  1. ;;**hard set of POSSIBLE ITEM RETENTION (#630) field in SURGERY (#130) file disabled in SR*3.0*205
  1. ;S:$P($G(^SRF(SRTN,25)),"^",6)="" $P(^SRF(SRTN,25),"^",6)="Y"
  1. ;
  1. 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
  1. D WSXR^SRTOVRF(SRTN)
  1. I '$P(^SRF(SRTN,0),"^",20) D ^SROPCE1
  1. I $D(SRODR) D ^SROCON1
  1. S SROERR=SRTN G END
  1. COMP ; sromen-comp
  1. K SRODR
  1. G:'$G(SRTN) NO D ^SROLOCK G:SROLOCK END
  1. N SRLCK S SRLCK=$$LOCK^SROUTL(SRTN) I 'SRLCK G END
  1. K DR W @IOF,! S DIE=130,DA=SRTN,DR="[SROMEN-COMP]" D ^DIE
  1. I $D(SRODR) D ^SROCON1
  1. G END
  1. SHORT ; sromen-out
  1. D RT K SRODR
  1. G:'$G(SRTN) NO
  1. ; RBD - 10/15/13 - PATCH 177 - Code set labeling issue fixed.
  1. N SRICDV S SRICDV=$$ICDSTR^SROICD(SRTN)
  1. ; End 177
  1. D ^SROLOCK I SROLOCK S Q3("VIEW")=""
  1. N SRLCK S SRLCK=$$LOCK^SROUTL(SRTN) I 'SRLCK G END
  1. K ^TMP("SR182",$J) ; set by 'AO' x-ref
  1. 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
  1. D WSXR^SRTOVRF(SRTN)
  1. I '$P(^SRF(SRTN,0),"^",20) D ^SROPCE1
  1. I $D(SRODR) D ^SROCON1
  1. S SROERR=SRTN G END
  1. VERF ; Time Out Verified Utilizing Checklist
  1. D RT K SRODR
  1. G:'$G(SRTN) NO D ^SROLOCK I SROLOCK S Q3("VIEW")=""
  1. N SRLCK S SRLCK=$$LOCK^SROUTL(SRTN) I 'SRLCK G END
  1. 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
  1. 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
  1. 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
  1. I $D(SRODR) D ^SROCON1
  1. S SROERR=SRTN G END
  1. PACU ; sromen-pacu
  1. D RT K SRODR
  1. G:'$G(SRTN) NO D ^SROLOCK I SROLOCK S Q3("VIEW")=""
  1. N SRLCK S SRLCK=$$LOCK^SROUTL(SRTN) I 'SRLCK G END
  1. 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
  1. I $D(SRODR) D ^SROCON1
  1. S SROERR=SRTN D ^SROERR0
  1. G END
  1. POST ; sromen-post
  1. ; JAS - 11/13/13 - PATCH 177 - Added next line to fix code set labeling issue.
  1. K SRICDV S SRICDV=$$ICDSTR^SROICD(SRTN)
  1. D RT K SRODR
  1. G:'$G(SRTN) NO D ^SROLOCK I SROLOCK S Q3("VIEW")=""
  1. N SRLCK S SRLCK=$$LOCK^SROUTL(SRTN) I 'SRLCK G END
  1. 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
  1. I '$P(^SRF(SRTN,0),"^",20) D ^SROPCE1
  1. I $D(SRODR) D ^SROCON1
  1. S SROERR=SRTN G END
  1. REF ; sromen-refer
  1. K SRODR
  1. G:'$G(SRTN) NO D ^SROLOCK G:SROLOCK END
  1. N SRLCK S SRLCK=$$LOCK^SROUTL(SRTN) I 'SRLCK G END
  1. W @IOF K DR S DIE=130,DA=SRTN,DR="[SROMEN-REFER]" W !! D ^DIE
  1. I $D(SRODR) D ^SROCON1
  1. G END
  1. STAFF ; sromen-staff
  1. D RT K SRODR
  1. G:'$G(SRTN) NO D ^SROLOCK I SROLOCK S Q3("VIEW")=""
  1. N SRLCK S SRLCK=$$LOCK^SROUTL(SRTN) I 'SRLCK G END
  1. 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
  1. I '$P(^SRF(SRTN,0),"^",20) D ^SROPCE1
  1. I $D(SRODR) D ^SROCON1
  1. S SROERR=SRTN G END
  1. START ; sromen-start
  1. D RT K SRODR
  1. G:'$G(SRTN) NO
  1. ; RBD - 10/15/13 - PATCH 177 - Code set labeling issue fixed.
  1. N SRICDV S SRICDV=$$ICDSTR^SROICD(SRTN)
  1. ; End 177
  1. D ^SROLOCK I SROLOCK S Q3("VIEW")=""
  1. N SRLCK S SRLCK=$$LOCK^SROUTL(SRTN) I 'SRLCK G END
  1. D HWT^SROACL2 ; SR*3*184 change - retrieve height & weight from vital
  1. 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
  1. I '$P(^SRF(SRTN,0),"^",20) D ^SROPCE1
  1. I $D(SRODR) D ^SROCON1
  1. S SROERR=SRTN G END
  1. REV ; review request information (request menu)
  1. K SRNEWOP D ^SROPS D RT G:'$G(SRTN) END
  1. N SRICDV S SRICDV=$$ICDSTR^SROICD(SRTN)
  1. K Y,DR S Q3("VIEW")="",ST="REVIEW REQUEST",DIC=130,DA=SRTN,DR="[SRSREQV]" D EN2^SROVAR,^SRCUSS K DR,SRTN
  1. G END
  1. NO ;
  1. W !!,"An operative procedure must be selected to use this option.",!
  1. W !!,"Press RETURN to continue " R X:DTIME
  1. END ;
  1. I $D(SROERR) D ^SROERR0
  1. I $G(SRTN) D UNLOCK^SROUTL(SRTN)
  1. K SRDTIME D ^SRSKILL W @IOF
  1. Q
  1. RT ; start RT logging
  1. I $G(SRTN),$D(XRTL) S XRTN="SROMENU" D T0^%ZOSV
  1. Q
  1. AB ; sromen-abort
  1. D RT K SRODR
  1. G:'$G(SRTN) NO D ^SROLOCK G:SROLOCK END
  1. D ABORT^SRSCAN0 D END K DR,SRTN