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/XUMFP513.m@ 701

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

initial load of WorldVistAEHR

File size: 4.4 KB
Line 
1XUMFP513 ;ALB/BRM - Master File Param COUNTY CODE ; 10/29/02 9:52am
2 ;;8.0;KERNEL;**246**;Jul 10, 1995
3 ;
4 ;
5 ; This routine sets up the parameters required by the COUNTY CODE
6 ; (#5.13) file for the Master File server mechanism.
7 ;
8 ; ** This routine is not a supported interface -- use XUMFP **
9 ;
10 ; See XUMFP for parameter list documentation
11 ;
12 N PKV,PROTOCOL,HLFS,HLCS,RT,RF
13 ;
14 S PARAM("PRE")="PRE^XUMFP513"
15 S PARAM("POST")="POST^XUMFP513"
16 S TYPE=0
17 ;
18 I $O(HL(""))="" D
19 .S:UPDATE PROTOCOL=$O(^ORD(101,"B","XUMF MFN",0))
20 .S:QUERY PROTOCOL=$O(^ORD(101,"B","XUMF MFQ",0))
21 .S:'PROTOCOL ERROR="1^invalid protocol" Q:ERROR
22 .S ^TMP("XUMF MFS",$J,"PARAM","PROTOCOL")=PROTOCOL
23 .D INIT^HLFNC2(PROTOCOL,.HL)
24 ;
25 I $O(HL(""))="" S ERROR="1^"_$P(HL,U,2) Q
26 S HLFS=HL("FS"),HLCS=$E(HL("ECH"))
27 ;
28 I QUERY D QRD
29 ;
30 ; MFI -- Master File Identification Segment
31 S ^TMP("XUMF MFS",$J,"PARAM","MFI")="5P13" ;Master File Identifier
32 S ^TMP("XUMF MFS",$J,"PARAM","MFAI")="" ;Application Identifier
33 S ^TMP("XUMF MFS",$J,"PARAM","FLEC")="UPD" ;File-Level Event Code
34 S ^TMP("XUMF MFS",$J,"PARAM","ENDT")="" ;Entered Date/Time
35 S ^TMP("XUMF MFS",$J,"PARAM","MFIEDT")="" ;Effective Date/Time
36 S ^TMP("XUMF MFS",$J,"PARAM","RLC")="NE" ;Response Level Code
37 ;
38 ; MFE -- Master File Entry
39 I $G(^TMP("XUMF MFS",$J,"PARAM","RLEC"))="" D ;Record-Level Event Code
40 .S ^TMP("XUMF MFS",$J,"PARAM","RLEC")="UPD"
41 S ^TMP("XUMF MFS",$J,"PARAM","MFNCID")="" ;MFN Control ID
42 I $G(^TMP("XUMF MFS",$J,"PARAM","MFEEDT"))="" D ;Effective Date/Time
43 .S ^TMP("XUMF MFS",$J,"PARAM","MFEEDT")=$$HLDATE^HLFNC($$NOW^XLFDT)
44 ;
45SEG ; -- LOC segment used for County Code File updates
46 ;
47 I IEN D
48 .S PKV=$P($G(^XIP(5.13,+IEN,0)),U)
49 .S ^TMP("XUMF MFS",$J,"PARAM","PKV")=PKV ; Primary Key Value
50 I NEW D
51 .S PKV="NEW"
52 .S ^TMP("XUMF MFS",$J,"PARAM","PKV")=PKV ; Primary Key Value
53 ;
54 ; LOC -- Location Identification Segment sequence
55 S ^TMP("XUMF MFS",$J,"PARAM","SEGMENT")="LOC"
56 ; primary key value
57 S ^TMP("XUMF MFS",$J,"PARAM","SEG","LOC","SEQ",1,.01)="PL"
58 ; location address (contains components utilizing XAD)
59 ; components and subcomponents are recognized by decimal SEQ values
60 S ^TMP("XUMF MFS",$J,"PARAM","SEG","LOC","SEQ",5.4,2)="ZST" ;state
61 S ^TMP("XUMF MFS",$J,"PARAM","SEG","LOC","SEQ",5.8,1)="ST" ;county
62 S ^TMP("XUMF MFS",$J,"PARAM","SEG","LOC","SEQ",5.9,.01)="ST" ;FIPS
63 S ^TMP("XUMF MFS",$J,"PARAM","SEG","LOC","SEQ",5.12,"HLSCS",2,3)="DT" ;inactive date
64 ;
65 Q:'GROUP
66 Q:$G(HL("MTN"))="MFR"
67 ;
68GROUP ; -- query group
69 ;
70 S IEN=0
71 F S IEN=$O(^TMP("XUMF MFS",$J,"PARAM","IENS",IEN)) Q:'IEN D
72 .S PKV=$P(^XIP(5.13,IEN,0),U)
73 .S ^TMP("XUMF MFS",$J,"PARAM",IEN,"PKV")=PKV
74 ;
75 Q
76 ;
77QRD ; -- query definition segment
78 ;
79 ;Query Date/Time
80 I '$D(^TMP("XUMF MFS",$J,"PARAM","QDT")) D
81 .S ^TMP("XUMF MFS",$J,"PARAM","QDT")=$$HLDATE^HLFNC($$NOW^XLFDT)
82 ;
83 ;Query Format Code
84 I '$D(^TMP("XUMF MFS",$J,"PARAM","QFC")) D
85 .S ^TMP("XUMF MFS",$J,"PARAM","QFC")="R"
86 ;
87 ;Query Priority
88 I '$D(^TMP("XUMF MFS",$J,"PARAM","QP")) D
89 .S ^TMP("XUMF MFS",$J,"PARAM","QP")="I"
90 ;
91 ;Query ID
92 I '$D(^TMP("XUMF MFS",$J,"PARAM","QID")) D
93 .S ^TMP("XUMF MFS",$J,"PARAM","QID")="5P13 "_$S(ARRAY:"ARRAY",1:"FILE")
94 ;
95 ;Deferred Response Type (optional)
96 I '$D(^TMP("XUMF MFS",$J,"PARAM","DRT")) D
97 .S ^TMP("XUMF MFS",$J,"PARAM","DRT")=""
98 ;
99 ;Deferred Response Date/Time (optional)
100 I '$D(^TMP("XUMF MFS",$J,"PARAM","DRDT")) D
101 .S ^TMP("XUMF MFS",$J,"PARAM","DRDT")=""
102 ;
103 ;Quantity Limited Request
104 I '$D(^TMP("XUMF MFS",$J,"PARAM","QLR")) D
105 .S ^TMP("XUMF MFS",$J,"PARAM","QLR")="RD"_HLCS_999
106 ;
107 ;Who Subject Filter - sta#, D x-ref, assigning facility
108 I '$D(^TMP("XUMF MFS",$J,"PARAM","WHO")) D
109 .N X S X=$S(ALL:"ALL",IEN:$P($G(^XIP(5.13,+IEN,0)),U),1:"IEN ARRAY")
110 .S $P(X,HLCS,9,10)="B"_HLCS_"VA"
111 .S ^TMP("XUMF MFS",$J,"PARAM","WHO")=X
112 ;
113 ;What Subject Filter
114 I '$D(^TMP("XUMF MFS",$J,"PARAM","WHAT")) D
115 .S ^TMP("XUMF MFS",$J,"PARAM","WHAT")="5.13"_HLCS_"IFN"_HLCS_"VA FM"
116 ;
117 ;What Department Data Code
118 I '$D(^TMP("XUMF MFS",$J,"PARAM","WDDC")) D
119 .N X S X="INFRASTRUCTURE"_HLCS_"INFORMATION INFRASTRUCTURE"
120 .S X=X_HLCS_"VA TS"
121 .S ^TMP("XUMF MFS",$J,"PARAM","WDDC")=X
122 ;
123 ;What Data Code Value Qual (optional)
124 I '$D(^TMP("XUMF MFS",$J,"PARAM","WDCVQ")) D
125 .S ^TMP("XUMF MFS",$J,"PARAM","WDCVQ")=""
126 ;
127 ;Query Results Level (optional)
128 I '$D(^TMP("XUMF MFS",$J,"PARAM","QRL")) D
129 .S ^TMP("XUMF MFS",$J,"PARAM","QRL")=""
130 ;
131 Q
132 ;
133PRE ; -- pre-update record
134 ;
135 Q
136 ;
137POST ; -- post-update record
138 ;
139 Q
140 ;
Note: See TracBrowser for help on using the repository browser.