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/XUMFPFT.m@ 1800

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

initial load of WorldVistAEHR
File size: 4.2 KB
Line 
1XUMFPFT ;CIOFO-SF/RAM - Master File Param FACILITY TYPE ;06/28/00
2 ;;8.0;KERNEL;**206,217**;Jul 10, 1995
3 ;
4 ; This routine sets up the parameters required by the FACILITY TYPE
5 ; (#4) 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 N PKV,PROTOCOL,HLFS,HLCS,RT,RF
12 ;
13 S PARAM("PRE")="PRE^XUMFPFT"
14 S PARAM("POST")="POST^XUMFPFT"
15 ;
16 I $O(HL(""))="" D
17 .S:UPDATE PROTOCOL=$O(^ORD(101,"B","XUMF MFN",0))
18 .S:QUERY PROTOCOL=$O(^ORD(101,"B","XUMF MFQ",0))
19 .S:'PROTOCOL ERROR="1^invalid protocol" Q:ERROR
20 .S ^TMP("XUMF MFS",$J,"PARAM","PROTOCOL")=PROTOCOL
21 .D INIT^HLFNC2(PROTOCOL,.HL)
22 ;
23 I $O(HL(""))="" S ERROR="1^"_$P(HL,U,2) Q
24 S HLFS=HL("FS"),HLCS=$E(HL("ECH"))
25 ;
26 I QUERY D QRD
27 ;
28 ; MFI -- Master File Identification Segment
29 S ^TMP("XUMF MFS",$J,"PARAM","MFI")="Z4T" ;Master File Identifier
30 S ^TMP("XUMF MFS",$J,"PARAM","MFAI")="" ;Application Identifier
31 S ^TMP("XUMF MFS",$J,"PARAM","FLEC")="UPD" ;File-Level Event Code
32 S ^TMP("XUMF MFS",$J,"PARAM","ENDT")="" ;Entered Data/Time
33 S ^TMP("XUMF MFS",$J,"PARAM","MFIEDT")="" ;Effective Date/Time
34 S ^TMP("XUMF MFS",$J,"PARAM","RLC")="NE" ;Response Level Code
35 ;
36 ; MFE -- Master File Entry
37 I $G(^TMP("XUMF MFS",$J,"PARAM","RLEC"))="" D ;Record-Level Event Code
38 .S ^TMP("XUMF MFS",$J,"PARAM","RLEC")="MUP"
39 S ^TMP("XUMF MFS",$J,"PARAM","MFNCID")="" ;MFN Control ID
40 I $G(^TMP("XUMF MFS",$J,"PARAM","MFEEDT"))="" D ;Effective Date/Time
41 .S ^TMP("XUMF MFS",$J,"PARAM","MFEEDT")=$$HLDATE^HLFNC($$NOW^XLFDT)
42 ;
43SEG ; -- ZFT segment
44 ;
45 I IEN D
46 .S PKV=$P($G(^DIC(4.1,+IEN,0)),U)_HLCS_"FACILITY TYPE"_HLCS_"B"
47 .S ^TMP("XUMF MFS",$J,"PARAM","PKV")=PKV ; Primary Key Value
48 I NEW D
49 .S PKV="NEW"_HLCS_"FACILITY TYPE"_HLCS_"B"
50 .S ^TMP("XUMF MFS",$J,"PARAM","PKV")=PKV ; Primary Key Value
51 ;
52 ; ZFT -- VA Specific VHA Facility Type Segment sequence
53 S ^TMP("XUMF MFS",$J,"PARAM","SEGMENT")="ZFT"
54 S ^TMP("XUMF MFS",$J,"PARAM","SEG","ZFT","SEQ",1,.01)="ST" ;name
55 S ^TMP("XUMF MFS",$J,"PARAM","SEG","ZFT","SEQ",2,1)="ST" ;full name
56 S ^TMP("XUMF MFS",$J,"PARAM","SEG","ZFT","SEQ",3,2)="ST" ;title
57 S ^TMP("XUMF MFS",$J,"PARAM","SEG","ZFT","SEQ",4,3)="ST" ;status
58 ;
59 Q:'GROUP
60 Q:$G(HL("MTN"))="MFR"
61 ;
62GROUP ; -- query group
63 ;
64 S IEN=0
65 F S IEN=$O(^TMP("XUMF MFS",$J,"PARAM","IEN",IEN)) Q:'IEN D
66 .S PKV=$P(^DIC(4.1,IEN,0),U)_HLCS_"FACILITY TYPE"_HLCS_"B"
67 .S ^TMP("XUMF MFS",$J,"PARAM",IEN,"PKV")=PKV
68 ;
69 Q
70 ;
71QRD ; -- query definition segment
72 ;
73 ;Query Date/Time
74 I '$D(^TMP("XUMF MFS",$J,"PARAM","QDT")) D
75 .S ^TMP("XUMF MFS",$J,"PARAM","QDT")=$$HLDATE^HLFNC($$NOW^XLFDT)
76 ;
77 ;Query Format Code
78 I '$D(^TMP("XUMF MFS",$J,"PARAM","QFC")) D
79 .S ^TMP("XUMF MFS",$J,"PARAM","QFC")="R"
80 ;
81 ;Query Priority
82 I '$D(^TMP("XUMF MFS",$J,"PARAM","QP")) D
83 .S ^TMP("XUMF MFS",$J,"PARAM","QP")="I"
84 ;
85 ;Query ID
86 I '$D(^TMP("XUMF MFS",$J,"PARAM","QID")) D
87 .S ^TMP("XUMF MFS",$J,"PARAM","QID")="Z4T "_$S(ARRAY:"ARRAY",1:"FILE")
88 ;
89 ;Deferred Response Type (optional)
90 I '$D(^TMP("XUMF MFS",$J,"PARAM","DRT")) D
91 .S ^TMP("XUMF MFS",$J,"PARAM","DRT")=""
92 ;
93 ;Deferred Response Date/Time (optional)
94 I '$D(^TMP("XUMF MFS",$J,"PARAM","DRDT")) D
95 .S ^TMP("XUMF MFS",$J,"PARAM","DRDT")=""
96 ;
97 ;Quantity Limited Request
98 I '$D(^TMP("XUMF MFS",$J,"PARAM","QLR")) D
99 .S ^TMP("XUMF MFS",$J,"PARAM","QLR")="RD"_HLCS_999
100 ;
101 ;Who Subject Filter - sta#, D x-ref, assigning facility
102 I '$D(^TMP("XUMF MFS",$J,"PARAM","WHO")) D
103 .N X S X=$S(ALL:"ALL",IEN:$P($G(^DIC(4.1,+IEN,0)),U),1:"IEN ARRAY")
104 .S $P(X,HLCS,9,10)="B"_HLCS_"VA"
105 .S ^TMP("XUMF MFS",$J,"PARAM","WHO")=X
106 ;
107 ;What Subject Filter
108 I '$D(^TMP("XUMF MFS",$J,"PARAM","WHAT")) D
109 .S ^TMP("XUMF MFS",$J,"PARAM","WHAT")="4.1"_HLCS_"IFN"_HLCS_"VA FM"
110 ;
111 ;What Department Data Code
112 I '$D(^TMP("XUMF MFS",$J,"PARAM","WDDC")) D
113 .N X S X="INFRASTRUCTURE"_HLCS_"INFORMATION INFRASTRUCTURE"
114 .S X=X_HLCS_"VA TS"
115 .S ^TMP("XUMF MFS",$J,"PARAM","WDDC")=X
116 ;
117 ;What Data Code Value Qual (optional)
118 I '$D(^TMP("XUMF MFS",$J,"PARAM","WDCVQ")) D
119 .S ^TMP("XUMF MFS",$J,"PARAM","WDCVQ")=""
120 ;
121 ;Query Results Level (optional)
122 I '$D(^TMP("XUMF MFS",$J,"PARAM","QRL")) D
123 .S ^TMP("XUMF MFS",$J,"PARAM","QRL")=""
124 ;
125 Q
126 ;
127PRE ; -- pre-update record
128 ;
129 Q
130 ;
131POST ; -- post-update record
132 ;
133 Q
134 ;
Note: See TracBrowser for help on using the repository browser.