close Warning: Can't use blame annotator: 
svn blame failed on WorldVistAEHR/trunk/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSULRHL3.m: 'GenericSWIGWrapper' object has no attribute '_wrap'

source: WorldVistAEHR/trunk/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSULRHL3.m@ 1800

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

initial load of WorldVistAEHR
File size: 5.9 KB
RevLine 
1PSULRHL3 ;HCIOFO/BH - Daily file procesing ; 4/28/04 3:10pm
2 ;;4.0;PHARMACY BENEFITS MANAGEMENT;**3**;MARCH, 2005
3 ;
4 ; ** THIS ROUTINE SHOULD NEVER BE INSTALLED AT A SITE ***
5 ; ** THIS ROUTINE IS ONLY TO BE RUN ON THE CMOP-NAT SERVER ***
6 ;
7 Q
8 ;
9PROCESS ; This process loops through the file containing parsed HL7 data.
10 ; This process runs each day and collects up to the previous days data.
11 ; The data is ordered by facility. All the data for the facility for
12 ; for up to the previous day gets filed into one flat file for PBM to
13 ; process. A pre-init sub routine CULL loops through all x-refs that
14 ; indicate processed data for facility and date and culls the data and
15 ; removes the FD x-ref.
16 ;
17 ;
18 D CULL
19 ;
20 ;
21 N DFN,EDATE,FACILITY,FILE,IEN,OPEN,OUTDIR,PSUDTE,QUIT,RDATE,RC,SDATE,TEMP,X,X1,X2
22 ;
23 ; End date for search
24 D NOW^%DTC S TEMP=%,EDATE=$P(TEMP,".",1)
25 ; Run date i.e. going to process data up to yesterday
26 S X1=$P(TEMP,".",1),X2="-1" D C^%DTC S RDATE=$P(X,".",1)
27 ;
28 ;
29 S FACILITY="",(QUIT,OPEN)=0
30 ;
31 F S FACILITY=$O(^DIZ(99999,"FDP",FACILITY)) Q:'FACILITY!(QUIT) D
32 . ;
33 . I $D(^DIZ(99999,"FD",FACILITY,RDATE)) D Q
34 . . D ERROR(3,FACILITY,RDATE) Q
35 . ; New facility so close any open files.
36 . I OPEN D CLOSE S OPEN=0
37 . S DATE="0"
38 . F S DATE=$O(^DIZ(99999,"FDP",FACILITY,DATE)) Q:'DATE!(DATE'<EDATE)!(QUIT) D
39 . . ;
40 . . S DFN=""
41 . . F S DFN=$O(^DIZ(99999,"FDP",FACILITY,DATE,DFN)) Q:'DFN!(QUIT) D
42 . . . S IEN=""
43 . . . F S IEN=$O(^DIZ(99999,"FDP",FACILITY,DATE,DFN,IEN)) Q:'IEN!(QUIT) D
44 . . . . I 'OPEN D Q:'RC
45 . . . . . S RC=$$OPEN()
46 . . . . . I 'RC S QUIT=1 Q
47 . . . . . S OPEN=1
48 . . . . D FILE
49 I OPEN D CLOSE
50 Q
51 ;
52 ;
53OPEN() ; Open the output directory
54 N DST,POP,SRC
55 S FILE=FACILITY_DT_".DAT"
56 ;S OUTDIR="W:\PBM\National-PBM"
57 S OUTDIR="USER$:[PBM.LAB]"
58 ;
59 K DST,SRC
60 S SRC(FILE)=""
61 I $$LIST^%ZISH(OUTDIR,"SRC","DST") D ERROR(2,FACILITY,FILE) Q 0
62 ;
63 D OPEN^%ZISH("HL7FILE",OUTDIR,FILE,"W")
64 I $G(POP) D ERROR(1,FACILITY,OUTDIR_FILE) Q 0
65 ;
66 Q 1
67 ;
68CLOSE ; Set Cross ref indicating that facilities data for the day got
69 ; processed, and close the output file.
70 N FDA
71 K FDA
72 S FDA(99999,"+1,",.01)=$E(FILE,1,3)
73 S FDA(99999,"+1,",.03)=RDATE
74 D UPDATE^DIE("","FDA",)
75 D CLOSE^%ZISH("HL7FILE")
76 Q
77 ;
78FILE ; File the lab data to the output file in the following single string format.
79 ;
80 ; PAT|Facility|ICN|SSN|DFN|Date/Time Specimen Collected|Site/Specimen|Local Lab Number^Local Lab Name|
81 ; NLT Code^NLT Name|LOINC Code^LOINC Name|Result|Units|Low Range|High Range|
82 ;
83 ;
84 N CNT,CR,DFN,FAC,HRANGE,ICN,LABA,LABB,LABC,LNCODE,LNNAME,LOCALLAB,LRANGE,NLTCODE,NLTNAME,RANGE,REC,RESIEN,RESREC,RESREC1,RESULT,SPEC,SPECDATE,SPECREC,SPECIEN,SSN,STR,STR1,TEST,UNITS
85 ;
86 U IO
87 S REC=^DIZ(99999,IEN,0)
88 S SSN=$P(REC,U,5),ICN=$P(REC,U,4),FAC=$P(REC,U,1),DFN=$P(REC,U,2)
89 ;
90 S SPECIEN=0
91 F S SPECIEN=$O(^DIZ(99999,IEN,1,SPECIEN)) Q:'SPECIEN D
92 . ; Do not file if Specimen has no results
93 . S TEST=0
94 . S TEST=$O(^DIZ(99999,IEN,1,SPECIEN,1,TEST)) Q:'TEST
95 . S SPECREC=^DIZ(99999,IEN,1,SPECIEN,0)
96 . S SPEC=$P(SPECREC,U,1),SPECDATE=$P(SPECREC,U,2)
97 . S STR="PAT|"_FAC_"|"_ICN_"|"_SSN_"|"_DFN_"|"_SPECDATE_"|"_SPEC
98 . ;W STR
99 . S RESIEN=0
100 . ;S CNT=0
101 . F S RESIEN=$O(^DIZ(99999,IEN,1,SPECIEN,1,RESIEN)) Q:'RESIEN D
102 . . S RESREC=^DIZ(99999,IEN,1,SPECIEN,1,RESIEN,0)
103 . . S RESREC1=^DIZ(99999,IEN,1,SPECIEN,1,RESIEN,2)
104 . . ;S CNT=CNT+1
105 . . S LOCALLAB=$P(RESREC,U,6),NLTCODE=$P(RESREC,U,2)
106 . . S NLTNAME=$P(RESREC,U,3),LNNAME=$P(RESREC,U,5)
107 . . S LNCODE=$P(RESREC,U,4),RESULT=$P(RESREC,U,1)
108 . . S UNITS=$P(RESREC1,U,1),RANGE=$P(RESREC1,U,2)
109 . . ; Most of the time High and Low range are separated by a "-"
110 . . I RANGE["-" D
111 . . . S LRANGE=$P(RANGE,"-",1),HRANGE=$P(RANGE,"-",2)
112 . . I RANGE'["-" D
113 . . . S LRANGE=RANGE,HRANGE=""
114 . . S LABA="|^"_LOCALLAB_"|"_NLTCODE_"^"_NLTNAME_"|"_LNCODE_"^"_LNNAME_"|"
115 . . ;
116 . . S LABB=RESULT_"|"_UNITS_"|"
117 . . ;
118 . . S LABC=LRANGE_"|"_HRANGE_"|"
119 . . W STR_LABA_LABB_LABC,!
120 Q
121 ;
122ERROR(CODE,FAC,MESSAGE) ; Error processing
123 N ARR,STR
124 I CODE=1 S STR=DT_": Cannot open output file "_MESSAGE
125 I CODE=2 S STR=DT_": File name already exists in the output directory "_MESSAGE
126 I CODE=3 D
127 . S MESSAGE=$E(MESSAGE,4,5)_"/"_$E(MESSAGE,6,7)_"/"_$E(MESSAGE,2,3)
128 . S STR=DT_": Trying to process records for Facility #"_FAC_" for the date of "_MESSAGE_" that have already been processed."
129 S FDA(99999,"+1,",.01)=FAC
130 S FDA(99999,"+1,",2)=STR
131 D UPDATE^DIE("","FDA",)
132 Q
133 ;
134 ;
135CULL ; Cull all entries for a facility that have been processed on or before the date in FD x-ref
136 N A,B,DFN,DELLIEN,FAC,IDATE,IEN,PDATE
137 S FAC="0"
138 F S FAC=$O(^DIZ(99999,"FD",FAC)) Q:'FAC D
139 . S PDATE=0
140 . F S PDATE=$O(^DIZ(99999,"FD",FAC,PDATE)) Q:'PDATE D
141 . . S IDATE=0
142 . . ; Remove entry with FD x-ref
143 . . S DELLIEN=0
144 . . S DELLIEN=$O(^DIZ(99999,"FD",FAC,PDATE,DELLIEN))
145 . . K B
146 . . S B(99999,DELLIEN_",",.01)="@" D FILE^DIE(,"B")
147 . . ;
148 . . F S IDATE=$O(^DIZ(99999,"FDP",FAC,IDATE)) Q:'IDATE!($P(IDATE,".",1)>PDATE) D
149 . . . S DFN=0
150 . . . F S DFN=$O(^DIZ(99999,"FDP",FAC,IDATE,DFN)) Q:'DFN D
151 . . . . S IEN=0
152 . . . . F S IEN=$O(^DIZ(99999,"FDP",FAC,IDATE,DFN,IEN)) Q:'IEN D
153 . . . . . K A
154 . . . . . S A(99999,IEN_",",.01)="@" D FILE^DIE(,"A")
155 Q
156 ;
157 ;
158ERORDSP ; Display errors
159 ;
160 N DATE,DONE,EDATE,FAC,IEN,PG
161 S PG=0,DATE=$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)
162 D HEAD
163 I '$D(^DIZ(99999,"FDE")) W "No Error's to report." H 4 Q
164 ;
165 ;
166 S FAC="0"
167 F S FAC=$O(^DIZ(99999,"FDE",FAC)) Q:'FAC D
168 . ;
169 . S EDATE=0
170 . F S EDATE=$O(^DIZ(99999,"FDE",FAC,EDATE)) Q:'EDATE D
171 . . S IEN=0
172 . . F S IEN=$O(^DIZ(99999,"FDE",FAC,EDATE,IEN)) Q:'IEN D
173 . . . S MSG=^DIZ(99999,IEN,2)
174 . . . I ($Y+4>IOSL) D PRTC Q:$D(DONE) D HEAD
175 . . . W !," "_MSG,!
176 Q
177 ;
178HEAD ;
179 W:$Y>0 @IOF S PG=PG+1
180 W " "_DATE,?71,"Page ",PG,!!
181 W " Error log for PBM III national database processing.",!
182 W " ---------------------------------------------------",!
183 Q
184 ;
185PRTC ;press return to continue prompt
186 Q:$E(IOST,1,2)'="C-"!($D(IO("S")))
187 K DIR W ! S DIR(0)="E" D ^DIR K DIR I 'Y S DONE=1
188 Q
189 ;
190 ;
Note: See TracBrowser for help on using the repository browser.