ORX2 ; slc/dcm - OE/RR Patient lock entry points ;17-May-2010 08:35;PLS
;;3.0;ORDER ENTRY/RESULTS REPORTING;**16,48,158,168,183,190,1004,195,292,1010**;Dec 17, 1997;Build 47
;Modified - IHS/MSC/DKM - 5/3/2006 - Line LOCK1+6
PT1 ;;Entry point to unlock patient when done adding orders - NO LONGER USED
;;Required variable ORVP.
Q:'$D(ORVP) Q:'$L(ORVP) Q:ORVP'["DPT("
D UNLOCK(+ORVP) K ORPTLK,ORELK
Q
LK ;;Entry point for locking patient when updating orders
;;Entry: X=VP to Patient "DFN;DPT(" Exit: Y=1 if lock succeeds
Q:'$D(X) Q:'$L(X) Q:X'["DPT(" Q:'$D(@("^"_$P(X,";",2)_+X_",0)"))
S Y=$$LOCK(+X) Q:Y
W !!,$C(7),$P(Y,U,2) D READ
S Y=0 K X
Q
ULK ;;Entry point to unlock patient
;;Required variable X=VP to patient.
Q:'$D(X) Q:'$L(X) Q:X'["DPT(" Q:'$D(@("^"_$P(X,";",2)_+X_",0)"))
D UNLOCK(+X)
Q
;
LOCK(DFN) ; -- Lock patient chart (silent)
; Returns 1 if successful, or 0^Message if could not get lock
;
Q:'$G(DFN) "0^Invalid patient" N Y,ORLK,NOW,NOW1
S ORLK=$G(^XTMP("ORPTLK-"_DFN,1)) Q:ORLK=(DUZ_U_$J) 1 ;locked
L +^XTMP("ORPTLK-"_DFN):$S($G(DILOCKTM)>0:DILOCKTM,1:5) I '$T S Y="0^"_$S(+ORLK:$P($G(^VA(200,+ORLK,0)),U),1:"Another person")_" is editing orders for this patient." Q Y
S NOW=$$NOW^XLFDT,NOW1=$$FMADD^XLFDT(NOW,1)
S ^XTMP("ORPTLK-"_DFN,0)=NOW1_U_NOW_"^CPRS Chart Lock",^(1)=DUZ_U_$J
Q 1
;
UNLOCK(DFN) ; -- Unlock patient chart (silent)
L -^XTMP("ORPTLK-"_DFN)
I $G(^XTMP("ORPTLK-"_DFN,1))=(DUZ_U_$J) K ^XTMP("ORPTLK-"_DFN)
Q
;
INC(IFN) ;Increment zero node on file 100.2
N X,X3,X4
Q:'$G(IFN) 1 Q:$D(^OR(100.2,IFN)) 1
L +^OR(100.2,0):5 I '$T Q 0
S:'$D(^OR(100.2,0)) ^(0)="OE/RR PATIENT^100.2P" S X=^(0)
S X4=+$P(X,U,4)+1,X3=$S(IFN>$P(X,U,3):IFN,1:$P(X,U,3))
S $P(^OR(100.2,0),U,3,4)=X3_U_X4
L -^OR(100.2,0)
Q 1
;
LOCK1(ORDER) ; -- Lock ORDER in file #100
; Returns 1 if successful or 0^Message if could not get lock
;
N X,Y,NOW,NOW1 I '$G(ORDER) Q "0^Invalid order number"
;DBIA #4001 Private DBIA w CMOP
I $D(^XTMP("ORLK-"_ORDER,0)),(^(0)["CPRS/CMOP") Q "0^CMOP Transmission"
I $P($G(^XTMP("ORLK-"_+ORDER,1)),U,2)=$J Q 1 ;IHS/CIA/DKM - Added to address phantom locks
L +^OR(100,+ORDER):$S($G(DILOCKTM)>0:DILOCKTM,1:5) I '$T S X=+$G(^XTMP("ORLK-"_+ORDER,1)),Y="0^"_$S(X:$P($G(^VA(200,X,0)),U),1:"Another person")_" is working on this order." Q Y
I $P($G(^OR(100,+ORDER,0)),U,12)="I" S Y=+$P($G(^(3)),U,6) I Y,$P($G(^OR(100,Y,3)),U,3)=11 D Q Y
. S X=$S($P(^OR(100,Y,3),U,11)=2:"renewal",1:"edit")
. S Y="0^An unreleased "_X_" exists for this order." L -^OR(100,+ORDER)
S NOW=$$NOW^XLFDT,NOW1=$$FMADD^XLFDT(NOW,1)
S ^XTMP("ORLK-"_+ORDER,0)=NOW1_U_NOW_"^CPRS Order Lock",^(1)=DUZ_U_$J
Q 1
;
UNLK1(ORDER) ; -- Unlock ORDER in file #100
;DBIA #4001 CMOP
S ORDER=+ORDER Q:'ORDER
I $D(^XTMP("ORLK-"_ORDER,0)),(^(0)["CPRS/CMOP") D Q
. I $J'=$P($G(^XTMP("ORLK-"_ORDER,1)),U,2) Q
. L -^OR(100,ORDER) K ^XTMP("ORLK-"_ORDER)
L +^OR(100,ORDER):$S($G(DILOCKTM)>0:DILOCKTM,1:5)
I '$T Q
E L -^OR(100,ORDER)
L -^OR(100,ORDER) K ^XTMP("ORLK-"_ORDER)
Q
;
READ ; -- instead of READ^ORUTL
N X,Y,DIR
S DIR(0)="EA",DIR("A")=" Press return to continue "
D ^DIR
Q
;
LCKEVT(EVT) ;Function atttempts to lock event, added w/patch 194
N J
F J=1:1:5 L +^ORE(100.2,EVT,0):1 Q:$T H 1
Q $T
;
UNLEVT(EVT) ;Unlocks global, added w/patch 195
L -^ORE(100.2,EVT,0)
Q
ORX2 ; slc/dcm - OE/RR Patient lock entry points ;17-May-2010 08:35;PLS
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**16,48,158,168,183,190,1004,195,292,1010**;Dec 17, 1997;Build 47
+2 ;Modified - IHS/MSC/DKM - 5/3/2006 - Line LOCK1+6
PT1 ;;Entry point to unlock patient when done adding orders - NO LONGER USED
+1 ;;Required variable ORVP.
+2 IF '$DATA(ORVP)
QUIT
IF '$LENGTH(ORVP)
QUIT
IF ORVP'["DPT("
QUIT
+3 DO UNLOCK(+ORVP)
KILL ORPTLK,ORELK
+4 QUIT
LK ;;Entry point for locking patient when updating orders
+1 ;;Entry: X=VP to Patient "DFN;DPT(" Exit: Y=1 if lock succeeds
+2 IF '$DATA(X)
QUIT
IF '$LENGTH(X)
QUIT
IF X'["DPT("
QUIT
IF '$DATA(@("^"_$PIECE(X,";",2)_+X_",0)"))
QUIT
+3 SET Y=$$LOCK(+X)
IF Y
QUIT
+4 WRITE !!,$CHAR(7),$PIECE(Y,U,2)
DO READ
+5 SET Y=0
KILL X
+6 QUIT
ULK ;;Entry point to unlock patient
+1 ;;Required variable X=VP to patient.
+2 IF '$DATA(X)
QUIT
IF '$LENGTH(X)
QUIT
IF X'["DPT("
QUIT
IF '$DATA(@("^"_$PIECE(X,";",2)_+X_",0)"))
QUIT
+3 DO UNLOCK(+X)
+4 QUIT
+5 ;
LOCK(DFN) ; -- Lock patient chart (silent)
+1 ; Returns 1 if successful, or 0^Message if could not get lock
+2 ;
+3 IF '$GET(DFN)
QUIT "0^Invalid patient"
NEW Y,ORLK,NOW,NOW1
+4 ;locked
SET ORLK=$GET(^XTMP("ORPTLK-"_DFN,1))
IF ORLK=(DUZ_U_$JOB)
QUIT 1
+5 LOCK +^XTMP("ORPTLK-"_DFN):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:5)
IF '$TEST
SET Y="0^"_$SELECT(+ORLK:$PIECE($GET(^VA(200,+ORLK,0)),U),1:"Another person")_" is editing orders for this patient."
QUIT Y
+6 SET NOW=$$NOW^XLFDT
SET NOW1=$$FMADD^XLFDT(NOW,1)
+7 SET ^XTMP("ORPTLK-"_DFN,0)=NOW1_U_NOW_"^CPRS Chart Lock"
SET ^(1)=DUZ_U_$JOB
+8 QUIT 1
+9 ;
UNLOCK(DFN) ; -- Unlock patient chart (silent)
+1 LOCK -^XTMP("ORPTLK-"_DFN)
+2 IF $GET(^XTMP("ORPTLK-"_DFN,1))=(DUZ_U_$JOB)
KILL ^XTMP("ORPTLK-"_DFN)
+3 QUIT
+4 ;
INC(IFN) ;Increment zero node on file 100.2
+1 NEW X,X3,X4
+2 IF '$GET(IFN)
QUIT 1
IF $DATA(^OR(100.2,IFN))
QUIT 1
+3 LOCK +^OR(100.2,0):5
IF '$TEST
QUIT 0
+4 IF '$DATA(^OR(100.2,0))
SET ^(0)="OE/RR PATIENT^100.2P"
SET X=^(0)
+5 SET X4=+$PIECE(X,U,4)+1
SET X3=$SELECT(IFN>$PIECE(X,U,3):IFN,1:$PIECE(X,U,3))
+6 SET $PIECE(^OR(100.2,0),U,3,4)=X3_U_X4
+7 LOCK -^OR(100.2,0)
+8 QUIT 1
+9 ;
LOCK1(ORDER) ; -- Lock ORDER in file #100
+1 ; Returns 1 if successful or 0^Message if could not get lock
+2 ;
+3 NEW X,Y,NOW,NOW1
IF '$GET(ORDER)
QUIT "0^Invalid order number"
+4 ;DBIA #4001 Private DBIA w CMOP
+5 IF $DATA(^XTMP("ORLK-"_ORDER,0))
IF (^(0)["CPRS/CMOP")
QUIT "0^CMOP Transmission"
+6 ;IHS/CIA/DKM - Added to address phantom locks
IF $PIECE($GET(^XTMP("ORLK-"_+ORDER,1)),U,2)=$JOB
QUIT 1
+7 LOCK +^OR(100,+ORDER):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:5)
IF '$TEST
SET X=+$GET(^XTMP("ORLK-"_+ORDER,1))
SET Y="0^"_$SELECT(X:$PIECE($GET(^VA(200,X,0)),U),1:"Another person")_" is working on this order."
QUIT Y
+8 IF $PIECE($GET(^OR(100,+ORDER,0)),U,12)="I"
SET Y=+$PIECE($GET(^(3)),U,6)
IF Y
IF $PIECE($GET(^OR(100,Y,3)),U,3)=11
Begin DoDot:1
+9 SET X=$SELECT($PIECE(^OR(100,Y,3),U,11)=2:"renewal",1:"edit")
+10 SET Y="0^An unreleased "_X_" exists for this order."
LOCK -^OR(100,+ORDER)
End DoDot:1
QUIT Y
+11 SET NOW=$$NOW^XLFDT
SET NOW1=$$FMADD^XLFDT(NOW,1)
+12 SET ^XTMP("ORLK-"_+ORDER,0)=NOW1_U_NOW_"^CPRS Order Lock"
SET ^(1)=DUZ_U_$JOB
+13 QUIT 1
+14 ;
UNLK1(ORDER) ; -- Unlock ORDER in file #100
+1 ;DBIA #4001 CMOP
+2 SET ORDER=+ORDER
IF 'ORDER
QUIT
+3 IF $DATA(^XTMP("ORLK-"_ORDER,0))
IF (^(0)["CPRS/CMOP")
Begin DoDot:1
+4 IF $JOB'=$PIECE($GET(^XTMP("ORLK-"_ORDER,1)),U,2)
QUIT
+5 LOCK -^OR(100,ORDER)
KILL ^XTMP("ORLK-"_ORDER)
End DoDot:1
QUIT
+6 LOCK +^OR(100,ORDER):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:5)
+7 IF '$TEST
QUIT
+8 IF '$TEST
LOCK -^OR(100,ORDER)
+9 LOCK -^OR(100,ORDER)
KILL ^XTMP("ORLK-"_ORDER)
+10 QUIT
+11 ;
READ ; -- instead of READ^ORUTL
+1 NEW X,Y,DIR
+2 SET DIR(0)="EA"
SET DIR("A")=" Press return to continue "
+3 DO ^DIR
+4 QUIT
+5 ;
LCKEVT(EVT) ;Function atttempts to lock event, added w/patch 194
+1 NEW J
+2 FOR J=1:1:5
LOCK +^ORE(100.2,EVT,0):1
IF $TEST
QUIT
HANG 1
+3 QUIT $TEST
+4 ;
UNLEVT(EVT) ;Unlocks global, added w/patch 195
+1 LOCK -^ORE(100.2,EVT,0)
+2 QUIT
