source: FOIAVistA/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/ECU1RPC.m@ 1713

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

initial load of FOIAVistA 6/30/08 version

File size: 4.2 KB
Line 
1ECU1RPC ;ALB/ACS;Event Capture Spreadsheet Utilities ;07 Aug 01
2 ;;2.0; EVENT CAPTURE ;**25,30,49,61**;8 May 96
3 ;
4 ;-----------------------------------------------------------------------
5 ;
6 ;INPUT ECDATA - Contains column headers or a row of Event Capture
7 ; spreadshet data
8 ;
9 ;
10 ;OTHER ^TMP($J,"COLS" array will store the column header order
11 ;
12 ;-----------------------------------------------------------------------
13 ;=======================================================================
14 ;MODIFICATIONS:
15 ;
16 ;08/2001 EC*2.0*30 Changed column header from 'Station' to
17 ; 'Location'.
18 ;=======================================================================
19 ;
20ECHDRS(ECDATA) ;
21 ;
22 ;--kill temporary file
23 K ^TMP($J,"COLS")
24 N PIECENUM,NUMCOLS
25 ;
26 ; --Set up column header order
27 S NUMCOLS=$L(ECDATA,U)
28 ;
29 ; --Remove first piece "COLHEADERS" from colum header string--
30 S ECDATA=$P(ECDATA,U,2,NUMCOLS)
31 S NUMCOLS=$L(ECDATA,U)
32 ;
33 ; --Spin through each piece in string and assign 'piece' value
34 F PIECENUM=1:1 Q:PIECENUM>NUMCOLS D
35 . S DATA=$P(ECDATA,U,PIECENUM)
36 . I DATA["Record Num" S ECRECPC=PIECENUM Q
37 . I DATA["Location" S ECSTAPC=PIECENUM Q
38 . I DATA["SSN" S ECSSNPC=PIECENUM Q
39 . I DATA["Pat LName" S ECPATLPC=PIECENUM Q
40 . I DATA["Pat FName" S ECPATFPC=PIECENUM Q
41 . I DATA["Unit Name" S ECDSSPC=PIECENUM Q
42 . I DATA["Unit Num" S ECDCMPC=PIECENUM Q
43 . I DATA["Unit IEN" S ECUNITPC=PIECENUM Q
44 . I DATA["Proc" S ECPROCPC=PIECENUM Q
45 . I DATA["Volume" S ECVOLPC=PIECENUM Q
46 . I DATA["Ordering Sect" S ECOSPC=PIECENUM Q
47 . I DATA["Prov" S ECPRVLPC=PIECENUM Q
48 . I DATA["Date/Time" S ECENCPC=PIECENUM Q
49 . I DATA["Category" S ECCATPC=PIECENUM Q
50 . I DATA["Diag" S ECDXPC=PIECENUM Q
51 . I DATA["Assoc Clin" S ECCLNPC=PIECENUM Q
52 . ;
53 . I DATA["Pat Stat" S ECPSTATV=+DATA Q
54 . I DATA["Override Deceased" S ECDECPAT=+DATA Q
55 . I DATA["Override Duplicate" S ECFILDUP=+DATA
56 ;
57 ;--Move column header piece numbers into Temp file ^TMP($J,"COLS")
58 ; for future reference
59 ;
60 K ^TMP($J,"COLS")
61 S ^TMP($J,"COLS","ECRECPC")=ECRECPC
62 S ^TMP($J,"COLS","ECSTAPC")=ECSTAPC
63 S ^TMP($J,"COLS","ECSSNPC")=ECSSNPC
64 S ^TMP($J,"COLS","ECPATLPC")=ECPATLPC
65 S ^TMP($J,"COLS","ECPATFPC")=ECPATFPC
66 S ^TMP($J,"COLS","ECDSSPC")=ECDSSPC
67 S ^TMP($J,"COLS","ECDCMPC")=ECDCMPC
68 S ^TMP($J,"COLS","ECUNITPC")=ECUNITPC
69 S ^TMP($J,"COLS","ECPROCPC")=ECPROCPC
70 S ^TMP($J,"COLS","ECVOLPC")=ECVOLPC
71 S ^TMP($J,"COLS","ECOSPC")=ECOSPC
72 S ^TMP($J,"COLS","ECPRVLPC")=ECPRVLPC
73 S ^TMP($J,"COLS","ECENCPC")=ECENCPC
74 S ^TMP($J,"COLS","ECCATPC")=ECCATPC
75 S ^TMP($J,"COLS","ECDXPC")=ECDXPC
76 S ^TMP($J,"COLS","ECCLNPC")=ECCLNPC
77 S ^TMP($J,"COLS","ECPSTATV")=ECPSTATV
78 S ^TMP($J,"COLS","ECDECPAT")=ECDECPAT
79 S ^TMP($J,"COLS","ECFILDUP")=ECFILDUP
80 ;
81 Q
82 ;
83GETDATA(ECDATA) ;
84 ;
85 ;--Get data piece numbers and uploaded data values
86 S ECRECPC=$G(^TMP($J,"COLS","ECRECPC"))
87 S ECRECV=$P(ECDATA,U,ECRECPC)
88 ;
89 S ECSTAPC=$G(^TMP($J,"COLS","ECSTAPC"))
90 S ECSTAV=$P(ECDATA,U,ECSTAPC)
91 ;
92 S ECSSNPC=$G(^TMP($J,"COLS","ECSSNPC"))
93 I ECSSNPC S ECSSNV=$P(ECDATA,U,ECSSNPC)
94 ;
95 S ECPATLPC=$G(^TMP($J,"COLS","ECPATLPC"))
96 S ECPATLV=$P(ECDATA,U,ECPATLPC)
97 ;
98 S ECPATFPC=$G(^TMP($J,"COLS","ECPATFPC"))
99 S ECPATFV=$P(ECDATA,U,ECPATFPC)
100 ; --concatenate patient name into one string, comma separated
101 S ECPATV=ECPATLV_","_ECPATFV
102 ;
103 S ECDSSPC=$G(^TMP($J,"COLS","ECDSSPC"))
104 S ECDSSV=$P(ECDATA,U,ECDSSPC)
105 ;
106 S ECDCMPC=$G(^TMP($J,"COLS","ECDCMPC"))
107 S ECDCMV=$P(ECDATA,U,ECDCMPC)
108 ;
109 S ECUNITPC=$G(^TMP($J,"COLS","ECUNITPC"))
110 S ECUNITV=$P(ECDATA,U,ECUNITPC)
111 ;
112 S ECPROCPC=$G(^TMP($J,"COLS","ECPROCPC"))
113 S ECPROCV=$P(ECDATA,U,ECPROCPC)
114 ;
115 S ECVOLPC=$G(^TMP($J,"COLS","ECVOLPC"))
116 S ECVOLV=$P(ECDATA,U,ECVOLPC)
117 ;
118 S ECOSPC=$G(^TMP($J,"COLS","ECOSPC"))
119 S ECOSV=$P(ECDATA,U,ECOSPC)
120 ;
121 S ECPRVLPC=$G(^TMP($J,"COLS","ECPRVLPC"))
122 S ECPROVV=$P(ECDATA,U,ECPRVLPC)
123 ;
124 S ECENCPC=$G(^TMP($J,"COLS","ECENCPC"))
125 S ECENCV=$P(ECDATA,U,ECENCPC),ECENCV=$TR(ECENCV," ","")
126 ;
127 S ECCATPC=$G(^TMP($J,"COLS","ECCATPC"))
128 S ECCATV=$P(ECDATA,U,ECCATPC)
129 ;
130 S ECDXPC=$G(^TMP($J,"COLS","ECDXPC"))
131 S ECDXV=$P(ECDATA,U,ECDXPC)
132 ;
133 S ECCLNPC=$G(^TMP($J,"COLS","ECCLNPC"))
134 S ECCLNV=$P(ECDATA,U,ECCLNPC)
135 ;
136 S ECPSTATV=$G(^TMP($J,"COLS","ECPSTATV"))
137 ;
138 S ECDECPAT=$G(^TMP($J,"COLS","ECDECPAT"))
139 ;
140 S ECFILDUP=$G(^TMP($J,"COLS","ECFILDUP"))
141 ;
142END Q
Note: See TracBrowser for help on using the repository browser.