- ORX2 ;SLC/DCM,AJB - OE/RR PATIENT LOCK ENTRY POINT ;Jun 23, 2022@07:59:29
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**16,48,158,168,183,190,195,292,405**;Dec 17, 1997;Build 211
- ;
- ; $$GET1^DIQ ICR #2056 ^DIR ICR #10026
- ; *^XLFDT ICR #10103
- ;
- 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 D Q Y
- . ; who and date/time of lock added to locked message *405 - various patient safety issues
- . S Y="0^"_$S(+ORLK=DUZ:"You have",1:$$GET1^DIQ(200,+ORLK,.01)_" has")_" this patient locked with another session. ["_$$FMTE^XLFDT($P($G(^XTMP("ORPTLK-"_DFN,0)),U,2),2)_"]"
- 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"
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORX2 3524 printed Jan 18, 2025@03:39:01 Page 2
- ORX2 ;SLC/DCM,AJB - OE/RR PATIENT LOCK ENTRY POINT ;Jun 23, 2022@07:59:29
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**16,48,158,168,183,190,195,292,405**;Dec 17, 1997;Build 211
- +2 ;
- +3 ; $$GET1^DIQ ICR #2056 ^DIR ICR #10026
- +4 ; *^XLFDT ICR #10103
- +5 ;
- 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
- LOCK(DFN) ; -- Lock patient chart (silent)
- +1 ; Returns 1 if successful, or 0^Message if could not get lock
- +2 if '$GET(DFN)
- QUIT "0^Invalid patient"
- NEW Y,ORLK,NOW,NOW1
- +3 ;locked
- SET ORLK=$GET(^XTMP("ORPTLK-"_DFN,1))
- if ORLK=(DUZ_U_$JOB)
- QUIT 1
- +4 LOCK +^XTMP("ORPTLK-"_DFN):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:5)
- IF '$TEST
- Begin DoDot:1
- +5 ; who and date/time of lock added to locked message *405 - various patient safety issues
- +6 SET Y="0^"_$SELECT(+ORLK=DUZ:"You have",1:$$GET1^DIQ(200,+ORLK,.01)_" has")_" this patient locked with another session. ["_$$FMTE^XLFDT($PIECE($GET(^XTMP("ORPTLK-"_DFN,0)),U,2),2)_"]"
- End DoDot:1
- QUIT Y
- +7 SET NOW=$$NOW^XLFDT
- SET NOW1=$$FMADD^XLFDT(NOW,1)
- +8 SET ^XTMP("ORPTLK-"_DFN,0)=NOW1_U_NOW_"^CPRS Chart Lock"
- SET ^(1)=DUZ_U_$JOB
- +9 QUIT 1
- 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
- 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 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
- +7 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
- +8 SET X=$SELECT($PIECE(^OR(100,Y,3),U,11)=2:"renewal",1:"edit")
- +9 SET Y="0^An unreleased "_X_" exists for this order."
- LOCK -^OR(100,+ORDER)
- End DoDot:1
- QUIT Y
- +10 SET NOW=$$NOW^XLFDT
- SET NOW1=$$FMADD^XLFDT(NOW,1)
- +11 SET ^XTMP("ORLK-"_+ORDER,0)=NOW1_U_NOW_"^CPRS Order Lock"
- SET ^(1)=DUZ_U_$JOB
- +12 QUIT 1
- +13 ;
- 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