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

SROLOCK.m

Go to the documentation of this file.
  1. SROLOCK ;B'HAM ISC/MAM - USED TO LOCK A CASE ;11/10/04
  1. ;;3.0; Surgery ;**7,50,134**;24 Jun 93
  1. CHECK ; check to determine if a case is locked
  1. K SROLOCK I $D(^SRF(SRTN,"LOCK")),$P(^("LOCK"),"^")=1 S SROLOCK=1
  1. I $D(SROLOCK) W !!,"This case has been verified and locked. It cannot be updated unless",!,"unlocked by your chief, or someone appointed by your chief.",!!,"Press RETURN to continue " R X:DTIME
  1. Q:$D(SROLOCK) S SROLOCK=0
  1. Q
  1. UNLOCK ; unlock a case for editing
  1. S Z=0 D SEL I '$D(SRTN) G END
  1. I '$P($G(^SRF(SRTN,"LOCK")),"^") W !!,"This case is not locked." G END
  1. S ^SRF("AL",SRTN)="",^SRF(SRTN,"LOCK")="" W !!,"Case #"_SRTN_" is now unlocked."
  1. END W !!,"Press RETURN to continue " R X:DTIME W @IOF
  1. K SROPS,C,CASE,CNT,CPT,DATE,DFN,I,M,LOOP,SRTN,SROPER,X,Y,Z
  1. Q
  1. LOCK ; queued to run nightly, locks cases that are passed the specified
  1. ; number of days for editing
  1. S SITE=0 F S SITE=$O(^SRO(133,SITE)) Q:'SITE S SR=^SRO(133,SITE,0),DAYS=$P(SR,"^",11) I DAYS S SRSITE("DIV")=$P(SR,"^") D
  1. .S X1=DT,MOE=25+DAYS,X2="-"_MOE D C^%DTC S START=X,X1=DT,X2="-"_DAYS D C^%DTC S END=X
  1. .S DATE=START-.0001 F S DATE=$O(^SRF("AC",DATE)) Q:DATE>END!(DATE="") D SRTN
  1. S L=0 F S L=$O(^SRF("AL",L)) Q:L="" S:$D(^SRF(L,0)) ^SRF(L,"LOCK")=1 K ^SRF("AL",L)
  1. ; clean up case edit/lock flags in ^XTMP
  1. S SRNOW=$$NOW^XLFDT,SRCASE="SRLOCK-0" F S SRCASE=$O(^XTMP(SRCASE)) Q:SRCASE="" S SRNOW1=$P($G(^XTMP(SRCASE,0)),"^") I SRNOW>SRNOW1 K ^XTMP(SRCASE)
  1. Q
  1. SRTN S SRTN=0 F S SRTN=$O(^SRF("AC",DATE,SRTN)) Q:SRTN="" I $D(^SRF(SRTN,0)),$$DIV^SROUTL0(SRTN),$P($G(^SRF(SRTN,.2)),"^",12)!$P($G(^SRF(SRTN,"NON")),"^",5) S ^SRF(SRTN,"LOCK")=1
  1. Q
  1. SEL ; select patient and case
  1. W @IOF S DIC(0)="QEAM",DIC=2 D ^DIC K DIC Q:Y'>0 S DFN=+Y,(CNT,SRCNT)=0
  1. I '$O(^SRF("ADT",DFN,0)) W !!,"No cases have been scheduled for the patient chosen.",!! Q
  1. W ! S SRI=0 F S SRI=$O(^SRF("ADT",DFN,SRI)) Q:SRI="" S SRTN=0 F S SRTN=$O(^SRF("ADT",DFN,SRI,SRTN)) Q:SRTN="" S L=$P($G(^SRF(SRTN,"LOCK")),"^") I L=1 S DATE=$P(^SRF(SRTN,0),"^",9),SRCNT=SRCNT+1 D LIST
  1. I 'SRCNT W !!,"There are no locked cases for this patient." K SRTN Q
  1. D ASK
  1. Q
  1. LIST W !,?5,SRCNT_". "_$E(DATE,4,5)_"-"_$E(DATE,6,7)_"-"_$E(DATE,2,3)
  1. S CNT=CNT+1,(CPT,SROPER)=$P(^SRF(SRTN,"OP"),"^") I $P($G(^SRF(SRTN,"NON")),"^")="Y" S SROPER=SROPER_" (NON-OR PROCEDURE)"
  1. K SROPS,MM,MMM S:$L(SROPER)<55 SROPS(1)=SROPER I $L(SROPER)>54 S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM=""
  1. W ?22,SROPS(1) W:$D(SROPS(2)) !,?22,SROPS(2) W:$D(SROPS(3)) !,?22,SROPS(3) S CPT(CNT)=SRTN
  1. Q
  1. ASK R !!,"Select Number: ",Z:DTIME I '$T!("^"[Z) K SRTN Q
  1. I Z["?" W !!,"Enter the number of the desired procedure, or '^' to quit." G ASK
  1. S:$D(CPT(Z)) SRTN=CPT(Z) I '$D(CPT(Z)) K SRTN
  1. Q
  1. LOOP ; break procedure if greater than 55 characters
  1. S SROPS(M)="" F LOOP=1:1 S MM=$P(SROPER," "),MMM=$P(SROPER," ",2,200) Q:MMM="" Q:$L(SROPS(M))+$L(MM)'<55 S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM
  1. Q
  1. ALL ; lock all eligible cases in entire file
  1. Q:'$O(^SRO(133,0))
  1. S SITE=0 F S SITE=$O(^SRO(133,SITE)) Q:'SITE S DAYS=$P(^SRO(133,SITE,0),"^",11),X1=DT,X2=$S(DAYS:"-"_DAYS,1:0) D C^%DTC S SRDIV(SITE)=X
  1. S SRTN=0 F S SRTN=$O(^SRF(SRTN)) Q:'SRTN S SR=$G(^SRF(SRTN,0)) I SR'="",$P($G(^SRF(SRTN,.2)),"^",12)!$P($G(^SRF(SRTN,"NON")),"^",5) D
  1. .S SITE=$$SITE^SROUTL0(SRTN) I SITE'="" S DATE=$P(SR,"^",9) I DATE<SRDIV(SITE) S ^SRF(SRTN,"LOCK")=1
  1. K DATE,DAYS,SITE,SR,SRDIV,SRTN,X,X1,X2
  1. Q