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