| 1 | RORRP017 ;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 | ;
|
|---|
| 45 | DRUGLIST(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 | ;
|
|---|
| 106 | VACLSLST(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
|
|---|
