source: WorldVistAEHR/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORRP017.m@ 1578

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

initial load of WorldVistAEHR

File size: 4.0 KB
Line 
1RORRP017 ;HCIOFO/SG - RPC: DRUGS AND CLASSES ; 9/29/05 10:00am
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 ; This routine uses the following IAs:
5 ;
6 ; #4533 ZERO^PSS50 (supported)
7 ; #4540 ZERO^PSN50P6 (supported)
8 ; #4543 C^PSN50P65, IEN^PSN50P65 (supported)
9 ;
10 Q
11 ;
12 ;***** RETURNS THE LIST OF DRUGS (DISPENSED OR GENERIC)
13 ; RPC: [ROR LIST DRUGS]
14 ;
15 ; .RESULTS Reference to a local variable where the results
16 ; are returned to.
17 ;
18 ; [PART] The partial match restriction.
19 ;
20 ; [FLAGS] Flags that control the execution (can be combined):
21 ; G Retrive generic drugs (from file #50.6).
22 ; Otherwise, list of dispensed drugs (from
23 ; file #50) is retrieved.
24 ;
25 ; [NUMBER] Deprecated
26 ; [FROM] Deprecated
27 ;
28 ; Return Values:
29 ;
30 ; A negative value of the first "^"-piece of the RESULTS(0)
31 ; indicates an error (see the RPCSTK^RORERR procedure for more
32 ; details).
33 ;
34 ; Otherwise, number of drugs is returned in the
35 ; @RESULTS@(0) and the subsequent nodes of the global array
36 ; contain the drugs.
37 ;
38 ; @RESULTS@(0) Number of drugs
39 ;
40 ; @RESULTS@(i) Drug
41 ; ^01: Drug IEN
42 ; ^02: Drug Name
43 ; ^03: VA Drug Class (only for dispensed)
44 ;
45DRUGLIST(RESULTS,PART,FLAGS,NUMBER,FROM) ;
46 N BUF,CNT,GENERIC,IEN,LP,NAME,NODE,RC,RORERRDL,TMP
47 D CLEAR^RORERR("DRUGLIST^RORRP017",1)
48 K RESULTS S RESULTS=$$ALLOC^RORTMP()
49 ;--- Check the parameters
50 S FLAGS=$G(FLAGS) S:$G(PART)="" PART="??"
51 S GENERIC=(FLAGS["G")
52 ;--- Get the list of drugs
53 S NODE=$$ALLOC^RORTMP(.TMP)
54 I GENERIC D
55 . D ZERO^PSN50P6(,PART,,,TMP) ; Generic
56 E D ZERO^PSS50(,PART,,,,TMP) ; Dispensed
57 ;--- Copy the data to the destination array
58 S:PART="??" PART="" S LP=$L(PART)
59 S NAME="",CNT=0
60 F S NAME=$O(@NODE@("B",NAME)) Q:NAME="" D
61 . S IEN=""
62 . F S IEN=$O(@NODE@("B",NAME,IEN)) Q:IEN="" D
63 . . S TMP=$G(@NODE@(IEN,.01)) Q:TMP=""
64 . . Q:$E(TMP,1,LP)'=PART ; Exclude mnemonics
65 . . S BUF=IEN_U_TMP S:'GENERIC $P(BUF,U,3)=$G(@NODE@(IEN,2))
66 . . S CNT=CNT+1,@RESULTS@(CNT)=BUF
67 ;--- Success
68 S @RESULTS@(0)=CNT
69 D FREE^RORTMP(NODE)
70 Q
71 ;
72 ;***** RETURNS THE LIST OF VA DRUG CLASSES
73 ; RPC: [ROR LIST VA DRUG CLASSES]
74 ;
75 ; .RESULTS Reference to a local variable where the results
76 ; are returned to.
77 ;
78 ; [PARENT] Reserved
79 ;
80 ; [PART] The partial match restriction.
81 ;
82 ; [FLAGS] Flags that control the execution (can be combined):
83 ; N Search classes by their names
84 ; (by default, the search is performed by codes)
85 ;
86 ; [NUMBER] Deprecated
87 ; [FROM] Deprecated
88 ;
89 ; Return Values:
90 ;
91 ; A negative value of the first "^"-piece of the @RESULTS@(0)
92 ; indicates an error (see the RPCSTK^RORERR procedure for more
93 ; details).
94 ;
95 ; Otherwise, number of drug classes is returned in the
96 ; @RESULTS@(0) and the subsequent nodes of the global array
97 ; contain the classes.
98 ;
99 ; @RESULTS@(0) Number of classes
100 ;
101 ; @RESULTS@(i) Drug Class
102 ; ^01: IEN
103 ; ^02: Classification
104 ; ^03: Code
105 ;
106VACLSLST(RESULTS,PARENT,PART,FLAGS,NUMBER,FROM) ;
107 N CNT,IEN,LP,NODE,RC,RORERRDL,SUBS,TMP,VAL,XREF
108 D CLEAR^RORERR("VACLSLST^RORRP017",1)
109 K RESULTS S RESULTS=$$ALLOC^RORTMP()
110 ;--- Check the parameters
111 S FLAGS=$G(FLAGS) S:$G(PART)="" PART="??"
112 ;--- Get the list of codes
113 S NODE=$$ALLOC^RORTMP(.TMP)
114 I FLAGS["N" D S XREF="C",SUBS=1
115 . D C^PSN50P65(,PART,TMP)
116 E D S XREF="B",SUBS=.01
117 . D IEN^PSN50P65(,PART,TMP)
118 ;--- Copy the data to the destination array
119 S:PART="??" PART="" S LP=$L(PART)
120 S VAL="",CNT=0
121 F S VAL=$O(@NODE@(XREF,VAL)) Q:VAL="" D
122 . S IEN=""
123 . F S IEN=$O(@NODE@(XREF,VAL,IEN)) Q:IEN="" D
124 . . S TMP=$G(@NODE@(IEN,SUBS))
125 . . Q:$E(TMP,1,LP)'=PART ; Exclude mnemonics
126 . . S CNT=CNT+1
127 . . S @RESULTS@(CNT)=IEN_U_$G(@NODE@(IEN,1))_U_$G(@NODE@(IEN,.01))
128 ;--- Success
129 S @RESULTS@(0)=CNT
130 D FREE^RORTMP(NODE)
131 Q
Note: See TracBrowser for help on using the repository browser.