source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUMF512F.m@ 846

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

initial load of WorldVistAEHR
File size: 3.2 KB
RevLine 
[613]1XUMF512F ;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
9MAIN(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 ;
75PRE ; -- pre-update record
76 Q
77 ;
78POST ; -- post-update record
79 Q
80 ;
Note: See TracBrowser for help on using the repository browser.