XUMFP512 ;ALB/BRM - Master File Param POSTAL CODE ; 10/17/02 2:36pm
;;8.0;KERNEL;**246**;Jul 10, 1995
;
;
; This routine sets up the parameters required by the POSTAL CODE
; (#5.12) file for the Master File server mechanism.
;
; ** This routine is not a supported interface -- use XUMFP **
;
; See XUMFP for parameter list documentation
;
N PKV,PROTOCOL,HLFS,HLCS,RT,RF
;
S PARAM("PRE")="PRE^XUMFP512"
S PARAM("POST")="POST^XUMFP512"
S TYPE=0
;
I $O(HL(""))="" D
.S:UPDATE PROTOCOL=$O(^ORD(101,"B","XUMF MFN",0))
.S:QUERY PROTOCOL=$O(^ORD(101,"B","XUMF MFQ",0))
.S:'PROTOCOL ERROR="1^invalid protocol" Q:ERROR
.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"))
;
I QUERY D QRD
;
; MFI -- Master File Identification Segment
S ^TMP("XUMF MFS",$J,"PARAM","MFI")="5P12" ;Master File Identifier
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
I $G(^TMP("XUMF MFS",$J,"PARAM","RLEC"))="" D ;Record-Level Event Code
.S ^TMP("XUMF MFS",$J,"PARAM","RLEC")="UPD"
S ^TMP("XUMF MFS",$J,"PARAM","MFNCID")="" ;MFN Control ID
I $G(^TMP("XUMF MFS",$J,"PARAM","MFEEDT"))="" D ;Effective Date/Time
.S ^TMP("XUMF MFS",$J,"PARAM","MFEEDT")=$$HLDATE^HLFNC($$NOW^XLFDT)
;
SEG ; -- LOC segment used for Postal Code File updates
;
I IEN D
.S PKV=$P($G(^XIP(5.12,+IEN,0)),U)
.S ^TMP("XUMF MFS",$J,"PARAM","PKV")=PKV ; Primary Key Value
I NEW D
.S PKV="NEW"
.S ^TMP("XUMF MFS",$J,"PARAM","PKV")=PKV ; Primary Key Value
;
; LOC -- Location Identification Segment sequence
S ^TMP("XUMF MFS",$J,"PARAM","SEGMENT")="LOC"
; primary key value
S ^TMP("XUMF MFS",$J,"PARAM","SEG","LOC","SEQ",1,.01)="PL"
; location address (contains components utilizing XAD)
; the components are recognized by decimal SEQ values
S ^TMP("XUMF MFS",$J,"PARAM","SEG","LOC","SEQ",5.3,1)="ST" ;city
S ^TMP("XUMF MFS",$J,"PARAM","SEG","LOC","SEQ",5.4,3)="ZST" ;state
S ^TMP("XUMF MFS",$J,"PARAM","SEG","LOC","SEQ",5.5,.01)="ST" ;p code
S ^TMP("XUMF MFS",$J,"PARAM","SEG","LOC","SEQ",5.9,2)="ST" ;county
S ^TMP("XUMF MFS",$J,"PARAM","SEG","LOC","SEQ",5.12,"HLSCS",2,4)="DT" ;inactive date
;
Q:'GROUP
Q:$G(HL("MTN"))="MFR"
;
GROUP ; -- query group
;
S IEN=0
F S IEN=$O(^TMP("XUMF MFS",$J,"PARAM","IENS",IEN)) Q:'IEN D
.S PKV=$P(^XIP(5.12,IEN,0),U)
.S ^TMP("XUMF MFS",$J,"PARAM",IEN,"PKV")=PKV
;
Q
;
QRD ; -- query definition segment
;
;Query Date/Time
I '$D(^TMP("XUMF MFS",$J,"PARAM","QDT")) D
.S ^TMP("XUMF MFS",$J,"PARAM","QDT")=$$HLDATE^HLFNC($$NOW^XLFDT)
;
;Query Format Code
I '$D(^TMP("XUMF MFS",$J,"PARAM","QFC")) D
.S ^TMP("XUMF MFS",$J,"PARAM","QFC")="R"
;
;Query Priority
I '$D(^TMP("XUMF MFS",$J,"PARAM","QP")) D
.S ^TMP("XUMF MFS",$J,"PARAM","QP")="I"
;
;Query ID
I '$D(^TMP("XUMF MFS",$J,"PARAM","QID")) D
.S ^TMP("XUMF MFS",$J,"PARAM","QID")="5P12 "_$S(ARRAY:"ARRAY",1:"FILE")
;
;Deferred Response Type (optional)
I '$D(^TMP("XUMF MFS",$J,"PARAM","DRT")) D
.S ^TMP("XUMF MFS",$J,"PARAM","DRT")=""
;
;Deferred Response Date/Time (optional)
I '$D(^TMP("XUMF MFS",$J,"PARAM","DRDT")) D
.S ^TMP("XUMF MFS",$J,"PARAM","DRDT")=""
;
;Quantity Limited Request
I '$D(^TMP("XUMF MFS",$J,"PARAM","QLR")) D
.S ^TMP("XUMF MFS",$J,"PARAM","QLR")="RD"_HLCS_999
;
;Who Subject Filter - sta#, D x-ref, assigning facility
I '$D(^TMP("XUMF MFS",$J,"PARAM","WHO")) D
.N X S X=$S(ALL:"ALL",IEN:$P($G(^XIP(5.12,+IEN,0)),U),1:"IEN ARRAY")
.S $P(X,HLCS,9,10)="B"_HLCS_"VA"
.S ^TMP("XUMF MFS",$J,"PARAM","WHO")=X
;
;What Subject Filter
I '$D(^TMP("XUMF MFS",$J,"PARAM","WHAT")) D
.S ^TMP("XUMF MFS",$J,"PARAM","WHAT")="5.12"_HLCS_"IFN"_HLCS_"VA FM"
;
;What Department Data Code
I '$D(^TMP("XUMF MFS",$J,"PARAM","WDDC")) D
.N X S X="INFRASTRUCTURE"_HLCS_"INFORMATION INFRASTRUCTURE"
.S X=X_HLCS_"VA TS"
.S ^TMP("XUMF MFS",$J,"PARAM","WDDC")=X
;
;What Data Code Value Qual (optional)
I '$D(^TMP("XUMF MFS",$J,"PARAM","WDCVQ")) D
.S ^TMP("XUMF MFS",$J,"PARAM","WDCVQ")=""
;
;Query Results Level (optional)
I '$D(^TMP("XUMF MFS",$J,"PARAM","QRL")) D
.S ^TMP("XUMF MFS",$J,"PARAM","QRL")=""
;
Q
;
PRE ; -- pre-update record
;
Q
;
POST ; -- post-update record
;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUMFP512 4697 printed Nov 22, 2024@17:21:07 Page 2
XUMFP512 ;ALB/BRM - Master File Param POSTAL CODE ; 10/17/02 2:36pm
+1 ;;8.0;KERNEL;**246**;Jul 10, 1995
+2 ;
+3 ;
+4 ; This routine sets up the parameters required by the POSTAL CODE
+5 ; (#5.12) file for the Master File server mechanism.
+6 ;
+7 ; ** This routine is not a supported interface -- use XUMFP **
+8 ;
+9 ; See XUMFP for parameter list documentation
+10 ;
+11 NEW PKV,PROTOCOL,HLFS,HLCS,RT,RF
+12 ;
+13 SET PARAM("PRE")="PRE^XUMFP512"
+14 SET PARAM("POST")="POST^XUMFP512"
+15 SET TYPE=0
+16 ;
+17 IF $ORDER(HL(""))=""
Begin DoDot:1
+18 if UPDATE
SET PROTOCOL=$ORDER(^ORD(101,"B","XUMF MFN",0))
+19 if QUERY
SET PROTOCOL=$ORDER(^ORD(101,"B","XUMF MFQ",0))
+20 if 'PROTOCOL
SET ERROR="1^invalid protocol"
if ERROR
QUIT
+21 SET ^TMP("XUMF MFS",$JOB,"PARAM","PROTOCOL")=PROTOCOL
+22 DO INIT^HLFNC2(PROTOCOL,.HL)
End DoDot:1
+23 ;
+24 IF $ORDER(HL(""))=""
SET ERROR="1^"_$PIECE(HL,U,2)
QUIT
+25 SET HLFS=HL("FS")
SET HLCS=$EXTRACT(HL("ECH"))
+26 ;
+27 IF QUERY
DO QRD
+28 ;
+29 ; MFI -- Master File Identification Segment
+30 ;Master File Identifier
SET ^TMP("XUMF MFS",$JOB,"PARAM","MFI")="5P12"
+31 ;Application Identifier
SET ^TMP("XUMF MFS",$JOB,"PARAM","MFAI")=""
+32 ;File-Level Event Code
SET ^TMP("XUMF MFS",$JOB,"PARAM","FLEC")="UPD"
+33 ;Entered Date/Time
SET ^TMP("XUMF MFS",$JOB,"PARAM","ENDT")=""
+34 ;Effective Date/Time
SET ^TMP("XUMF MFS",$JOB,"PARAM","MFIEDT")=""
+35 ;Response Level Code
SET ^TMP("XUMF MFS",$JOB,"PARAM","RLC")="NE"
+36 ;
+37 ; MFE -- Master File Entry
+38 ;Record-Level Event Code
IF $GET(^TMP("XUMF MFS",$JOB,"PARAM","RLEC"))=""
Begin DoDot:1
+39 SET ^TMP("XUMF MFS",$JOB,"PARAM","RLEC")="UPD"
End DoDot:1
+40 ;MFN Control ID
SET ^TMP("XUMF MFS",$JOB,"PARAM","MFNCID")=""
+41 ;Effective Date/Time
IF $GET(^TMP("XUMF MFS",$JOB,"PARAM","MFEEDT"))=""
Begin DoDot:1
+42 SET ^TMP("XUMF MFS",$JOB,"PARAM","MFEEDT")=$$HLDATE^HLFNC($$NOW^XLFDT)
End DoDot:1
+43 ;
SEG ; -- LOC segment used for Postal Code File updates
+1 ;
+2 IF IEN
Begin DoDot:1
+3 SET PKV=$PIECE($GET(^XIP(5.12,+IEN,0)),U)
+4 ; Primary Key Value
SET ^TMP("XUMF MFS",$JOB,"PARAM","PKV")=PKV
End DoDot:1
+5 IF NEW
Begin DoDot:1
+6 SET PKV="NEW"
+7 ; Primary Key Value
SET ^TMP("XUMF MFS",$JOB,"PARAM","PKV")=PKV
End DoDot:1
+8 ;
+9 ; LOC -- Location Identification Segment sequence
+10 SET ^TMP("XUMF MFS",$JOB,"PARAM","SEGMENT")="LOC"
+11 ; primary key value
+12 SET ^TMP("XUMF MFS",$JOB,"PARAM","SEG","LOC","SEQ",1,.01)="PL"
+13 ; location address (contains components utilizing XAD)
+14 ; the components are recognized by decimal SEQ values
+15 ;city
SET ^TMP("XUMF MFS",$JOB,"PARAM","SEG","LOC","SEQ",5.3,1)="ST"
+16 ;state
SET ^TMP("XUMF MFS",$JOB,"PARAM","SEG","LOC","SEQ",5.4,3)="ZST"
+17 ;p code
SET ^TMP("XUMF MFS",$JOB,"PARAM","SEG","LOC","SEQ",5.5,.01)="ST"
+18 ;county
SET ^TMP("XUMF MFS",$JOB,"PARAM","SEG","LOC","SEQ",5.9,2)="ST"
+19 ;inactive date
SET ^TMP("XUMF MFS",$JOB,"PARAM","SEG","LOC","SEQ",5.12,"HLSCS",2,4)="DT"
+20 ;
+21 if 'GROUP
QUIT
+22 if $GET(HL("MTN"))="MFR"
QUIT
+23 ;
GROUP ; -- query group
+1 ;
+2 SET IEN=0
+3 FOR
SET IEN=$ORDER(^TMP("XUMF MFS",$JOB,"PARAM","IENS",IEN))
if 'IEN
QUIT
Begin DoDot:1
+4 SET PKV=$PIECE(^XIP(5.12,IEN,0),U)
+5 SET ^TMP("XUMF MFS",$JOB,"PARAM",IEN,"PKV")=PKV
End DoDot:1
+6 ;
+7 QUIT
+8 ;
QRD ; -- query definition segment
+1 ;
+2 ;Query Date/Time
+3 IF '$DATA(^TMP("XUMF MFS",$JOB,"PARAM","QDT"))
Begin DoDot:1
+4 SET ^TMP("XUMF MFS",$JOB,"PARAM","QDT")=$$HLDATE^HLFNC($$NOW^XLFDT)
End DoDot:1
+5 ;
+6 ;Query Format Code
+7 IF '$DATA(^TMP("XUMF MFS",$JOB,"PARAM","QFC"))
Begin DoDot:1
+8 SET ^TMP("XUMF MFS",$JOB,"PARAM","QFC")="R"
End DoDot:1
+9 ;
+10 ;Query Priority
+11 IF '$DATA(^TMP("XUMF MFS",$JOB,"PARAM","QP"))
Begin DoDot:1
+12 SET ^TMP("XUMF MFS",$JOB,"PARAM","QP")="I"
End DoDot:1
+13 ;
+14 ;Query ID
+15 IF '$DATA(^TMP("XUMF MFS",$JOB,"PARAM","QID"))
Begin DoDot:1
+16 SET ^TMP("XUMF MFS",$JOB,"PARAM","QID")="5P12 "_$SELECT(ARRAY:"ARRAY",1:"FILE")
End DoDot:1
+17 ;
+18 ;Deferred Response Type (optional)
+19 IF '$DATA(^TMP("XUMF MFS",$JOB,"PARAM","DRT"))
Begin DoDot:1
+20 SET ^TMP("XUMF MFS",$JOB,"PARAM","DRT")=""
End DoDot:1
+21 ;
+22 ;Deferred Response Date/Time (optional)
+23 IF '$DATA(^TMP("XUMF MFS",$JOB,"PARAM","DRDT"))
Begin DoDot:1
+24 SET ^TMP("XUMF MFS",$JOB,"PARAM","DRDT")=""
End DoDot:1
+25 ;
+26 ;Quantity Limited Request
+27 IF '$DATA(^TMP("XUMF MFS",$JOB,"PARAM","QLR"))
Begin DoDot:1
+28 SET ^TMP("XUMF MFS",$JOB,"PARAM","QLR")="RD"_HLCS_999
End DoDot:1
+29 ;
+30 ;Who Subject Filter - sta#, D x-ref, assigning facility
+31 IF '$DATA(^TMP("XUMF MFS",$JOB,"PARAM","WHO"))
Begin DoDot:1
+32 NEW X
SET X=$SELECT(ALL:"ALL",IEN:$PIECE($GET(^XIP(5.12,+IEN,0)),U),1:"IEN ARRAY")
+33 SET $PIECE(X,HLCS,9,10)="B"_HLCS_"VA"
+34 SET ^TMP("XUMF MFS",$JOB,"PARAM","WHO")=X
End DoDot:1
+35 ;
+36 ;What Subject Filter
+37 IF '$DATA(^TMP("XUMF MFS",$JOB,"PARAM","WHAT"))
Begin DoDot:1
+38 SET ^TMP("XUMF MFS",$JOB,"PARAM","WHAT")="5.12"_HLCS_"IFN"_HLCS_"VA FM"
End DoDot:1
+39 ;
+40 ;What Department Data Code
+41 IF '$DATA(^TMP("XUMF MFS",$JOB,"PARAM","WDDC"))
Begin DoDot:1
+42 NEW X
SET X="INFRASTRUCTURE"_HLCS_"INFORMATION INFRASTRUCTURE"
+43 SET X=X_HLCS_"VA TS"
+44 SET ^TMP("XUMF MFS",$JOB,"PARAM","WDDC")=X
End DoDot:1
+45 ;
+46 ;What Data Code Value Qual (optional)
+47 IF '$DATA(^TMP("XUMF MFS",$JOB,"PARAM","WDCVQ"))
Begin DoDot:1
+48 SET ^TMP("XUMF MFS",$JOB,"PARAM","WDCVQ")=""
End DoDot:1
+49 ;
+50 ;Query Results Level (optional)
+51 IF '$DATA(^TMP("XUMF MFS",$JOB,"PARAM","QRL"))
Begin DoDot:1
+52 SET ^TMP("XUMF MFS",$JOB,"PARAM","QRL")=""
End DoDot:1
+53 ;
+54 QUIT
+55 ;
PRE ; -- pre-update record
+1 ;
+2 QUIT
+3 ;
POST ; -- post-update record
+1 ;
+2 QUIT
+3 ;
