source: WorldVistAEHR/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7VORM4.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: 3.9 KB
Line 
1LA7VORM4 ;DALOI/DLR - LAB ORM (Order) message builder ;1/27/07 12:25
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**73**;Sep 27, 1994;Build 7
3 ; Modified from FOIA VISTA,
4 ; Copyright (C) 2007 WorldVistA
5 ;
6 ; This program is free software; you can redistribute it and/or modify
7 ; it under the terms of the GNU General Public License as published by
8 ; the Free Software Foundation; either version 2 of the License, or
9 ; (at your option) any later version.
10 ;
11 ; This program is distributed in the hope that it will be useful,
12 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ; GNU General Public License for more details.
15 ;
16 ; You should have received a copy of the GNU General Public License
17 ; along with this program; if not, write to the Free Software
18 ; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
19 ;
20IN1 ;
21 N CNT
22 N IN1,INS0,INS1,INS2,INS3,INS4,LA7DATA,LA7DUR,LA7DURU,LA76205,LA762801,LA7X
23 N ADDR0,ADDR1,ADDR2,ADDR3,ADDR4,ADDR5
24 S CNT=0
25 S OCT=0,X=""
26 ; $O through insurances
27 F S OCT=$O(^DPT(DFN,.312,OCT)) Q:OCT'?1N.N D
28 . S INS0=$G(^DPT(DFN,.312,OCT,0))
29 . S INS1=$G(^DPT(DFN,.312,OCT,1))
30 . S INS2=$G(^DPT(DFN,.312,OCT,2))
31 . S INS3=$G(^DPT(DFN,.312,OCT,3))
32 . S INS4=$G(^DPT(DFN,.312,OCT,4))
33 . S IN1(0)="IN1"
34 . S IN1(1)=OCT
35 . S IN1(2)=$P(INS0,"^",2) ;"insurance plan id"
36 . S IN1(3)=$P(INS0,"^",1) ;"insurance co id"
37 . S IN1(4)=$P($G(^DIC(36,IN1(3),0)),"^",1) ; "coName"
38 . S ADDR0=$G(^DIC(36,IN1(3),.11))
39 . S ADDR1=$P(ADDR0,"^",1) ;STR 1
40 . S ADDR2=$P(ADDR0,"^",2) ;STR 2
41 . S ADDR3=$P(ADDR0,"^",3) ;STR 3
42 . S ADDR4=$P(ADDR0,"^",4) ;CITY
43 . S ADDR5=$P($G(^DIC(5,$P(ADDR0,"^",5),0)),"^",2) ;STATE
44 . S ADDR6=$P(ADDR0,"^",6) ;ZIP
45 . S IN1(5)=ADDR1_$E(HLECH,1)_ADDR2_$E(HLECH,1)_ADDR3_$E(HLECH,1)_ADDR4_$E(HLECH,1)_ADDR5_$E(HLECH,1)_ADDR6 ;"coAddress"
46 . S IN1(7)=$P($G(^DIC(36,IN1(3),.13)),"^") ;"coPhone"
47 . S IN1(8)=$P($G(^IBA(355.3,IN1(3),0)),"^",4) ;"GroupNo"
48 . S IN1(11)=$P(INS2,"^",9) ;"InsuredsGroupEmpName"
49 . S IN1(16)=$P(INS0,"^",17) ;"NameInsured"
50 . I $P(INS0,"^",17)'="" S IN1(17)=$P($G(^DG(408.11,$P(INS0,"^",17),0)),"^",1) ;"InsuredRelationToPatient"
51 . S IN1(18)=$P(INS3,"^",1) ;"InsuredDOB"
52 . S ADDR1=$P(INS3,"^",6) ;STR 1
53 . S ADDR2=$P(INS3,"^",7) ;STR 2
54 . S ADDR3=$P(INS3,"^",8) ;CITY
55 . S ADDR4="" I INS3'="" S ADDR4=$P(INS3,"^",9)
56 . I ADDR4'="" S ADDR4=$P($G(^DIC(5,ADDR4,0)),"^",2) ;STATE
57 . S ADDR5=$P(INS3,"^",10) ;ZIP
58 . S IN1(19)=ADDR1_$E(HLECH,1)_ADDR2_$E(HLECH,1)_ADDR3_$E(HLECH,1)_ADDR4_$E(HLECH,1)_ADDR5 ;"InsuredAddy"
59 . S IN1(32)="T" ;"BillingStatus"
60 . S IN1(35)="" ;"CompanyPlanCode"
61 . S IN1(36)=$P(INS0,"^",2) ;"PolicyNum"
62 . S ADDR1=$P(INS2,"^",2) ;STR 1
63 . S ADDR2=$P(INS2,"^",3) ;STR 2
64 . S ADDR3=$P(INS2,"^",4) ;STR 2
65 . S ADDR4=$P(INS2,"^",5) ;CITY
66 . S ADDR5="" I INS2'="" S ADDR5=$P(INS2,"^",6)
67 . I INS2'="" S ADDR5=$P($G(^DIC(5,ADDR5,0)),"^",2) ;STATE
68 . S ADDR6=$P(INS2,"^",7) ;ZIP
69 . S IN1(44)=ADDR1_$E(HLECH,1)_ADDR2_$E(HLECH,1)_ADDR3_$E(HLECH,1)_ADDR4_$E(HLECH,1)_ADDR5_$E(HLECH,1)_ADDR6 ;"InsuredsEmpAddress"
70 . S IN1(47)="" ;"CoverageType"
71 . D BUILDSEG^LA7VHLU(.IN1,.LA7DATA,LA7FS)
72 . D FILESEG^LA7VHLU(GBL,.LA7DATA)
73 . D FILE6249^LA7VHLU(LA76249,.LA7DATA)
74 ;
75 Q
76 ;
77GT1 ;
78 Q
79 ;
80NTE ;
81 Q
82 ;
83DG1(ORNUM) ; Get diagnosis info
84 N DXIEN,DXV,ICD9,ICDR,OCT,ORFMDAT,ORIFN,CNT
85 N DG1,LA7DATA,LA7DUR,LA7DURU,LA76205,LA762801,LA7X
86 S CNT=0
87 S ^BRAD("ORNUM")=ORNUM
88 ;S ORIFN=+^OR(100,ORNUM,5.1,1,0)
89 S OCT=0,X=""
90 ; Get the date of the order for CSV/CTD usage
91 S ORFMDAT=$$ORFMDAT^ORWDBA3(ORNUM)
92 ; $O through diagnoses for an order
93 F S OCT=$O(^OR(100,ORNUM,5.1,OCT)) Q:OCT'?1N.N D
94 . S CNT=CNT+1
95 . ; DXIEN=Dx IEN
96 . S DXIEN=+^OR(100,ORNUM,5.1,OCT,0)
97 . ; Get Dx record for date ORFMDAT
98 . S ICDR=$$ICDDX^ICDCODE(DXIEN,ORFMDAT)
99 . ; Get Dx verbiage and ICD code
100 . S DXV=$P(ICDR,U,4),ICD9=$P(ICDR,U,2)
101 .S DG1(0)="DG1"
102 .S DG1(1)=CNT
103 .S DG1(3)=ICD9
104 .D BUILDSEG^LA7VHLU(.DG1,.LA7DATA,LA7FS)
105 .D FILESEG^LA7VHLU(GBL,.LA7DATA)
106 .D FILE6249^LA7VHLU(LA76249,.LA7DATA)
107 Q
Note: See TracBrowser for help on using the repository browser.