SROLOCK ;B'HAM ISC/MAM - USED TO LOCK A CASE ;11/10/04
;;3.0; Surgery ;**7,50,134**;24 Jun 93
CHECK ; check to determine if a case is locked
K SROLOCK I $D(^SRF(SRTN,"LOCK")),$P(^("LOCK"),"^")=1 S SROLOCK=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
Q:$D(SROLOCK) S SROLOCK=0
Q
UNLOCK ; unlock a case for editing
S Z=0 D SEL I '$D(SRTN) G END
I '$P($G(^SRF(SRTN,"LOCK")),"^") W !!,"This case is not locked." G END
S ^SRF("AL",SRTN)="",^SRF(SRTN,"LOCK")="" W !!,"Case #"_SRTN_" is now unlocked."
END W !!,"Press RETURN to continue " R X:DTIME W @IOF
K SROPS,C,CASE,CNT,CPT,DATE,DFN,I,M,LOOP,SRTN,SROPER,X,Y,Z
Q
LOCK ; queued to run nightly, locks cases that are passed the specified
; number of days for editing
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
.S X1=DT,MOE=25+DAYS,X2="-"_MOE D C^%DTC S START=X,X1=DT,X2="-"_DAYS D C^%DTC S END=X
.S DATE=START-.0001 F S DATE=$O(^SRF("AC",DATE)) Q:DATE>END!(DATE="") D SRTN
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)
; clean up case edit/lock flags in ^XTMP
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)
Q
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
Q
SEL ; select patient and case
W @IOF S DIC(0)="QEAM",DIC=2 D ^DIC K DIC Q:Y'>0 S DFN=+Y,(CNT,SRCNT)=0
I '$O(^SRF("ADT",DFN,0)) W !!,"No cases have been scheduled for the patient chosen.",!! Q
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
I 'SRCNT W !!,"There are no locked cases for this patient." K SRTN Q
D ASK
Q
LIST W !,?5,SRCNT_". "_$E(DATE,4,5)_"-"_$E(DATE,6,7)_"-"_$E(DATE,2,3)
S CNT=CNT+1,(CPT,SROPER)=$P(^SRF(SRTN,"OP"),"^") I $P($G(^SRF(SRTN,"NON")),"^")="Y" S SROPER=SROPER_" (NON-OR PROCEDURE)"
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=""
W ?22,SROPS(1) W:$D(SROPS(2)) !,?22,SROPS(2) W:$D(SROPS(3)) !,?22,SROPS(3) S CPT(CNT)=SRTN
Q
ASK R !!,"Select Number: ",Z:DTIME I '$T!("^"[Z) K SRTN Q
I Z["?" W !!,"Enter the number of the desired procedure, or '^' to quit." G ASK
S:$D(CPT(Z)) SRTN=CPT(Z) I '$D(CPT(Z)) K SRTN
Q
LOOP ; break procedure if greater than 55 characters
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
Q
ALL ; lock all eligible cases in entire file
Q:'$O(^SRO(133,0))
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
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
.S SITE=$$SITE^SROUTL0(SRTN) I SITE'="" S DATE=$P(SR,"^",9) I DATE<SRDIV(SITE) S ^SRF(SRTN,"LOCK")=1
K DATE,DAYS,SITE,SR,SRDIV,SRTN,X,X1,X2
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROLOCK 3442 printed Oct 16, 2024@18:44:44 Page 2
SROLOCK ;B'HAM ISC/MAM - USED TO LOCK A CASE ;11/10/04
+1 ;;3.0; Surgery ;**7,50,134**;24 Jun 93
CHECK ; check to determine if a case is locked
+1 KILL SROLOCK
IF $DATA(^SRF(SRTN,"LOCK"))
IF $PIECE(^("LOCK"),"^")=1
SET SROLOCK=1
+2 IF $DATA(SROLOCK)
WRITE !!,"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 "
READ X:DTIME
+3 if $DATA(SROLOCK)
QUIT
SET SROLOCK=0
+4 QUIT
UNLOCK ; unlock a case for editing
+1 SET Z=0
DO SEL
IF '$DATA(SRTN)
GOTO END
+2 IF '$PIECE($GET(^SRF(SRTN,"LOCK")),"^")
WRITE !!,"This case is not locked."
GOTO END
+3 SET ^SRF("AL",SRTN)=""
SET ^SRF(SRTN,"LOCK")=""
WRITE !!,"Case #"_SRTN_" is now unlocked."
END WRITE !!,"Press RETURN to continue "
READ X:DTIME
WRITE @IOF
+1 KILL SROPS,C,CASE,CNT,CPT,DATE,DFN,I,M,LOOP,SRTN,SROPER,X,Y,Z
+2 QUIT
LOCK ; queued to run nightly, locks cases that are passed the specified
+1 ; number of days for editing
+2 SET SITE=0
FOR
SET SITE=$ORDER(^SRO(133,SITE))
if 'SITE
QUIT
SET SR=^SRO(133,SITE,0)
SET DAYS=$PIECE(SR,"^",11)
IF DAYS
SET SRSITE("DIV")=$PIECE(SR,"^")
Begin DoDot:1
+3 SET X1=DT
SET MOE=25+DAYS
SET X2="-"_MOE
DO C^%DTC
SET START=X
SET X1=DT
SET X2="-"_DAYS
DO C^%DTC
SET END=X
+4 SET DATE=START-.0001
FOR
SET DATE=$ORDER(^SRF("AC",DATE))
if DATE>END!(DATE="")
QUIT
DO SRTN
End DoDot:1
+5 SET L=0
FOR
SET L=$ORDER(^SRF("AL",L))
if L=""
QUIT
if $DATA(^SRF(L,0))
SET ^SRF(L,"LOCK")=1
KILL ^SRF("AL",L)
+6 ; clean up case edit/lock flags in ^XTMP
+7 SET SRNOW=$$NOW^XLFDT
SET SRCASE="SRLOCK-0"
FOR
SET SRCASE=$ORDER(^XTMP(SRCASE))
if SRCASE=""
QUIT
SET SRNOW1=$PIECE($GET(^XTMP(SRCASE,0)),"^")
IF SRNOW>SRNOW1
KILL ^XTMP(SRCASE)
+8 QUIT
SRTN SET SRTN=0
FOR
SET SRTN=$ORDER(^SRF("AC",DATE,SRTN))
if SRTN=""
QUIT
IF $DATA(^SRF(SRTN,0))
IF $$DIV^SROUTL0(SRTN)
IF $PIECE($GET(^SRF(SRTN,.2)),"^",12)!$PIECE($GET(^SRF(SRTN,"NON")),"^",5)
SET ^SRF(SRTN,"LOCK")=1
+1 QUIT
SEL ; select patient and case
+1 WRITE @IOF
SET DIC(0)="QEAM"
SET DIC=2
DO ^DIC
KILL DIC
if Y'>0
QUIT
SET DFN=+Y
SET (CNT,SRCNT)=0
+2 IF '$ORDER(^SRF("ADT",DFN,0))
WRITE !!,"No cases have been scheduled for the patient chosen.",!!
QUIT
+3 WRITE !
SET SRI=0
FOR
SET SRI=$ORDER(^SRF("ADT",DFN,SRI))
if SRI=""
QUIT
SET SRTN=0
FOR
SET SRTN=$ORDER(^SRF("ADT",DFN,SRI,SRTN))
if SRTN=""
QUIT
SET L=$PIECE($GET(^SRF(SRTN,"LOCK")),"^")
IF L=1
SET DATE=$PIECE(^SRF(SRTN,0),"^",9)
SET SRCNT=SRCNT+1
DO LIST
+4 IF 'SRCNT
WRITE !!,"There are no locked cases for this patient."
KILL SRTN
QUIT
+5 DO ASK
+6 QUIT
LIST WRITE !,?5,SRCNT_". "_$EXTRACT(DATE,4,5)_"-"_$EXTRACT(DATE,6,7)_"-"_$EXTRACT(DATE,2,3)
+1 SET CNT=CNT+1
SET (CPT,SROPER)=$PIECE(^SRF(SRTN,"OP"),"^")
IF $PIECE($GET(^SRF(SRTN,"NON")),"^")="Y"
SET SROPER=SROPER_" (NON-OR PROCEDURE)"
+2 KILL SROPS,MM,MMM
if $LENGTH(SROPER)<55
SET SROPS(1)=SROPER
IF $LENGTH(SROPER)>54
SET SROPER=SROPER_" "
FOR M=1:1
DO LOOP
if MMM=""
QUIT
+3 WRITE ?22,SROPS(1)
if $DATA(SROPS(2))
WRITE !,?22,SROPS(2)
if $DATA(SROPS(3))
WRITE !,?22,SROPS(3)
SET CPT(CNT)=SRTN
+4 QUIT
ASK READ !!,"Select Number: ",Z:DTIME
IF '$TEST!("^"[Z)
KILL SRTN
QUIT
+1 IF Z["?"
WRITE !!,"Enter the number of the desired procedure, or '^' to quit."
GOTO ASK
+2 if $DATA(CPT(Z))
SET SRTN=CPT(Z)
IF '$DATA(CPT(Z))
KILL SRTN
+3 QUIT
LOOP ; break procedure if greater than 55 characters
+1 SET SROPS(M)=""
FOR LOOP=1:1
SET MM=$PIECE(SROPER," ")
SET MMM=$PIECE(SROPER," ",2,200)
if MMM=""
QUIT
if $LENGTH(SROPS(M))+$LENGTH(MM)'<55
QUIT
SET SROPS(M)=SROPS(M)_MM_" "
SET SROPER=MMM
+2 QUIT
ALL ; lock all eligible cases in entire file
+1 if '$ORDER(^SRO(133,0))
QUIT
+2 SET SITE=0
FOR
SET SITE=$ORDER(^SRO(133,SITE))
if 'SITE
QUIT
SET DAYS=$PIECE(^SRO(133,SITE,0),"^",11)
SET X1=DT
SET X2=$SELECT(DAYS:"-"_DAYS,1:0)
DO C^%DTC
SET SRDIV(SITE)=X
+3 SET SRTN=0
FOR
SET SRTN=$ORDER(^SRF(SRTN))
if 'SRTN
QUIT
SET SR=$GET(^SRF(SRTN,0))
IF SR'=""
IF $PIECE($GET(^SRF(SRTN,.2)),"^",12)!$PIECE($GET(^SRF(SRTN,"NON")),"^",5)
Begin DoDot:1
+4 SET SITE=$$SITE^SROUTL0(SRTN)
IF SITE'=""
SET DATE=$PIECE(SR,"^",9)
IF DATE<SRDIV(SITE)
SET ^SRF(SRTN,"LOCK")=1
End DoDot:1
+5 KILL DATE,DAYS,SITE,SR,SRDIV,SRTN,X,X1,X2
+6 QUIT
