source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOPXRMI.m@ 1607

Last change on this file since 1607 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.7 KB
Line 
1PSOPXRMI ; 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 ;
6PSRX ;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 ;
Note: See TracBrowser for help on using the repository browser.