PSSCLINR ;;BIR/RTR-API FOR CLINICAL REMINDERS; 21 Jan 08
;;1.0;PHARMACY DATA MANAGEMENT;**133**;9/30/97;Build 1
;
;Return AND or VAC index of File 50
;PSSCRIX = AND or VAC
;PSSCRIV = Data value for Index
IX(PSSCRIX,PSSCRIV) ;
I $G(PSSCRIX)'="AND",$G(PSSCRIX)'="VAC" Q
I '$G(PSSCRIV) Q
K ^TMP($J,PSSCRIX,PSSCRIV)
M ^TMP($J,PSSCRIX,PSSCRIV)=^PSDRUG(PSSCRIX,PSSCRIV)
Q
;
;Return Drug Name from File 50
;PSSCLID = File 50 IEN
DRUG(PSSCLID) ;
Q $P($G(^PSDRUG(+$G(PSSCLID),0)),"^")
;
;Return Pharmacy Orderable Item Pointer from File 50
;PSSCLII = File 50 IEN
ITEM(PSSCLII) ;
Q $P($G(^PSDRUG(+$G(PSSCLII),2)),"^")
;
ING(PSSING) ;Return Drug ingredient Name
Q $P($G(^PS(50.416,PSSING,0)),"^")
IEN(PSSING) ;Return Drug Ingredient IEN
I '$D(^PS(50.416,"B",PSSING)) Q -1
Q $O(^PS(50.416,"B",PSSING,0))
;
NEPS() ;Return number of entries in PS(55).
N ADD,DA,DA1,DFN,DRUG,IND,NE,SDATE,SOL,STARTD,TEMP
;DBIA #4181
S (DFN,IND,NE)=0
F S DFN=+$O(^PS(55,DFN)) Q:DFN=0 D
.;Process Unit Dose.
. S DA=0
. F S DA=+$O(^PS(55,DFN,5,DA)) Q:DA=0 D
.. S TEMP=$G(^PS(55,DFN,5,DA,2))
.. S STARTD=$P(TEMP,U,2)
.. I STARTD="" Q
..;If the order is purged then SDATE is 1.
.. S SDATE=$P(TEMP,U,4)
.. I SDATE=1 Q
.. S DA1=0
.. F S DA1=+$O(^PS(55,DFN,5,DA,1,DA1)) Q:DA1=0 D
... S DRUG=$P(^PS(55,DFN,5,DA,1,DA1,0),U,1)
... I DRUG="" Q
... S NE=NE+1
.;Process the IV mutiple.
. S DA=0
. F S DA=+$O(^PS(55,DFN,"IV",DA)) Q:DA=0 D
.. S TEMP=$G(^PS(55,DFN,"IV",DA,0))
.. S STARTD=$P(TEMP,U,2)
.. I STARTD="" Q
.. S SDATE=$P(TEMP,U,3)
.. I SDATE=1 Q
..;Process Additives
.. S DA1=0
.. F S DA1=+$O(^PS(55,DFN,"IV",DA,"AD",DA1)) Q:DA1=0 D
... S ADD=$P(^PS(55,DFN,"IV",DA,"AD",DA1,0),U,1)
... I ADD="" Q
... S DRUG=$P($G(^PS(52.6,ADD,0)),U,2)
... I DRUG="" Q
... S NE=NE+1
..;Process Solutions
.. S DA1=0
.. F S DA1=+$O(^PS(55,DFN,"IV",DA,"SOL",DA1)) Q:DA1=0 D
... S SOL=$P(^PS(55,DFN,"IV",DA,"SOL",DA1,0),U,1)
... I SOL="" Q
... S DRUG=$P($G(^PS(52.7,SOL,0)),U,2)
... I DRUG="" Q
... S NE=NE+1
Q NE
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSCLINR 2107 printed Dec 13, 2024@02:30:30 Page 2
PSSCLINR ;;BIR/RTR-API FOR CLINICAL REMINDERS; 21 Jan 08
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**133**;9/30/97;Build 1
+2 ;
+3 ;Return AND or VAC index of File 50
+4 ;PSSCRIX = AND or VAC
+5 ;PSSCRIV = Data value for Index
IX(PSSCRIX,PSSCRIV) ;
+1 IF $GET(PSSCRIX)'="AND"
IF $GET(PSSCRIX)'="VAC"
QUIT
+2 IF '$GET(PSSCRIV)
QUIT
+3 KILL ^TMP($JOB,PSSCRIX,PSSCRIV)
+4 MERGE ^TMP($JOB,PSSCRIX,PSSCRIV)=^PSDRUG(PSSCRIX,PSSCRIV)
+5 QUIT
+6 ;
+7 ;Return Drug Name from File 50
+8 ;PSSCLID = File 50 IEN
DRUG(PSSCLID) ;
+1 QUIT $PIECE($GET(^PSDRUG(+$GET(PSSCLID),0)),"^")
+2 ;
+3 ;Return Pharmacy Orderable Item Pointer from File 50
+4 ;PSSCLII = File 50 IEN
ITEM(PSSCLII) ;
+1 QUIT $PIECE($GET(^PSDRUG(+$GET(PSSCLII),2)),"^")
+2 ;
ING(PSSING) ;Return Drug ingredient Name
+1 QUIT $PIECE($GET(^PS(50.416,PSSING,0)),"^")
IEN(PSSING) ;Return Drug Ingredient IEN
+1 IF '$DATA(^PS(50.416,"B",PSSING))
QUIT -1
+2 QUIT $ORDER(^PS(50.416,"B",PSSING,0))
+3 ;
NEPS() ;Return number of entries in PS(55).
+1 NEW ADD,DA,DA1,DFN,DRUG,IND,NE,SDATE,SOL,STARTD,TEMP
+2 ;DBIA #4181
+3 SET (DFN,IND,NE)=0
+4 FOR
SET DFN=+$ORDER(^PS(55,DFN))
if DFN=0
QUIT
Begin DoDot:1
+5 ;Process Unit Dose.
+6 SET DA=0
+7 FOR
SET DA=+$ORDER(^PS(55,DFN,5,DA))
if DA=0
QUIT
Begin DoDot:2
+8 SET TEMP=$GET(^PS(55,DFN,5,DA,2))
+9 SET STARTD=$PIECE(TEMP,U,2)
+10 IF STARTD=""
QUIT
+11 ;If the order is purged then SDATE is 1.
+12 SET SDATE=$PIECE(TEMP,U,4)
+13 IF SDATE=1
QUIT
+14 SET DA1=0
+15 FOR
SET DA1=+$ORDER(^PS(55,DFN,5,DA,1,DA1))
if DA1=0
QUIT
Begin DoDot:3
+16 SET DRUG=$PIECE(^PS(55,DFN,5,DA,1,DA1,0),U,1)
+17 IF DRUG=""
QUIT
+18 SET NE=NE+1
End DoDot:3
End DoDot:2
+19 ;Process the IV mutiple.
+20 SET DA=0
+21 FOR
SET DA=+$ORDER(^PS(55,DFN,"IV",DA))
if DA=0
QUIT
Begin DoDot:2
+22 SET TEMP=$GET(^PS(55,DFN,"IV",DA,0))
+23 SET STARTD=$PIECE(TEMP,U,2)
+24 IF STARTD=""
QUIT
+25 SET SDATE=$PIECE(TEMP,U,3)
+26 IF SDATE=1
QUIT
+27 ;Process Additives
+28 SET DA1=0
+29 FOR
SET DA1=+$ORDER(^PS(55,DFN,"IV",DA,"AD",DA1))
if DA1=0
QUIT
Begin DoDot:3
+30 SET ADD=$PIECE(^PS(55,DFN,"IV",DA,"AD",DA1,0),U,1)
+31 IF ADD=""
QUIT
+32 SET DRUG=$PIECE($GET(^PS(52.6,ADD,0)),U,2)
+33 IF DRUG=""
QUIT
+34 SET NE=NE+1
End DoDot:3
+35 ;Process Solutions
+36 SET DA1=0
+37 FOR
SET DA1=+$ORDER(^PS(55,DFN,"IV",DA,"SOL",DA1))
if DA1=0
QUIT
Begin DoDot:3
+38 SET SOL=$PIECE(^PS(55,DFN,"IV",DA,"SOL",DA1,0),U,1)
+39 IF SOL=""
QUIT
+40 SET DRUG=$PIECE($GET(^PS(52.7,SOL,0)),U,2)
+41 IF DRUG=""
QUIT
+42 SET NE=NE+1
End DoDot:3
End DoDot:2
End DoDot:1
+43 QUIT NE
