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

PSO52CLR.m

Go to the documentation of this file.
  1. PSO52CLR ;BIR/DB - Encapsulation Routine ; 27 Feb 2008
  1. ;;7.0;OUTPATIENT PHARMACY;**299**;DEC 1997;Build 5
  1. STAT(PSO) ;Return Status(#100) external format from Prescription (#52) file
  1. N PSOSTAT I $G(PSO)="" Q "UNKNOWN"
  1. S PSOSTAT=$$EXTERNAL^DILFD(52,100,,PSO)
  1. I $G(PSOSTAT)="" S PSOSTAT="UNKNOWN"
  1. Q PSOSTAT
  1. ;
  1. NEPSRX() ;Return number of entries in PSRX
  1. N DA,DA1,DATE,DSUP,DFN,DRUG,NE,RDATE,TEMP
  1. S (DA,NE)=0
  1. F S DA=+$O(^PSRX(DA)) Q:DA=0 D
  1. . S TEMP=$G(^PSRX(DA,0))
  1. . S DFN=$P(TEMP,U,2)
  1. . I DFN="" Q
  1. . S DRUG=$P(TEMP,U,6)
  1. . I DRUG="" Q
  1. . S DSUP=$P(TEMP,U,8)
  1. . I DSUP="" Q
  1. . S RDATE=+$P($G(^PSRX(DA,2)),U,13)
  1. . I RDATE>0 S NE=NE+1
  1. .;Process the refill mutiple.
  1. . S DA1=0
  1. . F S DA1=+$O(^PSRX(DA,1,DA1)) Q:DA1=0 D
  1. .. S TEMP=$G(^PSRX(DA,1,DA1,0))
  1. .. S DSUP=+$P(TEMP,U,10)
  1. .. I DSUP="" Q
  1. .. S RDATE=+$P(TEMP,U,18)
  1. .. I RDATE>0 S NE=NE+1
  1. .;Process the partial fill multiple.
  1. . S DA1=0
  1. . F S DA1=+$O(^PSRX(DA,"P",DA1)) Q:DA1=0 D
  1. .. S TEMP=$G(^PSRX(DA,"P",DA1,0))
  1. .. S DSUP=+$P(TEMP,U,10)
  1. .. I DSUP="" Q
  1. .. S RDATE=+$P(TEMP,U,19)
  1. .. I RDATE>0 S NE=NE+1
  1. K DA,DA1,DATE,DSUP,DFN,DRUG,RDATE,TEMP
  1. Q NE