| [613] | 1 | PSOPXRMI ; ISC/MFR - Build Reminders Indexes for PSRX ;06/18/2003
|
|---|
| 2 | ;;7.0;OUTPATIENT PHARMACY;**118**;DEC 1997
|
|---|
| 3 | ;External reference to PXRMSXRM is supported by DBIA 4113
|
|---|
| 4 | ;External reference to File ^PXRMINDX( supported by DBIA 4114
|
|---|
| 5 | ;
|
|---|
| 6 | PSRX ;Build the index for the Prescription File.
|
|---|
| 7 | N DA,DA1,DAS,DATE,DSUP,DFN,DRUG,END,ENTRIES,GLOBAL,IDEN,IND,INS
|
|---|
| 8 | N NE,NERROR,RDATE,SDATE,START,TENP,TEXT
|
|---|
| 9 | ;Don't leave any old stuff around.
|
|---|
| 10 | K ^PXRMINDX(52)
|
|---|
| 11 | S GLOBAL=$$GET1^DID(52,"","","GLOBAL NAME")
|
|---|
| 12 | S ENTRIES=$P(^PSRX(0),U,4)
|
|---|
| 13 | S TENP=ENTRIES/10
|
|---|
| 14 | S TENP=+$P(TENP,".",1)
|
|---|
| 15 | I TENP<1 S TENP=1
|
|---|
| 16 | D BMES^XPDUTL("Building indexes for PRESCRIPTION FILE")
|
|---|
| 17 | S TEXT="There are "_ENTRIES_" entries to process."
|
|---|
| 18 | D MES^XPDUTL(TEXT)
|
|---|
| 19 | S START=$H
|
|---|
| 20 | S (DA1,IND,NE,NERROR)=0
|
|---|
| 21 | F S DA1=+$O(^PSRX(DA1)) Q:DA1=0 D
|
|---|
| 22 | . S IND=IND+1
|
|---|
| 23 | . I IND#TENP=0 D
|
|---|
| 24 | .. S TEXT="Processing entry "_IND
|
|---|
| 25 | .. D MES^XPDUTL(TEXT)
|
|---|
| 26 | . I IND#10000=0 W "."
|
|---|
| 27 | . S TEMP=$G(^PSRX(DA1,0))
|
|---|
| 28 | . S DFN=$P(TEMP,U,2)
|
|---|
| 29 | . I DFN="" D Q
|
|---|
| 30 | .. S IDEN=DA1_" missing DFN"
|
|---|
| 31 | .. D ADDERROR^PXRMSXRM(GLOBAL,IDEN,.NERROR)
|
|---|
| 32 | . S DRUG=$P(TEMP,U,6)
|
|---|
| 33 | . I DRUG="" D Q
|
|---|
| 34 | .. S IDEN=DA1_" missing drug"
|
|---|
| 35 | .. D ADDERROR^PXRMSXRM(GLOBAL,IDEN,.NERROR) Q
|
|---|
| 36 | . S DSUP=$P(TEMP,U,8)
|
|---|
| 37 | . I DSUP="" D Q
|
|---|
| 38 | .. S IDEN=DA1_" missing days supply"
|
|---|
| 39 | .. D ADDERROR^PXRMSXRM(GLOBAL,IDEN,.NERROR)
|
|---|
| 40 | . S RDATE=+$P($G(^PSRX(DA1,2)),U,13)
|
|---|
| 41 | . I RDATE>0 D
|
|---|
| 42 | .. S SDATE=+$$FMADD^XLFDT(RDATE,DSUP)
|
|---|
| 43 | .. S DAS=DA1_";2"
|
|---|
| 44 | .. S ^PXRMINDX(52,"IP",DRUG,DFN,RDATE,SDATE,DAS)=""
|
|---|
| 45 | .. S ^PXRMINDX(52,"PI",DFN,DRUG,RDATE,SDATE,DAS)=""
|
|---|
| 46 | .. S NE=NE+1
|
|---|
| 47 | .;Process the refill mutiple.
|
|---|
| 48 | . S DA=0
|
|---|
| 49 | . F S DA=+$O(^PSRX(DA1,1,DA)) Q:DA=0 D
|
|---|
| 50 | .. S TEMP=$G(^PSRX(DA1,1,DA,0))
|
|---|
| 51 | .. S DSUP=+$P(TEMP,U,10)
|
|---|
| 52 | .. S RDATE=+$P(TEMP,U,18)
|
|---|
| 53 | .. I RDATE>0 D
|
|---|
| 54 | ... S SDATE=+$$FMADD^XLFDT(RDATE,DSUP)
|
|---|
| 55 | ... S DAS=DA1_";1;"_DA_";0"
|
|---|
| 56 | ... S ^PXRMINDX(52,"IP",DRUG,DFN,RDATE,SDATE,DAS)=""
|
|---|
| 57 | ... S ^PXRMINDX(52,"PI",DFN,DRUG,RDATE,SDATE,DAS)=""
|
|---|
| 58 | ... S NE=NE+1
|
|---|
| 59 | .;Process the partial fill multiple.
|
|---|
| 60 | . S DA=0
|
|---|
| 61 | . F S DA=+$O(^PSRX(DA1,"P",DA)) Q:DA=0 D
|
|---|
| 62 | .. S TEMP=$G(^PSRX(DA1,"P",DA,0))
|
|---|
| 63 | .. S DSUP=+$P(TEMP,U,10)
|
|---|
| 64 | .. S RDATE=+$P(TEMP,U,19)
|
|---|
| 65 | .. I RDATE>0 D
|
|---|
| 66 | ... S SDATE=+$$FMADD^XLFDT(RDATE,DSUP)
|
|---|
| 67 | ... S DAS=DA1_";P;"_DA_";0"
|
|---|
| 68 | ... S ^PXRMINDX(52,"IP",DRUG,DFN,RDATE,SDATE,DAS)=""
|
|---|
| 69 | ... S ^PXRMINDX(52,"PI",DFN,DRUG,RDATE,SDATE,DAS)=""
|
|---|
| 70 | ... S NE=NE+1
|
|---|
| 71 | S END=$H
|
|---|
| 72 | S TEXT=NE_" PRESCRIPTION results indexed."
|
|---|
| 73 | D MES^XPDUTL(TEXT)
|
|---|
| 74 | S TEXT=NERROR_" errors were encountered."
|
|---|
| 75 | D MES^XPDUTL(TEXT)
|
|---|
| 76 | D DETIME^PXRMSXRM(START,END)
|
|---|
| 77 | ;If there were errors send a message.
|
|---|
| 78 | I NERROR>0 D ERRMSG^PXRMSXRM(NERROR,GLOBAL)
|
|---|
| 79 | ;Send a MailMan message with the results.
|
|---|
| 80 | D COMMSG^PXRMSXRM(GLOBAL,START,END,NE,NERROR)
|
|---|
| 81 | S ^PXRMINDX(52,"GLOBAL NAME")=GLOBAL
|
|---|
| 82 | S ^PXRMINDX(52,"BUILT BY")=DUZ
|
|---|
| 83 | S ^PXRMINDX(52,"DATE BUILT")=$$NOW^XLFDT
|
|---|
| 84 | Q
|
|---|
| 85 | ;
|
|---|
