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/XUMFP4C.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.3 KB
Line 
1XUMFP4C ;CIOFO-SF/RAM - Master File C/S Params INSTITUTION ;06/28/00
2 ;;8.0;KERNEL;**206,209,217,270,294,335,390,416**;Jul 10, 1995;Build 5
3 ;
4 ; this routine is a called by XUMFP4 and is a continuation of that
5 ; routine
6 ;
7QRD ; -- query definition segment
8 ;
9 ;Query Date/Time
10 I '$D(^TMP("XUMF MFS",$J,"PARAM","QDT")) D
11 .S ^TMP("XUMF MFS",$J,"PARAM","QDT")=$$HLDATE^HLFNC($$NOW^XLFDT)
12 ;
13 ;Query Format Code
14 I '$D(^TMP("XUMF MFS",$J,"PARAM","QFC")) D
15 .S ^TMP("XUMF MFS",$J,"PARAM","QFC")="R"
16 ;
17 ;Query Priority
18 I '$D(^TMP("XUMF MFS",$J,"PARAM","QP")) D
19 .S ^TMP("XUMF MFS",$J,"PARAM","QP")="I"
20 ;
21 ;Query ID
22 I '$D(^TMP("XUMF MFS",$J,"PARAM","QID")) D
23 .S ^TMP("XUMF MFS",$J,"PARAM","QID")="Z04 "_$S(ARRAY:"ARRAY",1:"FILE")
24 ;
25 ;Deferred Response Type (optional)
26 I '$D(^TMP("XUMF MFS",$J,"PARAM","DRT")) D
27 .S ^TMP("XUMF MFS",$J,"PARAM","DRT")=""
28 ;
29 ;Deferred Response Date/Time (optional)
30 I '$D(^TMP("XUMF MFS",$J,"PARAM","DRDT")) D
31 .S ^TMP("XUMF MFS",$J,"PARAM","DRDT")=""
32 ;
33 ;Quantity Limited Request
34 I '$D(^TMP("XUMF MFS",$J,"PARAM","QLR")) D
35 .S ^TMP("XUMF MFS",$J,"PARAM","QLR")="RD"_HLCS_999
36 ;
37 ;Who Subject Filter - sta#, D x-ref, assigning facility
38 I '$D(^TMP("XUMF MFS",$J,"PARAM","WHO")) D
39 .N X S X=$S(ALL:"ALL",IEN:$P($G(^DIC(4,+IEN,99)),U),1:"IEN ARRAY")
40 .S $P(X,HLCS,9,10)="D"_HLCS_"045A4"
41 .S:$G(CDSYS)'="" $P(X,HLCS,9,10)=CDSYS_HLCS_""
42 .S ^TMP("XUMF MFS",$J,"PARAM","WHO")=X
43 ;
44 ;What Subject Filter
45 I '$D(^TMP("XUMF MFS",$J,"PARAM","WHAT")) D
46 .S ^TMP("XUMF MFS",$J,"PARAM","WHAT")="4"_HLCS_"IFN"_HLCS_"VA FM"
47 ;
48 ;What Department Data Code
49 I '$D(^TMP("XUMF MFS",$J,"PARAM","WDDC")) D
50 .N X S X="INFRASTRUCTURE"_HLCS_"INFORMATION INFRASTRUCTURE"
51 .S X=X_HLCS_"VA TS"
52 .S ^TMP("XUMF MFS",$J,"PARAM","WDDC")=X
53 ;
54 ;What Data Code Value Qual (optional)
55 I '$D(^TMP("XUMF MFS",$J,"PARAM","WDCVQ")) D
56 .S ^TMP("XUMF MFS",$J,"PARAM","WDCVQ")=""
57 ;
58 ;Query Results Level (optional)
59 I '$D(^TMP("XUMF MFS",$J,"PARAM","QRL")) D
60 .S ^TMP("XUMF MFS",$J,"PARAM","QRL")=""
61 ;
62 Q
63 ;
64PRE ; -- pre-update record
65 ;
66 D PRE^XUMFR
67 ;
68 D IFF(IEN)
69 ;
70 Q
71 ;
72POST ; -- post-update record
73 ;
74 D POST^XUMFR
75 ;
76 Q
77 ;
78GROUP ; -- query group
79 ;
80 S IEN=0
81 F S IEN=$O(^TMP("XUMF MFS",$J,"PARAM","IEN",IEN)) Q:'IEN D
82 .I '$G(^DIC(4,IEN,99)) D
83 ..S PKV="NEW"_HLCS_"STATION NUMBER"_HLCS_"D"
84 .I $G(^DIC(4,IEN,99)) D
85 ..S PKV=$P(^DIC(4,IEN,99),U)_HLCS_"STATION NUMBER"_HLCS_"D"
86 .I CDSYS'="" D
87 ..S $P(PKV,HLCS,1)=^TMP("XUMF MFS",$J,"PARAM","IEN",IEN)
88 ..S $P(PKV,HLCS,2)=$P($G(^DIC(4,+IEN,0)),U),$P(PKV,HLCS,3)=CDSYS
89 .S ^TMP("XUMF MFS",$J,"PARAM",IEN,"PKV")=PKV
90 .I '$P($G(^DIC(4,+IEN,99)),U,4) D
91 ..S ^TMP("XUMF MFS",$J,"PARAM",IEN,"IENS","ZIN",8)="1,"_IEN_","
92 ..;S ^TMP("XUMF MFS",$J,"PARAM",IEN,"KEY","ZIN",4.014,"1,"_IEN_",")="VISN"
93 ..S ^TMP("XUMF MFS",$J,"PARAM",IEN,"IENS","ZIN",9)="2,"_IEN_","
94 ..;S ^TMP("XUMF MFS",$J,"PARAM",IEN,"KEY","ZIN",4.014,"2,"_IEN_",")="PARENT FACILITY"
95 .S RF=$$RF^XUAF4(IEN) D:RF
96 ..S ^TMP("XUMF MFS",$J,"PARAM",IEN,"IENS","ZIN",10)=$P(RF,U,3)_","_IEN_","
97 ..S ^TMP("XUMF MFS",$J,"PARAM",IEN,"IENS","ZIN",11)=$P(RF,U,3)_","_IEN_","
98 ..;S ^TMP("XUMF MFS",$J,"PARAM",IEN,"KEY","ZIN",4.999,$P(RF,U,3)_","_IEN_",")=$P(RF,U,3)
99 .S RT=$$RT^XUAF4(IEN) D:RT
100 ..S ^TMP("XUMF MFS",$J,"PARAM",IEN,"IENS","ZIN",12)=$P(RT,U,3)_","_IEN_","
101 ..S ^TMP("XUMF MFS",$J,"PARAM",IEN,"IENS","ZIN",13)=$P(RT,U,3)_","_IEN_","
102 ..;S ^TMP("XUMF MFS",$J,"PARAM",IEN,"KEY","ZIN",4.999,$P(RT,U,3)_","_IEN_",")=$P(RT,U,3)
103 .S NPI=$$NPI^XUSNPI("Organization_ID",IEN) D:NPI
104 ..S ^TMP("XUMF MFS",$J,"PARAM",IEN,"IENS","ZIN",17)=$O(^DIC(4,IEN,"NPISTATUS","C",+NPI,999),-1)_","_IEN_","
105 ..S ^TMP("XUMF MFS",$J,"PARAM",IEN,"IENS","ZIN",18)=$O(^DIC(4,IEN,"NPISTATUS","C",+NPI,999),-1)_","_IEN_","
106 ..S ^TMP("XUMF MFS",$J,"PARAM",IEN,"IENS","ZIN",19)=$O(^DIC(4,IEN,"NPISTATUS","C",+NPI,999),-1)_","_IEN_","
107 .S TAX=$$TAXORG^XUSTAX(IEN) D:TAX
108 ..S ^TMP("XUMF MFS",$J,"PARAM",IEN,"IENS","ZIN",20)=$O(^DIC(4,IEN,"TAXONOMY","B",+$P(TAX,U,2),999),-1)_","_IEN_","
109 ..S ^TMP("XUMF MFS",$J,"PARAM",IEN,"IENS","ZIN",21)=$O(^DIC(4,IEN,"TAXONOMY","B",+$P(TAX,U,2),999),-1)_","_IEN_","
110 ..S ^TMP("XUMF MFS",$J,"PARAM",IEN,"IENS","ZIN",22)=$O(^DIC(4,IEN,"TAXONOMY","B",+$P(TAX,U,2),999),-1)_","_IEN_","
111 ;
112 Q
113 ;
114IFF(IEN) ; -- inactive facility remove VISN and parent association
115 ;
116 N FDA,IENS,XUMF
117 ;
118 S XUMF=1
119 ;
120 S IENS="1,"_IEN_","
121 S FDA(4.014,IENS,.01)="@"
122 S IENS="2,"_IEN_","
123 S FDA(4.014,IENS,.01)="@"
124 D FILE^DIE("E","FDA")
125 ;
126 Q
127 ;
Note: See TracBrowser for help on using the repository browser.