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

LRDPAREF.m

Go to the documentation of this file. 
  1. LRDPAREF ;VA/DALOI/FHS - PENDING ORDER FILE PATIENT LOOKUP ;JUL 06, 2010 3:14 PM
  1.  ;;5.2;LAB SERVICE;**153,222,286,1027**;NOV 01, 1997
  1.  ; Special patient lookup of Lab Orders Pending File
  1.  ;
  1. EN ; From ^LRDPA
  1.  ; Initialize array LRSD.
  1.  ;  CDT=collection date/time
  1.  ;  DFN=ien of patient in selected file
  1.  ;  DOB=patient's date of birth
  1.  ;  DPF=source file (2, or 67)
  1.  ;  ERROR=0
  1.  ;  LPC=longitudinal parity check
  1.  ;  PNM=patient name
  1.  ;  RIEN=IEN of ^LRT(67
  1.  ;  RPSITE=primary sending site
  1.  ;  RSITE=sending site
  1.  ;  RSITEN=sending site name
  1.  ;  RUID=specimen unique identifier
  1.  ;  SEX=patient's sex
  1.  ;  SSN=patient's SSN
  1.  ;  LA7PNM=Patient Bar code read if lookup fails
  1.  ;  On exit LRDPF set to '67^LRT(67, DFN=RIEN
  1.  ;
  1.  N DA,DIC,DIE,DIR,DIRUT,DTOUT,DUOUT
  1.  ;
  1.  K LRSD,LA7PNM
  1.  ;
  1.  F Y="CDT","DFN","DOB","DPF","ERROR","LPC","PNM","RIEN","RPSITE","RSITE","RUID","SEX","SSN" S LRSD(Y)=""
  1.  S LREND=0
  1.  D:'$D(LRLABKY) LABKEY^LRPARAM
  1.  I $G(LRREFBAR) D  Q:$G(LREND)
  1.  . D BAR K LA7PNM
  1.  . I LRSD("ERROR") D
  1.  . . D ERRMSG(LRSD("ERROR"),"Barcode error #")
  1.  . . I +LRSD("ERROR")=1 D CLEAN
  1.  I '$G(LRREFBAR)!(LRSD("ERROR")) D MAN
  1.  I $G(LREND) D CLEAN Q
  1.  I LRSD("ERROR") D  Q
  1.  . I LRSD("ERROR") D ERRMSG(LRSD("ERROR"),"Error #")
  1.  . D CLEAN
  1.  S LRSD("RPSITE")=LRRSITE("RPSITE")
  1. CK ;S PNM=LRSD("PNM"),SSN=LRSD("SSN"),DOB=LRSD("DOB"),SEX=LRSD("SEX"),LRXDPF=LRSD("DPF"),LRXDFN=LRSD("DFN")
  1.  D ^LRDPAREX
  1.  I $G(LREND)!($G(LRSD("ERROR"))) D  G CLEAN
  1.  . S LRSD("ERROR",1)="12^Validation Failure "
  1.  . W !,$C(7),$P(LRSD("ERROR"),"^",2),!
  1. OK ;
  1.  S:'$G(DFN) DFN=-1 S Y=DFN
  1.  I DFN=-1 S LRDFN=-1 K DIC S VA200="" Q
  1.  S X="^"_$P(LRDPF,"^",2)_Y_",""LR"")",LRDFN=+$S($D(@X):@X,1:-1) G E3:LRDFN>0
  1.  L +^LR(0):999999
  1.  S LRDFN=$P(^LR(0),U,3) S:LRDFN<1 LRDFN=1
  1.  F LRDFN=LRDFN:1 Q:'$D(^LR(LRDFN,0))#2
  1.  S ^LR(0)=$P(^LR(0),"^",1,2)_"^"_LRDFN_"^"_(1+$P(^(0),"^",4))
  1. E2 L +^LR(LRDFN):999999
  1.  S ^LR(LRDFN,0)=LRDFN_"^"_+LRDPF_"^"_DFN
  1.  S ^LR("B",LRDFN,LRDFN)=""
  1.  S @X=LRDFN,^LRT(67,LRSD("RIEN"),"LR")=LRDFN
  1.  L -(^LR(0),^LR(LRDFN))
  1. E3 I '$D(^LR(LRDFN,0))#2 D  Q
  1.  . W !!,"Internal patient ID incorrect in ^LR( for ",PNM,"."
  1.  . W !,"Contact Lab Coordinator.",$C(7)
  1.  . S LRDFN=-1
  1.  I LRDFN>0,$P(^LR(LRDFN,0),"^",2)'=+LRDPF!($P(^(0),"^",3)'=DFN) D  Q
  1.  . W !,$C(7),"Internal patient ID incorrect for ",PNM,"."
  1.  . W !,"Contact Lab Coordinator."
  1.  . S LRDFN=-1
  1.  D INF^LRX,PT^LRX
  1. RUID ;
  1.  I LRSD("RUID")="" D
  1.  . N DIR,DIRUT,DTOUT,X,Y
  1.  . ; If VA facility, require 10 character UID.
  1.  . I LRRSITE("RSITE"),$$GET1^DIQ(4,+LRRSITE("RSITE")_",",95,"I")="V" D
  1.  . . S DIR(0)="F^10:10^K:X'?1(10N,1U9N,2U8N,1N1U8N) X"
  1.  . . S DIR("?")="Enter the sending facility's ten character UID for this specimen"
  1.  . E  S DIR(0)="F^1:30",DIR("?")="Enter sending facility's specimen ID, 1-30 characters"
  1.  . S DIR("A")="Enter Remote UID"
  1.  . D ^DIR
  1.  . I $D(DIRUT) D CLEAN Q
  1.  . S LRSD("RUID")=Y
  1.  ;
  1.  Q
  1. DUP W !?5,"There are duplicate SSNs in the Referral File <abort>",!,$C(7)
  1. ERR ;
  1.  S LRDFN=-1 W !,"ERROR",!
  1.  Q
  1.  ;
  1. ERR1 ;
  1.  S LRDFN=-1 W !,"ERROR1",!
  1.  Q
  1.  ;
  1. CLEAN ;
  1.  S LRDFN=-1,LREND=1
  1.  Q
  1.  ;
  1.  ;
  1. BAR ; Scan PD bar code for patient/specimen info
  1.  ;
  1.  N DA,DIC,DIR,DIRUT,DR,DTOUT,DUOUT
  1.  ;
  1.  D PT^LA7SBCR1(.LRSD,"Scan Patient/Accession Barcode (PD)",.LRRSITE)
  1.  I LRSD("ERROR") Q
  1.  D DIQ
  1.  Q
  1.  ;
  1.  ;
  1. MAN ; Manual referral patient lookup
  1.  ;
  1.  N DIR,DIC,DA,X,Y
  1.  K ^DISV(DUZ,"^DPT("),^("^LRT(67,")
  1.  ;
  1.  ; Lookup using file #69.6 if manifest exists and not using bar code scanner
  1.  I '$G(LRREFBAR),$G(LRRSITE("SMID-OK")),LRRSITE("SMID")'="",$D(^LRO(69.6,"D",LRRSITE("SMID"))) D MF696 Q
  1.  ;
  1.  ; Ask user for information
  1.  S LRSD("ERROR")=""
  1.  S DIR(0)="67,3",DIR("A")="Select Patient Name -'^M' To enter New Name "
  1.  D ^DIR
  1.  I $D(DIRUT) S LRSD("ERROR")="1^User timeout/abort or Up-arrow entered"
  1.  I Y["DPT(" D DPTSET^LA7SBCR1(.LRSD,+Y)
  1.  I Y["LRT(" D LRTSET^LA7SBCR1(.LRSD,+Y)
  1.  I $E(X,1,2)="^M" D  Q
  1.  . K DIRUT,DIR
  1.  . D KEYIN^LRDPAREX
  1.  . S:$G(LREND) LRSD("ERROR")="15^Manual Patient entry not complete"
  1.  I LRSD("ERROR") Q
  1.  D DIQ K DIR
  1.  S DIR(0)="Y",DIR("A")="Is this the correct patient" D ^DIR
  1.  I Y'=1 S LRSD("ERROR")="5^Unsuccessful patient lookup" D CLEAN
  1.  Q
  1.  ;
  1.  ;
  1. MF696 ; Manual lookup of file #69.6
  1.  N DIR,DIC,LAIEN,LRSCN696,X,Y
  1.  S Y=$$FIND1^DIC(64.061,"","OMX","In-Transit","","I $P(^LAB(64.061,Y,0),U,7)=""U""")
  1.  I Y>0 S LRSCN696=+Y
  1.  E  S LRSCN696=""
  1.  S DIR(0)="PO^69.6:NEMQZ"
  1.  S DIR("S")="I $P(^(0),U,10)="_LRSCN696_",$D(^LRO(69.6,""D"",LRRSITE(""SMID""),Y))"
  1.  S DIR("A")="Enter UID of specimen"
  1.  D ^DIR
  1.  I $D(DIRUT) S LREND=1 Q
  1.  S LAIEN=Y,(LA7Y(0),LAIEN(0))=Y(0)
  1.  D GETS^DIQ(69.6,+LAIEN_",","*","IE","LAIEN")
  1.  S LRSD("DPF")="67^LRT(67,"
  1.  S LRSD("PNM")=LAIEN(69.6,+LAIEN_",",.01,"I")
  1.  S LRSD("DOB")=LAIEN(69.6,+LAIEN_",",.03,"I")
  1.  S LRSD("SEX")=LAIEN(69.6,+LAIEN_",",.02,"I")
  1.  S LRSD("RACE")=LAIEN(69.6,+LAIEN_",",.06,"I")
  1.  S LRSD("SSN")=LAIEN(69.6,+LAIEN_",",.09,"I")
  1.  S LRSD("CDT")=LAIEN(69.6,+LAIEN_",",11,"I")
  1.  S (LRRSITE("RPSITE"),LRSD("RPSITE"))=LAIEN(69.6,+LAIEN_",",1,"I")
  1.  S LRSD("RSITE")=LAIEN(69.6,+LAIEN_",",2,"I")
  1.  S LRSD("RSITEN")=$E(LAIEN(69.6,+LAIEN_",",2,"E"),1,19)
  1.  S LRSD("RUID")=LAIEN(69.6,+LAIEN_",",3,"I")
  1.  S LRSD("SMID")=LRRSITE("SMID")
  1.  I LRSD("SSN")="" S LRSD("SSN")=LAIEN(69.6,+LAIEN_",",700.04,"I")
  1.  I LRSD("SSN")="" S LRSD("ERROR")="2^Patient Identifier Absent" Q
  1.  S LRSD("RIEN")=$O(^LRT(67,"C",LRSD("SSN"),0))
  1.  I $G(LRSD("RIEN")),$G(^LRT(67,LRSD("RIEN"),"LR")) S LRSD("LRDFN")=^("LR"),LRSD("DFN")=LRSD("RIEN")
  1.  Q
  1.  ;
  1.  ;
  1. DIQ ; Display patient info
  1.  Q:'$G(LRSD("DFN"))
  1.  N DA,DIC,DX,S
  1.  S DIC=$S(+LRSD("DPF")=2:"^DPT(",+LRSD("DPF")=67:"^LRT(67,",1:"")
  1.  I DIC="" Q
  1.  S DA=LRSD("DFN"),DR=0,S=0
  1.  W @IOF
  1.  D EN^LRDIQ
  1.  Q
  1.  ;
  1. ERRMSG(X,Y) ; Display error message to user
  1.  ; Call with X=error message code^error message text
  1.  ;           Y=message prefix
  1.  S X=Y_$P(LRSD("ERROR"),"^")_" - "_$P(LRSD("ERROR"),"^",2)
  1.  D EN^DDIOL(X,"","!?5")
  1.  Q