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

PSOPXRMI.m

Go to the documentation of this file. 
  1. PSOPXRMI ; ISC/MFR - Build Reminders Indexes for PSRX ;14-Jul-2015 14:26;DU
  1.  ;;7.0;OUTPATIENT PHARMACY;**118,1015,1019**;DEC 1997;Build 4
  1.  ;External reference to PXRMSXRM is supported by DBIA 4113
  1.  ;External reference to File ^PXRMINDX( supported by DBIA 4114
  1.  ;Modified - IHS/MSC/nMGH - 10/03/2012 - patch 1015 to just quit if pt or drug not there and to
  1.  ;only send error on misisng days supply if its less than 1 year old
  1.  ;IHS/MSC/MGH patch 1015 quit without error message if RX is over 1 year old
  1.  ;IHS/MSC/MGH patch 1019 fix for index rebuild and erx meds
  1.  ;
  1. PSRX ;Build the index for the Prescription File.
  1.  N DA,DA1,DAS,DATE,DSUP,DFN,DRUG,END,ENTRIES,GLOBAL,IDEN,IND,INS
  1.  N NE,NERROR,RDATE,SDATE,IDATE,START,TENP,TEXT,YR,X,X1,X2,FDATE
  1.  ;Don't leave any old stuff around.
  1.  K ^PXRMINDX(52)
  1.  S GLOBAL=$$GET1^DID(52,"","","GLOBAL NAME")
  1.  S X1=$$NOW^XLFDT,X2=-365 D C^%DTC S YR=X    ;Patch 1015
  1.  S ENTRIES=$P(^PSRX(0),U,4)
  1.  S TENP=ENTRIES/10
  1.  S TENP=+$P(TENP,".",1)
  1.  I TENP<1 S TENP=1
  1.  D BMES^XPDUTL("Building indexes for PRESCRIPTION FILE")
  1.  S TEXT="There are "_ENTRIES_" entries to process."
  1.  D MES^XPDUTL(TEXT)
  1.  S START=$H
  1.  S (DA1,IND,NE,NERROR)=0
  1.  F  S DA1=+$O(^PSRX(DA1)) Q:DA1=0  D
  1.  . S IND=IND+1
  1.  . I IND#TENP=0 D
  1.  .. S TEXT="Processing entry "_IND
  1.  .. D MES^XPDUTL(TEXT)
  1.  . I IND#10000=0 W "."
  1.  . S TEMP=$G(^PSRX(DA1,0))
  1.  . S DFN=$P(TEMP,U,2)
  1.  . Q:DFN=""                      ;Patch 1015
  1.  . ;I DFN="" D  Q
  1.  . ;. S IDEN=DA1_" missing DFN"
  1.  . ;. D ADDERROR^PXRMSXRM(GLOBAL,IDEN,.NERROR)
  1.  . S DRUG=$P(TEMP,U,6)
  1.  . Q:DRUG=""                    ;Patch 1015
  1.  . ;I DRUG="" D  Q
  1.  . ;. S IDEN=DA1_" missing drug"
  1.  . ;. D ADDERROR^PXRMSXRM(GLOBAL,IDEN,.NERROR) Q
  1.  . S IDATE=$P(TEMP,U,13)           ;Patch 1015
  1.  . S DSUP=$P(TEMP,U,8)
  1.  . I DSUP="" D  Q
  1.  ..I IDATE>YR D                    ;Patch 1015
  1.  ... S IDEN=DA1_" missing days supply"
  1.  ... D ADDERROR^PXRMSXRM(GLOBAL,IDEN,.NERROR)
  1.  . S RDATE=+$P($G(^PSRX(DA1,2)),U,13)
  1.  . S FDATE=+$P($G(^PSRX(DA1,2)),U,2)  ;Patch 1019
  1.  . I RDATE=0&($P($G(^PSRX(DA1,999999921)),U,3)'="") S RDATE=FDATE ;Patch 1019
  1.  . I RDATE>0 D
  1.  .. S SDATE=+$$FMADD^XLFDT(RDATE,DSUP)
  1.  .. S DAS=DA1_";2"
  1.  .. S ^PXRMINDX(52,"IP",DRUG,DFN,RDATE,SDATE,DAS)=""
  1.  .. S ^PXRMINDX(52,"PI",DFN,DRUG,RDATE,SDATE,DAS)=""
  1.  .. S NE=NE+1
  1.  .;Process the refill mutiple.
  1.  . S DA=0
  1.  . F  S DA=+$O(^PSRX(DA1,1,DA)) Q:DA=0  D
  1.  .. S TEMP=$G(^PSRX(DA1,1,DA,0))
  1.  .. S DSUP=+$P(TEMP,U,10)
  1.  .. S RDATE=+$P(TEMP,U,18)
  1.  .. I RDATE>0 D
  1.  ... S SDATE=+$$FMADD^XLFDT(RDATE,DSUP)
  1.  ... S DAS=DA1_";1;"_DA_";0"
  1.  ... S ^PXRMINDX(52,"IP",DRUG,DFN,RDATE,SDATE,DAS)=""
  1.  ... S ^PXRMINDX(52,"PI",DFN,DRUG,RDATE,SDATE,DAS)=""
  1.  ... S NE=NE+1
  1.  .;Process the partial fill multiple.
  1.  . S DA=0
  1.  . F  S DA=+$O(^PSRX(DA1,"P",DA)) Q:DA=0  D
  1.  .. S TEMP=$G(^PSRX(DA1,"P",DA,0))
  1.  .. S DSUP=+$P(TEMP,U,10)
  1.  .. S RDATE=+$P(TEMP,U,19)
  1.  .. I RDATE>0 D
  1.  ... S SDATE=+$$FMADD^XLFDT(RDATE,DSUP)
  1.  ... S DAS=DA1_";P;"_DA_";0"
  1.  ... S ^PXRMINDX(52,"IP",DRUG,DFN,RDATE,SDATE,DAS)=""
  1.  ... S ^PXRMINDX(52,"PI",DFN,DRUG,RDATE,SDATE,DAS)=""
  1.  ... S NE=NE+1
  1.  S END=$H
  1.  S TEXT=NE_" PRESCRIPTION results indexed."
  1.  D MES^XPDUTL(TEXT)
  1.  S TEXT=NERROR_" errors were encountered."
  1.  D MES^XPDUTL(TEXT)
  1.  D DETIME^PXRMSXRM(START,END)
  1.  ;If there were errors send a message.
  1.  I NERROR>0 D ERRMSG^PXRMSXRM(NERROR,GLOBAL)
  1.  ;Send a MailMan message with the results.
  1.  D COMMSG^PXRMSXRM(GLOBAL,START,END,NE,NERROR)
  1.  S ^PXRMINDX(52,"GLOBAL NAME")=GLOBAL
  1.  S ^PXRMINDX(52,"BUILT BY")=DUZ
  1.  S ^PXRMINDX(52,"DATE BUILT")=$$NOW^XLFDT
  1.  Q
  1.  ;