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/XUMFXP2.m@ 1766

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

initial load of WorldVistAEHR

File size: 2.9 KB
Line 
1XUMFXP2 ;ISS/RAM - MFS parameters query/group ;06/28/00
2 ;;8.0;KERNEL;**299**;Jul 10, 1995
3 ;
4 ; this routine is a called by XUMFXP1 and is a continuation of that
5 ; routine
6 ;
7 Q
8 ;
9MAIN ; -- main
10 ;
11 N X
12 ;
13QRD ; -- query definition segment
14 ;
15 ;Query Date/Time
16 I '$D(^TMP("XUMF MFS",$J,"PARAM","QDT")) D
17 .S ^TMP("XUMF MFS",$J,"PARAM","QDT")=$$HLDATE^HLFNC($$NOW^XLFDT)
18 ;
19 ;Query Format Code
20 I '$D(^TMP("XUMF MFS",$J,"PARAM","QFC")) D
21 .S ^TMP("XUMF MFS",$J,"PARAM","QFC")="R"
22 ;
23 ;Query Priority
24 I '$D(^TMP("XUMF MFS",$J,"PARAM","QP")) D
25 .S ^TMP("XUMF MFS",$J,"PARAM","QP")="I"
26 ;
27 ;Query ID
28 I '$D(^TMP("XUMF MFS",$J,"PARAM","QID")) D
29 .S X=$P($G(^DIC(4.001,+IFN,0)),U,3)
30 .S ^TMP("XUMF MFS",$J,"PARAM","QID")=X_$S(ARRAY:" ARRAY",1:" FILE")
31 ;
32 ;Deferred Response Type (optional)
33 I '$D(^TMP("XUMF MFS",$J,"PARAM","DRT")) D
34 .S ^TMP("XUMF MFS",$J,"PARAM","DRT")=""
35 ;
36 ;Deferred Response Date/Time (optional)
37 I '$D(^TMP("XUMF MFS",$J,"PARAM","DRDT")) D
38 .S ^TMP("XUMF MFS",$J,"PARAM","DRDT")=""
39 ;
40 ;Quantity Limited Request
41 I '$D(^TMP("XUMF MFS",$J,"PARAM","QLR")) D
42 .S ^TMP("XUMF MFS",$J,"PARAM","QLR")="RD"_HLCS_999
43 ;
44 ;Who Subject Filter - ID, source table (use x-ref), assigning authority
45 I '$D(^TMP("XUMF MFS",$J,"PARAM","WHO")) D
46 .N PKV,XREF,AA
47 .S PKV=$$PKV^XUMFX(IFN,IEN,HLCS)
48 .S XREF=$P($G(^DIC(4.001,+IFN,"MFE")),U,8)
49 .S AA=$P($G(^DIC(4.001,+IFN,"MFE")),U,9)
50 .N X S X=$S(ALL:"ALL",IEN:$P(PKV,HLCS),1:"IEN ARRAY")
51 .S $P(X,HLCS,9,10)=XREF_HLCS_AA
52 .S ^TMP("XUMF MFS",$J,"PARAM","WHO")=X
53 ;
54 ;What Subject Filter
55 I '$D(^TMP("XUMF MFS",$J,"PARAM","WHAT")) D
56 .S ^TMP("XUMF MFS",$J,"PARAM","WHAT")=IFN_HLCS_"IFN"_HLCS_"VA FM"
57 ;
58 ;What Department Data Code
59 I '$D(^TMP("XUMF MFS",$J,"PARAM","WDDC")) D
60 .N X S X="INFRASTRUCTURE"_HLCS_"INFORMATION INFRASTRUCTURE"
61 .S X=X_HLCS_"VA TS"
62 .S ^TMP("XUMF MFS",$J,"PARAM","WDDC")=X
63 ;
64 ;What Data Code Value Qual (optional)
65 I '$D(^TMP("XUMF MFS",$J,"PARAM","WDCVQ")) D
66 .S ^TMP("XUMF MFS",$J,"PARAM","WDCVQ")=""
67 ;
68 ;Query Results Level (optional)
69 I '$D(^TMP("XUMF MFS",$J,"PARAM","QRL")) D
70 .S ^TMP("XUMF MFS",$J,"PARAM","QRL")=""
71 ;
72 Q
73 ;
74GROUP ; -- query group
75 ;
76 N XXX,IDX,SEQ
77 ;
78 S (IDX,SEQ)=0
79 F S IDX=$O(^DIC(4.001,IFN,1,IDX)) Q:'IDX D
80 .S SEQ=SEQ+1
81 .N FUNC,SUBFILE,X,Y
82 .S Y=$G(^DIC(4.001,+IFN,1,+IDX,0))
83 .S SUBFILE=$P(Y,U,4)
84 .Q:'SUBFILE
85 .S FUNC=$P(Y,U,8)
86 .I 'FUNC,FUNC'="" D
87 ..I FUNC'["(" S FUNC="$$"_FUNC_"^XUMFF" Q
88 ..S FUNC="$$"_$P(FUNC,"(")_"^XUMFF("_$P(FUNC,"(",2)
89 ..S XXX(SEQ)=FUNC
90 ;
91 S IEN=0
92 F S IEN=$O(^TMP("XUMF MFS",$J,"PARAM","IEN",IEN)) Q:'IEN D
93 .S PKV=$$PKV^XUMFX(IFN,IEN,HLCS)
94 .I CDSYS'="" D
95 ..S $P(PKV,HLCS,1)=^TMP("XUMF MFS",$J,"PARAM","IEN",IEN)
96 ..S $P(PKV,HLCS,2)=$P($G(@ROOT@(+IEN,0)),U)
97 ..S $P(PKV,HLCS,3)=CDSYS
98 .S ^TMP("XUMF MFS",$J,"PARAM",IEN,"PKV")=PKV
99 .;
100 .S SEQ=0
101 .F S SEQ=$O(XXX(SEQ)) Q:'SEQ D
102 ..S FUNC=XXX(SEQ)
103 ..S X="S X="_FUNC X X
104 ..Q:'X
105 ..S ^TMP("XUMF MFS",$J,"PARAM",IEN,"IENS",SEQ)=X_","_IEN_","
106 ;
107 Q
108 ;
Note: See TracBrowser for help on using the repository browser.