Changeset 434 for ccr/trunk/p/LA7QRY2.m

Timestamp:

Apr 14, 2009, 10:57:24 AM (15 years ago)

Author:

George Lilly

Message:

rollback of Lab for RPMS code

File:

• ccr/trunk/p/LA7QRY2.m (modified) (6 diffs)

ccr/trunk/p/LA7QRY2.m

@@ -1 @@
-LA7QRY2 ;DALOI/JMC - Lab HL7 Query Utility ;1/30/07  19:05
- ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,69,73**;Sep 27, 1994;Build 7
+LA7QRY2 ;DALOI/JMC - Lab HL7 Query Utility ; 04/13/09
+ ;;5.2;AUTOMATED LAB INSTRUMENTS;**46**;Sep 27, 1994
  ; JMC - mods to check for IHS V LAB file
  ;
@@ -10 +10 @@
  ;
  S (DFN,LRDFN)="",LA7PTYP=0
- ; VOE changes, Use HRN cross reference, Daou;;June 8,2005
- S LA7X=$O(^AUPNPAT("D",LA7PTID,""))
- I LA7X>0 D SETDFN(LA7X) S LA7PTYP=1
  ;
- ; See if SSN passed as patient identifier
- I DFN'>0 S LA7X=$O(^DPT("SSN",LA7PTID,0)) I LA7X>0 D SETDFN(LA7X) S LA7PTYP=1
+ ; SSN passed as patient identifier
+ I LA7PTID?9N.1A D
+ . S LA7PTYP=1
+ . S LA7X=$O(^DPT("SSN",LA7PTID,0))
+ . I LA7X>0 D SETDFN(LA7X)
  ;
  ; MPI/ICN (integration control number) passed as patient identifier
- I DFN'>0 S LA7X=$$GETDFN^MPIF001($P(LA7PTID,"V")) I LA7X>0 D SETDFN(LA7X) S LA7PTYP=2
+ I LA7PTID?10N1"V"6N D
+ . S LA7PTYP=2
+ . S LA7X=$$GETDFN^MPIF001($P(LA7PTID,"V"))
+ . I LA7X>0 D SETDFN(LA7X)
  ;
  ; If no patient identified/no laboratory record - return exception message
@@ -36 +39 @@
  I LA7EDT S LA7EDT(0)=9999999-LA7EDT
  ;
- S LRSS=""
- F  S LRSS=$O(LRSSLST(LRSS))  Q:LRSS=""  D
+ F LRSS="CH","MI","SP" D
  . S (LA7QUIT,LRIDT)=0
  . I LA7EDT(0) S LRIDT=$O(^LR(LRDFN,LRSS,LA7EDT(0)),-1)
@@ -68 +70 @@
  . . F  S LA7ROOT=$Q(@LA7ROOT) Q:LA7ROOT=""!($QS(LA7ROOT,2)'=LA7DT)!($QS(LA7ROOT,4)'="AN")  D
  . . . I $QS(LA7ROOT,6)'=LRDFN Q
- . . . S LRIDT=$QS(LA7ROOT,7),LRSS=""
- . . . F  S LRSS=$O(LRSSLST(LRSS))  Q:LRSS=""  D SEARCH
+ . . . S LRIDT=$QS(LA7ROOT,7)
+ . . . F LRSS="CH","MI","SP" D SEARCH
  ;
  ; If no orders in #69 then do long search through file #63.
- I 'LA7SRC  D
- . S LRSS=""
- . F  S LRSS=$O(LRSSLST(LRSS))  Q:LRSS=""  D
+ I 'LA7SRC D
+ . F LRSS="CH","MI","SP" D
  . . S LRIDT=0
  . . F  S LRIDT=$O(^LR(LRDFN,LRSS,LRIDT)) Q:'LRIDT  D
@@ -118 +119 @@
  F  S LRSB=$O(^LR(LRDFN,LRSS,LRIDT,LRSB)) Q:'LRSB  D
  . S LA7X=$G(^LR(LRDFN,LRSS,LRIDT,LRSB))
- . I $P($P(LA7X,"^",3),"!",3)="",$D(^AUPNVLAB) D LNCHK^C0CLA7Q ; WV check for IHS.
+ . I $D(^AUPNVLAB) D LNCHK^C0CLA7Q ; WV check for IHS.
  . S LA7CODE=$$DEFCODE^LA7VHLU5(LRSS,LRSB,$P(LA7X,"^",3),LA761)
  . D CHECK
@@ -182 +183 @@
  S DFN=LA7X,LRDFN=$P($G(^DPT(DFN,"LR")),"^")
  Q
- ;
- ;***** SETUP THE SEARCH CODES
-SCLIST(SCLST) ;
- N I,RC,SCALL,TMP  K LRSSLST
- S SCALL=",CH,MI,SP,"
- S SCLST=$$UP^XLFSTR($TR(SCLST," ")),RC="*"
- S:SCLST?.1"*" RC=SCLST,SCLST=$P(SCALL,",",2,999)
- F I=1:1  S TMP=$P(SCLST,",",I)  Q:TMP=""  D  Q:$D(LA7ERR)>1
- . I SCALL[(","_TMP_",")  S LRSSLST(TMP)=""  Q
- . S LA7ERR(7)="Invalid list of subscripts: '"_SCLST_"'"
- Q RC