PSSLOCK ;BIR/RSB-Pharmacy patient lock ;09/15/97 13:30
;;1.0;PHARMACY DATA MANAGEMENT;**26,58,125**;9/30/97;Build 2
;
; Reference to ^ORX2 supported by DBIA #867
; Reference to ^PS(53.1 supported by DBIA #2140
; Reference to ^PS(52.41 supported by DBIA #2844
; Reference to ^PSRX supported by DBIA #2845
; Reference to ^PS(55 supported by DBIA #2191
;
L(DFN,DIS) ;
I $G(PSONOLCK) Q 1
N FLAG S ^XTMP("PSSLOCK",0)=$$PDATE
I '$D(^XTMP("PSSLOCK",DFN)) D Q FLAG
. D NOW^%DTC S ^XTMP("PSSLOCK",DFN)=DUZ_"^"_%
. L +^XTMP("PSSLOCK",DFN):$S($G(DILOCKTM)>0:DILOCKTM,1:3) S FLAG=$S($T=1:$T,1:0)
I $D(^XTMP("PSSLOCK",DFN)) Q $$R
UL(DFN) ; unlock
I $G(PSONOLCK) Q
L -^XTMP("PSSLOCK",DFN) K ^XTMP("PSSLOCK",DFN)
Q
;
R() ; check lock on node
;if user has same patient already locked, Q 1, will only lock once
I $P($G(^XTMP("PSSLOCK",DFN)),"^")=DUZ Q 1
L +^XTMP("PSSLOCK",DFN):$S($G(DILOCKTM)>0:DILOCKTM,1:3)
I $T=1 D NOW^%DTC S ^XTMP("PSSLOCK",DFN)=DUZ_"^"_% Q 1
I $T=0 W:DIS=1 !,$$WHO(DFN) S Y=$P($G(^XTMP("PSSLOCK",DFN)),"^",2) X ^DD("DD") Q $S(DIS=0:0_"^"_$P($G(^VA(200,+$P($G(^XTMP("PSSLOCK",DFN)),"^"),0)),"^")_"^"_Y,1:0)
;
PDATE() ;
N X1,X2 S X1=DT,X2=+14 D C^%DTC
Q X_"^"_DT_"^Pharmacy patient locks"
;
WHO(DFN) ;
S Y=$P($G(^XTMP("PSSLOCK",DFN)),"^",2) X ^DD("DD")
Q $P($G(^VA(200,+$P($G(^XTMP("PSSLOCK",DFN)),"^"),0)),"^")_" is editing orders for this patient ("_Y_")"
;
;
LS(DFN,X) ;
;LOCK CPRS ORDER
;DFN is patient #, X is PSJORD OR PSGORD
N OR100 S OR100=$$ORD(DFN,X) I OR100=0 Q 1
N L S L=$$LOCK1^ORX2(OR100)
I L Q 1
I 'L W !,$P(L,"^",2),$C(7) D PAUSE^VALM1 Q 0
Q 0
;
UNL(DFN,X) ;
; unlocks order in file 100
; DFN is patient #, X is PSJORD OR PSGORD
D UNLK1^ORX2($$ORD(DFN,X))
Q
;
ORD(DFN,X) ;
; return order number in file 100 from entry in 53.1 or 55.
; DFN is patient #, X is PSJORD OR PSGORD
N ORD100
S ORD100=$S(X["N"!(X["P"):"^PS(53.1,"_+X_",0)",X["V":"^PS(55,"_DFN_",""IV"","_+X_",0)",1:"^PS(55,"_DFN_",5,"_+X_",0)",1:"NA")
Q +$P(@ORD100,"^",21)
;
PSOL(X) ;
S PSOMSG=1
I X["S" D Q
.S X=+$P($G(^PS(52.41,+$G(X),0)),"^") I X S PSOMSG=$$LOCK1^ORX2(X)
S X=+$P($G(^PSRX(+$G(X),"OR1")),"^",2) I X S PSOMSG=$$LOCK1^ORX2(X)
Q
PSOUL(X) ;
I X["S" D Q
.S X=+$P($G(^PS(52.41,+$G(X),0)),"^") I X D UNLK1^ORX2(X)
S X=+$P($G(^PSRX(+$G(X),"OR1")),"^",2) I X D UNLK1^ORX2(X)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSLOCK 2399 printed Sep 23, 2025@20:08:38 Page 2
PSSLOCK ;BIR/RSB-Pharmacy patient lock ;09/15/97 13:30
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**26,58,125**;9/30/97;Build 2
+2 ;
+3 ; Reference to ^ORX2 supported by DBIA #867
+4 ; Reference to ^PS(53.1 supported by DBIA #2140
+5 ; Reference to ^PS(52.41 supported by DBIA #2844
+6 ; Reference to ^PSRX supported by DBIA #2845
+7 ; Reference to ^PS(55 supported by DBIA #2191
+8 ;
L(DFN,DIS) ;
+1 IF $GET(PSONOLCK)
QUIT 1
+2 NEW FLAG
SET ^XTMP("PSSLOCK",0)=$$PDATE
+3 IF '$DATA(^XTMP("PSSLOCK",DFN))
Begin DoDot:1
+4 DO NOW^%DTC
SET ^XTMP("PSSLOCK",DFN)=DUZ_"^"_%
+5 LOCK +^XTMP("PSSLOCK",DFN):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)
SET FLAG=$SELECT($TEST=1:$TEST,1:0)
End DoDot:1
QUIT FLAG
+6 IF $DATA(^XTMP("PSSLOCK",DFN))
QUIT $$R
UL(DFN) ; unlock
+1 IF $GET(PSONOLCK)
QUIT
+2 LOCK -^XTMP("PSSLOCK",DFN)
KILL ^XTMP("PSSLOCK",DFN)
+3 QUIT
+4 ;
R() ; check lock on node
+1 ;if user has same patient already locked, Q 1, will only lock once
+2 IF $PIECE($GET(^XTMP("PSSLOCK",DFN)),"^")=DUZ
QUIT 1
+3 LOCK +^XTMP("PSSLOCK",DFN):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)
+4 IF $TEST=1
DO NOW^%DTC
SET ^XTMP("PSSLOCK",DFN)=DUZ_"^"_%
QUIT 1
+5 IF $TEST=0
if DIS=1
WRITE !,$$WHO(DFN)
SET Y=$PIECE($GET(^XTMP("PSSLOCK",DFN)),"^",2)
XECUTE ^DD("DD")
QUIT $SELECT(DIS=0:0_"^"_$PIECE($GET(^VA(200,+$PIECE($GET(^XTMP("PSSLOCK",DFN)),"^"),0)),"^")_"^"_Y,1:0)
+6 ;
PDATE() ;
+1 NEW X1,X2
SET X1=DT
SET X2=+14
DO C^%DTC
+2 QUIT X_"^"_DT_"^Pharmacy patient locks"
+3 ;
WHO(DFN) ;
+1 SET Y=$PIECE($GET(^XTMP("PSSLOCK",DFN)),"^",2)
XECUTE ^DD("DD")
+2 QUIT $PIECE($GET(^VA(200,+$PIECE($GET(^XTMP("PSSLOCK",DFN)),"^"),0)),"^")_" is editing orders for this patient ("_Y_")"
+3 ;
+4 ;
LS(DFN,X) ;
+1 ;LOCK CPRS ORDER
+2 ;DFN is patient #, X is PSJORD OR PSGORD
+3 NEW OR100
SET OR100=$$ORD(DFN,X)
IF OR100=0
QUIT 1
+4 NEW L
SET L=$$LOCK1^ORX2(OR100)
+5 IF L
QUIT 1
+6 IF 'L
WRITE !,$PIECE(L,"^",2),$CHAR(7)
DO PAUSE^VALM1
QUIT 0
+7 QUIT 0
+8 ;
UNL(DFN,X) ;
+1 ; unlocks order in file 100
+2 ; DFN is patient #, X is PSJORD OR PSGORD
+3 DO UNLK1^ORX2($$ORD(DFN,X))
+4 QUIT
+5 ;
ORD(DFN,X) ;
+1 ; return order number in file 100 from entry in 53.1 or 55.
+2 ; DFN is patient #, X is PSJORD OR PSGORD
+3 NEW ORD100
+4 SET ORD100=$SELECT(X["N"!(X["P"):"^PS(53.1,"_+X_",0)",X["V":"^PS(55,"_DFN_",""IV"","_+X_",0)",1:"^PS(55,"_DFN_",5,"_+X_",0)",1:"NA")
+5 QUIT +$PIECE(@ORD100,"^",21)
+6 ;
PSOL(X) ;
+1 SET PSOMSG=1
+2 IF X["S"
Begin DoDot:1
+3 SET X=+$PIECE($GET(^PS(52.41,+$GET(X),0)),"^")
IF X
SET PSOMSG=$$LOCK1^ORX2(X)
End DoDot:1
QUIT
+4 SET X=+$PIECE($GET(^PSRX(+$GET(X),"OR1")),"^",2)
IF X
SET PSOMSG=$$LOCK1^ORX2(X)
+5 QUIT
PSOUL(X) ;
+1 IF X["S"
Begin DoDot:1
+2 SET X=+$PIECE($GET(^PS(52.41,+$GET(X),0)),"^")
IF X
DO UNLK1^ORX2(X)
End DoDot:1
QUIT
+3 SET X=+$PIECE($GET(^PSRX(+$GET(X),"OR1")),"^",2)
IF X
DO UNLK1^ORX2(X)
+4 QUIT
