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

PSOEXDT.m

Go to the documentation of this file.
  1. PSOEXDT ;BHAM ISC/SAB - set exp. date and determine rx status ; 10/24/92 13:24
  1. ;;7.0;OUTPATIENT PHARMACY;**23,73,222,486,574,621,649**;DEC 1997;Build 1
  1. ;
  1. ;External reference ^PS(55 supported by DBIA 2228
  1. ;External reference ^PSDRUG( supported by DBIA 221
  1. ; this program sets the expiration date of an rx. the zeroeth node is
  1. ; held in rx0, and the second node is held in rx2. the variable 'j' is
  1. ; the internal number in the prescription file (^psrx).
  1. ;
  1. A ;
  1. S CS=0,RFLS=$P(RX0,"^",9),DYS=$P(RX0,"^",8),(ISSDT,X1)=$P(RX0,"^",13),X2=DYS*(RFLS+1)\1,PSODEA=$P(^PSDRUG($P(RX0,"^",6),0),"^",3)
  1. F DEA=1:1 Q:$E(PSODEA,DEA)="" I $E(+PSODEA,DEA)>1,$E(+PSODEA,DEA)<6 S $P(CS,"^")=1 S:$E(+PSODEA,DEA)=2 $P(CS,"^",2)=1
  1. I $G(CLOZPAT) G DT
  1. S X2=$S(DYS=X2:X2,CS:184,1:366)
  1. I X2<30 D
  1. . N % S %=$P(RX0,"^",3),X2=30
  1. . S:%?.N %=$P($G(^PS(53,+%,0)),"^") I %["AUTH ABS" S X2=5
  1. DT I X1']"" S X1=DT,X2=-1 ;486 End
  1. D C^%DTC S EX=$P(X,".") I +$G(PSORXED("RX1")),+$G(PSORXED("RX1"))>EX S EX=+$G(PSORXED("RX1"))
  1. ;
  1. ;If Calculated Rx Exp. Date is before Rx Fill Date (No Clozapine/No refills), reset to Fill Date + Days Supply
  1. I '$D(CLOZPAT),'RFLS,$$RXFLDT^PSOBPSUT(J,0)>EX D
  1. . S EX=$$FMADD^XLFDT($$RXFLDT^PSOBPSUT(J,0),DYS)
  1. . I $$FMDIFF^XLFDT(EX,ISSDT)>$S($G(CS):184,1:366) D
  1. . . S EX=$$FMADD^XLFDT(ISSDT,$S($G(CS):184,1:366))
  1. . I (EX<$$RXFLDT^PSOBPSUT(J,0)) D
  1. . . S EX=$$RXFLDT^PSOBPSUT(J,0)
  1. ;
  1. ; Updating calculated Expiration Date field on file #52 and "P"/"A" x-ref on file #55 (if different)
  1. I $G(EX)'="",EX'=$P($G(^PSRX(J,2)),"^",6) D
  1. . N PATIEN,OLDEXDT
  1. . S PATIEN=+$$GET1^DIQ(52,J,2,"I")
  1. . S OLDEXDT=$$GET1^DIQ(52,J,26,"I")
  1. . I OLDEXDT'="" K ^PS(55,PATIEN,"P","A",OLDEXDT,J)
  1. . S $P(^PSRX(J,2),"^",6)=EX
  1. . S ^PS(55,PATIEN,"P","A",EX,J)=""
  1. ;
  1. S RX2=$G(^PSRX(J,2))
  1. S Y=$S($D(^PSRX(J,2)):^(2),1:""),X="" F ZII=1:1:10 S X=X_$P(Y,"^",ZII)_"^"
  1. K EX,X1,X2,DYS,RFLS,CS,PSODEA,DEA,ISSDT Q
  1. STAT ;
  1. ;this entry point is call from dd(55.03,2,0). this field is a computed
  1. ;field that helps determine the status of rxs found in the pharmacy
  1. ;patient file. the status will be returned in the variable st.
  1. Q:'$D(^PSRX(J,0))!('$P($G(^PSRX(J,0)),"^",2))
  1. S PSOJ=J,DFN=+$P($G(^PSRX(J,0)),"^",2)
  1. D:$P($G(^PS(55,DFN,0)),"^",6)'=2 EN^PSOHLUP(DFN) S J=PSOJ
  1. B S ST0=+^PSRX(J,"STA") I ST0<12,$D(^PS(52.5,"B",J)) S ZII=$O(^(J,0)) I 'ZII,$D(^PS(52.5,ZII,0)),'$G(^("P")) S ST0=5
  1. D A:'$P(RX2,"^",6) I DT>$P(RX2,"^",6),((ST0<12)!(ST0>13)) S ST0=11
  1. S ST=$P("ERROR^ACTIVE^NON-VERIFIED^REFILL^HOLD^NON-VERIFIED^SUSPENDED^^^^^^EXPIRED^DISCONTINUED^DELETED^DISCONTINUED^DISCONTINUE (EDIT)^PROVIDER HOLD^","^",ST0+2)
  1. S RX0=$P(RX0_"^^^^^^^","^",1,14)_"^"_ST0_"^"_$P(RX0,"^",16,99)
  1. K PSOJ,DFN Q