PSJBCBU ;BIR/LDT-RETURN INFORMATION FOR AN ORDER IN HL7 FORMAT FOR BCMA CONTINGENCY PLAN;16 Mar 99 / 10:59 AM
;;5.0; INPATIENT MEDICATIONS ;**102**;16 DEC 97
;
; Reference to ^PS(55 is supported by DBIA 2191.
; Reference to ^%DTC is supported by DBIA 10000.
; Usage of this routine by BCMA BACKUP Software is supported by DBIA 3876.
;
EN(DFN,ON,PSJNAME) ; return detail data for Inpatient Meds.
;Input
; DFN - Patient's IEN
; ON - Order number for patient including "U" for Unit Dose, "V" for IV, and "P" for pending orders
; PSJNAME - Array name to return information in
N PSJBCBU S PSJBCBU=1
I $G(ON)["U",$D(^PS(55,+$G(DFN),5,+ON,0)) D EN1^PSJHL2(DFN,"XX",ON)
I $G(ON)["V",$D(^PS(55,+$G(DFN),"IV",+ON,0)) D EN1^PSJHL2(DFN,"XX",ON)
I $G(ON)["P",$D(^PS(53.1,+ON,0)),$P($G(^PS(53.1,+ON,0)),"^",15)=DFN D EN1^PSJHL2(DFN,"XX",ON)
I '$D(PSJNAME) S PSJNAME(0)=-1
K ^TMP("PSJHLS",$J,"PS")
Q
;
EN2(DFN,BDT) ; return condensed list of inpat meds
K ^TMP("PSJBU",$J)
NEW FON,ON,WBDT,Y,%
D:+$G(DFN) ORDER
I '$D(^TMP("PSJBU",$J,1,0)) S ^(0)=-1
K PSJINX
Q
ORDER ;Loop thru the orders.
I '+$G(BDT) D NOW^%DTC S BDT=%
I BDT'["." S BDT=BDT_".0001"
S PSJINX=0
;* U/D orders
S WBDT=BDT
F S WBDT=$O(^PS(55,DFN,5,"AUS",WBDT)) Q:'WBDT D
. F ON=0:0 S ON=$O(^PS(55,DFN,5,"AUS",WBDT,ON)) Q:'ON S FON=ON_"U" D TMP
;* IV orders
S WBDT=BDT
F S WBDT=$O(^PS(55,DFN,"IV","AIS",WBDT)) Q:'WBDT D
. F ON=0:0 S ON=$O(^PS(55,DFN,"IV","AIS",WBDT,ON)) Q:'ON S FON=ON_"V" D TMP
;* Pending orders
F PST="P","N" F ON=0:0 S ON=$O(^PS(53.1,"AS",PST,DFN,ON)) Q:'ON D
. S FON=ON_"P" D TMP
Q
;
TMP ;* Setup ^TMP that have common fields between IV and U/D
S PSJINX=PSJINX+1
S ^TMP("PSJBU",$J,PSJINX,0)=DFN_U_+ON_U_FON
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJBCBU 1830 printed Sep 23, 2025@19:42:19 Page 2
PSJBCBU ;BIR/LDT-RETURN INFORMATION FOR AN ORDER IN HL7 FORMAT FOR BCMA CONTINGENCY PLAN;16 Mar 99 / 10:59 AM
+1 ;;5.0; INPATIENT MEDICATIONS ;**102**;16 DEC 97
+2 ;
+3 ; Reference to ^PS(55 is supported by DBIA 2191.
+4 ; Reference to ^%DTC is supported by DBIA 10000.
+5 ; Usage of this routine by BCMA BACKUP Software is supported by DBIA 3876.
+6 ;
EN(DFN,ON,PSJNAME) ; return detail data for Inpatient Meds.
+1 ;Input
+2 ; DFN - Patient's IEN
+3 ; ON - Order number for patient including "U" for Unit Dose, "V" for IV, and "P" for pending orders
+4 ; PSJNAME - Array name to return information in
+5 NEW PSJBCBU
SET PSJBCBU=1
+6 IF $GET(ON)["U"
IF $DATA(^PS(55,+$GET(DFN),5,+ON,0))
DO EN1^PSJHL2(DFN,"XX",ON)
+7 IF $GET(ON)["V"
IF $DATA(^PS(55,+$GET(DFN),"IV",+ON,0))
DO EN1^PSJHL2(DFN,"XX",ON)
+8 IF $GET(ON)["P"
IF $DATA(^PS(53.1,+ON,0))
IF $PIECE($GET(^PS(53.1,+ON,0)),"^",15)=DFN
DO EN1^PSJHL2(DFN,"XX",ON)
+9 IF '$DATA(PSJNAME)
SET PSJNAME(0)=-1
+10 KILL ^TMP("PSJHLS",$JOB,"PS")
+11 QUIT
+12 ;
EN2(DFN,BDT) ; return condensed list of inpat meds
+1 KILL ^TMP("PSJBU",$JOB)
+2 NEW FON,ON,WBDT,Y,%
+3 if +$GET(DFN)
DO ORDER
+4 IF '$DATA(^TMP("PSJBU",$JOB,1,0))
SET ^(0)=-1
+5 KILL PSJINX
+6 QUIT
ORDER ;Loop thru the orders.
+1 IF '+$GET(BDT)
DO NOW^%DTC
SET BDT=%
+2 IF BDT'["."
SET BDT=BDT_".0001"
+3 SET PSJINX=0
+4 ;* U/D orders
+5 SET WBDT=BDT
+6 FOR
SET WBDT=$ORDER(^PS(55,DFN,5,"AUS",WBDT))
if 'WBDT
QUIT
Begin DoDot:1
+7 FOR ON=0:0
SET ON=$ORDER(^PS(55,DFN,5,"AUS",WBDT,ON))
if 'ON
QUIT
SET FON=ON_"U"
DO TMP
End DoDot:1
+8 ;* IV orders
+9 SET WBDT=BDT
+10 FOR
SET WBDT=$ORDER(^PS(55,DFN,"IV","AIS",WBDT))
if 'WBDT
QUIT
Begin DoDot:1
+11 FOR ON=0:0
SET ON=$ORDER(^PS(55,DFN,"IV","AIS",WBDT,ON))
if 'ON
QUIT
SET FON=ON_"V"
DO TMP
End DoDot:1
+12 ;* Pending orders
+13 FOR PST="P","N"
FOR ON=0:0
SET ON=$ORDER(^PS(53.1,"AS",PST,DFN,ON))
if 'ON
QUIT
Begin DoDot:1
+14 SET FON=ON_"P"
DO TMP
End DoDot:1
+15 QUIT
+16 ;
TMP ;* Setup ^TMP that have common fields between IV and U/D
+1 SET PSJINX=PSJINX+1
+2 SET ^TMP("PSJBU",$JOB,PSJINX,0)=DFN_U_+ON_U_FON
+3 QUIT
