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/XUMFP4.m@ 824

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

initial load of WorldVistAEHR
File size: 4.4 KB
RevLine 
[613]1XUMFP4 ;CIOFO-SF/RAM - Master File C/S Params INSTITUTION ;06/28/00
2 ;;8.0;KERNEL;**206,217,294,335,416**;Jul 10, 1995;Build 5
3 ;
4 ;
5 ; This routine sets up the parameters required by the INSTITUTION (#4)
6 ; file for the Master File server mechanism.
7 ;
8 ; ** This routine is not a supported interface -- use XUMFP **
9 ;
10 ; See XUMFP for parameter list documentation
11 ;
12 N PKV,HLFS,HLCS,RT,RF,NPI,TAX
13 ;
14 S ^TMP("XUMF MFS",$J,"PARAM","PRE")="PRE^XUMFP4C"
15 S ^TMP("XUMF MFS",$J,"PARAM","POST")="POST^XUMFP4C"
16 ;
17 I $O(HL(""))="" D
18 .I 'PROTOCOL D
19 ..S:UPDATE PROTOCOL=$O(^ORD(101,"B","XUMF MFN",0))
20 ..S:QUERY PROTOCOL=$O(^ORD(101,"B","XUMF MFQ",0))
21 .S:'PROTOCOL ERROR="1^invalid protocol" Q:ERROR
22 .S ^TMP("XUMF MFS",$J,"PARAM","PROTOCOL")=PROTOCOL
23 .D INIT^HLFNC2(PROTOCOL,.HL)
24 ;
25 I $O(HL(""))="" S ERROR="1^"_$P(HL,U,2) Q
26 S HLFS=HL("FS"),HLCS=$E(HL("ECH"))
27 ;
28 I QUERY D QRD^XUMFP4C
29 ;
30 ; MFI -- Master File Identification Segment
31 S ^TMP("XUMF MFS",$J,"PARAM","MFI")="Z04" ;Master File Identifier
32 S ^TMP("XUMF MFS",$J,"PARAM","MFAI")="" ;Application Identifier
33 S ^TMP("XUMF MFS",$J,"PARAM","FLEC")="UPD" ;File-Level Event Code
34 S ^TMP("XUMF MFS",$J,"PARAM","ENDT")="" ;Entered Data/Time
35 S ^TMP("XUMF MFS",$J,"PARAM","MFIEDT")="" ;Effective Date/Time
36 S ^TMP("XUMF MFS",$J,"PARAM","RLC")="NE" ;Response Level Code
37 ;
38 ; MFE -- Master File Entry
39 I $G(^TMP("XUMF MFS",$J,"PARAM","RLEC"))="" D ;Record-Level Event Code
40 .S ^TMP("XUMF MFS",$J,"PARAM","RLEC")="MUP"
41 S ^TMP("XUMF MFS",$J,"PARAM","MFNCID")="" ;MFN Control ID
42 I $G(^TMP("XUMF MFS",$J,"PARAM","MFEEDT"))="" D ;Effective Date/Time
43 .S ^TMP("XUMF MFS",$J,"PARAM","MFEEDT")=$$HLDATE^HLFNC($$NOW^XLFDT)
44 ;
45SEG ; -- ZIN segment
46 ;
47 S ^TMP("XUMF MFS",$J,"PARAM","MULT","ZIN",8)=""
48 S ^TMP("XUMF MFS",$J,"PARAM","MKEY","ZIN",8)="VISN"
49 S ^TMP("XUMF MFS",$J,"PARAM","MULT","ZIN",9)=""
50 S ^TMP("XUMF MFS",$J,"PARAM","MKEY","ZIN",9)="PARENT FACILITY"
51 ;history
52 S ^TMP("XUMF MFS",$J,"PARAM","MULT","ZIN",10)=10
53 S ^TMP("XUMF MFS",$J,"PARAM","MULT","ZIN",11)=10
54 S ^TMP("XUMF MFS",$J,"PARAM","MULT","ZIN",12)=12
55 S ^TMP("XUMF MFS",$J,"PARAM","MULT","ZIN",13)=12
56 ;npi
57 S ^TMP("XUMF MFS",$J,"PARAM","MULT","ZIN",17)=17
58 S ^TMP("XUMF MFS",$J,"PARAM","MULT","ZIN",18)=17
59 S ^TMP("XUMF MFS",$J,"PARAM","MULT","ZIN",19)=17
60 ;taxonomy
61 S ^TMP("XUMF MFS",$J,"PARAM","MULT","ZIN",20)=20
62 S ^TMP("XUMF MFS",$J,"PARAM","MULT","ZIN",21)=20
63 S ^TMP("XUMF MFS",$J,"PARAM","MULT","ZIN",22)=20
64 ;
65 I IEN D
66 .I $G(^DIC(4,IEN,99)) D
67 ..S PKV=$P(^DIC(4,IEN,99),U)_HLCS_"STATION NUMBER"_HLCS_"D"
68 .I 'PKV,CDSYS'="" D
69 ..I CDSYS="NPI" D
70 ...S $P(PKV,HLCS,1)=+$$NPI^XUSNPI("Organization_ID",IEN)
71 ..S $P(PKV,HLCS,2)=$P($G(^DIC(4,+IEN,0)),U),$P(PKV,HLCS,3)=CDSYS
72 .S ^TMP("XUMF MFS",$J,"PARAM","PKV")=PKV ; Primary Key Value
73 .S ^TMP("XUMF MFS",$J,"PARAM","IENS","ZIN",8)="1,"_IEN_","
74 .;S ^TMP("XUMF MFS",$J,"PARAM","KEY","ZIN",4.014,"1,"_IEN_",")="VISN"
75 .S ^TMP("XUMF MFS",$J,"PARAM","IENS","ZIN",9)="2,"_IEN_","
76 .;S ^TMP("XUMF MFS",$J,"PARAM","KEY","ZIN",4.014,"2,"_IEN_",")="PARENT FACILITY"
77 .S RF=$$RF^XUAF4(IEN) D:RF
78 ..S ^TMP("XUMF MFS",$J,"PARAM","IENS","ZIN",10)=$P(RF,U,3)_","_IEN_","
79 ..S ^TMP("XUMF MFS",$J,"PARAM","IENS","ZIN",11)=$P(RF,U,3)_","_IEN_","
80 ..;S ^TMP("XUMF MFS",$J,"PARAM","KEY","ZIN",4.999,$P(RF,U,3)_","_IEN_",")=$P(RF,U,3)
81 .S RT=$$RT^XUAF4(IEN) D:RT
82 ..S ^TMP("XUMF MFS",$J,"PARAM","IENS","ZIN",12)=$P(RT,U,3)_","_IEN_","
83 ..S ^TMP("XUMF MFS",$J,"PARAM","IENS","ZIN",13)=$P(RT,U,3)_","_IEN_","
84 ..;S ^TMP("XUMF MFS",$J,"PARAM","KEY","ZIN",4.999,$P(RT,U,3)_","_IEN_",")=$P(RT,U,3)
85 .S NPI=$$NPI^XUSNPI("Organization_ID",IEN) D:NPI
86 ..S ^TMP("XUMF MFS",$J,"PARAM","IENS","ZIN",17)=$O(^DIC(4,IEN,"NPISTATUS","C",+NPI,999),-1)_","_IEN_","
87 ..S ^TMP("XUMF MFS",$J,"PARAM","IENS","ZIN",18)=$O(^DIC(4,IEN,"NPISTATUS","C",+NPI,999),-1)_","_IEN_","
88 ..S ^TMP("XUMF MFS",$J,"PARAM","IENS","ZIN",19)=$O(^DIC(4,IEN,"NPISTATUS","C",+NPI,999),-1)_","_IEN_","
89 .S TAX=$$TAXORG^XUSTAX(IEN) D:TAX
90 ..S ^TMP("XUMF MFS",$J,"PARAM","IENS","ZIN",20)=$O(^DIC(4,IEN,"TAXONOMY","B",+$P(TAX,U,2),999),-1)_","_IEN_","
91 ..S ^TMP("XUMF MFS",$J,"PARAM","IENS","ZIN",21)=$O(^DIC(4,IEN,"TAXONOMY","B",+$P(TAX,U,2),999),-1)_","_IEN_","
92 ..S ^TMP("XUMF MFS",$J,"PARAM","IENS","ZIN",22)=$O(^DIC(4,IEN,"TAXONOMY","B",+$P(TAX,U,2),999),-1)_","_IEN_","
93 ;
94 I NEW D
95 .S PKV="NEW"_HLCS_"STATION NUMBER"_HLCS_"D"
96 .S ^TMP("XUMF MFS",$J,"PARAM","PKV")=PKV ; Primary Key Value
97 ;
98 D ^XUMFP4Z
99 ;
100GROUP ; -- query group
101 ;
102 D GROUP^XUMFP4C
103 ;
104 Q
105 ;
Note: See TracBrowser for help on using the repository browser.