| [613] | 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 | 
|---|