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

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

initial load of WorldVistAEHR

File size: 4.0 KB
Line 
1IVMPTRNA ;ALB/CKN/BRM,TDM - HL7 FULL DATA TRANSMISSION (Z07) BUILDER(CONTINUED);30 AUG 2001 ; 5/17/06 1:57pm
2 ;;2.0;INCOME VERIFICATION MATCH;**46,58,76,105**; 21-OCT-94;Build 2
3 Q
4NTROBX(DGNTARR) ;
5 N NTRTEMP,I,CS,RS,SS
6 I $G(HLECH)'="~|\&" N HLECH S HLECH="~|\&"
7 I $G(HLFS)'="^" N HLFS S HLFS="^"
8 S CS=$E(HLECH,1),SS=$E(HLECH,4),RS=$E(HLECH,2)
9 S NTRTEMP("NTR","Y")="1"_CS_"Received NTR Trmt"_CS_"VA0053"
10 S NTRTEMP("AVI","Y")="2"_CS_"Aviator Pre 1955"_CS_"VA0053"
11 S NTRTEMP("SUB","Y")="3"_CS_"Sub Trainee pre 1965"_CS_"VA0053"
12 S NTRTEMP("HNC","Y")="4"_CS_"Dx With Head Neck Cancer"_CS_"VA0053"
13 S NTRTEMP("NTR","N")="5"_CS_"No NTR Trmt"_CS_"VA0053"
14 S NTRTEMP("AVI","N")="6"_CS_"Not Aviator Pre 1955"_CS_"VA0053"
15 S NTRTEMP("SUB","N")="7"_CS_"Not Sub Trainee pre 1965"_CS_"VA0053"
16 S NTRTEMP("HNC","N")="8"_CS_"Not Dx With Head Neck Cancer"_CS_"VA0053"
17 S NTRTEMP("NTR","U")="9"_CS_"NTR Trmt Unknown"_CS_"VA0053"
18 S NTRTEMP("VER","M")="M"_CS_"Military Med Rec"_CS_"VA0052"
19 S NTRTEMP("VER","S")="S"_CS_"Qual Military Srvc"_CS_"VA0052"
20 S NTRTEMP("VER","N")="N"_CS_"Not Qualified"_CS_"VA0052"
21 S NTROBX(2)="CE",NTROBX(3)="VISTA"_CS_"28.11"
22 S NTROBX(5)=""
23 F I="NTR","AVI","SUB","HNC" D
24 . I $G(DGNTARR(I))="" Q
25 . I NTROBX(5)'="" S NTROBX(5)=$G(NTROBX(5))_RS
26 . S NTROBX(5)=$G(NTROBX(5))_$G(NTRTEMP(I,$G(DGNTARR(I))))
27 S NTROBX(11)="F"
28 S NTROBX(12)=$G(DGNTARR("HDT"))
29 S NTROBX(14)=$G(DGNTARR("VDT"))
30 I $G(DGNTARR("VSIT"))'="" D
31 . S NTROBX(15)=$P($G(^DIC(4,DGNTARR("VSIT"),99)),"^")
32 S NTROBX(16)=""
33 I $G(DGNTARR("HSIT"))'="" D
34 . S $P(NTROBX(16),CS,14)=SS_$P($G(^DIC(4,DGNTARR("HSIT"),99)),"^")
35 I $G(DGNTARR("VER"))'="" S NTROBX(17)=$G(NTRTEMP("VER",$G(DGNTARR("VER"))))
36 Q
37RF1(DFN,RF1TYP) ; create RF1 segment
38 ; Input:
39 ; DFN - Patient IEN
40 ; RF1TYP - RF1 Type
41 ; SAD = Street Address Change (Default)
42 ; CAD = Confidential Address Change
43 ; CPH = Cell Phone Number Change
44 ; PNO = Pager Number Change
45 ; EAD = E-Mail Address Change
46 ;
47 ; Output: RF1 segment
48 ;
49 N X,Y,ADDRSRC,ADRSRC,ADRSIT,ADTDT,I,CS,RS,SS,HLQ,RETURN,RFDAT,ERR
50 I $G(HLECH)'="~|\&" N HLECH S HLECH="~|\&"
51 I $G(HLFS)'="^" N HLFS S HLFS="^"
52 S CS=$E(HLECH,1),SS=$E(HLECH,4),RS=$E(HLECH,2),HLQ=""""
53 S:$G(RF1TYP)="" RF1TYP="SAD" ;Set type to 'SAD' if no value passed
54 ; initialize the RETURN variable
55 S RETURN="RF1",$P(RETURN,HLFS,4)=RF1TYP,$P(RETURN,HLFS,11)=""
56 Q:'$G(DFN) RETURN
57 ;I RF1TYP="SAD",$$BADADR^DGUTL3(DFN) Q RETURN
58 D RF1LOAD(RF1TYP) Q:$D(ERR) RETURN
59 I RF1TYP'="SAD",$G(ADRDT)="" Q ""
60 ; RF1 SEQ 1-2 are not currently used
61 ; RF1 SEQ 3
62 S $P(RETURN,HLFS,4)=RF1TYP
63 ; RF1 SEQ 4-5 are not currently used
64 ; RF1 SEQ 6
65 S $P(RETURN,HLFS,7)=$G(ADRSIT)
66 S:$G(ADRSRC)'="" $P(RETURN,HLFS,7)=$P(RETURN,HLFS,7)_CS_ADRSRC
67 ; RF1 SEQ 7
68 S $P(RETURN,HLFS,8)=$G(ADRDT)
69 ; RF1 SEQ 8-11 are not currently used
70 ; quit with completed RF1 segment
71 Q RETURN
72 ;
73ADDRCNV(ADDRSRC) ;convert Address Source to HL7 format
74 Q:$G(ADDRSRC)']"" ""
75 Q:ADDRSRC="HEC" "USVAHEC"
76 Q:ADDRSRC="VAMC" "USVAMC"
77 Q:ADDRSRC="HBSC" "USVAHBSC"
78 Q:ADDRSRC="NCOA" "USNCOA"
79 Q:ADDRSRC="BVA" "USVABVA"
80 Q:ADDRSRC="VAINS" "USVAINS"
81 Q:ADDRSRC="USPS" "USPS"
82 Q:ADDRSRC="LACS" "LACS"
83 Q ""
84 ;
85RF1LOAD(RF1TYP) ;
86 N RFDT,RFSRC,RFSIT,GETFLDS,RFDAT,ERR
87 K ADRDT,ADRSRC,ADRSIT
88 I RF1TYP="SAD" S RFDT=.118,RFSRC=.119,RFSIT=.12
89 I RF1TYP="CAD" S RFDT=.14112,RFSRC="",RFSIT=.14113
90 I RF1TYP="CPH" S RFDT=.139,RFSRC=.1311,RFSIT=.13111
91 I RF1TYP="PNO" S RFDT=.1312,RFSRC=.1313,RFSIT=.1314
92 I RF1TYP="EAD" S RFDT=.136,RFSRC=.137,RFSIT=.138
93 S GETFLDS=RFDT S:RFSRC'="" GETFLDS=GETFLDS_";"_RFSRC S GETFLDS=GETFLDS_";"_RFSIT
94 D GETS^DIQ(2,DFN_",",GETFLDS,"IE","RFDAT","ERR") Q:$D(ERR)
95 S ADRDT=$$FMTHL7^XLFDT($G(RFDAT(2,DFN_",",RFDT,"I")))
96 S:RFSRC'="" ADRSRC=$$EXTERNAL^DILFD(2,RFSRC,"",$G(RFDAT(2,DFN_",",RFSRC,"I")))
97 ; only populate Change Site if Source=VAMC or NO Source Field
98 I ($G(ADRSRC)="VAMC")!(RFSRC="") D
99 . S ADRSIT=$G(RFDAT(2,DFN_",",RFSIT,"I"))
100 . S:ADRSIT]"" ADRSIT=$$GET1^DIQ(4,ADRSIT_",",99)
101 S ADRSRC=$$ADDRCNV($G(ADRSRC)) ;convert source to HL7 format
102 Q
Note: See TracBrowser for help on using the repository browser.