Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LA7SBCR1

LA7SBCR1.m

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