source: FOIAVistA/tag/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUMFPMFS.m@ 1796

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

initial load of FOIAVistA 6/30/08 version

File size: 4.4 KB
Line 
1XUMFPMFS ;CIOFO-SF/RAM - Master File Param GENERIC ;8/14/06
2 ;;8.0;KERNEL;**262,369**;Jul 10, 1995;Build 27
3 ;
4 ; This routine sets up the parameters required by the ZL7
5 ; 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 N PKV,PROTOCOL,HLFS,HLCS,RT,RF,TABLE,TABNAM
12 ;
13 D FILE^DID(IFN,"","NAME","X")
14 S TABNAM=$S($G(X("NAME"))'="":X("NAME"),1:"NOTAB") K X
15 ;
16 S PARAM("PRE")="PRE^XUMFPMFS"
17 S PARAM("POST")="POST^XUMFPMFS"
18 ;
19 I $O(HL(""))="" D
20 .S:UPDATE PROTOCOL=$O(^ORD(101,"B","XUMF MFN",0))
21 .S:QUERY PROTOCOL=$O(^ORD(101,"B","XUMF MFQ",0))
22 .S:'PROTOCOL ERROR="1^invalid protocol" Q:ERROR
23 .S ^TMP("XUMF MFS",$J,"PARAM","PROTOCOL")=PROTOCOL
24 .D INIT^HLFNC2(PROTOCOL,.HL)
25 ;
26 I $O(HL(""))="" S ERROR="1^"_$P(HL,U,2) Q
27 S HLFS=HL("FS"),HLCS=$E(HL("ECH"))
28 ;
29 D
30 .I IFN=4.11 S TABLE="ZAG" Q
31 .I IFN=5 S TABLE="Z05" Q
32 .I IFN=49 S TABLE="Z49" Q
33 .I IFN=9.8 S TABLE="ZRN" Q
34 .S TABLE="NOTAB" Q
35 ;
36 I QUERY D QRD
37 ;
38 ; MFI -- Master File Identification Segment
39 ;
40 S ^TMP("XUMF MFS",$J,"PARAM","MFI")=TABLE ;Master File Identifier
41 S ^TMP("XUMF MFS",$J,"PARAM","MFAI")="" ;Application Identifier
42 S ^TMP("XUMF MFS",$J,"PARAM","FLEC")="UPD" ;File-Level Event Code
43 S ^TMP("XUMF MFS",$J,"PARAM","ENDT")="" ;Entered Data/Time
44 S ^TMP("XUMF MFS",$J,"PARAM","MFIEDT")="" ;Effective Date/Time
45 S ^TMP("XUMF MFS",$J,"PARAM","RLC")="NE" ;Response Level Code
46 ;
47 ; MFE -- Master File Entry
48 I $G(^TMP("XUMF MFS",$J,"PARAM","RLEC"))="" D ;Record-Level Event Code
49 .S ^TMP("XUMF MFS",$J,"PARAM","RLEC")="MUP"
50 S ^TMP("XUMF MFS",$J,"PARAM","MFNCID")="" ;MFN Control ID
51 I $G(^TMP("XUMF MFS",$J,"PARAM","MFEEDT"))="" D ;Effective Date/Time
52 .S ^TMP("XUMF MFS",$J,"PARAM","MFEEDT")=$$HLDATE^HLFNC($$NOW^XLFDT)
53 ;
54SEG ; -- ZL7 segment
55 ;
56 I IEN D
57 .S PKV=$P($G(@ROOT@(+IEN,0)),U)_HLCS_TABNAM_HLCS_"B"
58 .S ^TMP("XUMF MFS",$J,"PARAM","PKV")=PKV ; Primary Key Value
59 I NEW D
60 .S PKV="NEW"_HLCS_TABNAM_HLCS_"B"
61 .S ^TMP("XUMF MFS",$J,"PARAM","PKV")=PKV ; Primary Key Value
62 ;
63 D @(TABLE_"^XUMFPZL7")
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","IEN",IEN)) Q:'IEN D
72 .S PKV=$P(@ROOT@(IEN,0),U)_HLCS_TABNAM_HLCS_"B"
73 .S ^TMP("XUMF MFS",$J,"PARAM",IEN,"PKV")=PKV
74 .I IFN=9.8 D
75 ..N X S X=$O(^DIC(9.8,IEN,8,0)) Q:'X
76 ..S ^TMP("XUMF MFS",$J,"PARAM",IEN,"IENS","ZL7",5)=X_","_IEN_","
77 ..S ^TMP("XUMF MFS",$J,"PARAM",IEN,"IENS","ZL7",6)=X_","_IEN_","
78 ..F S X=$O(^DIC(9.8,IEN,8,X)) Q:'X D
79 ...S ^TMP("XUMF MFS",$J,"PARAM",IEN,"ROUTINE",5,X)=X_","_IEN_","
80 ...S ^TMP("XUMF MFS",$J,"PARAM",IEN,"ROUTINE",6,X)=X_","_IEN_","
81 ;
82 Q
83 ;
84QRD ; -- query definition segment
85 ;
86 ;Query Date/Time
87 I '$D(^TMP("XUMF MFS",$J,"PARAM","QDT")) D
88 .S ^TMP("XUMF MFS",$J,"PARAM","QDT")=$$HLDATE^HLFNC($$NOW^XLFDT)
89 ;
90 ;Query Format Code
91 I '$D(^TMP("XUMF MFS",$J,"PARAM","QFC")) D
92 .S ^TMP("XUMF MFS",$J,"PARAM","QFC")="R"
93 ;
94 ;Query Priority
95 I '$D(^TMP("XUMF MFS",$J,"PARAM","QP")) D
96 .S ^TMP("XUMF MFS",$J,"PARAM","QP")="I"
97 ;
98 ;Query ID
99 I '$D(^TMP("XUMF MFS",$J,"PARAM","QID")) D
100 .S ^TMP("XUMF MFS",$J,"PARAM","QID")=TABLE_" "_$S(ARRAY:"ARRAY",1:"FILE")
101 ;
102 ;Deferred Response Type (optional)
103 I '$D(^TMP("XUMF MFS",$J,"PARAM","DRT")) D
104 .S ^TMP("XUMF MFS",$J,"PARAM","DRT")=""
105 ;
106 ;Deferred Response Date/Time (optional)
107 I '$D(^TMP("XUMF MFS",$J,"PARAM","DRDT")) D
108 .S ^TMP("XUMF MFS",$J,"PARAM","DRDT")=""
109 ;
110 ;Quantity Limited Request
111 I '$D(^TMP("XUMF MFS",$J,"PARAM","QLR")) D
112 .S ^TMP("XUMF MFS",$J,"PARAM","QLR")="RD"_HLCS_99999
113 ;
114 ;Who Subject Filter
115 I '$D(^TMP("XUMF MFS",$J,"PARAM","WHO")) D
116 .N X S X=$S(ALL:"ALL",IEN:$P($G(@ROOT@(+IEN,0)),U),1:"IEN ARRAY")
117 .S $P(X,HLCS,9,10)="B"_HLCS_"VA"
118 .S ^TMP("XUMF MFS",$J,"PARAM","WHO")=X
119 ;
120 ;What Subject Filter
121 I '$D(^TMP("XUMF MFS",$J,"PARAM","WHAT")) D
122 .S ^TMP("XUMF MFS",$J,"PARAM","WHAT")=IFN_HLCS_"IFN"_HLCS_"VA FM"
123 ;
124 ;What Department Data Code
125 I '$D(^TMP("XUMF MFS",$J,"PARAM","WDDC")) D
126 .N X S X="INFRASTRUCTURE"_HLCS_"INFORMATION INFRASTRUCTURE"
127 .S X=X_HLCS_"VA TS"
128 .S ^TMP("XUMF MFS",$J,"PARAM","WDDC")=X
129 ;
130 ;What Data Code Value Qual (optional)
131 I '$D(^TMP("XUMF MFS",$J,"PARAM","WDCVQ")) D
132 .S ^TMP("XUMF MFS",$J,"PARAM","WDCVQ")=""
133 ;
134 ;Query Results Level (optional)
135 I '$D(^TMP("XUMF MFS",$J,"PARAM","QRL")) D
136 .S ^TMP("XUMF MFS",$J,"PARAM","QRL")=""
137 ;
138 Q
139 ;
140PRE ; -- pre-update record
141 ;
142 Q
143 ;
144POST ; -- post-update record
145 ;
146 Q
147 ;
Note: See TracBrowser for help on using the repository browser.