- 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 Feb 19, 2025@00:10:34 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