source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXFI.m@ 1783

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

initial load of FOIAVistA 6/30/08 version

File size: 4.1 KB
Line 
1PXRMEXFI ; SLC/PKR/PJH - Exchange utilities for file entries.;07/05/2007
2 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
3 ;==============================================
4DELALL(FILENUM,NAME) ;Delete all file entries named NAME.
5 N IEN,IND,LIST,MSG
6 D FIND^DIC(FILENUM,"","@","K",NAME,"*","","","","LIST","MSG")
7 I $P(LIST("DILIST",0),U,1)=0 Q
8 S IND=0
9 F S IND=$O(LIST("DILIST",2,IND)) Q:IND="" D
10 . S IEN=LIST("DILIST",2,IND)
11 . D DELETE(FILENUM,IEN)
12 Q
13 ;
14 ;==============================================
15DELETE(FILENUM,DA) ;Delete a file entry.
16 N DIK
17 S DIK=$$ROOT^DILFD(FILENUM)
18 D ^DIK
19 Q
20 ;
21 ;==============================================
22FEIMSG(SAME,ATTR) ;Output the general file exits install message.
23 N IND,NOUT,TEXT,TEXTO
24 S TEXT(1)=ATTR("FILE NAME")_" entry named "_ATTR("NAME")_" already exists"
25 I SAME D
26 . S TEXT(2)="and the packed component is identical, skipping."
27 . S TEXT(3)=" "
28 . D FORMAT^PXRMTEXT(1,70,3,.TEXT,.NOUT,.TEXTO)
29 . F IND=1:1:NOUT W !,TEXTO(IND)
30 . H 2
31 I 'SAME D
32 . S TEXT(2)="but the packed component is different, what do you want to do?"
33 . D FORMAT^PXRMTEXT(1,70,2,.TEXT,.NOUT,.TEXTO)
34 . F IND=1:1:NOUT W !,TEXTO(IND)
35 Q
36 ;
37 ;==============================================
38FOKTI(FILENUM) ;Check if it is ok to install/transport this FILE.
39 ;
40 ;Drugs not allowed.
41 I FILENUM=50 Q 0
42 ;
43 ;VA Generic not allowed.
44 I FILENUM=50.6 Q 0
45 ;
46 ;VA Drug Class not allowed.
47 I FILENUM=50.605 Q 0
48 ;
49 ;Lab tests not allowed.
50 I FILENUM=60 Q 0
51 ;
52 ;Radiology procedures not allowed.
53 I FILENUM=71 Q 0
54 ;
55 ;ICD9 (used in Dialogs) not allowed.
56 I FILENUM=80 Q 0
57 ;
58 ;ICD0 not allowed.
59 I FILENUM=80.1 Q 0
60 ;
61 ;CPT (used in Dialogs) not allowed.
62 I FILENUM=81 Q 0
63 ;
64 ;Order Dialogs not allowed.
65 I FILENUM=101.41 Q 0
66 ;
67 ;Orderable Items not allowed.
68 I FILENUM=101.43 Q 0
69 ;
70 ;Sites cannot create entries in GMRV VITAL TYPE.
71 I FILENUM=120.51 Q 0
72 ;
73 ;Mental Health Instruments not allowed.
74 I FILENUM=601 Q 0
75 I FILENUM=601.71 Q 0
76 ;
77 I FILENUM=790.404 Q 0
78 ;
79 ;If control gets to here then it is an allowed file type.
80 Q 1
81 ;
82 ;==============================================
83GETFACT(PT01,ATTR,NEWPT01,NAMECHG,IEN) ;Get the action for a file.
84 N ACTION,CHOICES,CSUM,DIR,FILENUM,MSG,RESULT
85 N SAME,X,Y
86 ;See if this entry is already defined.
87CHK ;
88 S NEWPT01=""
89 S FILENUM=ATTR("FILE NUMBER")
90 I IEN="" S IEN=$$EXISTS^PXRMEXIU(FILENUM,PT01)
91 I IEN D
92 .;If the entry already exists compare the existing entry checksum
93 .;with the packed entry checksum.
94 . S CSUM=$$FILE^PXRMEXCS(ATTR("FILE NUMBER"),IEN)
95 . S SAME=$S(ATTR("CHECKSUM")=CSUM:1,1:0)
96 . D FEIMSG(SAME,.ATTR)
97 . I SAME S ACTION="S"
98 . I 'SAME D
99 .. S CHOICES=$S(FILENUM=801.41:"CMOQS",FILENUM=811.5:"CMOQS",1:"COQS")
100 .. S DIR("B")="O"
101 .. S ACTION=$$GETACT^PXRMEXIU(CHOICES,.DIR)
102 E D
103 . W !!,ATTR("FILE NAME")," entry ",PT01," is NEW,"
104 . W !,"what do you want to do?"
105 . S CHOICES="CIQS"
106 . S DIR("B")="I"
107 . S ACTION=$$GETACT^PXRMEXIU(CHOICES,.DIR)
108 ;
109 I ACTION="Q" Q ACTION
110 I ACTION="C" D
111 . S NEWPT01=$$GETUNAME^PXRMEXIU(.ATTR)
112 .;Make sure the NEW .01 passes any input transforms.
113 . I NEWPT01="" S ACTION="S"
114 . E D CHK^DIE(ATTR("FILE NUMBER"),.01,"",NEWPT01,.RESULT,"MSG")
115 I $G(RESULT)="^" D G CHK
116 . D AWRITE^PXRMUTIL("MSG")
117 . K RESULT
118 ;
119 I ACTION="O" D
120 .;If the action is overwrite double check that is what the user
121 .;really wants to do.
122 . N DIROUT,DIRUT,DTOUT,DUOUT
123 . K DIR
124 . S DIR(0)="Y"_U_"A"
125 . S DIR("A")="Are you sure you want to overwrite"
126 . S DIR("B")="N"
127 . D ^DIR
128 . I $D(DIROUT)!$D(DIRUT) S Y=0
129 . I $D(DTOUT)!$D(DUOUT) S Y=0
130 . S ACTION=$S(Y:"O",1:"S")
131 ;
132 I ACTION="P" D
133 . N DIC,Y
134 . S DIC=ATTR("FILE NUMBER")
135 . S DIC(0)="AEMQ"
136 . D ^DIC
137 . I Y=-1 S ACTION="S"
138 . E S NEWPT01=$P(Y,U,2)
139 ;
140 I NEWPT01'="" S NAMECHG(ATTR("FILE NUMBER"),PT01)=NEWPT01
141 Q ACTION
142 ;
143 ;==============================================
144SETATTR(ATTR,FILE,PT01) ;Set the file attributes for the file FILE.
145 N MSG
146 S ATTR("FILE NUMBER")=FILE
147 S ATTR("FILE NAME")=$$GET1^DID(FILE,"","","NAME","","MSG")
148 ;This call gets the field length.
149 D FIELD^DID(FILE,.01,"","FIELD LENGTH","ATTR","MSG")
150 S ATTR("MIN FIELD LENGTH")=3
151 S (ATTR("NAME"),ATTR("PT01"))=PT01
152 Q
153 ;
Note: See TracBrowser for help on using the repository browser.