source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OREORV1.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 8.0 KB
Line 
1OREORV1 ; SLC/GDU - Orderable Items Records Validation [10/15/04 09:16]
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**217**;Dec 17,1997
3 ;OREORV1 - Orderable Items Record Validation
4 ;
5 ;BUG FIX FOR NOIS CASES:
6 ;DAN-0204-42157, ALB-1001-51034, SBY-0803-30443, NJH-0402-20607
7 ;
8 ;Scans the ^ORD(101.43, file and does the following:
9 ; 1. Counts the total number of entries in ^ORD(101.43,
10 ; 2. Determines if a source record ien is stored in the ID field of
11 ; file 101.43.
12 ; 3. Determines if a package code is stored in the ID field of file
13 ; 101.43.
14 ; 4. Determines if the package code matches the expected pattern of
15 ; 99XXX (XXX are 3 upper case letters).
16 ; 5. Using the interface standard (documented in OE/RR V3 Package
17 ; Interface Specifications, July 2001) it determines if the
18 ; package code is one that it can test for. If it can not be tested
19 ; for it is considered requiring manual confirmation. It counts the
20 ; number of OI records needing manual confirmation, subtotaled by
21 ; package.
22 ; 6. If the OI record can be tested for a source record and one is
23 ; found it is considered validated. It counts the number of
24 ; validated OI records and gives subtotals by package.
25 ; 7. If the OI record can be tested for a source record and one is not
26 ; found it is considered invalid. It counts the number of OI records
27 ; considered invalid. It subtotals by the active flag. It subtotals
28 ; by package. It will flag active records as inactive effective
29 ; immediately.
30 ;
31 ;This routine builds the temp global ^TMP($J,"OIC"
32 ;All of this information is written to a temporary global.
33 ;This is its structure:
34 ;$J - The M system variable for job number
35 ;OIC - Orderable Item Check
36 ;OIIEN - Orderable Item Internal Entry Number
37 ;OIIF - Orderable Item Inactive Flag
38 ;OIN - Orderable Item Name
39 ;OIPC - Orderable Item OIPC
40 ;Note all totals are calculated at run time.
41 ;^TMP($J,"OIC",0)=Total records processed
42 ;^TMP($J,"OIC",1)=Total records with null ID field
43 ;^TMP($J,"OIC",1,OIIEN)=Null
44 ;^TMP($J,"OIC",1,"B",OIN)=OIIEN^OIIF
45 ;^TMP($J,"OIC",2)=Total records with null source IENs
46 ;^TMP($J,"OIC",2,OIIEN)=Null
47 ;^TMP($J,"OIC",2,"B",OIN)=OIIEN^OIIF
48 ;^TMP($J,"OIC",3)=Total records with null source package codes
49 ;^TMP($J,"OIC",3,OIIEN)=Null
50 ;^TMP($J,"OIC",3,"B",OIN)=OIIEN^OIIF
51 ;^TMP($J,"OIC",4)=Total records with bad source package codes
52 ;^TMP($J,"OIC",4,OIPC)=Total by package
53 ;^TMP($J,"OIC",4,OIPC,OIIEN)=Null
54 ;^TMP($J,"OIC",4,OIPC,"B",OIN)=OIIEN^OIIF
55 ;^TMP($J,"OIC",5)=Total records not part of current specification
56 ;^TMP($J,"OIC",5,OIPC)=Total by package code
57 ;^TMP($J,"OIC",5,OIPC,OIIEN)=Null
58 ;^TMP($J,"OIC",5,OIPC,"B",OIN)= OIIEN^OIIF
59 ;^TMP($J,"OIC",6)=Total validated records
60 ;^TMP($J,"OIC",6,OIPC)=Total by package code
61 ;^TMP($J,"OIC",7)=Total records with no matching source records
62 ;^TMP($J,"OIC",7,"A")=Total active records
63 ;^TMP($J,"OIC",7,"A",OIPC)=Total by package code
64 ;^TMP($J,"OIC",7,"A",OIPC,OIIEN)=Null
65 ;^TMP($J,"OIC",7,"A",OIPC,"B",OIN)= OIIEN^OIIF
66 ;^TMP($J,"OIC",7,"I")=Total inactive records
67 ;^TMP($J,"OIC",7,"I",OIPC)=Total by package code
68 ;^TMP($J,"OIC",7,"I",OIPC,OIIEN)=Null
69 ;^TMP($J,"OIC",7,"I",OIPC,"B",OIN)= OIIEN^OIIF
70 ;
71 ;External References
72 ; $$FIND1^DIC DBIA 2051
73 ; UPDATE^DIE DBIA 2053
74 ; FDA^DILF DBIA 2054
75 ; $$GET1^DIQ DBIA 2056
76 ;
77OIIDIS ;Orderable Item ID Index Scan
78 ;Scan the ^ORD(101.43 and builds a list of orderable items with no
79 ;match in the source files.
80 ; ID - ID, field # 2, from file 101.43
81 ; IA - INACTIVATED, field # .1, from file 101.43.
82 ; IF - Inactive flag
83 ; If IA is null then it is set to A for active.
84 ; If IA is not null then it is set to I for inactive.
85 ; IEN - Internal Entry Number of record from file 101.43
86 ; NAME - NAME, field # .01, from file 101.43
87 ; SRIEN - Source Record Internal Entry Number, 1st piece ID
88 ; SRP - Source Record Package, 2nd piece ID
89 ; SRC - Source Record Check
90 ; 0 - source record does not exist
91 ; 1 - source record exist
92 ; U - Fileman, Kernel default delimiter variable, value of "^".
93 ; U is not newed or deleted.
94 N AF,IA,ID,IF,IEN,NAME,SRIEN,SRP,SRC,X
95 S U="^"
96 K ^TMP($J,"OIC")
97 F X=0:1:7 S ^TMP($J,"OIC",X)=0
98 S IEN=0 F S IEN=$O(^ORD(101.43,IEN)) Q:'IEN D
99 . S (ID,IF,NAME,SRIEN,SRP)="",SRC=0
100 . S ^TMP($J,"OIC",0)=$$CI(^TMP($J,"OIC",0))
101 . S NAME=$$GET1^DIQ(101.43,IEN,.01)
102 . S ID=$$GET1^DIQ(101.43,IEN,2)
103 . S IA=$$GET1^DIQ(101.43,IEN,.1)
104 . S IF=$S(IA="":"A",1:"I")
105 . I ID="" D BUILD(1,IEN,ID,IA,IF,NAME,SRP) Q
106 . S SRIEN=$P(ID,";")
107 . S SRP=$P(ID,";",2)
108 . I SRIEN="" D BUILD(2,IEN,ID,IA,IF,NAME,SRP) Q
109 . I SRP="" D BUILD(3,IEN,ID,IA,IF,NAME,SRP) Q
110 . I SRP'?1."99"3U D BUILD(4,IEN,ID,IA,IF,NAME,SRP) Q
111 . I $$PC(SRP)=0 D BUILD(5,IEN,ID,IA,IF,NAME,SRP) Q
112 . S SRC=$$SRC(SRP,SRIEN)
113 . I SRC>0 D BUILD(6,IEN,ID,IA,IF,NAME,SRP) Q
114 . D BUILD(7,IEN,ID,IA,IF,NAME,SRP)
115 Q
116BUILD(NODE,OIIEN,OIID,OIIA,OIIF,OIN,OISRP) ;
117 ;Build the temp OIC global
118 ;Variables passed to BUILD
119 ; NODE - Node to be written to
120 ; 1 = ID field is null
121 ; 2 = 1st piece of ID field is null
122 ; 3 = 2nd piece of ID field is null
123 ; 4 = 2nd piece of ID field is not properly formatted
124 ; 5 = 2nd piece of ID field is a package code not
125 ; part of current interface specification and
126 ; must be manually validated
127 ; 6 = OI record is considered valid
128 ; 7 = OI record has no matching source record
129 ; OIIEN - Orderable Item IEN
130 ; OIID - Orderable Item ID field
131 ; OIIA - Orderable Item INACTIVE field
132 ; OIIF - Orderable Item Inactive Flag
133 ; OIN - Orderable Item Name
134 ; OISRP - Orderable Item Source Record Package
135 ;Local variable
136 ; EM - Error message returned by FDA^DILF
137 ; FDA - FileMan Data Array, output of FDA^DILF, an input
138 ; array variable for UPDATE^DIE
139 N EM,FDA
140 S ^TMP($J,"OIC",NODE)=$$CI(^TMP($J,"OIC",NODE))
141 I NODE=1!(NODE=2)!(NODE=3) D Q
142 . S ^TMP($J,"OIC",NODE,OIIEN)=""
143 . S ^TMP($J,"OIC",NODE,"B",OIN)=OIIEN_U_$P(OIIA,"@")
144 I NODE=4!(NODE=5) D Q
145 . S:$D(^TMP($J,"OIC",NODE,OISRP))=0 ^TMP($J,"OIC",NODE,OISRP)=0
146 . S ^TMP($J,"OIC",NODE,OISRP)=$$CI(^TMP($J,"OIC",NODE,OISRP))
147 . S ^TMP($J,"OIC",NODE,OISRP,OIIEN)=""
148 . S ^TMP($J,"OIC",NODE,OISRP,"B",OIN)=OIIEN_U_$P(OIIA,"@")
149 I NODE=6 D Q
150 . S:$D(^TMP($J,"OIC",NODE,OISRP))=0 ^TMP($J,"OIC",NODE,OISRP)=0
151 . S ^TMP($J,"OIC",NODE,OISRP)=$$CI(^TMP($J,"OIC",NODE,OISRP)) Q
152 S:$D(^TMP($J,"OIC",NODE,OIIF))=0 ^TMP($J,"OIC",NODE,OIIF)=0
153 S ^TMP($J,"OIC",NODE,OIIF)=$$CI(^TMP($J,"OIC",NODE,OIIF))
154 S:$D(^TMP($J,"OIC",NODE,OIIF,OISRP))=0 ^TMP($J,"OIC",NODE,OIIF,OISRP)=0
155 S ^TMP($J,"OIC",NODE,OIIF,OISRP)=$$CI(^TMP($J,"OIC",NODE,OIIF,OISRP))
156 S ^TMP($J,"OIC",NODE,OIIF,OISRP,OIIEN)=""
157 I OIIF="A" D
158 . D FDA^DILF(101.43,OIIEN_",",.1,"R","T","FDA")
159 . D UPDATE^DIE("E","FDA",OIIEN_",","EM")
160 I OIIA="" S OIIA=$$GET1^DIQ(101.43,OIIEN,.1)
161 S ^TMP($J,"OIC",NODE,OIIF,OISRP,"B",OIN)=OIIEN_U_$P(OIIA,"@")
162 Q
163PC(PK) ;Package Check
164 ;Returns 1 if it is one of the source packages in July 2001 specs doc
165 ;Returns 0 if not one of the source packages in July 2001 specs doc
166 ;Variable passed to PC
167 ; PK - Package of the source record
168 S PK=$S(PK="99CON":1,PK="99FHD":1,PK="99FHT":1,PK="99LRT":1,PK="99ORD":1,PK="99PRC":1,PK="99PRO":1,PK="99PSP":1,PK="99RAP":1,1:0)
169 Q PK
170SRC(PK,SRI) ;Source Record Check
171 ;Returns 1 if source record is found, 0 if not
172 ;Variables passed to SRC
173 ; PK - Package of the source record
174 ; SRI - Source Record IEN
175 ;Local Variables
176 ; FN - File Number of source record. Determined by package code.
177 ; FR - Found Record, it is the return value.
178 ; It is equal to 1 if source record found, 0 if not
179 ; ORLV - Lookup Value, input variable for $$FIND1^DIC
180 N ERR,FN,FR,ORLV
181 S FN=$S(PK="99CON":123.5,PK="99FHD":111,PK="99FHT":118.2,PK="99LRT":60,PK="99ORD":101.43,PK="99PRC":123.3,PK="99PRO":101,PK="99PSP":50.7,1:71)
182 S ORLV="`"_SRI
183 S FR=$$FIND1^DIC(FN,"","",.ORLV,"","","ERR")
184 Q FR
185CI(CNT) ;Counter
186 ; CNT - Counter
187 S CNT=CNT+1
188 Q CNT
Note: See TracBrowser for help on using the repository browser.