| 1 | PXRMRXTY ; SLC/PKR - Routines for RXTYPE. ;01/04/2005
 | 
|---|
| 2 |  ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
 | 
|---|
| 3 |  ;
 | 
|---|
| 4 |  ;===============================================
 | 
|---|
| 5 | RXTYXHLP ;Rxtype executable help.
 | 
|---|
| 6 |  N DONE,IND,TEXT
 | 
|---|
| 7 |  S DONE=0
 | 
|---|
| 8 |  F IND=1:1 Q:DONE  D
 | 
|---|
| 9 |  . S TEXT=$P($T(TEXT+IND),";",3)
 | 
|---|
| 10 |  . I TEXT="**End Text**" S DONE=1 Q
 | 
|---|
| 11 |  . W !,TEXT
 | 
|---|
| 12 |  Q
 | 
|---|
| 13 |  ;
 | 
|---|
| 14 |  ;===============================================
 | 
|---|
| 15 | SRXTYL(FIND0,RXTYL) ;Set the Rxtype list.
 | 
|---|
| 16 |  N IND,NTYPE,RXTY,RXTYPE
 | 
|---|
| 17 |  K RXTYL
 | 
|---|
| 18 |  S RXTYPE=$P(FIND0,U,13)
 | 
|---|
| 19 |  I RXTYPE="" S (RXTYL("I"),RXTYL("N"),RXTYL("O"))="" Q
 | 
|---|
| 20 |  S NTYPE=$L(RXTYPE,",")
 | 
|---|
| 21 |  F IND=1:1:NTYPE D
 | 
|---|
| 22 |  . S RXTY=$P(RXTYPE,",",IND),RXTYL(RXTY)=""
 | 
|---|
| 23 |  I $D(RXTYL("A")) S (RXTYL("I"),RXTYL("N"),RXTYL("O"))="" K RXTYL("A")
 | 
|---|
| 24 |  Q
 | 
|---|
| 25 |  ;
 | 
|---|
| 26 |  ;===============================================
 | 
|---|
| 27 | TEXT ;RxType executable help text.
 | 
|---|
| 28 |  ;;RXTYPE controls the search for medications. The possible RXTYPEs are:
 | 
|---|
| 29 |  ;; A - all
 | 
|---|
| 30 |  ;; I - inpatient
 | 
|---|
| 31 |  ;; N - non-VA meds
 | 
|---|
| 32 |  ;; O - outpatient
 | 
|---|
| 33 |  ;;
 | 
|---|
| 34 |  ;;You may use any combination of the above in a comma separated list.
 | 
|---|
| 35 |  ;;For example I,N would search for inpatient medications and non-VA meds.
 | 
|---|
| 36 |  ;;
 | 
|---|
| 37 |  ;;The default is to search for all possible types of medications. So a blank
 | 
|---|
| 38 |  ;;RXTYPE is equivalent to A.
 | 
|---|
| 39 |  ;;
 | 
|---|
| 40 |  ;;**End Text**
 | 
|---|
| 41 |  Q
 | 
|---|
| 42 |  ;
 | 
|---|
| 43 |  ;===============================================
 | 
|---|
| 44 | VRXTYPE(X) ;Rxtype input transform. Check for valid Rxtypes.
 | 
|---|
| 45 |  N IND,NTYPE,RXTY,RXTYL,TEXT,VALID
 | 
|---|
| 46 |  ;Do not execute as part of a verify fields.
 | 
|---|
| 47 |  I $G(DIUTIL)="VERIFY FIELDS" Q 1
 | 
|---|
| 48 |  ;Do not execute as part of exchange.
 | 
|---|
| 49 |  I $G(PXRMEXCH) Q 1
 | 
|---|
| 50 |  S VALID=1
 | 
|---|
| 51 |  S NTYPE=$L(X,",")
 | 
|---|
| 52 |  F IND=1:1:NTYPE D
 | 
|---|
| 53 |  . S RXTY=$P(X,",",IND),RXTYL(RXTY)=""
 | 
|---|
| 54 |  .;Check for valid source abbreviations.
 | 
|---|
| 55 |  . I RXTY="A" Q
 | 
|---|
| 56 |  . I RXTY="I" Q
 | 
|---|
| 57 |  . I RXTY="N" Q
 | 
|---|
| 58 |  . I RXTY="O" Q
 | 
|---|
| 59 |  . S VALID=0
 | 
|---|
| 60 |  . S TEXT=RXTY_" is not a valid RXTYPE"
 | 
|---|
| 61 |  . D EN^DDIOL(TEXT)
 | 
|---|
| 62 |  Q VALID
 | 
|---|
| 63 |  ;
 | 
|---|