Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSJORAPI

PSJORAPI.m

Go to the documentation of this file.
PSJORAPI ;BIR/LDT-API utility routine ;7/8/00
 ;;5.0; INPATIENT MEDICATIONS ;**48**;16 DEC 1997
 ;
 ; Reference to ^PSDRUG is supported by DBIA 2192.
 ; Reference to ^PS(52.6 is supported by DBIA 1231.
 ; Reference to ^PS(52.7 is supported by DBIA 2173.
 ; Reference to ^PS(55 is supported by DBIA 2191.
 ;
EN(PSJB,PSJE,PSJX,PSJDT,PSJN)      ;
 ;PSJB - begin date
 ;PSJE - end date
 ;PSJX - medication array
 ;PSJDT - fill date (not used by Inaptient)
 ;PSJN - node subscript
 ;
 N PSJRD,PSJDRG,PSJND,PSJPDFN,PSJCX,PSJMED1,PSJMED2,PSJDNM,PSJBEG,PSJEND,PSJSTRT,PSJSTP
 Q:'$G(PSJB)!('$G(PSJE))
 Q:$G(PSJN)=""
 K ^TMP(PSJN,$J),^TMP($J,"PSJCT")
UD ;Check for Unit Dose orders
 N PSJND2,PSJORD,PSJDDRG
 S PSJBEG=PSJB-.0001,PSJEND=PSJE+.999999
 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
 . S PSJORD=0 F  S PSJORD=$O(^PS(55,"AUDS",PSJBEG,PSJPDFN,PSJORD)) Q:'PSJORD  D
 .. S PSJND2=$G(^PS(55,PSJPDFN,5,PSJORD,2)),PSJSTRT=$P(PSJND2,"^",2),PSJSTP=$P(PSJND2,"^",4)
 .. 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
IV ;Check for IV orders
 N PSJND0,PSJORD,PSJDDRG,FIL,DRG,DRGTYP
 S PSJBEG=PSJB-.0001,PSJEND=PSJE+.999999
 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
 . S PSJORD=0 F  S PSJORD=$O(^PS(55,"AIVS",PSJBEG,PSJPDFN,PSJORD)) Q:'PSJORD  D
 .. S PSJND0=$G(^PS(55,PSJPDFN,"IV",PSJORD,0)),PSJSTRT=$P(PSJND0,"^",2),PSJSTP=$P(PSJND0,"^",3)
 .. F DRGTYP="AD","SOL" F DRG=0:0 S DRG=$O(^PS(55,PSJPDFN,"IV",PSJORD,DRGTYP,DRG)) Q:'DRG  D
 ... 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
 G END
 Q
 ;
MED ;Check medication array for matches
 K PSJMED1,PSJMED2,PSJMED3
 I $D(PSJX(PSJDRG_";PSDRUG(")) S PSJMED1=1 D MEDS Q
 I $G(PSJND),$D(PSJX(PSJND_";PSNDF(50.6,")) S PSJMED2=1 D MEDS Q
 ;Here, add class check when ready, use PSJMED2 for NDF, default to 1 for VA Class in MEDS
 Q
MEDS I $D(^TMP($J,"PSJCT",PSJPDFN)) S (PSJCX,^TMP($J,"PSJCT",PSJPDFN))=^TMP($J,"PSJCT",PSJPDFN)+1
 I '$D(^TMP($J,"PSJCT",PSJPDFN)) S (PSJCX,^TMP($J,"PSJCT",PSJPDFN))=1
 S ^TMP(PSJN,$J,PSJPDFN,PSJCX,0)=$S($G(PSJMED1):PSJDRG_";PSDRUG(",1:$G(PSJND)_";PSNDF(50.6,")
 S ^TMP(PSJN,$J,PSJPDFN,PSJCX,1)=$G(PSJSTRT)_"^^"_$G(PSJDNM)_"^^"_$G(PSJSTP)
 Q
END ;
 K ^TMP($J,"PSJCT")
 Q