source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORPXRM.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 3.6 KB
Line 
1ORPXRM ; SLC/PKR - Clinical Reminder index routines for file 100. ;8/13/06 14:19
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**157,260**;Dec 17, 1997;Build 26
3 ;DBIA 4113 supports PXRMSXRM entry points.
4 ;DBIA 4114 supports setting and killing ^PXRMINDX
5 ;=========================================================
6INDEX ;Build the index for the ORDER file.
7 N D0,D0P,D1,DAS,DFN,END,ENTRIES,ETEXT,FERROR,GLOBAL,IND,NE,NDUP,NERROR
8 N OI,PROC,START,STRTDATE,STOP,TEMP,TENP,TEXT
9 ;Don't leave any old stuff around.
10 K ^PXRMINDX(100)
11 S GLOBAL=$$GET1^DID(100,"","","GLOBAL NAME")
12 S ENTRIES=$P(^OR(100,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 index for ORDER file")
17 S TEXT="There are "_ENTRIES_" entries to process."
18 D MES^XPDUTL(TEXT)
19 S START=$H
20 S (D0,D0P,FERROR,IND,NDUP,NE,NERROR)=0
21 F S D0=$O(^OR(100,D0)) Q:(+D0=0)!(FERROR) D
22 . I D0'>D0P D Q
23 .. S FERROR=1
24 .. S ETEXT=D0_" subscript is a bad, cannot continue!"
25 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
26 . S D0P=D0
27 . S IND=IND+1
28 . I IND#TENP=0 D
29 .. S TEXT="Processing entry "_IND
30 .. D MES^XPDUTL(TEXT)
31 . I IND#10000=0 W "."
32 . S TEMP=$G(^OR(100,D0,0))
33 . I TEMP="" D Q
34 .. S ETEXT=D0_" bad entry no 0 node"
35 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
36 . S DFN=$P(TEMP,U,2)
37 . I DFN="" D Q
38 .. S ETEXT=D0_" no DFN"
39 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
40 . I DFN'["DPT(" Q
41 . S DFN=$P(DFN,";",1)
42 . S STRTDATE=$P(TEMP,U,8)
43 .;If there is no start date get the release date for the new order.
44 . I STRTDATE="" S STRTDATE=$$RDATE(D0)
45 . I STRTDATE="" Q
46 . S STOP=$P(TEMP,U,9)
47 . S STOP=$S(STOP="":"U"_D0,1:STOP)
48 . S D1=0
49 . F S D1=+$O(^OR(100,D0,.1,D1)) Q:D1=0 D
50 .. S OI=^OR(100,D0,.1,D1,0)
51 .. S DAS=D0_";.1;"_D1_";0"
52 .. I OI="" D Q
53 ... S ETEXT=DAS_" no orderable item"
54 ... D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
55 .. I $D(^PXRMINDX(100,"IP",OI,DFN,STRTDATE,STOP,DAS)) S NDUP=NDUP+1
56 .. S ^PXRMINDX(100,"IP",OI,DFN,STRTDATE,STOP,DAS)=""
57 .. S ^PXRMINDX(100,"PI",DFN,OI,STRTDATE,STOP,DAS)=""
58 .. S NE=NE+1
59 S END=$H
60 S TEXT=NE_" ORDER results indexed."
61 W !,"There were "_NDUP_" duplicates."
62 D MES^XPDUTL(TEXT)
63 D DETIME^PXRMSXRM(START,END)
64 ;If there were errors send a message.
65 I NERROR>0 D ERRMSG^PXRMSXRM(NERROR,GLOBAL)
66 ;Send a MailMan message with the results.
67 D COMMSG^PXRMSXRM(GLOBAL,START,END,NE,NERROR)
68 S ^PXRMINDX(100,"GLOBAL NAME")=GLOBAL
69 S ^PXRMINDX(100,"BUILT BY")=DUZ
70 S ^PXRMINDX(100,"DATE BUILT")=$$NOW^XLFDT
71 Q
72 ;
73 ;=========================================================
74GETDATA(ORIFN,DATA) ;Return data, for a specified order file entry.
75 N ORUPCHUK
76 D EN^ORX8(ORIFN)
77 S ORUPCHUK("ORORDER")=$$OI^ORX8(ORIFN)
78 S ORUPCHUK("ORREL")=$$RDATE(ORIFN)
79 M DATA=ORUPCHUK
80 Q
81 ;
82 ;=========================================================
83KOR(X,DA) ;Kill index for Order file.
84 N DAS,DFN,STOP
85 I X(1)'["DPT" Q
86 I 'X(2)!'X(3) Q
87 S DFN=$P(X(1),";",1)
88 S DAS=DA(1)_";.1;"_DA_";0"
89 S STOP=$S(X(4)="":"U"_DA(1),1:X(4))
90 K ^PXRMINDX(100,"IP",X(2),DFN,X(3),STOP,DAS)
91 K ^PXRMINDX(100,"PI",DFN,X(2),X(3),STOP,DAS)
92 Q
93 ;=========================================================
94RDATE(ORIFN) ;Return the release date for the new order action.
95 N RDIEN
96 S RDIEN=$O(^OR(100,ORIFN,8,"C","NW",""))
97 I RDIEN="" Q ""
98 Q $P(^OR(100,ORIFN,8,RDIEN,0),U,16)
99 ;
100 ;=========================================================
101SOR(X,DA) ;Set index for Order file.
102 ;X(1)=OBJECT OF ORDER, X(2)=ORDERABLE ITEM, X(3)=START DATE
103 ;or release date, X(4)=STOP DATE
104 N DAS,DFN,STOP
105 I X(1)'["DPT" Q
106 I 'X(2)!'X(3) Q
107 S DFN=$P(X(1),";",1)
108 S DAS=DA(1)_";.1;"_DA_";0"
109 S STOP=$S(X(4)="":"U"_DA(1),1:+X(4))
110 S ^PXRMINDX(100,"IP",X(2),DFN,+X(3),STOP,DAS)=""
111 S ^PXRMINDX(100,"PI",DFN,X(2),+X(3),STOP,DAS)=""
112 Q
113 ;
Note: See TracBrowser for help on using the repository browser.