| 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
|
|---|
