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/XUMFEIMF.m@ 1141

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

initial load of WorldVistAEHR

File size: 3.3 KB
Line 
1XUMFEIMF ;OIFO-OAK/RAM - Edit IMF ;06/28/00
2 ;;8.0;KERNEL;**217,335**;Jul 10, 1995
3 ;
4 ; $$PARAM^HLCS2 call supported by IA #3552
5 ;
6 Q
7 ;
8MAIN ; -- main
9 ;
10 D INIT,SEL1
11 ;
12 I $G(DIRUT) G EXIT
13 I ERROR H 5 D EXIT G MAIN
14 ;
15EDT ;
16 D PRE,EDIT,POST
17 ;
18 S DIR(0)="Y",DIR("B")="YES"
19 S DIR("A")="Are you ready to update the Institution Master File"
20 D ^DIR K DIR
21 I $G(DIRUT) D G EDT
22 .W !!,"WARNING: You modified your entry without updating the IMF!"
23 G:'Y EDT
24 ;
25SEND ;
26 W !,"...send HL7 message to Master File Server..."
27 S PARAM("LLNK")="XUMF IMF MFK^XUMF "_$S('TEST:"FORUM",1:"TEST")
28 S PARAM("PROTOCOL")=$O(^ORD(101,"B","XUMF IMF MFN",0))
29 D MAIN^XUMFP(4,IEN,0,.PARAM,.ERROR) Q:ERROR
30 D MAIN^XUMFI(4,IEN,0,.PARAM,.ERROR)
31 ;
32 I $G(ERROR) W !,$G(ERROR),!
33 I '$G(ERROR) W !,"Sent."
34 ;
35 H 1
36 ;
37 L -^DIC(4,IEN)
38 ;
39 D EXIT G MAIN
40 ;
41 Q
42 ;
43INIT ; -- initialize
44 ;
45 K ^TMP("XUMF MFS",$J),^TMP("HLS",$J),^TMP("HLA",$J),PARAM
46 D CLEAN^DILF
47 ;
48 ;
49 S (ERROR,TEST,FLAG)=0
50 ;
51 I $P($$PARAM^HLCS2,U,3)="T" S TEST=1
52 ;
53 ;
54 S XUMF=1
55 ;
56 D LOAD^XUMF(4.1)
57 ;
58 Q
59 ;
60SEL1 ; -- select one institution
61 ;
62 D CHK^XUMF333
63 ;
64 W !
65 ;
66 K DIR
67 S DIR(0)="F^3:7^K:'(X?3N.AN) X"
68 S DIR("A")="Enter Station Number"
69 D ^DIR Q:$G(DIRUT)
70 ;
71 S STA=Y
72 ;
73 S IEN=$O(^DIC(4,"D",STA,0))
74 ;
75 I 'IEN W " Invalid selection!" H 2 G SEL1
76 ;
77 L +^DIC(4,IEN):0 I '$T D Q
78 .S ERROR="1^Another user is editing this entry."
79 .W !,ERROR,!
80 ;
81 I 'IEN D Q
82 .S ERROR="1^Not an existing Station Number,"
83 .W !,ERROR,!
84 ;
85 I $E($$STA^XUAF4(+$G(DUZ(2))),1,3)'=$E(STA,1,3) D Q
86 .S ERROR="1^Option may only be used to edit your facility!"
87 .W !,ERROR
88 .W !," to edit an inactive faciliy log on to that division"
89 .W !," you must have DIVISION in your NEW PERSON multiple."
90 .W !!," If Inactive facility not selectable - assign with"
91 .W !," XUMGR security key."
92 ;
93 Q
94 ;
95PRE ; -- pre-udpate
96 ;
97 S N0=$G(^DIC(4,+IEN,0))
98 S N1=$G(^DIC(4,+IEN,1))
99 S N3=$G(^DIC(4,+IEN,3))
100 S N4=$G(^DIC(4,+IEN,4))
101 S NV=$G(^DIC(4,+IEN,7,1))
102 S NP=$G(^DIC(4,+IEN,7,2))
103 S N99=$G(^DIC(4,+IEN,99))
104 ;
105 Q
106 ;
107EDIT ; -- address edit
108 ;
109 S DIE("NO^")="BACK"
110 ;
111 ; edit template
112 S DIE=4,DA=IEN
113 S DR="[XUMF IMF EDIT]"
114 D ^DIE
115 ;
116 ; if inactive remove parent and visn then quit
117 I $P($G(^DIC(4,+IEN,99)),U,4) D Q
118 .K IENS,FDA
119 .S IENS="1,"_IEN_","
120 .S FDA(4.014,IENS,.01)="@"
121 .D FILE^DIE("E","FDA")
122 .K IENS,FDA
123 .S IENS="2,"_IEN_","
124 .S FDA(4.014,IENS,.01)="@"
125 .D FILE^DIE("E","FDA")
126 .W !
127 ;
128VN K DIR
129 S DIR(0)="N^1:23^"
130 S DIR("A")="Enter VISN Number"
131 D ^DIR
132 ;
133 G:'Y VN
134 ;
135 K IENS,FDA
136 S IENS="?+1,"_IEN_","
137 S FDA(4.014,IENS,.01)="VISN"
138 S FDA(4.014,IENS,1)="VISN "_Y
139 D UPDATE^DIE("E","FDA")
140 ;
141PF ;
142 ; parent facility
143 W !,"Parent ASSOCIATION - Enter the admin PARENT for this facility"
144 S DIE="^DIC(4,"_IEN_",7,"
145 S DA(1)=IEN,DA=2
146 S DR="1~PARENT"
147 D ^DIE
148 W !
149 ;
150 Q
151 ;
152POST ; -- post update
153 ;
154 I $P($G(^DIC(4,+IEN,0)),U,2)'=$P($G(N0),U,2) S FLAG=1 Q
155 I $G(^DIC(4,+IEN,1))'=$G(N1) S FLAG=1 Q
156 I $G(^DIC(4,+IEN,4))'=$G(N4) S FLAG=1 Q
157 I $G(^DIC(4,+IEN,3))'=$G(N3) S FLAG=1 Q
158 I $G(^DIC(4,+IEN,7,1))'=$G(NV) S FLAG=1 Q
159 I $G(^DIC(4,+IEN,7,2))'=$G(NP) S FLAG=1 Q
160 I $G(^DIC(4,+IEN,99))'=$G(N99) S FLAG=1 Q
161 ;
162 Q
163 ;
164EXIT ; -- clean up
165 ;
166 D CLEAN^DILF,KILL^XUSCLEAN
167 K ^TMP("HLS",$J),^TMP("HLA",$J),^TMP("XUMF MFS",$J)
168 ;
169 K N0,N1,N3,N4,NV,NP,N99,XUMF,DIRUT,PARAM,DA,DR,DIE
170 K DIC,DIR,X,Y,NAME,STA,FLAG,IEN,TEST,ERROR,IENS
171 ;
172 Q
173 ;
Note: See TracBrowser for help on using the repository browser.