source: WorldVistAEHR/trunk/r/SURGERY-SR/SROLOCK.m@ 1651

Last change on this file since 1651 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.3 KB
RevLine 
[613]1SROLOCK ;B'HAM ISC/MAM - USED TO LOCK A CASE ;11/10/04
2 ;;3.0; Surgery ;**7,50,134**;24 Jun 93
3CHECK ; check to determine if a case is locked
4 K SROLOCK I $D(^SRF(SRTN,"LOCK")),$P(^("LOCK"),"^")=1 S SROLOCK=1
5 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
6 Q:$D(SROLOCK) S SROLOCK=0
7 Q
8UNLOCK ; unlock a case for editing
9 S Z=0 D SEL I '$D(SRTN) G END
10 I '$P($G(^SRF(SRTN,"LOCK")),"^") W !!,"This case is not locked." G END
11 S ^SRF("AL",SRTN)="",^SRF(SRTN,"LOCK")="" W !!,"Case #"_SRTN_" is now unlocked."
12END W !!,"Press RETURN to continue " R X:DTIME W @IOF
13 K SROPS,C,CASE,CNT,CPT,DATE,DFN,I,M,LOOP,SRTN,SROPER,X,Y,Z
14 Q
15LOCK ; queued to run nightly, locks cases that are passed the specified
16 ; number of days for editing
17 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
18 .S X1=DT,MOE=25+DAYS,X2="-"_MOE D C^%DTC S START=X,X1=DT,X2="-"_DAYS D C^%DTC S END=X
19 .S DATE=START-.0001 F S DATE=$O(^SRF("AC",DATE)) Q:DATE>END!(DATE="") D SRTN
20 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)
21 ; clean up case edit/lock flags in ^XTMP
22 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)
23 Q
24SRTN 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
25 Q
26SEL ; select patient and case
27 W @IOF S DIC(0)="QEAM",DIC=2 D ^DIC K DIC Q:Y'>0 S DFN=+Y,(CNT,SRCNT)=0
28 I '$O(^SRF("ADT",DFN,0)) W !!,"No cases have been scheduled for the patient chosen.",!! Q
29 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
30 I 'SRCNT W !!,"There are no locked cases for this patient." K SRTN Q
31 D ASK
32 Q
33LIST W !,?5,SRCNT_". "_$E(DATE,4,5)_"-"_$E(DATE,6,7)_"-"_$E(DATE,2,3)
34 S CNT=CNT+1,(CPT,SROPER)=$P(^SRF(SRTN,"OP"),"^") I $P($G(^SRF(SRTN,"NON")),"^")="Y" S SROPER=SROPER_" (NON-OR PROCEDURE)"
35 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=""
36 W ?22,SROPS(1) W:$D(SROPS(2)) !,?22,SROPS(2) W:$D(SROPS(3)) !,?22,SROPS(3) S CPT(CNT)=SRTN
37 Q
38ASK R !!,"Select Number: ",Z:DTIME I '$T!("^"[Z) K SRTN Q
39 I Z["?" W !!,"Enter the number of the desired procedure, or '^' to quit." G ASK
40 S:$D(CPT(Z)) SRTN=CPT(Z) I '$D(CPT(Z)) K SRTN
41 Q
42LOOP ; break procedure if greater than 55 characters
43 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
44 Q
45ALL ; lock all eligible cases in entire file
46 Q:'$O(^SRO(133,0))
47 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
48 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
49 .S SITE=$$SITE^SROUTL0(SRTN) I SITE'="" S DATE=$P(SR,"^",9) I DATE<SRDIV(SITE) S ^SRF(SRTN,"LOCK")=1
50 K DATE,DAYS,SITE,SR,SRDIV,SRTN,X,X1,X2
51 Q
Note: See TracBrowser for help on using the repository browser.