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