- PSO52CLR ;BIR/DB - Encapsulation Routine ; 27 Feb 2008
- ;;7.0;OUTPATIENT PHARMACY;**299**;DEC 1997;Build 5
- STAT(PSO) ;Return Status(#100) external format from Prescription (#52) file
- N PSOSTAT I $G(PSO)="" Q "UNKNOWN"
- S PSOSTAT=$$EXTERNAL^DILFD(52,100,,PSO)
- I $G(PSOSTAT)="" S PSOSTAT="UNKNOWN"
- Q PSOSTAT
- ;
- NEPSRX() ;Return number of entries in PSRX
- N DA,DA1,DATE,DSUP,DFN,DRUG,NE,RDATE,TEMP
- S (DA,NE)=0
- F S DA=+$O(^PSRX(DA)) Q:DA=0 D
- . S TEMP=$G(^PSRX(DA,0))
- . S DFN=$P(TEMP,U,2)
- . I DFN="" Q
- . S DRUG=$P(TEMP,U,6)
- . I DRUG="" Q
- . S DSUP=$P(TEMP,U,8)
- . I DSUP="" Q
- . S RDATE=+$P($G(^PSRX(DA,2)),U,13)
- . I RDATE>0 S NE=NE+1
- .;Process the refill mutiple.
- . S DA1=0
- . F S DA1=+$O(^PSRX(DA,1,DA1)) Q:DA1=0 D
- .. S TEMP=$G(^PSRX(DA,1,DA1,0))
- .. S DSUP=+$P(TEMP,U,10)
- .. I DSUP="" Q
- .. S RDATE=+$P(TEMP,U,18)
- .. I RDATE>0 S NE=NE+1
- .;Process the partial fill multiple.
- . S DA1=0
- . F S DA1=+$O(^PSRX(DA,"P",DA1)) Q:DA1=0 D
- .. S TEMP=$G(^PSRX(DA,"P",DA1,0))
- .. S DSUP=+$P(TEMP,U,10)
- .. I DSUP="" Q
- .. S RDATE=+$P(TEMP,U,19)
- .. I RDATE>0 S NE=NE+1
- K DA,DA1,DATE,DSUP,DFN,DRUG,RDATE,TEMP
- Q NE
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSO52CLR 1163 printed Feb 18, 2025@23:49:29 Page 2
- PSO52CLR ;BIR/DB - Encapsulation Routine ; 27 Feb 2008
- +1 ;;7.0;OUTPATIENT PHARMACY;**299**;DEC 1997;Build 5
- STAT(PSO) ;Return Status(#100) external format from Prescription (#52) file
- +1 NEW PSOSTAT
- IF $GET(PSO)=""
- QUIT "UNKNOWN"
- +2 SET PSOSTAT=$$EXTERNAL^DILFD(52,100,,PSO)
- +3 IF $GET(PSOSTAT)=""
- SET PSOSTAT="UNKNOWN"
- +4 QUIT PSOSTAT
- +5 ;
- NEPSRX() ;Return number of entries in PSRX
- +1 NEW DA,DA1,DATE,DSUP,DFN,DRUG,NE,RDATE,TEMP
- +2 SET (DA,NE)=0
- +3 FOR
- SET DA=+$ORDER(^PSRX(DA))
- if DA=0
- QUIT
- Begin DoDot:1
- +4 SET TEMP=$GET(^PSRX(DA,0))
- +5 SET DFN=$PIECE(TEMP,U,2)
- +6 IF DFN=""
- QUIT
- +7 SET DRUG=$PIECE(TEMP,U,6)
- +8 IF DRUG=""
- QUIT
- +9 SET DSUP=$PIECE(TEMP,U,8)
- +10 IF DSUP=""
- QUIT
- +11 SET RDATE=+$PIECE($GET(^PSRX(DA,2)),U,13)
- +12 IF RDATE>0
- SET NE=NE+1
- +13 ;Process the refill mutiple.
- +14 SET DA1=0
- +15 FOR
- SET DA1=+$ORDER(^PSRX(DA,1,DA1))
- if DA1=0
- QUIT
- Begin DoDot:2
- +16 SET TEMP=$GET(^PSRX(DA,1,DA1,0))
- +17 SET DSUP=+$PIECE(TEMP,U,10)
- +18 IF DSUP=""
- QUIT
- +19 SET RDATE=+$PIECE(TEMP,U,18)
- +20 IF RDATE>0
- SET NE=NE+1
- End DoDot:2
- +21 ;Process the partial fill multiple.
- +22 SET DA1=0
- +23 FOR
- SET DA1=+$ORDER(^PSRX(DA,"P",DA1))
- if DA1=0
- QUIT
- Begin DoDot:2
- +24 SET TEMP=$GET(^PSRX(DA,"P",DA1,0))
- +25 SET DSUP=+$PIECE(TEMP,U,10)
- +26 IF DSUP=""
- QUIT
- +27 SET RDATE=+$PIECE(TEMP,U,19)
- +28 IF RDATE>0
- SET NE=NE+1
- End DoDot:2
- End DoDot:1
- +29 KILL DA,DA1,DATE,DSUP,DFN,DRUG,RDATE,TEMP
- +30 QUIT NE