source: WorldVistAEHR/trunk/r/BAR_CODE_MED_ADMIN-ALPB-PSB/ALPBUTL1.m@ 975

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

revised back to 6/30/08 version

File size: 7.3 KB
Line 
1ALPBUTL1 ;OIFO-DALLAS MW,SED,KC-BCBU BACKUP REPORT FUNCTIONS AND UTILITIES ;01/01/03
2 ;;3.0;BAR CODE MED ADMIN;**8**;Mar 2004
3 ;
4 ; Reference/IA
5 ; INP^VADPT/10061
6 ; DIC(42/10039
7 ; DIC(42/2440
8 ;
9ERRBLD(SEG,MSG,ERR) ; build an error array for non-FileMan-related errors...
10 ; SEG = HL7 segment name
11 ; MSG = a message that will be used in the error text portion of the array (optional -- if not passed, the
12 ; default will be used)
13 ; ERR = array passed by reference in which error will be returned
14 ; note: code 999 is a code indicating a non-FileMan error for filing the error message in file 53.71
15 S ERR("DIERR")=1
16 S ERR("DIERR",1)=999
17 S ERR("DIERR",1,"TEXT",1)=$S($G(MSG)'="":MSG,1:"Invalid parameter passed to "_SEG_" module in routine ALPBHL1U")
18 Q
19 ;
20ERRLOG(IEN,OIEN,MSGREC,SEGNAME,SEGDATA,ERRTEXT) ; log filing errors...
21 ; this module logs error data in the BCMA BACKUP PARAMETERS file (53.71). These
22 ; errors usually occur as the result of missing or bad data passed to one of the
23 ; File Manager DBS calls used by this package.
24 ;
25 ; IEN = the patient's record number in file 53.7
26 ; OIEN = the order number's sub-file record number in file 53.7
27 ; MSGREC = the HL7 message's record number in file 772
28 ; SEGNAME = the HL7 segment associated with the error (optional)
29 ; SEGDATA = the HL7 segment's data (optional)
30 ; ERRTEXT = an array passed by reference which contains the error
31 ; code (numeric) and the error text to be filed. It is
32 ; expected that this is usually the error array returned
33 ; from a FileMan DBS call, so the format is specific:
34 ;
35 ; ERRTEXT("DIERR",n)=error code (numeric)
36 ; ERRTEXT("DIERR",n,"TEXT",1)=first line of error text
37 ; ERRTEXT("DIERR",n,"TEXT",2)=second line of error text
38 ; ERRTEXT("DIERR",n,"TEXT",n)=last line of error text
39 ;
40 ; However, any error message can be passed to this module
41 ; as long as the above format is used.
42 N ALPBCODE,ALPBFERR,ALPBFILE,ALPBLOGD,ALPBN1,ALPBN2,ALPBPIEN,ALPBTEXT,ALPBX
43 S ALPBLOGD=$$NOW^XLFDT()
44 S ALPBPIEN=+$O(^ALPB(53.71,0))
45 I ALPBPIEN=0 D
46 .S X="ONE"
47 .S DIC="^ALPB(53.71,"
48 .S DIC(0)="LZ"
49 .S DIC("DR")="1///^S X=3"
50 .S DINUM=1
51 .S DLAYGO=53.71
52 .D FILE^DICN K DIC
53 .S ALPBPIEN=+Y
54 I ALPBPIEN'>0 Q
55 S ALPBN1=+$O(^ALPB(53.71,ALPBPIEN,1," "),-1)+1
56 S ALPBFILE(53.713,"+"_ALPBN1_","_ALPBPIEN_",",.01)=ALPBLOGD
57 S ALPBFILE(53.713,"+"_ALPBN1_","_ALPBPIEN_",",1)=+$G(IEN)
58 S ALPBFILE(53.713,"+"_ALPBN1_","_ALPBPIEN_",",2)=+$G(OIEN)
59 S ALPBFILE(53.713,"+"_ALPBN1_","_ALPBPIEN_",",3)=+$G(MSGREC)
60 S ALPBFILE(53.713,"+"_ALPBN1_","_ALPBPIEN_",",3.1)=$G(SEGNAME)
61 S ALPBFILE(53.713,"+"_ALPBN1_","_ALPBPIEN_",",3.2)=$G(SEGDATA)
62 D UPDATE^DIE("","ALPBFILE","ALPBN1","ALPBFERR")
63 K ALPBFERR,ALPBFILE
64 S ALPBX=0
65 F S ALPBX=$O(ERRTEXT("DIERR",ALPBX)) Q:'ALPBX D
66 .S ALPBCODE=ERRTEXT("DIERR",ALPBX)
67 .; file the error code...
68 .S ALPBN2=+$O(^ALPB(53.71,ALPBPIEN,1,ALPBN1,2," "),-1)+1
69 .S ALPBFILE(53.7135,"+"_ALPBN2_","_ALPBN1_","_ALPBPIEN_",",.01)=ALPBCODE
70 .D UPDATE^DIE("","ALPBFILE","ALPBN2","ALPBFERR")
71 .K ALPBFERR,ALPBFILE
72 .; file the error text...
73 .M ALPBTEXT=ERRTEXT("DIERR",ALPBX,"TEXT")
74 .D WP^DIE(53.7135,ALPBN2_","_ALPBN1_","_ALPBPIEN_",",1,"","ALPBTEXT","ALPBFERR")
75 .;S ALPBFILE(53.7135,"+"_ALPBN2_","_ALPBN1_","_ALPBPIEN_",",1)=ALPBTEXT
76 .;D UPDATE^DIE("","ALPBFILE","ALPBN2","ALPBFERR")
77 .K ALPBCODE,ALPBFERR,ALPBFILE,ALPBN2,ALPBTEXT
78 Q
79 ;
80CLEAN(IEN) ; check error log records to see if the patients' whose records
81 ; are noted still exist in file 53.7. if not, delete the error log
82 ; record(s) in file 53.71...
83 ; IEN = patient record number in file 53.7
84 ; Note: this function is also called from DELPT^ALPBUTL when a patient's
85 ; record is deleted (as a result of a discharge action) from 53.7.
86 ;
87 N ALPBX,ALPBY,DA,DIK,X,Y
88 ; patient still has record in 53.7? if so, quit...
89 I $G(^ALPB(53.7,IEN,0))'="" Q
90 S ALPBX=0
91 F S ALPBX=$O(^ALPB(53.71,"C",IEN,ALPBX)) Q:'ALPBX D
92 .S ALPBY=0
93 .F S ALPBY=$O(^ALPB(53.71,"C",IEN,ALPBX,ALPBY)) Q:'ALPBY D
94 ..S DA=ALPBY
95 ..S DA(1)=ALPBX
96 ..S DIK="^ALPB(53.71,"_DA(1)_",1,"
97 ..D ^DIK
98 ..K DA,DIK
99 .K ALPBY
100 K ALPBX
101 Q
102 ;
103DELERR(ERRIEN) ; delete an error log entry from file 53.71...
104 ; ERRIEN = error log entry's internal record number
105 N ALPBPARM,DA,DIK,X,Y
106 S ALPBPARM=+$O(^ALPB(53.71,0))
107 I ALPBPARM'>0 Q
108 S DA=ERRIEN
109 S DA(1)=ALPBPARM
110 S DIK="^ALPB(53.71,"_DA(1)_",1,"
111 D ^DIK
112 Q
113 ;
114PTLIST(LTYPE,RESULTS) ; get list of patients in file 53.7...
115 ; LTYPE = passed = "ALL" to list all patients or
116 ; = <wardname> to list patients on a selected ward
117 ; RESULTS = an array passed by reference in which data will be returned
118 N ALPBDATA,ALPBIEN,ALPBPTN,ALPBX
119 I $G(LTYPE)="" S LTYPE="ALL"
120 S ALPBX=0
121 I LTYPE="ALL" D
122 .S ALPBPTN=""
123 .F S ALPBPTN=$O(^ALPB(53.7,"B",ALPBPTN)) Q:ALPBPTN="" D
124 ..S ALPBIEN=0
125 ..F S ALPBIEN=$O(^ALPB(53.7,"B",ALPBPTN,ALPBIEN)) Q:'ALPBIEN D
126 ...S ALPBDATA=$G(^ALPB(53.7,ALPBIEN,0))
127 ...I ALPBDATA="" K ALPBDATA Q
128 ...S ALPBX=ALPBX+1
129 ...S RESULTS(ALPBX)=ALPBPTN_"^"_$P(ALPBDATA,"^",2)_"^"_$P(ALPBDATA,"^",5)_"^"_$P(ALPBDATA,"^",6)_"^"_$P(ALPBDATA,"^",7)
130 ...K ALPBDATA
131 ..K ALPBIEN
132 .K ALPBPTN
133 I LTYPE'="ALL" D
134 .S ALPBPTN=""
135 .F S ALPBPTN=$O(^ALPB(53.7,"AW",LTYPE,ALPBPTN)) Q:ALPBPTN="" D
136 ..S ALPBIEN=0
137 ..F S ALPBIEN=$O(^ALPB(53.7,"AW",LTYPE,ALPBPTN,ALPBIEN)) Q:'ALPBIEN D
138 ...S ALPBDATA=$G(^ALPB(53.7,ALPBIEN,0))
139 ...I ALPBDATA="" K ALPBDATA Q
140 ...S ALPBX=ALPBX+1
141 ...S RESULTS(ALPBX)=ALPBPTN_"^"_$P(ALPBDATA,"^",2)_"^"_$P(ALPBDATA,"^",5)_"^"_$P(ALPBDATA,"^",6)_"^"_$P(ALPBDATA,"^",7)
142 ...K ALPBDATA
143 ..K ALPBIEN
144 .K ALPBPTN
145 Q
146 ;
147STAT(ST) ;This will return the value of a status code for pharmacy
148 I $G(ST)="" Q ""
149 I $L($T(@ST)) G @ST
150 Q ""
151IP Q "pending"
152CM Q "finished/verified by pharmacist(active)"
153DC Q "discontinued"
154RP Q "replaced"
155HD Q "on hold"
156ZE Q "expired"
157ZS Q "suspended(active)"
158ZU Q "un-suspended(active)"
159ZX Q "unreleased"
160ZZ Q "renewed"
161 ;
162STAT2(CODE) ; convert order status code for output...
163 ; this function is used primarily by the workstation software
164 ; CODE = an order status code
165 ; returns printable status code
166 I $G(CODE)="" Q "Unknown"
167 I CODE="IP"!(CODE="ZX") Q "Pending"
168 I CODE="CM"!(CODE="ZU")!(CODE="ZZ") Q "Active"
169 I CODE="HD"!(CODE="ZS") Q "Hold"
170 I CODE="DC"!(CODE="RP")!(CODE="ZE") Q "Expired"
171 Q "Unknown"
172 ;
173DIV(DFN,ALPBMDT) ;get the Division for a patient
174 I +$G(DFN)'>0 Q ""
175 N ALPBDIV,ALPWRD,VAIN,VAINDT
176 S:+$G(ALPBMDT)>0 VAINDT=$P(ALPBMDT,".",1)
177 K ALPBMDT
178 D INP^VADPT
179 S ALPWRD=$P($G(VAIN(4)),U,1)
180 Q:+ALPWRD'>0 ""
181 ;Check to see if ward is a DOMICILIARY
182 I $P($G(^DIC(42,ALPWRD,0)),U,3)="D" Q "DOM"
183 S ALPBDIV=$P($G(^DIC(42,ALPWRD,0)),U,11)
184 Q:+ALPBDIV'>0 ""
185 Q ALPBDIV
186 ;
187CNV(A,B,X) ;CONVERT A STRING
188 ;This API will take a HL7 segment and convert characters
189 ;defined in the input
190 ;Example:
191 ;Single encoding characters can be converted such as ^ to ~
192 ;or multiple encoding characters can be converted such as
193 ; |~^@/ to ^~|/@
194 ;A is the string of HL7 encoding characters to be converted
195 ;B is the string of HL7 encoding characters to be converted to
196 ;X is te message string to be converted
197 I A=""!B=""!X="" Q ""
198 F I=1:1:$L(A) S A(I)=$E(A,I,I),A(I,1)=""
199 F I=1:1:$L(B) S B(I)=$E(B,I,I)
200 S J=0
201 F S J=$O(A(J)) Q:+J'>0 D
202 . F I=1:1:$L(X) S:$E(X,I,I)=A(J) A(J,1)=A(J,1)_I_U
203 S J=0
204 F S J=$O(A(J)) Q:+J'>0 D
205 . Q:'$D(A(J,1))!'$D(B(J))
206 . F I=1:1:$L(A(J,1),U) S C=$P(A(J,1),U,I) S:+C>0 $E(X,C,C)=B(J)
207 Q X
Note: See TracBrowser for help on using the repository browser.