source: WorldVistAEHR/trunk/r/VISTA_OFFICE_EHR-VEPE/VEPERI2.m@ 1581

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

initial load of WorldVistAEHR
File size: 5.3 KB
RevLine 
[613]1VEPERI2 ;;DAOU/WCJ - Incoming HL7 messages ;2-MAY-2005
2 ;;1.0;VOEB;;Jun 12, 2005;Build 1
3 ;;;VISTA OFFICE/EHR;
4 ;;Per VHA Directive 10-93-142, this routine should not be modified.
5 ;
6 ;**Program Description**
7 ; Find matching insurance or file ne entries in 36, 355.3, and 366.03.
8 ;
9 Q
10 ;
11FILEINS(HLP,HLF,DFN,IEN,FE,HLMTIEN) ;
12 ;
13 Q:'$D(HLP("IN1"))
14 ;
15 N SETID,INSCONM,PLAN,PLANID
16 S FE=0
17 ;
18 ; Make sure IN1 are sequential and start with 1.
19 ; The first character of the 4 digit SETID is the SETID for IN1
20 F SETID=1000:1000 Q:'$D(HLP("IN1",SETID))
21 I $O(HLP("IN1",SETID)) S FE=$$FATALERR^VEPERI6(1,"HL7","INVALID SETID FOR IN1",HLMTIEN,.HLP) Q
22 ;
23 ; Get existing plans for this patient
24 D GETINS(DFN,.PLAN) ;
25 ;
26 S SETID=0 F S SETID=$O(HLP("IN1",SETID)) Q:'+SETID!(FE) D
27 . S INSCONM=$G(HLP("IN1",SETID,4))
28 . I INSCONM="" S FE=$$FATALERR^VEPERI6(1,"DATA","IN1 MISSING INS CO NAME",HLMTIEN,.HLP) Q
29 . S PLANID=$G(HLP("IN1",SETID,2))
30 . I PLANID="" S FE=$$FATALERR^VEPERI6(1,"DATA","IN1 MISSING PLAN ID",HLMTIEN,.HLP)
31 . ;
32 . ; Check patient's exisitng info
33 . I $D(PLAN(INSCONM,PLANID)) D Q
34 .. S IEN(SETID,36)=$P(PLAN(INSCONM,PLANID),U)
35 .. S IEN(SETID,355.3)=$P(PLAN(INSCONM,PLANID),U,2)
36 .. S IEN(SETID,366.03)=$P(PLAN(INSCONM,PLANID),U,3)
37 .. D FILE
38 . ;
39 . ; Get all other INS CO/PLAN ID combos on file
40 . D INSCO(INSCONM,.PLAN)
41 . ;
42 . ; See if any matched
43 . I $D(PLAN(INSCONM,PLANID)) D Q
44 .. S IEN(SETID,36)=$P(PLAN(INSCONM,PLANID),U)
45 .. S IEN(SETID,355.3)=$P(PLAN(INSCONM,PLANID),U,2)
46 .. S IEN(SETID,366.03)=$P(PLAN(INSCONM,PLANID),U,3)
47 .. D FILE
48 . ;
49 . S IEN(SETID,36)=$$ADD36(INSCONM)
50 . I IEN(SETID,36)'=+IEN(SETID,36) S FE=IEN(SETID,36) Q
51 . S IEN(SETID,366.03)=$$ADD36603(PLANID)
52 . I IEN(SETID,366.03)'=+IEN(SETID,366.03) S FE=IEN(SETID,366.03) Q
53 . S IEN(SETID,355.3)=$$ADD3553(IEN(SETID,36),IEN(SETID,366.03))
54 . I IEN(SETID,355.3)'=+IEN(SETID,355.3) S FE=IEN(SETID,355.3) Q
55 . D FILE
56 Q
57 ;
58FILE ;
59 N FDA,FILE,FIELD,ERR
60 F FILE=36,366.03,355.3 D Q:FE
61 . K FDA
62 . S FIELD=0 F S FIELD=$O(HLF("DATA",FILE,FIELD)) Q:FIELD="" D
63 .. Q:'$D(HLF("DATA",FILE,FIELD,SETID))
64 .. S IEN=IEN(SETID,FILE)_","
65 .. S FDA(FILE,IEN,FIELD)=HLF("DATA",FILE,FIELD,SETID)
66 . Q:'$D(FDA) ; nothing to file
67 . D FILE^DIE("EKT","FDA","ERR")
68 . I $D(ERR) Q
69 Q
70 ;
71 ; This will get all the insurance for an existing patient. It's
72 ; purpose is to set up the following array.
73 ;
74 ; PLAN(INSURANCE CO NAME,PLAN ID)=
75 ; [1] = IEN to file 36
76 ; [2] = IEN to file 355.3
77 ; [3] = IEN to file 366.03
78 ;
79 ; This subroutine assume that Plan ID are unique within and insurance company
80 ;
81GETINS(DFN,PLAN) ;
82 ;
83 Q:'+DFN
84 ;
85 N RESULT,INSIEN,SCREEN,NUM,DONE
86 N INS,INSCONM,D0,DIC,DLAYGO
87 S U="^"
88 ;
89 ; If this is an existing patient, see if this is about an exisiting
90 ; entry on file being edited.
91 D ALL^IBCNS1(DFN,"INS",,,1) ; get all of the patients insurance
92 S D0=0 F S D0=$O(INS(D0)) Q:'D0 D
93 . S INSIEN=$P(INS(D0,0),U)
94 . ;
95 . ; Only Check Ins Co once
96 . Q:$D(DONE(INSIEN))
97 . S DONE(INSIEN)=""
98 . ;
99 . ; Get INS CO name
100 . K RESULT
101 . D FIND^DIC(36,,"@;.01","AX",INSIEN,,,,,"RESULT")
102 . Q:'$P(RESULT("DILIST",0),U)
103 . S INSCONM=$G(RESULT("DILIST","ID",1,.01)) S:INSCONM="" INSCONM=" "
104 . ;
105 . ; Get all PLAN ID's for that insurance
106 . K RESULT
107 . D FIND^DIC(355.3,,"@;.03;6.01I;6.01","Q",INSIEN,,,,,"RESULT")
108 . Q:'$P(RESULT("DILIST",0),U)
109 . S NUM="" F S NUM=$O(RESULT("DILIST","ID",NUM)) Q:'NUM D
110 .. N EXT
111 .. S EXT=$G(RESULT("DILIST","ID",NUM,6.01,"E")) S:EXT="" EXT="NO PLAN ON FILE"
112 .. S PLAN(INSCONM,EXT)=INSIEN_U_$G(RESULT("DILIST",2,NUM))_U_$G(RESULT("DILIST","ID",NUM,6.01,"I"))
113 Q
114 ;
115INSCO(INSCO,PLAN) ;
116 ;
117 ; This will get all the PLAN ID's for an insurance co name. It's
118 ; purpose is to set up the following array.
119 ;
120 ; PLAN(INSURANCE CO NAME,PLAN ID)=
121 ; [1] = IEN to file 36
122 ; [2] = IEN to file 355.3
123 ; [3] = IEN to file 366.03
124 ;
125 ; This subroutine assume that Plan ID are unique within and insurance company
126 ;
127 ; Find all active insurance companies with this exact name
128 N RESULT,NUM,RESULT2,LOOP,INSIEN
129 D FIND^DIC(36,,"@;.01","X",INSCO,,,,,"RESULT")
130 ;
131 ; Quit if no matches
132 Q:'+RESULT("DILIST",0)
133 ;
134 ; One or more matches
135 F LOOP=1:1 Q:'$D(RESULT("DILIST",2,LOOP)) D
136 . S INSIEN=RESULT("DILIST",2,LOOP)
137 . ;
138 . ; Get all PLAN ID's for that insurance
139 . K RESULT2
140 . D FIND^DIC(355.3,,"@;.03;6.01I;6.01","Q",INSIEN,,,,,"RESULT2")
141 . Q:'$P(RESULT2("DILIST",0),U)
142 . S NUM="" F S NUM=$O(RESULT2("DILIST","ID",NUM)) Q:'NUM D
143 .. N EXT
144 .. S EXT=$G(RESULT2("DILIST","ID",NUM,6.01,"E")) S:EXT="" EXT="NO PLAN ON FILE"
145 .. S PLAN(INSCONM,EXT)=INSIEN_U_$G(RESULT2("DILIST",2,NUM))_U_$G(RESULT2("DILIST","ID",NUM,6.01,"I"))
146 Q
147 ;
148 ; Add an entry to file 36 INSURANCE COMPANY
149ADD36(X) ;
150 N Y
151 S X=""""_X_""""
152 S DIC=36,DIC(0)="L",DLAYGO=1
153 D ^DIC
154 I Y<1 S FE=$$FATALERR^VEPERI6(1,"DATA","COULD NOT ADD PLAN TO DICTIONARY",HLMTIEN,.HLP) Q FE
155 Q +Y
156 ;
157 ; Add an entry to file 366.03 PLAN
158ADD36603(X) ;
159 N Y
160 S X=""""_X_""""
161 S DIC=366.03,DIC(0)="L",DLAYGO=1
162 D ^DIC
163 I Y<1 S FE=$$FATALERR^VEPERI6(1,"DATA","COULD NOT ADD PLAN TO DICTIONARY",HLMTIEN,.HLP) Q FE
164 Q +Y
165 ;
166 ; Add an entry to file 355.3 GROUP INSURANCE PLAN
167 ; This is passed in a pointer to 36 (ins co) and a pointer to 366.03 (plans)
168ADD3553(P36,P36603) ;
169 N Y
170 S X=P36
171 S DIC=355.3,DIC(0)="UL",DIC("S")="I 0"
172 S DIC("DR")="6.01////"_P36603
173 D ^DIC
174 I Y<1 S FE=$$FATALERR^VEPERI6(1,"DATA","COULD NOT ADD PLAN TO DICTIONARY",HLMTIEN,.HLP) Q FE
175 Q +Y
Note: See TracBrowser for help on using the repository browser.