source: qrda/C0Q/trunk/p/C0QSET.m@ 1361

Last change on this file since 1361 was 1361, checked in by George Lilly, 13 years ago

update
File size: 3.5 KB
Line 
1C0QSET ;GPL - SET OPERATIONS ON LISTS ;818/11 8:50pm
2 ;;1.0;MU PACKAGE;;;Build 26
3 ;
4 ;2011 George Lilly glilly@glilly.net - Licensed under the terms of the GNU
5 ;General Public License See attached copy of the License.
6 ;
7 ;This program is free software; you can redistribute it and/or modify
8 ;it under the terms of the GNU General Public License as published by
9 ;the Free Software Foundation; either version 2 of the License, or
10 ;(at your option) any later version.
11 ;
12 ;This program is distributed in the hope that it will be useful,
13 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;GNU General Public License for more details.
16 ;
17 ;You should have received a copy of the GNU General Public License along
18 ;with this program; if not, write to the Free Software Foundation, Inc.,
19 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
20 ;
21 Q
22 ;
23TEST ; TEST OF UNITY ROUTINE
24 ;
25 S A(1)=""
26 S A(2)=""
27 S A(3)=""
28 S B(3)=""
29 S B(4)=""
30 D UNITY("C","A","B")
31 ZWR C
32 Q
33 ;
34TEST2 ; WHICH PATIENTS HAVE MEDICATIONS? WHICH DON'T?
35 ; WHAT BAD PATIENT POINTERS ARE IN THE MEDICATIONS FILE?
36 S PATS=$NA(^DPT)
37 S MEDS=$NA(^PS(55))
38 D UNITY("DELTA",PATS,MEDS)
39 W !,"PATIENTS WITH NO MEDS",!
40 ZWR DELTA(0,*)
41 W !,"BAD POINTERS IN THE MEDS FILE",!
42 ZWR DELTA(2,*)
43 Q
44 ;
45UNITY(ZRTN,ZNEW,ZOLD) ; RETURNS THE DELTA BETWEEN THE NEW AND OLD LISTS
46 ; ONLY NUMERIC LISTS SUPPORTED. FOR LIST WITH STRINGS SEE UNITYS
47 ; ZRTN,ZNEW AND ZOLD ARE ALL PASSED BY NAME
48 ; FORMAT OF RETURN ARRAY:
49 ; @ZRTN@(0,X)="" ; X IS MISSING FROM OLD
50 ; @ZRTN@(1,Y)="" ; Y IS IN BOTH NEW AND OLD - NOT MISSING
51 ; @ZRTN@(2,Z)="" ; Z IS EXTRA IN OLD - WOULD BEED TO BE DELETED FOR UNITY
52 N C0QD ; TEMP WORK ARRAY
53 N ZN S ZN=0 ; COUNT
54 N ZI S ZI=0
55 F S ZI=$O(@ZNEW@(ZI)) Q:+ZI=0 D ; FOR EACH ITEM IN NEW
56 . S C0QD(ZI)=0 ; SET THEM ALL AS 0 MEANING NEW
57 . S ZN=ZN+1
58 S @ZRTN@("COUNT")=ZN ; NEW FILE COUNT
59 S ZI=0
60 F S ZI=$O(@ZOLD@(ZI)) Q:+ZI=0 D ; FOR EACH ITEM IN OLD
61 . I $D(C0QD(ZI)) S C0QD(ZI)=1 ; NOT NEW - PRESENT IN NEW AND OLD
62 . E S C0QD(ZI)=2 ; EXTRA IN OLD - WOULD NEED TO BE DELETED
63 S ZI=0
64 F S ZI=$O(C0QD(ZI)) Q:+ZI=0 D ; FOR EACH ITEM
65 . S @ZRTN@(C0QD(ZI),ZI)="" ; SET RESULTS IN RETURN ARRAY
66 Q
67 ;
68UNITYS(ZRTN,ZNEW,ZOLD) ; RETURNS THE DELTA BETWEEN THE NEW AND OLD LISTS
69 ; THIS VERSION HAS SUPPORT FOR NUMBERS AND STRINGS IN A LIST
70 ; ZRTN,ZNEW AND ZOLD ARE ALL PASSED BY NAME
71 ; FORMAT OF RETURN ARRAY:
72 ; @ZRTN@(0,X)="" ; X IS MISSING FROM OLD
73 ; @ZRTN@(1,Y)="" ; Y IS IN BOTH NEW AND OLD - NOT MISSING
74 ; @ZRTN@(2,Z)="" ; Z IS EXTRA IN OLD - WOULD BEED TO BE DELETED FOR UNITY
75 N C0QD ; TEMP WORK ARRAY
76 N ZI S ZI=""
77 F S ZI=$O(@ZNEW@(ZI)) Q:ZI="" D ; FOR EACH ITEM IN NEW
78 . S C0QD(ZI)=0 ; SET THEM ALL AS 0 MEANING NEW
79 S ZI=""
80 F S ZI=$O(@ZOLD@(ZI)) Q:ZI="" D ; FOR EACH ITEM IN OLD
81 . I $D(C0QD(ZI)) S C0QD(ZI)=1 ; NOT NEW - PRESENT IN NEW AND OLD
82 . E S C0QD(ZI)=2 ; EXTRA IN OLD - WOULD NEED TO BE DELETED
83 S ZI=""
84 F S ZI=$O(C0QD(ZI)) Q:ZI="" D ; FOR EACH ITEM
85 . S @ZRTN@(C0QD(ZI),ZI)="" ; SET RESULTS IN RETURN ARRAY
86 Q
87 ;
88AND(ZRTN,ZNEW,ZOLD) ; RETURNS A LIST OF WHAT IS COMMON TO BOTH NEW AND OLD
89 N ZD
90 D UNITY("ZD",ZNEW,ZOLD)
91 M @ZRTN=ZD(1)
92 Q
93 ;
94NAND(ZRTN,ZNEW,ZOLD) ; RETURNS WHAT IS IN A OR B BUT NOT BOTH
95 N ZD
96 D UNITY("ZD",ZNEW,ZOLD)
97 M @ZRTN=ZD(0)
98 M @ZRTN=ZD(2)
99 Q
100 ;
101AMINUSB(ZRTN,ZA,ZB) ; WHAT'S LEFT IN A AFTER REMOVING B FROM IT
102 N ZD
103 D UNITY("ZD",ZA,ZB)
104 M @ZRTN=ZD(0)
105 Q
106 ;
107OR(ZRTN,ZA,ZB) ; WHAT'S IN A OR B OR BOTH
108 N ZD
109 D UNITY("ZD",ZA,ZB)
110 M @ZRTN=ZD(0)
111 M @ZRTN=ZD(1)
112 M @ZRTN=ZD(2)
113 Q
114 ;
115END ;end of C0QSET;
Note: See TracBrowser for help on using the repository browser.