| [613] | 1 | PSJBCBU ;BIR/LDT-RETURN INFORMATION FOR AN ORDER IN HL7 FORMAT FOR BCMA CONTINGENCY PLAN;16 Mar 99 / 10:59 AM
|
|---|
| 2 | ;;5.0; INPATIENT MEDICATIONS ;**102**;16 DEC 97
|
|---|
| 3 | ;
|
|---|
| 4 | ; Reference to ^PS(55 is supported by DBIA 2191.
|
|---|
| 5 | ; Reference to ^%DTC is supported by DBIA 10000.
|
|---|
| 6 | ; Usage of this routine by BCMA BACKUP Software is supported by DBIA 3876.
|
|---|
| 7 | ;
|
|---|
| 8 | EN(DFN,ON,PSJNAME) ; return detail data for Inpatient Meds.
|
|---|
| 9 | ;Input
|
|---|
| 10 | ; DFN - Patient's IEN
|
|---|
| 11 | ; ON - Order number for patient including "U" for Unit Dose, "V" for IV, and "P" for pending orders
|
|---|
| 12 | ; PSJNAME - Array name to return information in
|
|---|
| 13 | N PSJBCBU S PSJBCBU=1
|
|---|
| 14 | I $G(ON)["U",$D(^PS(55,+$G(DFN),5,+ON,0)) D EN1^PSJHL2(DFN,"XX",ON)
|
|---|
| 15 | I $G(ON)["V",$D(^PS(55,+$G(DFN),"IV",+ON,0)) D EN1^PSJHL2(DFN,"XX",ON)
|
|---|
| 16 | 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)
|
|---|
| 17 | I '$D(PSJNAME) S PSJNAME(0)=-1
|
|---|
| 18 | K ^TMP("PSJHLS",$J,"PS")
|
|---|
| 19 | Q
|
|---|
| 20 | ;
|
|---|
| 21 | EN2(DFN,BDT) ; return condensed list of inpat meds
|
|---|
| 22 | K ^TMP("PSJBU",$J)
|
|---|
| 23 | NEW FON,ON,WBDT,Y,%
|
|---|
| 24 | D:+$G(DFN) ORDER
|
|---|
| 25 | I '$D(^TMP("PSJBU",$J,1,0)) S ^(0)=-1
|
|---|
| 26 | K PSJINX
|
|---|
| 27 | Q
|
|---|
| 28 | ORDER ;Loop thru the orders.
|
|---|
| 29 | I '+$G(BDT) D NOW^%DTC S BDT=%
|
|---|
| 30 | I BDT'["." S BDT=BDT_".0001"
|
|---|
| 31 | S PSJINX=0
|
|---|
| 32 | ;* U/D orders
|
|---|
| 33 | S WBDT=BDT
|
|---|
| 34 | F S WBDT=$O(^PS(55,DFN,5,"AUS",WBDT)) Q:'WBDT D
|
|---|
| 35 | . F ON=0:0 S ON=$O(^PS(55,DFN,5,"AUS",WBDT,ON)) Q:'ON S FON=ON_"U" D TMP
|
|---|
| 36 | ;* IV orders
|
|---|
| 37 | S WBDT=BDT
|
|---|
| 38 | F S WBDT=$O(^PS(55,DFN,"IV","AIS",WBDT)) Q:'WBDT D
|
|---|
| 39 | . F ON=0:0 S ON=$O(^PS(55,DFN,"IV","AIS",WBDT,ON)) Q:'ON S FON=ON_"V" D TMP
|
|---|
| 40 | ;* Pending orders
|
|---|
| 41 | F PST="P","N" F ON=0:0 S ON=$O(^PS(53.1,"AS",PST,DFN,ON)) Q:'ON D
|
|---|
| 42 | . S FON=ON_"P" D TMP
|
|---|
| 43 | Q
|
|---|
| 44 | ;
|
|---|
| 45 | TMP ;* Setup ^TMP that have common fields between IV and U/D
|
|---|
| 46 | S PSJINX=PSJINX+1
|
|---|
| 47 | S ^TMP("PSJBU",$J,PSJINX,0)=DFN_U_+ON_U_FON
|
|---|
| 48 | Q
|
|---|
