208 lines
7.3 KiB
Mathematica
208 lines
7.3 KiB
Mathematica
ALPBUTL1 ;OIFO-DALLAS MW,SED,KC-BCBU BACKUP REPORT FUNCTIONS AND UTILITIES ;01/01/03
|
|
;;3.0;BAR CODE MED ADMIN;**8**;Mar 2004
|
|
;
|
|
; Reference/IA
|
|
; INP^VADPT/10061
|
|
; DIC(42/10039
|
|
; DIC(42/2440
|
|
;
|
|
ERRBLD(SEG,MSG,ERR) ; build an error array for non-FileMan-related errors...
|
|
; SEG = HL7 segment name
|
|
; MSG = a message that will be used in the error text portion of the array (optional -- if not passed, the
|
|
; default will be used)
|
|
; ERR = array passed by reference in which error will be returned
|
|
; note: code 999 is a code indicating a non-FileMan error for filing the error message in file 53.71
|
|
S ERR("DIERR")=1
|
|
S ERR("DIERR",1)=999
|
|
S ERR("DIERR",1,"TEXT",1)=$S($G(MSG)'="":MSG,1:"Invalid parameter passed to "_SEG_" module in routine ALPBHL1U")
|
|
Q
|
|
;
|
|
ERRLOG(IEN,OIEN,MSGREC,SEGNAME,SEGDATA,ERRTEXT) ; log filing errors...
|
|
; this module logs error data in the BCMA BACKUP PARAMETERS file (53.71). These
|
|
; errors usually occur as the result of missing or bad data passed to one of the
|
|
; File Manager DBS calls used by this package.
|
|
;
|
|
; IEN = the patient's record number in file 53.7
|
|
; OIEN = the order number's sub-file record number in file 53.7
|
|
; MSGREC = the HL7 message's record number in file 772
|
|
; SEGNAME = the HL7 segment associated with the error (optional)
|
|
; SEGDATA = the HL7 segment's data (optional)
|
|
; ERRTEXT = an array passed by reference which contains the error
|
|
; code (numeric) and the error text to be filed. It is
|
|
; expected that this is usually the error array returned
|
|
; from a FileMan DBS call, so the format is specific:
|
|
;
|
|
; ERRTEXT("DIERR",n)=error code (numeric)
|
|
; ERRTEXT("DIERR",n,"TEXT",1)=first line of error text
|
|
; ERRTEXT("DIERR",n,"TEXT",2)=second line of error text
|
|
; ERRTEXT("DIERR",n,"TEXT",n)=last line of error text
|
|
;
|
|
; However, any error message can be passed to this module
|
|
; as long as the above format is used.
|
|
N ALPBCODE,ALPBFERR,ALPBFILE,ALPBLOGD,ALPBN1,ALPBN2,ALPBPIEN,ALPBTEXT,ALPBX
|
|
S ALPBLOGD=$$NOW^XLFDT()
|
|
S ALPBPIEN=+$O(^ALPB(53.71,0))
|
|
I ALPBPIEN=0 D
|
|
.S X="ONE"
|
|
.S DIC="^ALPB(53.71,"
|
|
.S DIC(0)="LZ"
|
|
.S DIC("DR")="1///^S X=3"
|
|
.S DINUM=1
|
|
.S DLAYGO=53.71
|
|
.D FILE^DICN K DIC
|
|
.S ALPBPIEN=+Y
|
|
I ALPBPIEN'>0 Q
|
|
S ALPBN1=+$O(^ALPB(53.71,ALPBPIEN,1," "),-1)+1
|
|
S ALPBFILE(53.713,"+"_ALPBN1_","_ALPBPIEN_",",.01)=ALPBLOGD
|
|
S ALPBFILE(53.713,"+"_ALPBN1_","_ALPBPIEN_",",1)=+$G(IEN)
|
|
S ALPBFILE(53.713,"+"_ALPBN1_","_ALPBPIEN_",",2)=+$G(OIEN)
|
|
S ALPBFILE(53.713,"+"_ALPBN1_","_ALPBPIEN_",",3)=+$G(MSGREC)
|
|
S ALPBFILE(53.713,"+"_ALPBN1_","_ALPBPIEN_",",3.1)=$G(SEGNAME)
|
|
S ALPBFILE(53.713,"+"_ALPBN1_","_ALPBPIEN_",",3.2)=$G(SEGDATA)
|
|
D UPDATE^DIE("","ALPBFILE","ALPBN1","ALPBFERR")
|
|
K ALPBFERR,ALPBFILE
|
|
S ALPBX=0
|
|
F S ALPBX=$O(ERRTEXT("DIERR",ALPBX)) Q:'ALPBX D
|
|
.S ALPBCODE=ERRTEXT("DIERR",ALPBX)
|
|
.; file the error code...
|
|
.S ALPBN2=+$O(^ALPB(53.71,ALPBPIEN,1,ALPBN1,2," "),-1)+1
|
|
.S ALPBFILE(53.7135,"+"_ALPBN2_","_ALPBN1_","_ALPBPIEN_",",.01)=ALPBCODE
|
|
.D UPDATE^DIE("","ALPBFILE","ALPBN2","ALPBFERR")
|
|
.K ALPBFERR,ALPBFILE
|
|
.; file the error text...
|
|
.M ALPBTEXT=ERRTEXT("DIERR",ALPBX,"TEXT")
|
|
.D WP^DIE(53.7135,ALPBN2_","_ALPBN1_","_ALPBPIEN_",",1,"","ALPBTEXT","ALPBFERR")
|
|
.;S ALPBFILE(53.7135,"+"_ALPBN2_","_ALPBN1_","_ALPBPIEN_",",1)=ALPBTEXT
|
|
.;D UPDATE^DIE("","ALPBFILE","ALPBN2","ALPBFERR")
|
|
.K ALPBCODE,ALPBFERR,ALPBFILE,ALPBN2,ALPBTEXT
|
|
Q
|
|
;
|
|
CLEAN(IEN) ; check error log records to see if the patients' whose records
|
|
; are noted still exist in file 53.7. if not, delete the error log
|
|
; record(s) in file 53.71...
|
|
; IEN = patient record number in file 53.7
|
|
; Note: this function is also called from DELPT^ALPBUTL when a patient's
|
|
; record is deleted (as a result of a discharge action) from 53.7.
|
|
;
|
|
N ALPBX,ALPBY,DA,DIK,X,Y
|
|
; patient still has record in 53.7? if so, quit...
|
|
I $G(^ALPB(53.7,IEN,0))'="" Q
|
|
S ALPBX=0
|
|
F S ALPBX=$O(^ALPB(53.71,"C",IEN,ALPBX)) Q:'ALPBX D
|
|
.S ALPBY=0
|
|
.F S ALPBY=$O(^ALPB(53.71,"C",IEN,ALPBX,ALPBY)) Q:'ALPBY D
|
|
..S DA=ALPBY
|
|
..S DA(1)=ALPBX
|
|
..S DIK="^ALPB(53.71,"_DA(1)_",1,"
|
|
..D ^DIK
|
|
..K DA,DIK
|
|
.K ALPBY
|
|
K ALPBX
|
|
Q
|
|
;
|
|
DELERR(ERRIEN) ; delete an error log entry from file 53.71...
|
|
; ERRIEN = error log entry's internal record number
|
|
N ALPBPARM,DA,DIK,X,Y
|
|
S ALPBPARM=+$O(^ALPB(53.71,0))
|
|
I ALPBPARM'>0 Q
|
|
S DA=ERRIEN
|
|
S DA(1)=ALPBPARM
|
|
S DIK="^ALPB(53.71,"_DA(1)_",1,"
|
|
D ^DIK
|
|
Q
|
|
;
|
|
PTLIST(LTYPE,RESULTS) ; get list of patients in file 53.7...
|
|
; LTYPE = passed = "ALL" to list all patients or
|
|
; = <wardname> to list patients on a selected ward
|
|
; RESULTS = an array passed by reference in which data will be returned
|
|
N ALPBDATA,ALPBIEN,ALPBPTN,ALPBX
|
|
I $G(LTYPE)="" S LTYPE="ALL"
|
|
S ALPBX=0
|
|
I LTYPE="ALL" D
|
|
.S ALPBPTN=""
|
|
.F S ALPBPTN=$O(^ALPB(53.7,"B",ALPBPTN)) Q:ALPBPTN="" D
|
|
..S ALPBIEN=0
|
|
..F S ALPBIEN=$O(^ALPB(53.7,"B",ALPBPTN,ALPBIEN)) Q:'ALPBIEN D
|
|
...S ALPBDATA=$G(^ALPB(53.7,ALPBIEN,0))
|
|
...I ALPBDATA="" K ALPBDATA Q
|
|
...S ALPBX=ALPBX+1
|
|
...S RESULTS(ALPBX)=ALPBPTN_"^"_$P(ALPBDATA,"^",2)_"^"_$P(ALPBDATA,"^",5)_"^"_$P(ALPBDATA,"^",6)_"^"_$P(ALPBDATA,"^",7)
|
|
...K ALPBDATA
|
|
..K ALPBIEN
|
|
.K ALPBPTN
|
|
I LTYPE'="ALL" D
|
|
.S ALPBPTN=""
|
|
.F S ALPBPTN=$O(^ALPB(53.7,"AW",LTYPE,ALPBPTN)) Q:ALPBPTN="" D
|
|
..S ALPBIEN=0
|
|
..F S ALPBIEN=$O(^ALPB(53.7,"AW",LTYPE,ALPBPTN,ALPBIEN)) Q:'ALPBIEN D
|
|
...S ALPBDATA=$G(^ALPB(53.7,ALPBIEN,0))
|
|
...I ALPBDATA="" K ALPBDATA Q
|
|
...S ALPBX=ALPBX+1
|
|
...S RESULTS(ALPBX)=ALPBPTN_"^"_$P(ALPBDATA,"^",2)_"^"_$P(ALPBDATA,"^",5)_"^"_$P(ALPBDATA,"^",6)_"^"_$P(ALPBDATA,"^",7)
|
|
...K ALPBDATA
|
|
..K ALPBIEN
|
|
.K ALPBPTN
|
|
Q
|
|
;
|
|
STAT(ST) ;This will return the value of a status code for pharmacy
|
|
I $G(ST)="" Q ""
|
|
I $L($T(@ST)) G @ST
|
|
Q ""
|
|
IP Q "pending"
|
|
CM Q "finished/verified by pharmacist(active)"
|
|
DC Q "discontinued"
|
|
RP Q "replaced"
|
|
HD Q "on hold"
|
|
ZE Q "expired"
|
|
ZS Q "suspended(active)"
|
|
ZU Q "un-suspended(active)"
|
|
ZX Q "unreleased"
|
|
ZZ Q "renewed"
|
|
;
|
|
STAT2(CODE) ; convert order status code for output...
|
|
; this function is used primarily by the workstation software
|
|
; CODE = an order status code
|
|
; returns printable status code
|
|
I $G(CODE)="" Q "Unknown"
|
|
I CODE="IP"!(CODE="ZX") Q "Pending"
|
|
I CODE="CM"!(CODE="ZU")!(CODE="ZZ") Q "Active"
|
|
I CODE="HD"!(CODE="ZS") Q "Hold"
|
|
I CODE="DC"!(CODE="RP")!(CODE="ZE") Q "Expired"
|
|
Q "Unknown"
|
|
;
|
|
DIV(DFN,ALPBMDT) ;get the Division for a patient
|
|
I +$G(DFN)'>0 Q ""
|
|
N ALPBDIV,ALPWRD,VAIN,VAINDT
|
|
S:+$G(ALPBMDT)>0 VAINDT=$P(ALPBMDT,".",1)
|
|
K ALPBMDT
|
|
D INP^VADPT
|
|
S ALPWRD=$P($G(VAIN(4)),U,1)
|
|
Q:+ALPWRD'>0 ""
|
|
;Check to see if ward is a DOMICILIARY
|
|
I $P($G(^DIC(42,ALPWRD,0)),U,3)="D" Q "DOM"
|
|
S ALPBDIV=$P($G(^DIC(42,ALPWRD,0)),U,11)
|
|
Q:+ALPBDIV'>0 ""
|
|
Q ALPBDIV
|
|
;
|
|
CNV(A,B,X) ;CONVERT A STRING
|
|
;This API will take a HL7 segment and convert characters
|
|
;defined in the input
|
|
;Example:
|
|
;Single encoding characters can be converted such as ^ to ~
|
|
;or multiple encoding characters can be converted such as
|
|
; |~^@/ to ^~|/@
|
|
;A is the string of HL7 encoding characters to be converted
|
|
;B is the string of HL7 encoding characters to be converted to
|
|
;X is te message string to be converted
|
|
I A=""!B=""!X="" Q ""
|
|
F I=1:1:$L(A) S A(I)=$E(A,I,I),A(I,1)=""
|
|
F I=1:1:$L(B) S B(I)=$E(B,I,I)
|
|
S J=0
|
|
F S J=$O(A(J)) Q:+J'>0 D
|
|
. F I=1:1:$L(X) S:$E(X,I,I)=A(J) A(J,1)=A(J,1)_I_U
|
|
S J=0
|
|
F S J=$O(A(J)) Q:+J'>0 D
|
|
. Q:'$D(A(J,1))!'$D(B(J))
|
|
. 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)
|
|
Q X
|