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