source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRDPAREF.m@ 1800

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

initial load of WorldVistAEHR

File size: 5.6 KB
RevLine 
[613]1LRDPAREF ;DALOI/FHS - PENDING ORDER FILE PATIENT LOOKUP ; 12/3/1997
2 ;;5.2;LAB SERVICE;**153,222,286**;Sep 27, 1994
3 ; Special patient lookup of Lab Orders Pending File
4 ;
5EN ; From ^LRDPA
6 ; Initialize array LRSD.
7 ; CDT=collection date/time
8 ; DFN=ien of patient in selected file
9 ; DOB=patient's date of birth
10 ; DPF=source file (2, or 67)
11 ; ERROR=0
12 ; LPC=longitudinal parity check
13 ; PNM=patient name
14 ; RIEN=IEN of ^LRT(67
15 ; RPSITE=primary sending site
16 ; RSITE=sending site
17 ; RSITEN=sending site name
18 ; RUID=specimen unique identifier
19 ; SEX=patient's sex
20 ; SSN=patient's SSN
21 ; LA7PNM=Patient Bar code read if lookup fails
22 ; On exit LRDPF set to '67^LRT(67, DFN=RIEN
23 ;
24 N DA,DIC,DIE,DIR,DIRUT,DTOUT,DUOUT
25 ;
26 K LRSD,LA7PNM
27 ;
28 F Y="CDT","DFN","DOB","DPF","ERROR","LPC","PNM","RIEN","RPSITE","RSITE","RUID","SEX","SSN" S LRSD(Y)=""
29 S LREND=0
30 D:'$D(LRLABKY) LABKEY^LRPARAM
31 I $G(LRREFBAR) D Q:$G(LREND)
32 . D BAR K LA7PNM
33 . I LRSD("ERROR") D
34 . . D ERRMSG(LRSD("ERROR"),"Barcode error #")
35 . . I +LRSD("ERROR")=1 D CLEAN
36 I '$G(LRREFBAR)!(LRSD("ERROR")) D MAN
37 I $G(LREND) D CLEAN Q
38 I LRSD("ERROR") D Q
39 . I LRSD("ERROR") D ERRMSG(LRSD("ERROR"),"Error #")
40 . D CLEAN
41 S LRSD("RPSITE")=LRRSITE("RPSITE")
42CK ;S PNM=LRSD("PNM"),SSN=LRSD("SSN"),DOB=LRSD("DOB"),SEX=LRSD("SEX"),LRXDPF=LRSD("DPF"),LRXDFN=LRSD("DFN")
43 D ^LRDPAREX
44 I $G(LREND)!($G(LRSD("ERROR"))) D G CLEAN
45 . S LRSD("ERROR",1)="12^Validation Failure "
46 . W !,$C(7),$P(LRSD("ERROR"),"^",2),!
47OK ;
48 S:'$G(DFN) DFN=-1 S Y=DFN
49 I DFN=-1 S LRDFN=-1 K DIC S VA200="" Q
50 S X="^"_$P(LRDPF,"^",2)_Y_",""LR"")",LRDFN=+$S($D(@X):@X,1:-1) G E3:LRDFN>0
51 L +^LR(0):999999
52 S LRDFN=$P(^LR(0),U,3) S:LRDFN<1 LRDFN=1
53 F LRDFN=LRDFN:1 Q:'$D(^LR(LRDFN,0))#2
54 S ^LR(0)=$P(^LR(0),"^",1,2)_"^"_LRDFN_"^"_(1+$P(^(0),"^",4))
55E2 L +^LR(LRDFN):999999
56 S ^LR(LRDFN,0)=LRDFN_"^"_+LRDPF_"^"_DFN
57 S ^LR("B",LRDFN,LRDFN)=""
58 S @X=LRDFN,^LRT(67,LRSD("RIEN"),"LR")=LRDFN
59 L -(^LR(0),^LR(LRDFN))
60E3 I '$D(^LR(LRDFN,0))#2 D Q
61 . W !!,"Internal patient ID incorrect in ^LR( for ",PNM,"."
62 . W !,"Contact Lab Coordinator.",$C(7)
63 . S LRDFN=-1
64 I LRDFN>0,$P(^LR(LRDFN,0),"^",2)'=+LRDPF!($P(^(0),"^",3)'=DFN) D Q
65 . W !,$C(7),"Internal patient ID incorrect for ",PNM,"."
66 . W !,"Contact Lab Coordinator."
67 . S LRDFN=-1
68 D INF^LRX,PT^LRX
69RUID ;
70 I LRSD("RUID")="" D
71 . N DIR,DIRUT,DTOUT,X,Y
72 . ; If VA facility, require 10 character UID.
73 . I LRRSITE("RSITE"),$$GET1^DIQ(4,+LRRSITE("RSITE")_",",95,"I")="V" D
74 . . S DIR(0)="F^10:10^K:X'?1(10N,1U9N,2U8N,1N1U8N) X"
75 . . S DIR("?")="Enter the sending facility's ten character UID for this specimen"
76 . E S DIR(0)="F^1:30",DIR("?")="Enter sending facility's specimen ID, 1-30 characters"
77 . S DIR("A")="Enter Remote UID"
78 . D ^DIR
79 . I $D(DIRUT) D CLEAN Q
80 . S LRSD("RUID")=Y
81 ;
82 Q
83DUP W !?5,"There are duplicate SSNs in the Referral File <abort>",!,$C(7)
84ERR ;
85 S LRDFN=-1 W !,"ERROR",!
86 Q
87 ;
88ERR1 ;
89 S LRDFN=-1 W !,"ERROR1",!
90 Q
91 ;
92CLEAN ;
93 S LRDFN=-1,LREND=1
94 Q
95 ;
96 ;
97BAR ; Scan PD bar code for patient/specimen info
98 ;
99 N DA,DIC,DIR,DIRUT,DR,DTOUT,DUOUT
100 ;
101 D PT^LA7SBCR1(.LRSD,"Scan Patient/Accession Barcode (PD)",.LRRSITE)
102 I LRSD("ERROR") Q
103 D DIQ
104 Q
105 ;
106 ;
107MAN ; Manual referral patient lookup
108 ;
109 N DIR,DIC,DA,X,Y
110 K ^DISV(DUZ,"^DPT("),^("^LRT(67,")
111 ;
112 ; Lookup using file #69.6 if manifest exists and not using bar code scanner
113 I '$G(LRREFBAR),$G(LRRSITE("SMID-OK")),LRRSITE("SMID")'="",$D(^LRO(69.6,"D",LRRSITE("SMID"))) D MF696 Q
114 ;
115 ; Ask user for information
116 S LRSD("ERROR")=""
117 S DIR(0)="67,3",DIR("A")="Select Patient Name -'^M' To enter New Name "
118 D ^DIR
119 I $D(DIRUT) S LRSD("ERROR")="1^User timeout/abort or Up-arrow entered"
120 I Y["DPT(" D DPTSET^LA7SBCR1(.LRSD,+Y)
121 I Y["LRT(" D LRTSET^LA7SBCR1(.LRSD,+Y)
122 I $E(X,1,2)="^M" D Q
123 . K DIRUT,DIR
124 . D KEYIN^LRDPAREX
125 . S:$G(LREND) LRSD("ERROR")="15^Manual Patient entry not complete"
126 I LRSD("ERROR") Q
127 D DIQ K DIR
128 S DIR(0)="Y",DIR("A")="Is this the correct patient" D ^DIR
129 I Y'=1 S LRSD("ERROR")="5^Unsuccessful patient lookup" D CLEAN
130 Q
131 ;
132 ;
133MF696 ; Manual lookup of file #69.6
134 N DIR,DIC,LAIEN,LRSCN696,X,Y
135 S Y=$$FIND1^DIC(64.061,"","OMX","In-Transit","","I $P(^LAB(64.061,Y,0),U,7)=""U""")
136 I Y>0 S LRSCN696=+Y
137 E S LRSCN696=""
138 S DIR(0)="PO^69.6:NEMQZ"
139 S DIR("S")="I $P(^(0),U,10)="_LRSCN696_",$D(^LRO(69.6,""D"",LRRSITE(""SMID""),Y))"
140 S DIR("A")="Enter UID of specimen"
141 D ^DIR
142 I $D(DIRUT) S LREND=1 Q
143 S LAIEN=Y,(LA7Y(0),LAIEN(0))=Y(0)
144 D GETS^DIQ(69.6,+LAIEN_",","*","IE","LAIEN")
145 S LRSD("DPF")="67^LRT(67,"
146 S LRSD("PNM")=LAIEN(69.6,+LAIEN_",",.01,"I")
147 S LRSD("DOB")=LAIEN(69.6,+LAIEN_",",.03,"I")
148 S LRSD("SEX")=LAIEN(69.6,+LAIEN_",",.02,"I")
149 S LRSD("RACE")=LAIEN(69.6,+LAIEN_",",.06,"I")
150 S LRSD("SSN")=LAIEN(69.6,+LAIEN_",",.09,"I")
151 S LRSD("CDT")=LAIEN(69.6,+LAIEN_",",11,"I")
152 S (LRRSITE("RPSITE"),LRSD("RPSITE"))=LAIEN(69.6,+LAIEN_",",1,"I")
153 S LRSD("RSITE")=LAIEN(69.6,+LAIEN_",",2,"I")
154 S LRSD("RSITEN")=$E(LAIEN(69.6,+LAIEN_",",2,"E"),1,19)
155 S LRSD("RUID")=LAIEN(69.6,+LAIEN_",",3,"I")
156 S LRSD("SMID")=LRRSITE("SMID")
157 I LRSD("SSN")="" S LRSD("SSN")=LAIEN(69.6,+LAIEN_",",700.04,"I")
158 I LRSD("SSN")="" S LRSD("ERROR")="2^Patient Identifier Absent" Q
159 S LRSD("RIEN")=$O(^LRT(67,"C",LRSD("SSN"),0))
160 I $G(LRSD("RIEN")),$G(^LRT(67,LRSD("RIEN"),"LR")) S LRSD("LRDFN")=^("LR"),LRSD("DFN")=LRSD("RIEN")
161 Q
162 ;
163 ;
164DIQ ; Display patient info
165 Q:'$G(LRSD("DFN"))
166 N DA,DIC,DX,S
167 S DIC=$S(+LRSD("DPF")=2:"^DPT(",+LRSD("DPF")=67:"^LRT(67,",1:"")
168 I DIC="" Q
169 S DA=LRSD("DFN"),DR=0,S=0
170 W @IOF
171 D EN^LRDIQ
172 Q
173 ;
174ERRMSG(X,Y) ; Display error message to user
175 ; Call with X=error message code^error message text
176 ; Y=message prefix
177 S X=Y_$P(LRSD("ERROR"),"^")_" - "_$P(LRSD("ERROR"),"^",2)
178 D EN^DDIOL(X,"","!?5")
179 Q
Note: See TracBrowser for help on using the repository browser.