Changeset 636 for FOIAVistA/tag/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7VORM1.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• AUTOMATED_LAB_INSTRUMENTS-LA/LA7VORM1.m (modified) (8 diffs)

FOIAVistA/tag/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7VORM1.m

@@ -1 @@
-LA7VORM1 ;DALOI/DLR - LAB ORM (Order) message builder ; 12-12-96
- ;;5.2;AUTOMATED LAB INSTRUMENTS;**27,51,46,61,64**;Sep 27, 1994
+LA7VORM1 ;DALOI/DLR - LAB ORM (Order) message builder ;1/27/07  12:25
+ ;;5.2;AUTOMATED LAB INSTRUMENTS;**27,51,46,61,64,73**;Sep 27, 1994;Build 7
+ ; Modified from FOIA VISTA,
+ ; Copyright (C) 2007 WorldVistA
+ ;
+ ; This program is free software; you can redistribute it and/or modify
+ ; it under the terms of the GNU General Public License as published by
+ ; the Free Software Foundation; either version 2 of the License, or
+ ; (at your option) any later version.
+ ;
+ ; This program is distributed in the hope that it will be useful,
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ; GNU General Public License for more details.
+ ;
+ ; You should have received a copy of the GNU General Public License
+ ; along with this program; if not, write to the Free Software
+ ; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
  ;
 BUILD(LA7628) ;
@@ -6 +22 @@
  ;
  N LA7101,LA762801,LA7629,LA7NVAF,LA7PIDSN,LA7X,ECNT,GBL,SHP,SHPC,SITE,ORUID,NTST
+ N LDATE,LDATE2
  ;
  I $G(LA7628)<1!('$D(^LAHM(62.8,+$G(LA7628),0))) D  Q
@@ -11 +28 @@
  . D EXIT
  ;
+ S LDATE2=$P(^LAHM(62.8,LA7628,0),"-",2)
+ S LDATE=($E(LDATE2,1,4)-1700)_$E(LDATE2,5,8)
  S GBL="^TMP(""HLS"","_$J_")",ECNT=1
  S LA7628(0)=$G(^LAHM(62.8,LA7628,0))
@@ -64 +83 @@
  S (LRDFN,LRI,LA7PIDSN)=0
  F  S LRDFN=$O(^TMP("LA7628",$J,LRDFN)) Q:'LRDFN  D  Q:$G(HL)
- . N LA7PID,LA7PV1
+ . N LA7PID,LA7PV1,ORNUM
  . I LA7SMSG=1 D STARTMSG Q:$G(HL)
- . I LA7SMSG<2 D PID,PV1
+ . I LA7SMSG<2 D PID,PV1,IN1^LA7VORM4
  . S LA7UID=""
  . F  S LA7UID=$O(^TMP("LA7628",$J,LRDFN,LA7UID)) Q:LA7UID=""  D
- . . N LA76802,LA7ORC,X
+ . . N LA76802,LA7ORC,X,ORCCHK,DGCHK
+ . . S ORCCHK="",DGCHK=""
  . . S X=$Q(^LRO(68,"C",LA7UID))
  . . I $QS(X,3)'=LA7UID Q
@@ -76 +96 @@
  . . S I=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,5,0))
  . . S LA76802(5)=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,5,I,0))
- . . I LA7SMSG=2 D STARTMSG Q:$G(HL)  D PID,PV1
+ . . ;check for VOE before inserting insurance
+ . . I DUZ("AG")="E",LA7SMSG=2 D STARTMSG Q:$G(HL)  D PID,PV1,IN1^LA7VORM4
+ . . I DUZ("AG")'="E",LA7SMSG=2 D STARTMSG Q:$G(HL)  D PID,PV1
  . . S (LA7OBRSN,LA762801)=0
  . . F  S LA762801=$O(^TMP("LA7628",$J,LRDFN,LA7UID,LA762801)) Q:'LA762801  D
@@ -82 +104 @@
  . . . F I=0,.1,1,2,5 S LA762801(I)=$G(^LAHM(62.8,LA7628,10,LA762801,I))
  . . . I $$CHKTST^LA7SMU(LA7628,LA762801)'=0 Q  ;deleted accession
- . . . D ORC,OBR^LA7VORM3,OBX^LA7VORM3
+ . . . ; check for VOE to prepare for Diagnosis codes.
+ . . . I DUZ("AG")="E" D  ; check for VOE
+ . . . . S ITEMNUM=0
+ . . . . F  S ITEMNUM=ITEMNUM+1 Q:ITEMNUM>$P(^LRO(69,LDATE,1,0),"^",4)  D
+ . . . . . I LRDFN=$P(^LRO(69,LDATE,1,ITEMNUM,0),"^") S ORNUM=$P(^LRO(69,LDATE,1,ITEMNUM,0),"^",11)
+ . . . . I ORCCHK'=1 D ORC S ORCCHK=1
+ . . . . D OBR^LA7VORM3,OBX^LA7VORM3
+ . . . E  D  ; not VOE
+ . . . . D ORC,OBR^LA7VORM3,OBX^LA7VORM3
+ . . ; check for VOE before inserting Diagnosis code
+ . . I DUZ("AG")="E",DGCHK'=1 D DG1^LA7VORM4(ORNUM) S DGCHK=1
  . . I LA7SMSG=2 D BLG,SENDMSG
  . I LA7SMSG<2 D BLG
@@ -97 +129 @@
  K LRAA,LRACC,LRAD,LRAN,LRDFN,LRI
  K LTST,NLT,NLTIEN,PCNT,RUID,SNIEN,TIEN,X,Y,LA
+ K ORCCHK,DGCHK,LDATE,LDATE2
  D KVAR^LRX
  I $D(ZTQUEUED) S ZTREQ="@"
@@ -228 +261 @@
  Q
  ;
- ;
 BLG ; Billing segment
  ;