| 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 | 
|---|