229 lines
6.0 KiB
Mathematica
229 lines
6.0 KiB
Mathematica
LA7SBCR1 ;DALOI/JMC - Shipping Barcode Reader Utility ; 23 Feb 2004
|
|
;;5.2;AUTOMATED LAB INSTRUMENTS;**27,46,64**;Sep 27, 1994
|
|
Q
|
|
;
|
|
PT(LA7,LA7PROM,LA7SCFG) ; Setup patient/ordering site info from barcode.
|
|
; Input:
|
|
; LA7=array to return values
|
|
; LA7PROM=array of prompts to display to user
|
|
; LA7SCFG=array of shipping configuration info
|
|
;
|
|
; Returns array LA7()
|
|
; If successful DFN=ien of patient in #2, if DPF=2
|
|
; DOB=patient's date of birth
|
|
; DPF=source file (2, 67, or 537010)
|
|
; CDT=collection date/time
|
|
; ERROR=0
|
|
; PNM=patient name
|
|
; RSITE=sending site
|
|
; RUID=specimen unique identifier
|
|
; SEX=patient's sex
|
|
; SSN=patient's SSN
|
|
;
|
|
; unsuccessful ERROR=>0
|
|
;
|
|
N LA7BCS,LA7IEN,LA7X,LA7Y,LA7Z,Y
|
|
S LA7="",LA7BCS=0,LA7PNM=""
|
|
S LA7PROM=$G(LA7PROM,"Patient/Accession Info (PD)")
|
|
S Y=$$RD^LA7SBCR(.LA7PROM,1)
|
|
;
|
|
I Y=0 D Q
|
|
. S LA7("ERROR")="1^User timeout/abort"
|
|
;
|
|
I Y<1 D Q
|
|
. S LA7("ERROR")="2^Incorrect bar-code format"
|
|
;
|
|
; barcode info & longitudinal parity check
|
|
; original style bar code
|
|
I $E(Y,1,9)="1^STX^PD^" D
|
|
. S LA7=$P(Y,"STX^PD^",2)
|
|
. S LA7=$P(LA7,"^ETX",1)
|
|
. S LA7("LPC")=$P(Y,"^ETX",2)
|
|
; new style bar code
|
|
I $E(Y,1,5)="1^PD^" D
|
|
. S LA7=$P(Y,"^",3,6)
|
|
. S LA7("LPC")=$P(Y,"^",7)
|
|
. S LA7BCS=1
|
|
;
|
|
I LA7="" D Q
|
|
. S LA7("ERROR")="2^Incorrect bar-code format"
|
|
;
|
|
I $G(LA7("LPC"))'=$G(LA7SCFG("LPC")) D Q
|
|
. S LA7("ERROR")="9^Parity check does not match on (SM) and (PD) barcodes"
|
|
;
|
|
S LA7("RSITE")=$P(LA7,"^",2)
|
|
I LA7("RSITE")'=$P(LA7SCFG("RSITE"),"^",3) D
|
|
. S LA7("ERROR")="31^Site in PD barcode does not match shipping configuration file"
|
|
;
|
|
; Remote specimen identifier
|
|
S LA7("RUID")=$P(LA7,"^",3)
|
|
;
|
|
; Specimen collection date, using either old or new style(LA7BCS=1) bar code
|
|
I 'LA7BCS,$P(LA7,"^",5) S LA7("CDT")=$$DT^LA7SBCR($P(LA7,"^",5))
|
|
I LA7BCS,$P(LA7,"^",4) S LA7("CDT")=$$DT^LA7SBCR($P(LA7,"^",4))
|
|
;
|
|
; Patient identifier
|
|
S LA7X=$P(LA7,"^") ; Patient's ID
|
|
;
|
|
; No SSN in first piece
|
|
I LA7X="" S LA7("ERROR")="3^No SSN in barcode" Q
|
|
S LA7("SSN")=LA7X
|
|
;
|
|
; Try LAB PENDING ORDERS file
|
|
D LPO(.LA7,LA7SCFG("SMID"))
|
|
;
|
|
; Check for patient in file #2.
|
|
I $G(LA7("ERROR")) D DPT(.LA7,LA7X)
|
|
;
|
|
; Else try Lab Referral file.
|
|
I $G(LA7("ERROR")) D LRT(.LA7,LA7X)
|
|
;
|
|
; Get additional info from PD1 bar code
|
|
I +$G(LA7("ERROR"))=4 D PD1
|
|
Q
|
|
;
|
|
;
|
|
DPT(LA7,LA7X) ; Lookup in Patient file.
|
|
; Check for patient in file #2.
|
|
S LA7Y=$O(^DPT("SSN",LA7X,0))
|
|
; SSN not found.
|
|
I 'LA7Y S LA7("ERROR")="4^Unsuccessful SSN lookup" Q
|
|
S LA7Y(0)=$G(^DPT(LA7Y,0))
|
|
; SSN not found.
|
|
I LA7Y(0)="" S LA7("ERROR")="4^Unsuccessful SSN lookup" Q
|
|
;
|
|
D DPTSET(.LA7,LA7Y)
|
|
Q
|
|
;
|
|
;
|
|
LRT(LA7,LA7X) ; Lookup in Lab Referral file.
|
|
; Clear error flag.
|
|
S LA7("ERROR")=""
|
|
S LA7Y=$O(^LRT(67,"C",LA7X,0))
|
|
; SSN not found.
|
|
I 'LA7Y S LA7("ERROR")="4^Unsuccessful SSN lookup" Q
|
|
S LA7Y(0)=$G(^LRT(67,LA7Y,0))
|
|
; SSN not found.
|
|
I LA7Y(0)="" S LA7("ERROR")="4^Unsuccessful SSN lookup" Q
|
|
D LRTSET(.LA7,LA7Y)
|
|
Q
|
|
;
|
|
;
|
|
LPO(LA7,LA7SM) ; Lookup in LAB PENDING ORDERS file #69.6
|
|
;
|
|
N LA7696,LA7RUID
|
|
S LA7RUID=LA7("RUID"),LA7696=""
|
|
I LA7SM'="",LA7RUID'="" S LA7696=$O(^LRO(69.6,"AD",LA7SM,LA7RUID,0))
|
|
I 'LA7696 S LA7("ERROR")="4^Unsuccessful SSN lookup" Q
|
|
D LPOSET(.LA7,LA7696)
|
|
Q
|
|
;
|
|
;
|
|
DPTSET(LA7,LA7Y) ; Setup array from Patient file.
|
|
;
|
|
N RACE,LA7ERR
|
|
S LA7Y(0)=$G(^DPT(LA7Y,0))
|
|
; Zeroth node not found.
|
|
I LA7Y(0)="" S LA7("ERROR")="6^No zeroth node in file" Q
|
|
S LA7("DFN")=LA7Y
|
|
S LA7("DOB")=$P(LA7Y(0),"^",3)
|
|
; Source file
|
|
S:LA7Y LA7("DPF")=2_U_"DPT("
|
|
S LA7("PNM")=$P(LA7Y(0),"^")
|
|
S LA7("RIEN")=+$G(^DPT(LA7Y,"LRT"))
|
|
S LA7("SEX")=$P(LA7Y(0),"^",2)
|
|
S LA7("SSN")=$P(LA7Y(0),"^",9)
|
|
D GETS^DIQ(2,LA7Y_",","2*","I","RACE","LA7ERR")
|
|
I '$D(LA7ERR) D
|
|
. S X=$Q(RACE(2.02)) Q:X=""
|
|
. S LA7("RACE")=$P(@X,"^")
|
|
Q
|
|
;
|
|
;
|
|
LRTSET(LA7,LA7Y) ; Setup array from Lab Referral file.
|
|
S LA7Y(0)=$G(^LRT(67,LA7Y,0))
|
|
; Zeroth node not found.
|
|
I LA7Y(0)="" S LA7("ERROR")="6^No zeroth node in file" Q
|
|
S LA7("DFN")=LA7Y
|
|
S LA7("DOB")=$P(LA7Y(0),"^",3)
|
|
;
|
|
; Source file
|
|
S:LA7Y LA7("DPF")=67_U_"LRT(67,"
|
|
;
|
|
S LA7("PNM")=$P(LA7Y(0),"^")
|
|
S LA7("RIEN")=LA7Y
|
|
S LA7("SEX")=$P(LA7Y(0),"^",2)
|
|
S LA7("SSN")=$P(LA7Y(0),"^",9)
|
|
Q
|
|
;
|
|
;
|
|
LPOSET(LA7,LA7Y) ; Setup array from LAB PENDING ORDERS file #69.6
|
|
;
|
|
N I
|
|
F I=0,.1 S LA7Y(I)=$G(^LRO(69.6,LA7Y,I))
|
|
; Zeroth node not found.
|
|
I LA7Y(0)="" D Q
|
|
. S LA7("ERROR")="6^No zeroth node in file"
|
|
; Patient identifiers don't match
|
|
I LA7("SSN")'=$P(LA7Y(0),U,9) Q
|
|
;
|
|
S LA7("PNM")=$P(LA7Y(0),U,1)
|
|
S LA7("DOB")=$P(LA7Y(0),U,3)
|
|
S LA7("SEX")=$P(LA7Y(0),U,2)
|
|
S LA7("DPF")="67^LRT(67,"
|
|
S LA7("RACE")=$P(LA7Y(.1),U)
|
|
S LA7("ERROR")=""
|
|
S LA7("RIEN")=$O(^LRT(67,"C",LA7("SSN"),0))
|
|
I $G(LA7("RIEN")),$G(^LRT(67,LA7("RIEN"),"LR")) D
|
|
. S LA7("LRDFN")=^LRT(67,LA7("RIEN"),"LR")
|
|
. S LA7("DFN")=LA7("RIEN")
|
|
Q
|
|
;
|
|
;
|
|
PD1 ; Read PD1 bar code information
|
|
;
|
|
N LA7PROM
|
|
;
|
|
S LA7PROM="Scan Patient Name Barcode (PD1)"
|
|
S LA7PROM(1)="Patient Demographics not found"
|
|
S LA7("ERROR")="",LA7Z=""
|
|
S Y=$$RD^LA7SBCR(.LA7PROM,1)
|
|
I Y<1 D Q
|
|
. S LA7("ERROR")="2^Incorrect bar-code format"
|
|
;
|
|
; barcode info & longitudinal parity check
|
|
; original style bar code
|
|
I $E(Y,1,10)="1^STX^PD1^" D
|
|
. S LA7Z=$P(Y,"STX^PD1^",2)
|
|
. S LA7Z=$P(LA7Z,"^ETX")
|
|
. S LA7Z("LPC")=$P(Y,"^ETX",2)
|
|
; new style bar code
|
|
I $E(Y,1,6)="1^PD1^" D
|
|
. S LA7Z=$P(Y,"^",3,6)
|
|
. S LA7Z("LPC")=$P(Y,"^",7)
|
|
;
|
|
I LA7Z="" D Q
|
|
. S LA7("ERROR")="2^Incorrect bar-code format"
|
|
;
|
|
I $G(LA7Z("LPC"))'=$G(LA7SCFG("LPC")) D Q
|
|
. S LA7("ERROR")="10^Parity check does not match on (SM) and (PD1) barcodes"
|
|
;
|
|
; Name not found.
|
|
I $L($P(LA7Z,U,2))<2 D Q
|
|
. S LA7("ERROR")="21^Unsuccessful name scan"
|
|
;
|
|
; wrong patient scanned not found.
|
|
I $P(LA7Z,U)'=LA7("SSN") D Q
|
|
. S LA7("ERROR")="22^SSN does not match PD barcode"
|
|
;
|
|
; Wrong DOB format.
|
|
I $P(LA7Z,U,3)'?7N D Q
|
|
. S LA7("ERROR")="23^Incorrect DOB"
|
|
;
|
|
S LA7("PNM")=$P(LA7Z,U,2)
|
|
S LA7("DOB")=$P(LA7Z,U,3)
|
|
S LA7("SEX")=$P(LA7Z,U,4)
|
|
S LA7("DPF")="67^LRT(67,"
|
|
S LA7("ERROR")=""
|
|
Q
|