52 lines
1.9 KiB
Mathematica
52 lines
1.9 KiB
Mathematica
|
RRCI18L ; Package File Loader
|
||
|
|
;RRCI18L V0.0001;;MTZ/RCR/27MAY2004 29Aug2004
|
||
|
|
;Donated by Chris Richardson
|
||
|
|
;Initial database design by Marcus Werner
|
||
|
|
;Copyright 2008 WorldVistA. Licensed under the terms of the GNU
|
||
|
|
;General Public License See attached copy of the License.
|
||
|
|
;
|
||
|
|
;This program is free software; you can redistribute it and/or modify
|
||
|
|
;it under the terms of the GNU General Public License as published by
|
||
|
|
;the Free Software Foundation; either version 2 of the License, or
|
||
|
|
;(at your option) any later version.
|
||
|
|
;
|
||
|
|
;This program is distributed in the hope that it will be useful,
|
||
|
|
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
|
|
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
|
|
;GNU General Public License for more details.
|
||
|
|
;
|
||
|
|
;You should have received a copy of the GNU General Public License along
|
||
|
|
;with this program; if not, write to the Free Software Foundation, Inc.,
|
||
|
|
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
||
|
|
V ; Note: Snapshot file .84 before this run so that
|
||
|
|
; it might be restored completely.
|
||
|
|
N CODE,END,EXIT,I,J,K,LL,RRCODE,RRCFILE,RRCIEN,RRCNODE,MSK
|
||
|
|
S F="/root/VA-File-Custody.txt",U="^",V="`"
|
||
|
|
O F:READ
|
||
|
|
U F
|
||
|
|
F D Q:$L(R,"#")>5
|
||
|
|
. R R
|
||
|
|
. U 0 W R,!
|
||
|
|
. D PROC(R)
|
||
|
|
. U F
|
||
|
|
.QUIT
|
||
|
|
U 0
|
||
|
|
C F
|
||
|
|
QUIT
|
||
|
|
; ============
|
||
|
|
PROC(X) ; Process the Row just read in
|
||
|
|
N I,T
|
||
|
|
S T=$C(9),P=$C(34)
|
||
|
|
F I=1:1:$L(X,T) S V(I)=$TR($P(X,T,I),P)
|
||
|
|
S FN=V(1),NS=V(4)
|
||
|
|
Q:NS=""
|
||
|
|
S Y=$G(SUM(NS))
|
||
|
|
S LV=$P(Y,U,2)
|
||
|
|
S:LV="" LV=9999999999999
|
||
|
|
I FN<LV S $P(Y,U,2)=FN
|
||
|
|
I FN>$P(Y,U,3) S $P(Y,U,3)=FN
|
||
|
|
S SUM(NS)=NS_U_$P(Y,U,2,3)
|
||
|
|
QUIT
|
||
|
|
; ============
|
||
|
|
; ============
|