source: WorldVistAEHR/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMLINS3.m

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

initial load of WorldVistAEHR
File size: 3.6 KB
Line 
1IVMLINS3 ;ALB/KCL - IVM INSURANCE POLICY TRANSFER ; 01-FEB-94
2 ;;2.0;INCOME VERIFICATION MATCH;**14,111**; 21-OCT-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;
6TRANSFER(IVMAUTO) ; user has chosen to transfer insurance information,
7 ; received from HEC, to the MCCR insurance buffer. this routine
8 ; will call $$ADDSTF^IBCNBES(3,DFN,IVMIBDAT) to place HEC's insurance
9 ; information in the MCCR insurance buffer where authorized insurance
10 ; personnel will either upload or reject the data.
11 ; 3 indicates that source of information is IVM
12 ; IVMIBDAT = data, to be filed in the MCCR buffer, in an array
13 ; subscripted by field number of the data field in
14 ; the INSURANCE BUFFER file (#355.33)
15 ; INPUT: IVMAUTO = 1 if auto-filing directly from upload
16 ; 0 if using list manager interface to file
17 ; THE FOLLOWING ARE ASSUMED TO BE DEFINED:
18 ; IVMIN1 (ST/ST1 segment string nodes of file 301.5)
19 ; IVMADD (5th "^" piece of IVMIN1 for ins co address data)
20 ;
21 N IVMIB,IVMIBDAT,IVMNOI,IVMPRTI
22 ;
23 I '$G(IVMAUTO) W !!,"Transferring HEC'S insurance data to the MCCR insurance buffer",!
24 S IVMNOI=$S($P(IVMIN1,HLFS,17)="v":$P($$PT^IVMUFNC4(DFN),"^"),1:$P(IVMIN1,HLFS,16))
25 S IVMPRTI=$S($P(IVMIN1,HLFS,17)="v":"01",1:"02")
26 ;
27 S IVMIBDAT(20.01)=$E($P(IVMIN1,HLFS,4),1,30) ;ins co name
28 S IVMIBDAT(20.02)=$E($P(IVMIN1,HLFS,7),1,20) ;phone number
29 S IVMIBDAT(21.01)=$E($P(IVMADD,"~",1),1,35) ;street add [line 1]
30 S IVMIBDAT(21.02)=$E($P(IVMADD,"~",2),1,30) ;street add [line 2]
31 S IVMIBDAT(21.04)=$E($P(IVMADD,"~",3),1,25) ;city
32 S IVMIBDAT(21.05)=$$STATE1^IVMUFNC4($P(IVMADD,"~",4)) ;state
33 S IVMIBDAT(21.06)=$E($P(IVMADD,"~",5),1,20) ;zip
34 S IVMIBDAT(40.02)=$E($P(IVMIN1,HLFS,9),1,20) ;group name
35 S IVMIBDAT(40.03)=$E($P(IVMIN1,HLFS,8),1,17) ;group number
36 S IVMIBDAT(40.05)=$S($P(IVMIN1,HLFS,28)=1:1,1:0) ;precertification required
37 S IVMIBDAT(40.09)=$P(IVMIN1,HLFS,15) ;type of plan
38 S IVMIBDAT(60.01)=DFN ;patient name
39 S IVMIBDAT(60.02)=$$FMDATE^HLFNC($P(IVMIN1,HLFS,12)) ;effective date
40 S IVMIBDAT(60.03)=$$FMDATE^HLFNC($P(IVMIN1,HLFS,13)) ;expiration date
41 S IVMIBDAT(60.04)=$E($P(IVMIN1,HLFS,36),1,20) ;subcriber id
42 S IVMIBDAT(60.05)=$P(IVMIN1,HLFS,17) ;whose insurance
43 S IVMIBDAT(60.06)=IVMPRTI ;pt relationship to insured
44 S IVMIBDAT(60.07)=IVMNOI ;name of insured
45 ;
46 S IVMIB=$$ADDSTF^IBCNBES(3,DFN,.IVMIBDAT)
47 I 'IVMIB D Q
48 .Q:$G(IVMAUTO)
49 .W !,"The following error occurred when transferring data:"
50 .W !,$P(IVMIB,"^",2)
51 .W !,"Please contact your IRM staff for help"
52 ;
53 N DA,DIE,DR
54 S DA=IVMJ,DA(1)=IVMI
55 ;
56 ; - delete segment name (.02 field of 301.501 multiple) from IVM PATIENT
57 ; file to remove from ASEG cross-reference
58 S DIE="^IVM(301.5,"_DA(1)_",""IN"",",DR=".02////@" D ^DIE
59 ;
60 I $G(IVMAUTO) G IVMQ
61 ;
62 W "completed.",!
63 ;
64 S DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR K DIR
65 ;
66REMOVE ; - remove entry from the List Manager display after transferring
67 K ^TMP("IVMIUPL",$J,IVMNAME,IVMI,IVMJ)
68 ;
69 ; - action completed
70 S IVMDONE=1
71 ;
72IVMQ K DIRUT,DTOUT,DUOUT,IVMACT,IVMDA,IVMFLAG,IVMREPTR,X,Y
73 Q
74 ;
75AUTO ; Auto-upload all Z04 entries pending in file 301.501
76 ; Called by the patch IVM*2*111 post-install
77 N DFN,IVMI,IVMJ,IVMIN1,IVMADD,IVM0NOD,HLFS
78 S HLFS=U
79 ;
80 S IVMI=0 F S IVMI=$O(^IVM(301.5,"ASEG","IN1",IVMI)) Q:'IVMI D
81 . S IVMJ=0 F S IVMJ=$O(^IVM(301.5,"ASEG","IN1",IVMI,IVMJ)) Q:'IVMJ D
82 .. S IVM0NOD=$G(^IVM(301.5,IVMI,0)) I IVM0NOD']"" Q
83 .. S DFN=+IVM0NOD
84 .. I $G(^DPT(+DFN,0))']"" Q
85 .. Q:$P($G(^IVM(301.5,IVMI,"IN",IVMJ,0)),U,2)'="IN1"
86 .. S IVMIN1=$$GETIN1^IVMLINS1(IVMI,IVMJ)
87 .. Q:IVMIN1=""
88 .. S IVMADD=$P(IVMIN1,U,5)
89 .. D TRANSFER(1)
90 ;
91 Q
92 ;
Note: See TracBrowser for help on using the repository browser.