source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRPXAPP.m@ 1582

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

initial load of FOIAVistA 6/30/08 version

File size: 5.8 KB
Line 
1LRPXAPP ;SLC/STAFF Test Lab APIs ;11/12/03 15:44
2 ;;5.2;LAB SERVICE;**295**;Sep 27, 1994
3 ;
4 ; - This routine shows examples of calling APIs in LRPXAPI.
5 ; - This routine is provided for documentation and testing.
6 ; - The temp global ^TMP("LRPXAPI",$J, is used as an example.
7 ; - You should use a TMP global with your package's namespace.
8 ;
9TESTS ; sample application to test TESTS API
10 ; gets the lab tests (without results) on a patient (in date range)
11 N COND,DFN,ERR,FROM,ITEMS,MORE,TO,TYPE K ITEMS
12 K ^TMP("LRPXAPP",$J)
13 D GETTYPE^LRPXAPPU(.TYPE,.ERR) I ERR Q
14 D GETPT^LRPXAPPU(.DFN,.ERR) I ERR Q
15 D GETDATE^LRPXAPPU(.FROM,.TO,.ERR) I ERR Q
16 D GETCOND^LRPXAPPU(.COND,TYPE,.ERR) I ERR Q
17 F D Q:'MORE
18 . D TESTS^LRPXAPI(.ITEMS,DFN,TYPE,,.MORE,COND,FROM,TO)
19 . M ^TMP("LRPXAPP",$J)=ITEMS
20 D DISPLAY^LRPXAPPU
21 K ^TMP("LRPXAPP",$J)
22 Q
23 ;
24ARESULTS ; sample application to test RESULTS API for all results
25 ; gets all lab results on a patient (in date range)
26 N COND,DFN,ERR,FROM,TO,TYPE
27 K ^TMP("LRPXAPP",$J)
28 D GETTYPE^LRPXAPPU(.TYPE,.ERR) I ERR Q
29 D GETPT^LRPXAPPU(.DFN,.ERR) I ERR Q
30 D GETDATE^LRPXAPPU(.FROM,.TO,.ERR) I ERR Q
31 D GETCOND^LRPXAPPU(.COND,TYPE,.ERR) I ERR Q
32 D RESULTS^LRPXAPI("LRPXAPP",DFN,TYPE,1000000,,COND,FROM,TO)
33 D DISPLAY^LRPXAPPU
34 K ^TMP("LRPXAPP",$J)
35 Q
36 ;
37RESULTS ; sample application to test RESULTS API
38 ; gets patient's lab test results (in date range)
39 K ^TMP("LRPXAPP",$J)
40 N COND,DFN,ERR,FROM,ITEM,MORE,RESULTS,TO,TYPE K RESULTS
41 D GETTYPE^LRPXAPPU(.TYPE,.ERR) I ERR Q
42 D GETPT^LRPXAPPU(.DFN,.ERR) I ERR Q
43 D GETDATE^LRPXAPPU(.FROM,.TO,.ERR) I ERR Q
44 I TYPE="C" D GETTEST^LRPXAPPU(.ITEM,TYPE,.ERR) I ERR Q
45 I TYPE="A" D GETAP^LRPXAPPU(.ITEM,.ERR) I ERR Q
46 I TYPE="M" D GETMICRO^LRPXAPPU(.ITEM,.ERR) I ERR Q
47 D GETCOND^LRPXAPPU(.COND,TYPE,.ERR) I ERR Q
48 F D Q:'MORE
49 . D RESULTS^LRPXAPI(.RESULTS,DFN,ITEM,,.MORE,COND,FROM,TO)
50 . M ^TMP("LRPXAPP",$J)=RESULTS
51 D DISPLAY^LRPXAPPU
52 K ^TMP("LRPXAPP",$J)
53 Q
54 ;
55PATIENTS ; sample application to test PATIENTS API
56 ; gets all patients that have had a specific lab test (in date range)
57 N ERR,COND,FROM,ITEM,MORE,PATIENTS,SUB,TO,TYPE K PATIENTS
58 D GETTYPE^LRPXAPPU(.TYPE,.ERR) I ERR Q
59 I TYPE="C" D GETTEST^LRPXAPPU(.ITEM,TYPE,.ERR) I ERR Q
60 I TYPE="A" D GETAP^LRPXAPPU(.ITEM,.ERR) I ERR Q
61 I TYPE="M" D GETMICRO^LRPXAPPU(.ITEM,.ERR) I ERR Q
62 D GETCOND^LRPXAPPU(.COND,TYPE,.ERR) I ERR Q
63 D GETDATE^LRPXAPPU(.FROM,.TO,.ERR) I ERR Q
64 F D Q:'MORE
65 . D PATIENTS^LRPXAPI(.PATIENTS,ITEM,,10,.MORE,COND,FROM,TO)
66 . S SUB=""
67 . F S SUB=$O(PATIENTS(SUB)) Q:SUB="" W !,PATIENTS(SUB)
68 Q
69 ;
70DATES ; sample application to test DATES API
71 ; gets the dates of labs (without results) on a patient (in date range)
72 N DFN,ERR,FROM,ITEMS,MORE,TO,TYPE K ITEMS
73 K ^TMP("LRPXAPP",$J)
74 D GETPT^LRPXAPPU(.DFN,.ERR) I ERR Q
75 D GETTYPE^LRPXAPPU(.TYPE,.ERR) I ERR Q
76 D GETDATE^LRPXAPPU(.FROM,.TO,.ERR) I ERR Q
77 F D Q:'MORE
78 . D DATES^LRPXAPI(.ITEMS,DFN,TYPE,,.MORE,FROM,TO)
79 . M ^TMP("LRPXAPP",$J)=ITEMS
80 D DISPLAY^LRPXAPPU
81 K ^TMP("LRPXAPP",$J)
82 Q
83 ;
84TESTLOOK ; test a lookup that screens for only tests done on patient
85 N DIC,DFN,ERR,X,Y K DIC
86 D GETPT^LRPXAPPU(.DFN,.ERR) I ERR Q
87 S DIC=60,DIC(0)="AEMOQ"
88 S DIC("S")="I $P(^(0),U,4)=""CH"",$$HASITEM^LRPXAPI(DFN,+Y)"
89 D ^DIC I Y<1 Q
90 W !,Y
91 Q
92 ;
93TESTVAL ; test conditions and values for a patient's test
94 N COL,COND,DFN,ERR,LRDFN,LRDN,LRIDT,RESULT,TEST
95 D GETPT^LRPXAPPU(.DFN,.ERR) I ERR Q
96 S LRDFN=$$LRDFN^LRPXAPIU(DFN)
97 D GETTEST^LRPXAPPU(.TEST,"C",.ERR) I ERR Q
98 S LRDN=$$LRDN^LRPXAPIU(TEST)
99 D GETCOND^LRPXAPPU(.COND,TYPE,.ERR) I ERR Q
100 S COL=0
101 F S COL=$O(^PXRMINDX(63,"IP",TEST,DFN,COL)) Q:COL<1 D
102 . S LRIDT=$$LRIDT^LRPXAPIU(COL)
103 . W !!,$$VAL^LRPXAPI(LRDFN,LRIDT,LRDN)
104 . D VALUE^LRPXAPI(.RESULT,DFN,COL,TEST,COND,.ERR)
105 . W !,RESULT
106 . D LRVALUE^LRPXAPI(.RESULT,LRDFN,LRIDT,LRDN,COND,.ERR)
107 . W !,RESULT
108 Q
109 ;
110VALUES ; test to get patient's values from PXRMINDX index
111 N COL,DFN,ERR,ITEM,NODE,RESULT,STOP,TYPE
112 D GETTYPE^LRPXAPPU(.TYPE,.ERR) I ERR Q
113 D GETPT^LRPXAPPU(.DFN,.ERR) I ERR Q
114 I TYPE="C" S ITEM=0,STOP="@"
115 I TYPE="A" S ITEM="A",STOP="AZ"
116 I TYPE="M" S ITEM="M",STOP="MZ"
117 F S ITEM=$O(^PXRMINDX(63,"PI",DFN,ITEM)) Q:ITEM="" Q:ITEM]STOP D
118 . S COL=0
119 . F S COL=$O(^PXRMINDX(63,"PI",DFN,ITEM,COL)) Q:COL<1 D
120 .. S NODE=""
121 .. F S NODE=$O(^PXRMINDX(63,"PI",DFN,ITEM,COL,NODE)) Q:NODE="" D
122 ... D LRPXRM^LRPXAPI(.RESULT,NODE,ITEM)
123 ... W !,ITEM,!,NODE,!,RESULT
124 Q
125 ;
126SPEC ; test of specimen APIs
127 ; displays specimen node, comments, results
128 ; restricted to MAX number of collections
129 N COL,COLCNT,CNT,DATA,DFN,ERR,ITEM,MAX,RESULTS K COLCNT,RESULTS
130 S MAX=10,CNT=0
131 D GETPT^LRPXAPPU(.DFN,.ERR) I ERR Q
132 S ITEM=0
133 F S ITEM=$O(^PXRMINDX(63,"PI",DFN,ITEM)) Q:ITEM<1 D Q:CNT>MAX
134 . S COL=0
135 . F S COL=$O(^PXRMINDX(63,"PI",DFN,ITEM,COL)) Q:COL<1 D Q:CNT>MAX
136 .. I $D(COLCNT(COL)) Q
137 .. S COLCNT(COL)="",CNT=CNT+1
138 .. ; use "A", "C", "S", "V" to test
139 .. D SPEC^LRPXAPI(.RESULTS,DFN,COL,"A",.ERR)
140 .. W !
141 .. W !,$$COMMENT^LRPXAPI($$LRDFN^LRPXAPIU(DFN),$$LRIDT^LRPXAPIU(COL))
142 .. S DATA="RESULTS(0)"
143 .. F S DATA=$Q(@DATA) Q:DATA="" D
144 ... W !,DATA_"="_@DATA
145 .. K RESULTS
146 Q
147 ;
148CHNODE ; test CH data - some not defined
149 N CNT,ERR,DEF,DFN,LRDFN,LRDN,LRIDT,NODE,RESULTS K RESULTS
150 D GETPT^LRPXAPPU(.DFN,.ERR) I ERR Q
151 S LRDFN=$$LRDFN^LRPXAPIU(DFN)
152 S CNT=0
153 S LRIDT=0
154 F S LRIDT=$O(^LR(LRDFN,"CH",LRIDT)) Q:LRIDT<1 D Q:CNT>3
155 . S CNT=CNT+1
156 . W !!!,LRDFN," ",LRIDT
157 . S LRDN=1
158 . F S LRDN=$O(^LR(LRDFN,"CH",LRIDT,LRDN)) Q:LRDN<1 D
159 .. S NODE=$G(^LR(LRDFN,"CH",LRIDT,LRDN))
160 .. W !!,LRDN,!,NODE,!
161 .. D CHNODE^LRPXAPI(.RESULTS,NODE)
162 .. S DEF=""
163 .. F S DEF=$O(RESULTS(DEF)) Q:DEF="" D
164 ... W !,DEF," = ",RESULTS(DEF)
165 Q
166 ;
167CONDOK ; sample application to test if condition is valid
168 N COND,ERR,TYPE
169 D GETTYPE^LRPXAPPU(.TYPE,.ERR) I ERR Q
170 F D GETCOND^LRPXAPPU(.COND,TYPE,.ERR) Q:ERR Q:'$L(COND) D
171 . I $$CONDOK^LRPXAPIU(COND) W !,COND,!,"condition is ok" Q
172 . W !,COND,!,"condition is NOT ok" Q
173 Q
174 ;
Note: See TracBrowser for help on using the repository browser.