1 | XUMF512F ;ALB/BRM-Postal and County Code Master File edit ; [10/11/02 9:15am]
|
---|
2 | ;;8.0;KERNEL;**246**;Jul 10, 1995
|
---|
3 | ;
|
---|
4 | ; this routine will be used to transmit updates made to the
|
---|
5 | ; #300.9 file to populate the #5.12 and #5.13 files on the VistA
|
---|
6 | ; system.
|
---|
7 | ;
|
---|
8 | Q
|
---|
9 | MAIN(IEN3009,UPDTFIL,ERROR) ;entry point
|
---|
10 | ;
|
---|
11 | N IFN,PARAM,PKV,PROTOCOL,TYPE,HL,QUERY,UPDATE,ALL,MFR,MFQ,HLFS,HLCS
|
---|
12 | N GROUP,ARRAY,ROOT,NEW,I
|
---|
13 | ;
|
---|
14 | ;
|
---|
15 | I '$G(UPDTFIL)!("^5.12^5.13^"'[("^"_UPDTFIL_"^")) S ERROR="1^invalid update file" Q
|
---|
16 | I '$G(IEN3009) S ERROR="1^invalid 300.9 ien" Q
|
---|
17 | S IFN=300.9,TYPE=0,ERROR=0,QUERY=0,GROUP=0,ARRAY=0
|
---|
18 | S ALL=0,NEW=0,MFR=0,MFQ=0
|
---|
19 | S PARAM("BROADCAST")=1
|
---|
20 | K ^TMP("XUMF MFS",$J)
|
---|
21 | S ^TMP("XUMF MFS",$J,"PARAM","PRE")="PRE^XUMF512F"
|
---|
22 | S ^TMP("XUMF MFS",$J,"PARAM","POST")="POST^XUMF512F"
|
---|
23 | S ^TMP("XUMF MFS",$J,"PARAM","BROADCAST")=1
|
---|
24 | S ^TMP("XUMF MFS",$J,"PARAM","UPDATE FILE")=$G(UPDTFIL)
|
---|
25 | ;
|
---|
26 | S PROTOCOL=$O(^ORD(101,"B","XUMF MFN",0))
|
---|
27 | I 'PROTOCOL S ERROR="1^invalid protocol" Q
|
---|
28 | S ^TMP("XUMF MFS",$J,"PARAM","PROTOCOL")=PROTOCOL
|
---|
29 | D INIT^HLFNC2(PROTOCOL,.HL)
|
---|
30 | ;
|
---|
31 | I $O(HL(""))="" S ERROR="1^"_$P(HL,U,2) Q
|
---|
32 | S HLFS=HL("FS"),HLCS=$E(HL("ECH"))
|
---|
33 | ;
|
---|
34 | ; MFI -- Master File Identification Segment
|
---|
35 | S ^TMP("XUMF MFS",$J,"PARAM","MFI")=$TR(UPDTFIL,".","P") ;MFI
|
---|
36 | S ^TMP("XUMF MFS",$J,"PARAM","MFAI")="" ;Application Identifier
|
---|
37 | S ^TMP("XUMF MFS",$J,"PARAM","FLEC")="UPD" ;File-Level Event Code
|
---|
38 | S ^TMP("XUMF MFS",$J,"PARAM","ENDT")="" ;Entered Date/Time
|
---|
39 | S ^TMP("XUMF MFS",$J,"PARAM","MFIEDT")="" ;Effective Date/Time
|
---|
40 | S ^TMP("XUMF MFS",$J,"PARAM","RLC")="NE" ;Response Level Code
|
---|
41 | ;
|
---|
42 | ; MFE -- Master File Entry
|
---|
43 | S ^TMP("XUMF MFS",$J,"PARAM","RLEC")="MUP"
|
---|
44 | S ^TMP("XUMF MFS",$J,"PARAM","MFNCID")="" ;MFN Control ID
|
---|
45 | S ^TMP("XUMF MFS",$J,"PARAM","MFEEDT")=$$HLDATE^HLFNC($$NOW^XLFDT) ;Effective Date/Time
|
---|
46 | ;
|
---|
47 | ; LOC segment used for Postal Code File updates
|
---|
48 | ; data will be obtained from the 300.9 file
|
---|
49 | ;
|
---|
50 | ; create ^TMP for Postal Code update message
|
---|
51 | I ^TMP("XUMF MFS",$J,"PARAM","UPDATE FILE")=5.12 D
|
---|
52 | .S PKV=$P($G(^IVM(300.9,IEN3009,0)),U)
|
---|
53 | .S ^TMP("XUMF MFS",$J,"PARAM","PKV")=PKV ; Primary Key Value
|
---|
54 | .S ^TMP("XUMF MFS",$J,"PARAM","SEGMENT")="LOC"
|
---|
55 | .S ^TMP("XUMF MFS",$J,"PARAM","SEG","LOC","SEQ",1,.01)="PL"
|
---|
56 | .S ^TMP("XUMF MFS",$J,"PARAM","SEG","LOC","SEQ",5.3,2)="ST" ;city
|
---|
57 | .S ^TMP("XUMF MFS",$J,"PARAM","SEG","LOC","SEQ",5.4,1)="ST" ;state
|
---|
58 | .S ^TMP("XUMF MFS",$J,"PARAM","SEG","LOC","SEQ",5.5,.01)="ST" ;p cod
|
---|
59 | .S ^TMP("XUMF MFS",$J,"PARAM","SEG","LOC","SEQ",5.8,5)="ST" ;county
|
---|
60 | .S ^TMP("XUMF MFS",$J,"PARAM","SEG","LOC","SEQ",5.9,4.7)="ST" ;FIPS
|
---|
61 | ; create ^TMP for County Code update message
|
---|
62 | I ^TMP("XUMF MFS",$J,"PARAM","UPDATE FILE")=5.13 D
|
---|
63 | .S PKV=$P($G(^IVM(300.9,IEN3009,0)),"^",12)_$P($G(^IVM(300.9,IEN3009,0)),"^",5)
|
---|
64 | .S ^TMP("XUMF MFS",$J,"PARAM","PKV")=PKV ; Primary Key Value
|
---|
65 | .S ^TMP("XUMF MFS",$J,"PARAM","SEGMENT")="LOC"
|
---|
66 | .S ^TMP("XUMF MFS",$J,"PARAM","SEG","LOC","SEQ",1,4.7)="ST" ;PKV
|
---|
67 | .S ^TMP("XUMF MFS",$J,"PARAM","SEG","LOC","SEQ",5.4,1)="ST" ;state
|
---|
68 | .S ^TMP("XUMF MFS",$J,"PARAM","SEG","LOC","SEQ",5.8,5)="ST" ;county
|
---|
69 | .S ^TMP("XUMF MFS",$J,"PARAM","SEG","LOC","SEQ",5.9,4.7)="ST" ;5-digit FIPS
|
---|
70 | ;
|
---|
71 | ; transmit updates in MFN~M05 message
|
---|
72 | D MAIN^XUMFI(IFN,IEN3009,TYPE,.PARAM,.ERROR)
|
---|
73 | Q
|
---|
74 | ;
|
---|
75 | PRE ; -- pre-update record
|
---|
76 | Q
|
---|
77 | ;
|
---|
78 | POST ; -- post-update record
|
---|
79 | Q
|
---|
80 | ;
|
---|