source: WorldVistAEHR/trunk/r/CLINICAL_PROCEDURES-MD/MDRPCOO.m@ 1259

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

initial load of WorldVistAEHR

File size: 6.2 KB
Line 
1MDRPCOO ; HOIFO/DP - Object RPCs (TMDOutput) ; [03-24-2003 15:44]
2 ;;1.0;CLINICAL PROCEDURES;;Apr 01, 2004
3 ; Integration Agreements:
4 ; IA# 2263 [Supported] Kernel Parameter APIs.
5 ; IA# 2541 [Supported] API to get some Kernel System Parameter fields.
6 ; IA# 2320 [Supported] %ZISH entry points.
7 ;
8ANALYZE ; [Procedure] Analyze an insturment interface
9 ; Checks the CP instrument file for completeness of an entry.
10 ; Special Note, variable RTN actually contains the IEN of the
11 ; entry.
12 ;
13 ; Variables:
14 ; MDTMP: [Private] Scratch
15 ;
16 ; New private variables
17 NEW MDTMP
18 D INST^MDHL7U2(RTN,.MDTMP)
19 S @RESULTS@(0)=MDTMP_U_MDTMP(0)
20 F X=0:0 S X=$O(MDTMP(X)) Q:X="" D
21 .S @RESULTS@(X)=MDTMP(X)
22 Q
23 ;
24DIQ(DD,IENS) ; [Procedure] Gather data about an entry
25 ; Input parameters
26 ; 1. DD [Literal/Required] DDNumber
27 ; 2. IENS [Literal/Required] IENS of entry to retrieve
28 ;
29 K ^TMP($J)
30 D GETS^DIQ(DD,IENS,"*","",$NA(^TMP($J)))
31 Q
32 ;
33EXECUTE ; [Procedure] Execute the output
34 D INIT
35 D HFSOPEN("TMDOUTPUT")
36 I POP S @RESULTS@(0)="-1^Unable to open HFS Device" Q
37 U IO D @RTN
38 D HFSCLOSE("TMDOUTPUT")
39 D EXIT
40 Q
41 ;
42EXIT ; [Procedure] Cleanup
43 K ^TMP("DILIST",$J),^TMP($J)
44 Q
45 ;
46HFSCLOSE(HANDLE) ; [Procedure]
47 ; Input parameters
48 ; 1. HANDLE [Literal/Required] File Handle
49 ;
50 ; Variables:
51 ; MDDEL: [Private] Deletion array for Kernel
52 ; MDDIR: [Private] Holds VistA scratch directory
53 ; MDFILE: [Private] Unique filename
54 ;
55 ; New private variables
56 NEW MDDEL,MDDIR,MDFILE
57 D CLOSE^%ZISH(HANDLE)
58 K @RESULTS
59 S MDDIR=$$GET^XPAR("DIV","MD HFS SCRATCH")
60 S MDFILE="MD"_DUZ_".DAT",MDDEL(MDFILE)=""
61 S X=$$FTG^%ZISH(MDDIR,MDFILE,$NAME(@RESULTS@(1)),3)
62 S Y=$O(@RESULTS@(""),-1)+1,@RESULTS@(Y)="[End of Report]"
63 S X=$$DEL^%ZISH(MDDIR,$NA(MDDEL))
64 Q
65 ;
66HFSOPEN(HANDLE) ; [Procedure] Open Host File for output
67 ; Input parameters
68 ; 1. HANDLE [Literal/Required] File Handle
69 ;
70 ; Variables:
71 ; MDDIR: [Private] VistA scratch directory
72 ; MDFILE: [Private] Unique file name
73 ;
74 ; New private variables
75 NEW MDDIR,MDFILE
76 S MDDIR=$$GET^XPAR("DIV","MD HFS SCRATCH")
77 S MDFILE="MD"_DUZ_".DAT"
78 D OPEN^%ZISH(HANDLE,MDDIR,MDFILE,"W") Q:POP
79 Q
80 ;
81INIT ; [Procedure] Cleanup environment before starting
82 K ^TMP("DILIST",$J),^TMP($J)
83 Q
84 ;
85INST(IEN) ; [Procedure] Display Instrument
86 ; Input parameters
87 ; 1. IEN [Literal/Required] Instrument IEN or * for all
88 ;
89 ; Variables:
90 ; MDDX: [Private] Scratch counter
91 ;
92 ; New private variables
93 NEW MDDX
94 I $G(IEN,"*")="*" D Q
95 .W "NAME",?20,"PRINT NAME",?40,"SERIAL #",?50,"M RTN",?60,"PKG",?72,"ACTIVE"
96 .D LIST^DIC(702.09,"","@;.01;.06;.08;.11;.12;.09","P")
97 .F X=0:0 S X=$O(^TMP("DILIST",$J,X)) Q:'X S MDDX=$G(^(X,0)) D
98 ..W !,$$EXT($P(MDDX,U,2),18),?20,$E($P(MDDX,U,3),1,18),?40,$P(MDDX,U,4),?50,$P(MDDX,U,5),?60,$P(MDDX,U,6),?72,$P(MDDX,U,7)
99 D DIQ(702.09,IEN_",")
100 W $$LINE(702.09,IEN_",",.01,0,1),!!
101 S X=.01 F S X=$O(^TMP($J,702.09,IEN_",",X)) Q:'X D
102 .W !,$$LINE(702.09,IEN_",",X,30,1)
103 Q
104 ;
105LINE(DD,IENS,FIELD,COL,TITLE) ; [Procedure] Display a default line of a field loaded from DIQ above
106 ; Input parameters
107 ; 1. DD [Literal/Required] DD Number
108 ; 2. IENS [Literal/Required] Record IENS
109 ; 3. FIELD [Literal/Required] Field number
110 ; 4. COL [Literal/Required] Column for data
111 ; 5. TITLE [Literal/Required] Use FileMan TITLE:1 or LABEL:0
112 ;
113 Q:'$$VFIELD^DILFD(DD,FIELD) ""
114 W:$X>1 !
115 W $S($G(TITLE):$$GET1^DID(DD,FIELD,"","TITLE"),1:$$GET1^DID(DD,FIELD,"","LABEL"))
116 W ": ",?($G(COL,0)),$S(^TMP($J,DD,IENS,FIELD)]"":^(FIELD),1:"<Blank>")
117 Q ""
118 ;
119PAR ; [Procedure] Display System Parameters
120 ; Variables:
121 ; MD: [Private] Scratch
122 ; MDLST: [Private] Scratch
123 ; MDMULT: [Private] Scratch
124 ; MDPAR: [Private] Scratch
125 ; MDWP: [Private] Scratch
126 ;
127 ; New private variables
128 NEW MD,MDLST,MDMULT,MDPAR,MDWP
129 W "System Parameters For: ",$$KSP^XUPARAM("WHERE")
130 D RPC^MDRPCOV(.X,"PARLST","SYS")
131 F MD=0:0 S MD=$O(^TMP($J,MD)) Q:'MD D
132 .S MDPAR=$P(^TMP($J,MD),U,2)
133 .S MDMULT=($P(^TMP($J,MD),U,5)="Yes")
134 .S MDWP=($P(^TMP($J,MD),U,4)="word processing")
135 .W !!,"Parameter: ",MDPAR
136 .W ?55,"Type: ",$P(^TMP($J,MD),U,4)
137 .W !,"Description: ",$P(^TMP($J,MD),U,3)
138 .W ?55,"Multiple: ",$P(^TMP($J,MD),U,5)
139 .D:'MDMULT ; Not Multiple
140 ..I 'MDWP W !," Value: ",$$GET^XPAR("SYS",MDPAR,,"E") Q
141 ..K MDWP D GETWP^XPAR(.MDWP,"SYS",MDPAR,1) D
142 ...W !,"WP-Text:"
143 ...F X=0:0 S X=$O(MDWP(X)) Q:'X W !?2,MDWP(X,0)
144 .D:MDMULT ; Multiple Instances
145 ..D:'MDWP
146 ...W !,?2,"Values:"
147 ...D GETLST^XPAR(.MDLST,"SYS",MDPAR,"E")
148 ...F X=0:0 S X=$O(MDLST(X)) Q:'X D
149 ....W !?2,$P(MDLST(X),"^",1)
150 ....W ?30,"= ",$P(MDLST(X),U,2)
151 ....;W !!," Instance: ",$P(MDLST(X),"^",1)
152 ....;W !," Value: ",$P(MDLST(X),U,2)
153 K ^TMP($J)
154 Q
155 ;
156PROC(IEN) ; [Procedure] Display a procedure
157 ; Input parameters
158 ; 1. IEN [Literal/Required] Procedure IEN or * for all
159 ;
160 I $G(IEN,"*")="*" D Q
161 .W "NAME",?32,"TREATING SPECIALTY",?54,"TIU NOTE",?76,"LOCATION",?98,"ACTIVE",?108,"EXT DATA"
162 .D LIST^DIC(702.01,"","@;.01;.02;.04;.05;.09;.03","P")
163 .F X=0:0 S X=$O(^TMP("DILIST",$J,X)) Q:'X D
164 ..; Naked refs below are from ^TMP("DILIST",$J,X)
165 ..W !,$$EXT($P(^(X,0),U,2),30)
166 ..W ?32,$$EXT($P(^(0),U,3),20)
167 ..W ?54,$$EXT($P(^(0),U,4),20)
168 ..W ?76,$$EXT($P(^(0),U,5),20)
169 ..W ?98,$P(^(0),U,6)
170 ..W ?108,$P(^(0),U,7)
171 D DIQ(702.01,IEN_",")
172 W $$LINE(702.01,IEN_",",.01,0,1),!
173 S X=.01 F S X=$O(^TMP($J,702.01,IEN_",",X)) Q:'X D
174 .W !,$$LINE(702.01,IEN_",",X,32,1)
175 K ^TMP("DILIST",$J),^TMP($J)
176 W !!,"Associated Instruments",!,$TR($J("",30)," ","-"),!
177 D LIST^DIC(702.011,","_IEN_",",.01,"P")
178 I '$O(^TMP("DILIST",$J,0)) W ?5,"<None>"
179 E F X=0:0 S X=$O(^TMP("DILIST",$J,X)) Q:'X W $P(^(X,0),U,2),!
180 K ^TMP("DILIST",$J)
181 Q
182 ;
183RPC(RESULTS,OPTION,RTN) ; [Procedure] Main RPC for TMD_Output Object
184 ; RPC: [MD TMDOUTPUT]
185 ;
186 ; Input parameters
187 ; 1. RESULTS [Literal/Required] RPC Return Array
188 ; 2. OPTION [Literal/Required] Option to execute
189 ; 3. RTN [Literal/Required] Routine to execute
190 ;
191 S RESULTS=$NA(^TMP("MD",$J)) K @RESULTS
192 I $T(@OPTION)]"" D @OPTION
193 D:'$D(@RESULTS) BADRPC^MDRPCU("MD TMDOUTPUT","MDRPCOO",OPTION)
194 D CLEAN^DILF
195 Q
196 ;
197EXT(VALUE,LENGTH) ; [Function] $Extract with ... trailer
198 ; Input parameters
199 ; 1. VALUE [Literal/Required] Value to truncate
200 ; 2. LENGTH [Literal/Required] Result length
201 ;
202 I $L(VALUE)>LENGTH S VALUE=$E(VALUE,1,LENGTH-3)_"..."
203 Q VALUE
204 ;
Note: See TracBrowser for help on using the repository browser.