1 | PSJORAPI ;BIR/LDT-API utility routine ;7/8/00
|
---|
2 | ;;5.0; INPATIENT MEDICATIONS ;**48**;16 DEC 1997
|
---|
3 | ;
|
---|
4 | ; Reference to ^PSDRUG is supported by DBIA 2192.
|
---|
5 | ; Reference to ^PS(52.6 is supported by DBIA 1231.
|
---|
6 | ; Reference to ^PS(52.7 is supported by DBIA 2173.
|
---|
7 | ; Reference to ^PS(55 is supported by DBIA 2191.
|
---|
8 | ;
|
---|
9 | EN(PSJB,PSJE,PSJX,PSJDT,PSJN) ;
|
---|
10 | ;PSJB - begin date
|
---|
11 | ;PSJE - end date
|
---|
12 | ;PSJX - medication array
|
---|
13 | ;PSJDT - fill date (not used by Inaptient)
|
---|
14 | ;PSJN - node subscript
|
---|
15 | ;
|
---|
16 | N PSJRD,PSJDRG,PSJND,PSJPDFN,PSJCX,PSJMED1,PSJMED2,PSJDNM,PSJBEG,PSJEND,PSJSTRT,PSJSTP
|
---|
17 | Q:'$G(PSJB)!('$G(PSJE))
|
---|
18 | Q:$G(PSJN)=""
|
---|
19 | K ^TMP(PSJN,$J),^TMP($J,"PSJCT")
|
---|
20 | UD ;Check for Unit Dose orders
|
---|
21 | N PSJND2,PSJORD,PSJDDRG
|
---|
22 | S PSJBEG=PSJB-.0001,PSJEND=PSJE+.999999
|
---|
23 | F S PSJBEG=$O(^PS(55,"AUDS",PSJBEG)) Q:'PSJBEG!(PSJBEG>PSJEND) S PSJPDFN=0 F S PSJPDFN=$O(^PS(55,"AUDS",PSJBEG,PSJPDFN)) Q:'PSJPDFN D
|
---|
24 | . S PSJORD=0 F S PSJORD=$O(^PS(55,"AUDS",PSJBEG,PSJPDFN,PSJORD)) Q:'PSJORD D
|
---|
25 | .. S PSJND2=$G(^PS(55,PSJPDFN,5,PSJORD,2)),PSJSTRT=$P(PSJND2,"^",2),PSJSTP=$P(PSJND2,"^",4)
|
---|
26 | .. S PSJDDRG=0 F S PSJDDRG=$O(^PS(55,PSJPDFN,5,PSJORD,1,PSJDDRG)) Q:'PSJDDRG S PSJDRG=+$G(^PS(55,PSJPDFN,5,PSJORD,1,PSJDDRG,0)),PSJND=+$G(^PSDRUG(+PSJDRG,"ND")),PSJDNM=$P($G(^(0)),"^") D MED
|
---|
27 | IV ;Check for IV orders
|
---|
28 | N PSJND0,PSJORD,PSJDDRG,FIL,DRG,DRGTYP
|
---|
29 | S PSJBEG=PSJB-.0001,PSJEND=PSJE+.999999
|
---|
30 | F S PSJBEG=$O(^PS(55,"AIVS",PSJBEG)) Q:'PSJBEG!(PSJBEG>PSJEND) S PSJPDFN=0 F S PSJPDFN=$O(^PS(55,"AIVS",PSJBEG,PSJPDFN)) Q:'PSJPDFN D
|
---|
31 | . S PSJORD=0 F S PSJORD=$O(^PS(55,"AIVS",PSJBEG,PSJPDFN,PSJORD)) Q:'PSJORD D
|
---|
32 | .. S PSJND0=$G(^PS(55,PSJPDFN,"IV",PSJORD,0)),PSJSTRT=$P(PSJND0,"^",2),PSJSTP=$P(PSJND0,"^",3)
|
---|
33 | .. F DRGTYP="AD","SOL" F DRG=0:0 S DRG=$O(^PS(55,PSJPDFN,"IV",PSJORD,DRGTYP,DRG)) Q:'DRG D
|
---|
34 | ... S PSJDDRG=+$G(^PS(55,PSJPDFN,"IV",PSJORD,DRGTYP,DRG,0)),FIL=$S(DRGTYP="AD":52.6,1:52.7),PSJDRG=$P($G(^PS(FIL,+PSJDDRG,0)),"^",2),PSJND=+$G(^PSDRUG(+PSJDRG,"ND")),PSJDNM=$P($G(^(0)),"^") D MED
|
---|
35 | G END
|
---|
36 | Q
|
---|
37 | ;
|
---|
38 | MED ;Check medication array for matches
|
---|
39 | K PSJMED1,PSJMED2,PSJMED3
|
---|
40 | I $D(PSJX(PSJDRG_";PSDRUG(")) S PSJMED1=1 D MEDS Q
|
---|
41 | I $G(PSJND),$D(PSJX(PSJND_";PSNDF(50.6,")) S PSJMED2=1 D MEDS Q
|
---|
42 | ;Here, add class check when ready, use PSJMED2 for NDF, default to 1 for VA Class in MEDS
|
---|
43 | Q
|
---|
44 | MEDS I $D(^TMP($J,"PSJCT",PSJPDFN)) S (PSJCX,^TMP($J,"PSJCT",PSJPDFN))=^TMP($J,"PSJCT",PSJPDFN)+1
|
---|
45 | I '$D(^TMP($J,"PSJCT",PSJPDFN)) S (PSJCX,^TMP($J,"PSJCT",PSJPDFN))=1
|
---|
46 | S ^TMP(PSJN,$J,PSJPDFN,PSJCX,0)=$S($G(PSJMED1):PSJDRG_";PSDRUG(",1:$G(PSJND)_";PSNDF(50.6,")
|
---|
47 | S ^TMP(PSJN,$J,PSJPDFN,PSJCX,1)=$G(PSJSTRT)_"^^"_$G(PSJDNM)_"^^"_$G(PSJSTP)
|
---|
48 | Q
|
---|
49 | END ;
|
---|
50 | K ^TMP($J,"PSJCT")
|
---|
51 | Q
|
---|