1 | RORUTL16 ;HCIOFO/SG - PHARMACY DATA SEARCH (UTILITIES) ; 10/6/05 9:34am
|
---|
2 | ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
|
---|
3 | ;
|
---|
4 | ; This routine uses the following IAs:
|
---|
5 | ;
|
---|
6 | ; #4533 AND^PSS50, VAC^PSS50 (supported)
|
---|
7 | ; #4543 IEN^PSN50P65 (supported)
|
---|
8 | ;
|
---|
9 | Q
|
---|
10 | ;
|
---|
11 | ;***** LOADS THE LIST OF REGISTRY SPECIFIC DRUGS
|
---|
12 | ;
|
---|
13 | ; ROR8DST Closed root of the destination buffer
|
---|
14 | ;
|
---|
15 | ; REGIEN Registry IEN
|
---|
16 | ;
|
---|
17 | ; [FLAGS] Flags to control processing:
|
---|
18 | ; A Do not kill the destination array before
|
---|
19 | ; loading the drugs (Add the drugs)
|
---|
20 | ; C Include VA drug classes from the file #798.6
|
---|
21 | ; D Include local (dispensed) drugs from the LOCAL
|
---|
22 | ; DRUG NAME multiple of the file #798.1
|
---|
23 | ; G Include generic drugs from the file #799.51
|
---|
24 | ; R Reduce everything to local (dispensed) drugs
|
---|
25 | ;
|
---|
26 | ; If this parameter has no value ($G(FLAGS)="") then
|
---|
27 | ; the default set of flags is used: "DGR".
|
---|
28 | ;
|
---|
29 | ; [GROUPID] Optional identifier of the drug group. By default
|
---|
30 | ; ($G(GROUPID)=""), 0 is used.
|
---|
31 | ;
|
---|
32 | ; Return Values:
|
---|
33 | ; <0 Error code
|
---|
34 | ; 0 Ok
|
---|
35 | ;
|
---|
36 | ; The list of drugs is returned as follow:
|
---|
37 | ;
|
---|
38 | ; @ROR8DST@(
|
---|
39 | ; DrugIEN,
|
---|
40 | ; GroupID) ""
|
---|
41 | ; "C",
|
---|
42 | ; VAClassIEN,
|
---|
43 | ; GroupID) ""
|
---|
44 | ; "G",
|
---|
45 | ; GenericDrugIEN,
|
---|
46 | ; GroupID) ""
|
---|
47 | ;
|
---|
48 | ; DrugIEN is an internal entry number of the local drug record
|
---|
49 | ; in the DRUG file (#50).
|
---|
50 | ;
|
---|
51 | ; Nodes "C" and/or "G" are created only if the R flag is not used.
|
---|
52 | ; Otherwise, VA drug classes and generic drugs are reduced to the
|
---|
53 | ; local (dispensed) drugs.
|
---|
54 | ;
|
---|
55 | DRUGLIST(ROR8DST,REGIEN,FLAGS,GROUPID) ;
|
---|
56 | N DRUGIEN,IEN,NDFP,RC,REDUCE,ROOT,RORMSG,VACLIEN
|
---|
57 | S FLAGS=$S($G(FLAGS)'="":FLAGS,1:"DGR")
|
---|
58 | S GROUPID=$S($G(GROUPID)'="":GROUPID,1:0)
|
---|
59 | S REDUCE=(FLAGS["R") K:FLAGS'["A" @ROR8DST
|
---|
60 | ;
|
---|
61 | ;--- Drug classes
|
---|
62 | D:FLAGS["C"
|
---|
63 | . S IEN=0
|
---|
64 | . F S IEN=$O(^ROR(798.6,"AC",REGIEN,IEN)) Q:IEN'>0 D
|
---|
65 | . . D RXADDVCL(ROR8DST,+$G(^ROR(798.6,IEN,0)),REDUCE,GROUPID)
|
---|
66 | ;
|
---|
67 | ;--- Local drug names
|
---|
68 | D:FLAGS["D"
|
---|
69 | . S ROOT=$$ROOT^DILFD(798.129,","_REGIEN_",",1)
|
---|
70 | . S IEN=0
|
---|
71 | . F S IEN=$O(@ROOT@(IEN)) Q:IEN'>0 D
|
---|
72 | . . S DRUGIEN=+$P($G(@ROOT@(IEN,0)),U)
|
---|
73 | . . S:DRUGIEN>0 @ROR8DST@(DRUGIEN,GROUPID)=""
|
---|
74 | ;
|
---|
75 | ;--- Generic drugs
|
---|
76 | D:FLAGS["G"
|
---|
77 | . N RGS S RGS=REGIEN_"#",DRUGIEN=0
|
---|
78 | . F S DRUGIEN=$O(^ROR(799.51,"ARDG",RGS,DRUGIEN)) Q:DRUGIEN'>0 D
|
---|
79 | . . D RXADDGEN(ROR8DST,DRUGIEN,REDUCE,GROUPID)
|
---|
80 | Q 0
|
---|
81 | ;
|
---|
82 | ;***** LOADS PHARMACY ORDER DATA
|
---|
83 | ;
|
---|
84 | ; .ROR8DST Reference to the ROR8DST parameter
|
---|
85 | ; passed into the callback function.
|
---|
86 | ;
|
---|
87 | ; ORDFLGS Flags describing the original order
|
---|
88 | ;
|
---|
89 | ; Return Values:
|
---|
90 | ; <0 Error code
|
---|
91 | ; 0 Ok
|
---|
92 | ; 1 Skip this refill
|
---|
93 | ;
|
---|
94 | ORDER(ROR8DST,ORDFLGS) ;
|
---|
95 | N DATE,FILLTYPE
|
---|
96 | D:ORDFLGS["I"
|
---|
97 | . S DATE=$P(RORRXE(0),U,5),FILLTYPE="I"
|
---|
98 | D:ORDFLGS["O"
|
---|
99 | . S DATE=$P(RORRXE("RXN",0),U,6)
|
---|
100 | . S FILLTYPE=$P(RORRXE("RXN",0),U,3)
|
---|
101 | Q
|
---|
102 | ;
|
---|
103 | ;***** ADDS THE GENERIC DRUG TO THE LIST OF DRUGS
|
---|
104 | ;
|
---|
105 | ; ROR8DST Closed root of the destination buffer
|
---|
106 | ;
|
---|
107 | ; GENIEN IEN of a generic drug
|
---|
108 | ;
|
---|
109 | ; [REDUCE] Reduce the class to a list of local drugs
|
---|
110 | ;
|
---|
111 | ; [GROUPID] Drug group ID
|
---|
112 | ;
|
---|
113 | RXADDGEN(ROR8DST,GENIEN,REDUCE,GROUPID) ;
|
---|
114 | Q:GENIEN'>0
|
---|
115 | S GROUPID=$S($G(GROUPID)'="":GROUPID,1:0)
|
---|
116 | I '$G(REDUCE) S @ROR8DST@("G",GENIEN,GROUPID)="" Q
|
---|
117 | N DRUGIEN,RORTMP,RORTS
|
---|
118 | S RORTMP=$$ALLOC^RORTMP(.RORTS)
|
---|
119 | D AND^PSS50(GENIEN,,,RORTS)
|
---|
120 | S DRUGIEN=0
|
---|
121 | F S DRUGIEN=$O(@RORTMP@(DRUGIEN)) Q:DRUGIEN'>0 D
|
---|
122 | . S @ROR8DST@(DRUGIEN,GROUPID)=""
|
---|
123 | D FREE^RORTMP(RORTMP)
|
---|
124 | Q
|
---|
125 | ;
|
---|
126 | ;***** ADDS THE VA DRUG CLASS TO THE LIST OF DRUGS
|
---|
127 | ;
|
---|
128 | ; ROR8DST Closed root of the destination buffer
|
---|
129 | ;
|
---|
130 | ; VACL Either IEN or code of a VA drug class
|
---|
131 | ;
|
---|
132 | ; [REDUCE] Reduce the class to a list of local drugs
|
---|
133 | ;
|
---|
134 | ; [GROUPID] Drug group ID
|
---|
135 | ;
|
---|
136 | ; [FLAGS] Flags to control processing:
|
---|
137 | ; E Always treat content of the VACL parameter as
|
---|
138 | ; a code of the VA Drug Class (instead of IEN)
|
---|
139 | ;
|
---|
140 | RXADDVCL(ROR8DST,VACL,REDUCE,GROUPID,FLAGS) ;
|
---|
141 | N DRUGIEN,RORMSG,RORTMP,RORTS,TMP,VACLIEN
|
---|
142 | S RORTMP=$$ALLOC^RORTMP(.RORTS)
|
---|
143 | D
|
---|
144 | . S VACLIEN=+VACL
|
---|
145 | . I (VACLIEN'=VACL)!($G(FLAGS)["E") D
|
---|
146 | . . D IEN^PSN50P65(,VACL,RORTS)
|
---|
147 | . . S TMP=+$G(@RORTMP@(0))
|
---|
148 | . . S VACLIEN=$S(TMP=1:+$O(@RORTMP@(0)),1:0)
|
---|
149 | . Q:VACLIEN'>0
|
---|
150 | . ;---
|
---|
151 | . S GROUPID=$S($G(GROUPID)'="":GROUPID,1:0)
|
---|
152 | . I '$G(REDUCE) S @ROR8DST@("C",VACLIEN,GROUPID)="" Q
|
---|
153 | . D VAC^PSS50(VACLIEN,,,RORTS)
|
---|
154 | . S DRUGIEN=0
|
---|
155 | . F S DRUGIEN=$O(@RORTMP@(DRUGIEN)) Q:DRUGIEN'>0 D
|
---|
156 | . . S @ROR8DST@(DRUGIEN,GROUPID)=""
|
---|
157 | ;
|
---|
158 | D FREE^RORTMP(RORTMP)
|
---|
159 | Q
|
---|