ORBCMA5 ; SLC/JDL - BCMA Order utility ;07/25/14 14:23
;;3.0;ORDER ENTRY/RESULTS REPORTING;**133,350**;Dec 17, 1997;Build 77
;;BCMA ORDER UTITLITY;**133**;12/12/2001
;
;
;
GETUDID(Y,INFO) ; Get Unit/Dose Order Form ID
S Y=$O(^ORD(101.41,"B","PSJ OR PAT OE",0))
S:$L(Y)<1 Y=0
Q
GETIVID(Y,INFO) ; Get IV Order Form ID
S Y=$O(^ORD(101.41,"B","PSJI OR PAT FLUID OE",0))
S:$L(Y)<1 Y=0
Q
GETUD(Y,ODITM) ; get unit dose orderable item
; ODITM: Orderable item ien
N DGIDX,OIIEN,UDIEN
S DGIDX=0
S UDIEN=$O(^ORD(101.44,"B","ORWDSET UD RX",0))
F S DGIDX=$O(^ORD(101.44,UDIEN,20,DGIDX)) Q:'DGIDX D
. S OIIEN=$P(^ORD(101.44,UDIEN,20,DGIDX,0),U,1)
. I OIIEN=ODITM S Y=^ORD(101.44,UDIEN,20,DGIDX,0)
K DGIDX,OIIEN,UDIEN
Q
ODITMBC(Y,XREF,ODLST) ; --Return orderable items info based on ItemIen
N CNT,NUM,XRF
S CNT=0,NUM=0,XRF=""
S:$L(XREF) XRF=XREF
F S CNT=$O(ODLST(CNT)) Q:'CNT D FNDINFO(.Y,ODLST(CNT))
Q
FNDINFO(Y,ODIEN) ;
N ODI,CRTM,FRM,XX,FINDIT
S XX="",FINDIT=0
S FRM="",CRTM=$$NOW^XLFDT
F S FRM=$O(^ORD(101.43,XRF,FRM)) Q:FRM="" D
. S ODI=0 F S ODI=$O(^ORD(101.43,XRF,FRM,ODI)) Q:'ODI D
.. S XX=^ORD(101.43,XRF,FRM,ODI)
.. I +$P(XX,U,3),$P(XX,U,3)<CRTM Q
.. I ODI=+ODIEN D
... S NUM=NUM+1,FINDIT=1
... I 'XX S Y(NUM)=ODIEN_U_$P(XX,U,2)_U_$P(XX,U,2)
... E S Y(NUM)=ODIEN_U_$P(XX,U,2)_$C(9)_"<"_$P(XX,U,4)_">"_U_$P(XX,U,4)
I FINDIT=0 D
. S:$D(^ORD(101.43,+ODIEN,0)) XX=^ORD(101.43,+ODIEN,0)
. S NUM=NUM+1
. S:$L(XX) Y(NUM)=ODIEN_U_$P(XX,U)_U_$P(XX,U)_U_"NF"
Q
LOCK(ORY,DFN,ORJOB) ; -- Lock patient chart (silent)
; Returns 1 if successful, or 0^Message if could not get lock
;
I '$G(DFN) S ORY="0^Invalid patient" Q
I $G(ORJOB)="" S ORY="0^Invalid Job" Q
N Y,ORLK,NOW,NOW1
S ORLK=$G(^XTMP("ORPTLK-"_DFN,1)) I ORLK=(DUZ_U_ORJOB) S ORY=1 Q ;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_ORJOB
S ORY=1 Q
;
UNLOCK(ORY,DFN,ORJOB) ; -- Unlock patient chart (silent)
I '$G(DFN) S ORY=0 Q
I $G(ORJOB)="" W ORY=0 Q
L -^XTMP("ORPTLK-"_DFN)
I $G(^XTMP("ORPTLK-"_DFN,1))=(DUZ_U_ORJOB) K ^XTMP("ORPTLK-"_DFN)
S ORY=1 Q
;
JOB(ORY) ;return $J
S ORY=$J Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORBCMA5 2405 printed Sep 23, 2025@20:03:56 Page 2
ORBCMA5 ; SLC/JDL - BCMA Order utility ;07/25/14 14:23
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**133,350**;Dec 17, 1997;Build 77
+2 ;;BCMA ORDER UTITLITY;**133**;12/12/2001
+3 ;
+4 ;
+5 ;
GETUDID(Y,INFO) ; Get Unit/Dose Order Form ID
+1 SET Y=$ORDER(^ORD(101.41,"B","PSJ OR PAT OE",0))
+2 if $LENGTH(Y)<1
SET Y=0
+3 QUIT
GETIVID(Y,INFO) ; Get IV Order Form ID
+1 SET Y=$ORDER(^ORD(101.41,"B","PSJI OR PAT FLUID OE",0))
+2 if $LENGTH(Y)<1
SET Y=0
+3 QUIT
GETUD(Y,ODITM) ; get unit dose orderable item
+1 ; ODITM: Orderable item ien
+2 NEW DGIDX,OIIEN,UDIEN
+3 SET DGIDX=0
+4 SET UDIEN=$ORDER(^ORD(101.44,"B","ORWDSET UD RX",0))
+5 FOR
SET DGIDX=$ORDER(^ORD(101.44,UDIEN,20,DGIDX))
if 'DGIDX
QUIT
Begin DoDot:1
+6 SET OIIEN=$PIECE(^ORD(101.44,UDIEN,20,DGIDX,0),U,1)
+7 IF OIIEN=ODITM
SET Y=^ORD(101.44,UDIEN,20,DGIDX,0)
End DoDot:1
+8 KILL DGIDX,OIIEN,UDIEN
+9 QUIT
ODITMBC(Y,XREF,ODLST) ; --Return orderable items info based on ItemIen
+1 NEW CNT,NUM,XRF
+2 SET CNT=0
SET NUM=0
SET XRF=""
+3 if $LENGTH(XREF)
SET XRF=XREF
+4 FOR
SET CNT=$ORDER(ODLST(CNT))
if 'CNT
QUIT
DO FNDINFO(.Y,ODLST(CNT))
+5 QUIT
FNDINFO(Y,ODIEN) ;
+1 NEW ODI,CRTM,FRM,XX,FINDIT
+2 SET XX=""
SET FINDIT=0
+3 SET FRM=""
SET CRTM=$$NOW^XLFDT
+4 FOR
SET FRM=$ORDER(^ORD(101.43,XRF,FRM))
if FRM=""
QUIT
Begin DoDot:1
+5 SET ODI=0
FOR
SET ODI=$ORDER(^ORD(101.43,XRF,FRM,ODI))
if 'ODI
QUIT
Begin DoDot:2
+6 SET XX=^ORD(101.43,XRF,FRM,ODI)
+7 IF +$PIECE(XX,U,3)
IF $PIECE(XX,U,3)<CRTM
QUIT
+8 IF ODI=+ODIEN
Begin DoDot:3
+9 SET NUM=NUM+1
SET FINDIT=1
+10 IF 'XX
SET Y(NUM)=ODIEN_U_$PIECE(XX,U,2)_U_$PIECE(XX,U,2)
+11 IF '$TEST
SET Y(NUM)=ODIEN_U_$PIECE(XX,U,2)_$CHAR(9)_"<"_$PIECE(XX,U,4)_">"_U_$PIECE(XX,U,4)
End DoDot:3
End DoDot:2
End DoDot:1
+12 IF FINDIT=0
Begin DoDot:1
+13 if $DATA(^ORD(101.43,+ODIEN,0))
SET XX=^ORD(101.43,+ODIEN,0)
+14 SET NUM=NUM+1
+15 if $LENGTH(XX)
SET Y(NUM)=ODIEN_U_$PIECE(XX,U)_U_$PIECE(XX,U)_U_"NF"
End DoDot:1
+16 QUIT
LOCK(ORY,DFN,ORJOB) ; -- Lock patient chart (silent)
+1 ; Returns 1 if successful, or 0^Message if could not get lock
+2 ;
+3 IF '$GET(DFN)
SET ORY="0^Invalid patient"
QUIT
+4 IF $GET(ORJOB)=""
SET ORY="0^Invalid Job"
QUIT
+5 NEW Y,ORLK,NOW,NOW1
+6 ;locked
SET ORLK=$GET(^XTMP("ORPTLK-"_DFN,1))
IF ORLK=(DUZ_U_ORJOB)
SET ORY=1
QUIT
+7 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
+8 SET NOW=$$NOW^XLFDT
SET NOW1=$$FMADD^XLFDT(NOW,1)
+9 SET ^XTMP("ORPTLK-"_DFN,0)=NOW1_U_NOW_"^CPRS Chart Lock"
SET ^(1)=DUZ_U_ORJOB
+10 SET ORY=1
QUIT
+11 ;
UNLOCK(ORY,DFN,ORJOB) ; -- Unlock patient chart (silent)
+1 IF '$GET(DFN)
SET ORY=0
QUIT
+2 IF $GET(ORJOB)=""
WRITE ORY=0
QUIT
+3 LOCK -^XTMP("ORPTLK-"_DFN)
+4 IF $GET(^XTMP("ORPTLK-"_DFN,1))=(DUZ_U_ORJOB)
KILL ^XTMP("ORPTLK-"_DFN)
+5 SET ORY=1
QUIT
+6 ;
JOB(ORY) ;return $J
+1 SET ORY=$JOB
QUIT
