source: WorldVistAEHR/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSSSXRD.m@ 1259

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

initial load of WorldVistAEHR

File size: 4.7 KB
Line 
1PSSSXRD ; BIR/PKR - Build indexes for drug files. ;08/30/2004
2 ;;1.0;PHARMACY DATA MANAGEMENT;**62,89**;9/30/97
3 ;
4 ;Reference to ^PXRMINDX supported by DBIA #4114
5 ;Reference to ADDERROR^PXRMSXRM supported by DBIA #4113
6 ;Reference to DETIME^PXRMSXRM supported by DBIA #4113
7 ;Reference to COMMSG^PXRMSXRM supported by DBIA #4113
8 Q
9 ;===============================================================
10PSPA ;Build the index for the Pharmacy Patient File.
11 N ADD,DA,DA1,DAS,DATE,DFN,DRUG,END,ENTRIES,GLOBAL,IDEN,IND,INS,NE
12 N NERROR,POI,SDATE,SOL,START,STARTD,TEMP,TENP,TEXT
13 S GLOBAL=$$GET1^DID(55,"","","GLOBAL NAME")
14 ;Don't leave any old stuff around.
15 K ^PXRMINDX(55),^PXRMINDX("55NVA")
16 S ENTRIES=$P(^PS(55,0),U,4)
17 S TENP=ENTRIES/10
18 S TENP=+$P(TENP,".",1)
19 I TENP<1 S TENP=1
20 D BMES^XPDUTL("Building indexes for PHARMACY PATIENT FILE")
21 S TEXT="There are "_ENTRIES_" entries to process."
22 D MES^XPDUTL(TEXT)
23 S START=$H
24 S (DFN,IND,NE,NERROR)=0
25 F S DFN=+$O(^PS(55,DFN)) Q:DFN=0 D
26 . S IND=IND+1
27 . I IND#TENP=0 D
28 .. S TEXT="Processing entry "_IND
29 .. D MES^XPDUTL(TEXT)
30 . I IND#10000=0 W "."
31 .;Process Unit Dose.
32 . S DA=0
33 . F S DA=+$O(^PS(55,DFN,5,DA)) Q:DA=0 D
34 .. S TEMP=$G(^PS(55,DFN,5,DA,2))
35 .. S STARTD=$P(TEMP,U,2)
36 .. I STARTD="" D Q
37 ... S IDEN="DFN="_DFN_" D1="_DA_" Unit Dose missing start date"
38 ... D ADDERROR^PXRMSXRM(GLOBAL,IDEN,.NERROR)
39 .. S SDATE=$P(TEMP,U,4)
40 .. I SDATE=1 Q
41 .. I SDATE="" D Q
42 ... S IDEN="DFN="_DFN_" D1="_DA_" Unit Dose missing stop date"
43 ... D ADDERROR^PXRMSXRM(GLOBAL,IDEN,.NERROR)
44 .. S DA1=0
45 .. F S DA1=+$O(^PS(55,DFN,5,DA,1,DA1)) Q:DA1=0 D
46 ... S DRUG=$P(^PS(55,DFN,5,DA,1,DA1,0),U,1)
47 ... I DRUG="" D Q
48 .... S IDEN="DFN="_DFN_" D1="_DA_" D2="_DA1_" Unit Dose missing drug"
49 .... D ADDERROR^PXRMSXRM(GLOBAL,IDEN,.NERROR)
50 ... S DAS=DFN_";5;"_DA_";1;"_DA1_";0"
51 ... S ^PXRMINDX(55,"IP",DRUG,DFN,STARTD,SDATE,DAS)=""
52 ... S ^PXRMINDX(55,"PI",DFN,DRUG,STARTD,SDATE,DAS)=""
53 ... S NE=NE+1
54 .;Process the IV multiple.
55 . S DA=0
56 . F S DA=+$O(^PS(55,DFN,"IV",DA)) Q:DA=0 D
57 .. S TEMP=$G(^PS(55,DFN,"IV",DA,0))
58 .. S STARTD=$P(TEMP,U,2)
59 .. I STARTD="" D Q
60 ... S IDEN="DFN="_DFN_" D1="_DA_" IV missing start date"
61 ... D ADDERROR^PXRMSXRM(GLOBAL,IDEN,.NERROR)
62 .. S SDATE=$P(TEMP,U,3)
63 .. I SDATE=1 Q
64 .. I SDATE="" D Q
65 ... S IDEN="DFN="_DFN_" D1="_DA_" IV missing stop date"
66 ... D ADDERROR^PXRMSXRM(GLOBAL,IDEN,.NERROR)
67 ..;Process Additives
68 .. S DA1=0
69 .. F S DA1=+$O(^PS(55,DFN,"IV",DA,"AD",DA1)) Q:DA1=0 D
70 ... S ADD=$P(^PS(55,DFN,"IV",DA,"AD",DA1,0),U,1)
71 ... I ADD="" D Q
72 .... S IDEN="DFN="_DFN_" D1="_DA_" D2="_DA1_" IV missing additive"
73 .... D ADDERROR^PXRMSXRM(GLOBAL,IDEN,.NERROR)
74 ... S DRUG=$P($G(^PS(52.6,ADD,0)),U,2)
75 ... I DRUG="" D Q
76 .... S IDEN="DFN="_DFN_" D1="_DA_" D2="_DA1_" IV additive missing drug"
77 .... D ADDERROR^PXRMSXRM(GLOBAL,IDEN,.NERROR)
78 ... S NE=NE+1
79 ... S DAS=DFN_";IV;"_DA_";AD;"_DA1_";0"
80 ... S ^PXRMINDX(55,"IP",DRUG,DFN,STARTD,SDATE,DAS)=""
81 ... S ^PXRMINDX(55,"PI",DFN,DRUG,STARTD,SDATE,DAS)=""
82 ..;Process Solutions
83 .. S DA1=0
84 .. F S DA1=+$O(^PS(55,DFN,"IV",DA,"SOL",DA1)) Q:DA1=0 D
85 ... S SOL=$P(^PS(55,DFN,"IV",DA,"SOL",DA1,0),U,1)
86 ... I SOL="" D Q
87 .... S IDEN="DFN="_DFN_" D1="_DA_" D2="_DA1_" IV-SOL missing solution"
88 .... D ADDERROR^PXRMSXRM(GLOBAL,IDEN,.NERROR)
89 ... S DRUG=$P($G(^PS(52.7,SOL,0)),U,2)
90 ... I DRUG="" D Q
91 .... S IDEN="DFN="_DFN_" D1="_DA_" D2="_DA1_" IV-SOL missing Drug"
92 .... D ADDERROR^PXRMSXRM(GLOBAL,IDEN,.NERROR)
93 ... S NE=NE+1
94 ... S DAS=DFN_";IV;"_DA_";SOL;"_DA1_";0"
95 ... S ^PXRMINDX(55,"IP",DRUG,DFN,STARTD,SDATE,DAS)=""
96 ... S ^PXRMINDX(55,"PI",DFN,DRUG,STARTD,SDATE,DAS)=""
97 .;Process the NVA multiple.
98 . S DA=0
99 . F S DA=+$O(^PS(55,DFN,"NVA",DA)) Q:DA=0 D
100 .. S TEMP=$G(^PS(55,DFN,"NVA",DA,0))
101 .. S STARTD=$P(TEMP,U,9)
102 .. I STARTD="" S STARTD=$P(TEMP,U,10)
103 .. I STARTD="" D Q
104 ... S IDEN="DFN="_DFN_" D1="_DA_" NVA missing start date"
105 ... D ADDERROR^PXRMSXRM(GLOBAL,IDEN,.NERROR)
106 .. S SDATE=$P(TEMP,U,7)
107 .. I SDATE="" S SDATE="U"_DFN_DA
108 .. S DAS=DFN_";NVA;"_DA_";0"
109 .. S POI=$P(TEMP,U,1)
110 .. S ^PXRMINDX("55NVA","IP",POI,DFN,STARTD,SDATE,DAS)=""
111 .. S ^PXRMINDX("55NVA","PI",DFN,POI,STARTD,SDATE,DAS)=""
112 S END=$H
113 S TEXT=NE_" PHARMACY PATIENTS results indexed."
114 D MES^XPDUTL(TEXT)
115 S TEXT=NERROR_" errors were encountered."
116 D MES^XPDUTL(TEXT)
117 D DETIME^PXRMSXRM(START,END)
118 ;If there were errors send a message.
119 I NERROR>0 D ERRMSG^PXRMSXRM(NERROR,GLOBAL)
120 ;Send a MailMan message with the results.
121 D COMMSG^PXRMSXRM(GLOBAL,START,END,NE,NERROR)
122 S ^PXRMINDX(55,"GLOBAL NAME")=$$GET1^DID(55,"","","GLOBAL NAME")
123 S ^PXRMINDX(55,"BUILT BY")=DUZ
124 S ^PXRMINDX(55,"DATE BUILT")=$$NOW^XLFDT
125 S ^PXRMINDX("55NVA","GLOBAL NAME")=^PXRMINDX(55,"GLOBAL NAME")
126 S ^PXRMINDX("55NVA","BUILT BY")=^PXRMINDX(55,"BUILT BY")
127 S ^PXRMINDX("55NVA","DATE BUILT")=^PXRMINDX(55,"DATE BUILT")
128 Q
Note: See TracBrowser for help on using the repository browser.