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/XUMFXP1.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: 3.8 KB
Line 
1XUMFXP1 ;ISS/RAM - MFS parameters ;06/28/00
2 ;;8.0;KERNEL;**299**;Jul 10, 1995
3 ;
4 ;
5 ; This routine sets up the parameters required by the
6 ; Master File server mechanism.
7 ;
8 ; ** This routine is not a supported interface -- use XUMFXP **
9 ;
10 ; See XUMFXP for parameter list documentation
11 ;
12 Q
13 ;
14MAIN ; -- main
15 ;
16 N PKV,HLFS,HLCS,RT,RF,SEQ,PRE,POST,LKUP,RDF,NUM,HLREP,IDX,XXX,YYY,X,Y
17 ;
18 I 'PROTOCOL D
19 .;S:UPDATE PROTOCOL=$$FIND1^DIC(101,,"B","DS Pub Man~~L")
20 .S:UPDATE PROTOCOL=$$FIND1^DIC(101,,"B","XUMFX SERVER")
21 .S:QUERY PROTOCOL=$$FIND1^DIC(101,,"B","XUMF MFQ")
22 S:'PROTOCOL ERROR="1^invalid protocol" Q:ERROR
23 S ^TMP("XUMF MFS",$J,"PARAM","PROTOCOL")=PROTOCOL
24 ;
25 I $O(HL(""))="" D
26 .D INIT^HLFNC2(PROTOCOL,.HL)
27 I $O(HL(""))="" S ERROR="1^"_$P(HL,U,2) Q
28 S HLFS=HL("FS"),HLCS=$E(HL("ECH")),HLREP=$E(HL("ECH"),2)
29 ;
30 Q:$G(MFK)
31 ;
32 I QUERY D QRD^XUMFXP2
33 ;
34 ; MFI -- Master File Identification
35 ;
36 ;Master File Identifier
37 ;S ^TMP("XUMF MFS",$J,"PARAM","MFI")=$P($G(^DIC(4.001,+IFN,0)),U,3)
38 S ^TMP("XUMF MFS",$J,"PARAM","MFI")=+IFN
39 ;Application Identifier
40 S ^TMP("XUMF MFS",$J,"PARAM","MFAI")=$G(^TMP("XUMF MFS",$J,"PARAM","MFAI"))
41 ;File-Level Event Code
42 S ^TMP("XUMF MFS",$J,"PARAM","FLEC")="UPD"
43 ;Entered Data/Time
44 S ^TMP("XUMF MFS",$J,"PARAM","ENDT")=""
45 ;Effective Date/Time
46 S ^TMP("XUMF MFS",$J,"PARAM","MFIEDT")=""
47 ;Response Level Code
48 S ^TMP("XUMF MFS",$J,"PARAM","RLC")="NE"
49 ;
50 ; MFE -- Master File Entry
51 ;
52 ;Record-Level Event Code
53 I $G(^TMP("XUMF MFS",$J,"PARAM","RLEC"))="" D
54 .S ^TMP("XUMF MFS",$J,"PARAM","RLEC")="MUP"
55 ;MFN Control ID
56 S ^TMP("XUMF MFS",$J,"PARAM","MFNCID")=""
57 ;Effective Date/Time
58 I $G(^TMP("XUMF MFS",$J,"PARAM","MFEEDT"))="" D
59 .S ^TMP("XUMF MFS",$J,"PARAM","MFEEDT")=$$HLDATE^HLFNC($$NOW^XLFDT)
60 ;
61SEG ; -- data segment
62 ;
63 ;FOR MULTIPLE FIELDS
64 ;
65 ; MKEY is defined only when .01 is not passed in HL7 segment
66 ; but is some constant string (like VISN in INSTITUTION assoc mult).
67 ; MKEY and MULT evaluate FALSE.
68 ;
69 ; MULT is set to field number # for SEQ. SEQ=.01 set to itself.
70 ; MULT set to .01 field #. MULT is TRUE. MKEY undefined.
71 ;
72 I IEN D
73 .S PKV=$$PKV^XUMFX(IFN,IEN,HLCS)
74 .S ^TMP("XUMF MFS",$J,"PARAM","PKV")=PKV
75 I NEW D
76 .S PKV=$$PKV^XUMFX(IFN,"NEW",HLCS)
77 .S ^TMP("XUMF MFS",$J,"PARAM","PKV")=PKV
78 ;
79 S (IDX,SEQ,NUM,CNT)=0,RDF(0)=""
80 F S IDX=$O(^DIC(4.001,IFN,1,IDX)) Q:'IDX D
81 .S Y=$G(^DIC(4.001,+IFN,1,IDX,0))
82 .;
83 .N FLD,TYP,SUBFILE,COLUMN,WIDTH
84 .S COLUMN=$P(Y,U),WIDTH=$P(Y,U,9),NUM=NUM+1,SEQ=SEQ+1
85 .S FLD=$P(Y,U,2),SUBFILE=$P(Y,U,4),LKUP=$P(Y,U,7)
86 .S TYP=$P(Y,U,3),TYP=$$GET1^DIQ(771.4,(+TYP_","),.01)
87 .S YYY(COLUMN,SEQ)=""
88 .;
89 .I $L(RDF(CNT)_(COLUMN_HLCS_TYP_HLCS_WIDTH_HLREP))>200 D
90 ..S CNT=CNT+1,RDF(CNT)=""
91 .S RDF(CNT)=RDF(CNT)_COLUMN_HLCS_TYP_HLCS_WIDTH_HLREP
92 .;
93 .I 'SUBFILE D Q
94 ..S ^TMP("XUMF MFS",$J,"PARAM","SEQ",SEQ,FLD)=TYP_U_LKUP
95 .;
96 .; -- multiple
97 .;
98 .I $P(Y,U,6)'="" D ;.01 is a field
99 ..;S ^TMP("XUMF MFS",$J,"PARAM","MULT",SEQ)=$P(Y,U,6)
100 ..S XXX(SEQ)=$P(Y,U,6)
101 .I $P(Y,U,6)="" D ;.01 is lkup on MKEY literal
102 ..S ^TMP("XUMF MFS",$J,"PARAM","MULT",SEQ)=""
103 ..S ^TMP("XUMF MFS",$J,"PARAM","MKEY",SEQ)=$P(Y,U,5)
104 .;
105 .N LKUP,FUNC
106 .S LKUP=$P(Y,U,7),FUNC=$P(Y,U,8)
107 .S ^TMP("XUMF MFS",$J,"PARAM","SEQ",SEQ,"FILE")=SUBFILE
108 .S ^TMP("XUMF MFS",$J,"PARAM","SEQ",SEQ,"FIELD")=FLD
109 .S ^TMP("XUMF MFS",$J,"PARAM","SEQ",SEQ,"DTYP")=TYP
110 .S ^TMP("XUMF MFS",$J,"PARAM","SEQ",SEQ,"LKUP")=LKUP
111 .Q:'IEN
112 .I 'FUNC,FUNC'="" D
113 ..I FUNC'["(" S FUNC="$$"_FUNC_"^XUMFF" Q
114 ..S FUNC="$$"_$P(FUNC,"(")_"^XUMFF("_$P(FUNC,"(",2)
115 .S X="S X="_FUNC X:X["$$" X
116 .Q:'X
117 .S ^TMP("XUMF MFS",$J,"PARAM","IENS",SEQ)=X_","_IEN_","
118 ;
119 S SEQ=0
120 F S SEQ=$O(XXX(SEQ)) Q:'SEQ D
121 .S X=XXX(SEQ),Y=$O(YYY(X,0))
122 .S ^TMP("XUMF MFS",$J,"PARAM","MULT",SEQ)=Y
123 ;
124 S RDF="RDF"_HLFS_NUM_HLFS_RDF(0) K RDF(0)
125 M ^TMP("XUMF MFS",$J,"PARAM","RDF")=RDF
126 ;
127GROUP ; -- query group
128 ;
129 D GROUP^XUMFXP2
130 ;
131 Q
132 ;
133 ;
Note: See TracBrowser for help on using the repository browser.