source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXHF.m@ 1006

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

initial load of WorldVistAEHR

File size: 6.2 KB
Line 
1PXRMEXHF ; SLC/PKR - Routines to select and deal with host files. ;12/21/2004
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
3 ;============================================
4CHF(SUCCESS,LIST,PATH,FILE) ;Put the repository entries in LIST into the
5 ;host file specified by PATH and FILE.
6 N GBL,LIEN,RIEN
7 S SUCCESS=1
8 S LIEN=$O(LIST(""))
9 I LIEN="" Q
10 S RIEN=$$RIEN^PXRMEXU1(LIEN)
11 S GBL="^PXD(811.8,"_RIEN_",100,1,0)"
12 ;Save the first entry.
13 S SUCCESS(LIEN)=$$GTF^%ZISH(GBL,4,PATH,FILE)
14 I SUCCESS(LIEN)=0 Q
15 ;Append any remaining entries.
16 F S LIEN=$O(LIST(LIEN)) Q:+LIEN=0 D
17 . S RIEN=$$RIEN^PXRMEXU1(LIEN)
18 . S GBL="^PXD(811.8,"_RIEN_",100,1,0)"
19 . S SUCCESS(LIEN)=$$GATF^%ZISH(GBL,4,PATH,FILE)
20 Q
21 ;
22 ;============================================
23GETEHF() ;Get an existing host file.
24 ;Build a list of all .PRD files in the current directory.
25 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,FILESPEC,FILELIST,PATH,X,Y
26 S FILESPEC("*.PRD")=""
27 S PATH=$$PWD^%ZISH
28 S DIR(0)="FAU"_U_"1:32"
29 S DIR("A")="Enter a path: "
30 S DIR("B")=PATH
31 S DIR("?",1)="A host file is a file on your host system."
32 S DIR("?",2)="A complete host file consists of a path, file name, and extension"
33 S DIR("?",3)="A path consists of a device and directory name."
34 S DIR("?",4)="The default extension is prd (Packed Reminder Definition)."
35 S DIR("?")="The default path is "_PATH
36 D ^DIR
37 I $D(DIROUT)!$D(DIRUT) Q ""
38 I $D(DTOUT)!($D(DUOUT)) Q ""
39 S PATH=Y
40 S Y=$$LIST^%ZISH(PATH,"FILESPEC","FILELIST")
41 I Y D
42 . W !,"The following PRD files were found in ",PATH
43 . S FILE=""
44 . F S FILE=$O(FILELIST(FILE)) Q:FILE="" W !,?2,FILE
45 E W !,"No PRD files were found in path ",PATH
46 ;
47 K DIR,X,Y
48 S DIR(0)="FAOU"_U_"1:32"
49 S DIR("A")="Enter a file name: "
50 S DIR("?",1)="A file name has the format NAME.EXTENSION, the default extension is PRD"
51 S DIR("?",2)="Therefore if you type in FILE for the file name, the host file will be"
52 S DIR("?")=" "_PATH_"FILE.PRD"
53 D ^DIR
54 I $D(DIROUT)!$D(DIRUT) Q ""
55 I $D(DTOUT)!($D(DUOUT)) Q ""
56 S FILE=Y
57 ;Add the default extension if there isn't one.
58 I FILE'["." S FILE=FILE_".PRD"
59 Q PATH_U_FILE
60 ;
61 ;============================================
62GETHFS() ;Get the name of a host file to store repository entries in.
63 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,FILE,HFNAME,PATH,X,Y
64GETHF ;As a default set the path to the current directory.
65 S PATH=$$PWD^%ZISH
66 S DIR(0)="FAU"_U_"1:32"
67 S DIR("A")="Enter a path: "
68 S DIR("B")=PATH
69 S DIR("?",1)="A host file is a file on your host system."
70 S DIR("?",2)="A complete host file consists of a path, file name, and extension"
71 S DIR("?",3)="A path consists of a device and directory name."
72 S DIR("?",4)="The default extension is prd (Packed Reminder Definition)."
73 S DIR("?")="The default path is "_PATH
74 D ^DIR
75 I $D(DIROUT)!$D(DIRUT) Q 0
76 I $D(DTOUT)!($D(DUOUT)) Q 0
77 S PATH=Y
78 K DIR,X,Y
79 S DIR(0)="FAU"_U_"1:32"
80 S DIR("A")="Enter a file name: "
81 S DIR("?",1)="A file name has the format NAME.EXTENSION, the default extension is PRD"
82 S DIR("?",2)="Therefore if you type in FILE for the file name, the host file will be"
83 S DIR("?")=" "_PATH_"FILE.PRD"
84 D ^DIR
85 I $D(DIROUT)!$D(DIRUT) Q 0
86 I $D(DTOUT)!($D(DUOUT)) Q 0
87 S FILE=Y
88 ;Add the default extension if there isn't one.
89 I FILE'["." S FILE=FILE_".PRD"
90 S HFNAME=PATH_FILE
91 S DIR(0)="YAO"
92 S DIR("A")="Will save selected entries to host file "_HFNAME_"?: "
93 S DIR("B")="Y"
94 K X,Y
95 D ^DIR
96 I $D(DIROUT)!$D(DIRUT) Q 0
97 I $D(DTOUT)!($D(DUOUT)) Q 0
98 I 'Y G GETHF
99 Q PATH_U_FILE
100 ;
101 ;============================================
102LHF(SUCCESS,PATH,FILE) ;Load a host file containing repository entries into
103 ;the repository.
104 N CURRL,CSUM,DATEP,DONE,EXTYPE,FDA,GBL,IENROOT,IND,LINE
105 N MSG,NENTRY,NLINES,RETMP,RNAME,SITE,SOURCE,SSOURCE,US,USER,VRSN
106 K ^TMP($J,"EXHF")
107 S GBL="^TMP($J,""EXHF"",1,0)"
108 S GBL=$NA(@GBL)
109 S SUCCESS=$$FTG^%ZISH(PATH,FILE,GBL,3)
110 I 'SUCCESS Q
111 ;Make sure it has the correct format.
112 I (^TMP($J,"EXHF",1,0)'["xml")!(^TMP($J,"EXHF",2,0)'="<REMINDER_EXCHANGE_FILE_ENTRY>") D Q
113 . W !,"This host file does not have the correct format!"
114 . H 2
115 . S SUCCESS=0
116 . K ^TMP($J,"EXHF")
117 W !,"Loading host file ",PATH,FILE
118 S RETMP="^TMP($J,""EXLHF"")"
119 S (CURRL,DONE,NENTRY,NLINES,SSOURCE)=0
120 F Q:DONE D
121 . S CURRL=CURRL+1
122 . I '$D(^TMP($J,"EXHF",CURRL,0)) S DONE=1 Q
123 . S LINE=^TMP($J,"EXHF",CURRL,0)
124 . S NLINES=NLINES+1
125 . S ^TMP($J,"EXLHF",NLINES,0)=LINE
126 . I LINE["<PACKAGE_VERSION>" S VRSN=$$GETTAGV^PXRMEXU3(LINE,"<PACKAGE_VERSION>")
127 . I LINE["<EXCHANGE_TYPE>" S EXTYPE=$$GETTAGV^PXRMEXU3(LINE,"<EXCHANGE_TYPE>",1)
128 . I LINE="<SOURCE>" S SSOURCE=1
129 . I SSOURCE D
130 .. I LINE["<NAME>" S RNAME=$$GETTAGV^PXRMEXU3(LINE,"<NAME>",1)
131 .. I LINE["<USER>" S USER=$$GETTAGV^PXRMEXU3(LINE,"<USER>",1)
132 .. I LINE["<SITE>" S SITE=$$GETTAGV^PXRMEXU3(LINE,"<SITE>",1)
133 .. I LINE["<DATE_PACKED>" S DATEP=$$GETTAGV^PXRMEXU3(LINE,"<DATE_PACKED>")
134 . I LINE="</SOURCE>" D
135 .. S SSOURCE=0
136 .. S SOURCE=USER_" at "_SITE
137 .;See if the entry is loaded into the temporary storage.
138 . I LINE="</REMINDER_EXCHANGE_FILE_ENTRY>" D
139 .. S NLINES=0
140 .. S NENTRY=NENTRY+1
141 ..;Make sure it has the correct format.
142 .. I (^TMP($J,"EXLHF",1,0)'["xml")!(^TMP($J,"EXLHF",2,0)'="<REMINDER_EXCHANGE_FILE_ENTRY>") D Q
143 ... W !,"There is a problem reading this host file try a new copy of it."
144 ... S SUCCESS=0
145 ... H 2
146 ..;Make sure this entry does not already exist.
147 .. I $$REXISTS^PXRMEXIU(RNAME,DATEP) D
148 ... W !,RNAME," with a date packed of ",DATEP
149 ... W !,"is already in the Exchange File."
150 ... S SUCCESS(NENTRY)=0
151 ... H 2
152 .. E D
153 ... K FDA,IENROOT
154 ... S FDA(811.8,"+1,",.01)=RNAME
155 ... S FDA(811.8,"+1,",.02)=SOURCE
156 ... S FDA(811.8,"+1,",.03)=DATEP
157 ... S FDA(811.8,"+1,",115)=$S($G(EXTYPE)="":"REMINDER",1:EXTYPE)
158 ... D UPDATE^PXRMEXPU(.US,.FDA,.IENROOT)
159 ... S SUCCESS(NENTRY)=US
160 ...;Create the description and save the data.
161 ... N DESCT,DESL,KEYWORDT
162 ... D DESC^PXRMEXU3(RETMP,.DESCT)
163 ... D KEYWORD^PXRMEXU3(RETMP,.KEYWORDT)
164 ... S DESL("RNAME")=RNAME,DESL("SOURCE")=SOURCE,DESL("DATEP")=DATEP
165 ... S DESL("VRSN")=VRSN
166 ... D DESC^PXRMEXU1(IENROOT(1),.DESL,"DESCT","KEYWORDT")
167 ... M ^PXD(811.8,IENROOT(1),100)=^TMP($J,"EXLHF")
168 .. K ^TMP($J,"EXLHF")
169 ;
170 ;Check the success of the entry installs.
171 S SUCCESS=1
172 S IND=""
173 F S IND=$O(SUCCESS(IND)) Q:+IND=0 D
174 . I 'SUCCESS(IND) S SUCCESS=0 Q
175 K ^TMP($J,"EXHF"),^TMP($J,"EXLHF")
176 Q
177 ;
Note: See TracBrowser for help on using the repository browser.