PXRMRXTY.m

PXRMRXTY ; SLC/PKR - Routines for RXTYPE. ;01/04/2005

 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005

 ;

 ;===============================================

RXTYXHLP ;Rxtype executable help.

 N DONE,IND,TEXT

 S DONE=0

 F IND=1:1 Q:DONE  D

 . S TEXT=$P($T(TEXT+IND),";",3)

 . I TEXT="**End Text**" S DONE=1 Q

 . W !,TEXT

 Q

 ;

 ;===============================================

SRXTYL(FIND0,RXTYL) ;Set the Rxtype list.

 N IND,NTYPE,RXTY,RXTYPE

 K RXTYL

 S RXTYPE=$P(FIND0,U,13)

 I RXTYPE="" S (RXTYL("I"),RXTYL("N"),RXTYL("O"))="" Q

 S NTYPE=$L(RXTYPE,",")

 F IND=1:1:NTYPE D

 . S RXTY=$P(RXTYPE,",",IND),RXTYL(RXTY)=""

 I $D(RXTYL("A")) S (RXTYL("I"),RXTYL("N"),RXTYL("O"))="" K RXTYL("A")

 Q

 ;

 ;===============================================

TEXT ;RxType executable help text.

 ;;RXTYPE controls the search for medications. The possible RXTYPEs are:

 ;; A - all

 ;; I - inpatient

 ;; N - non-VA meds

 ;; O - outpatient

 ;;

 ;;You may use any combination of the above in a comma separated list.

 ;;For example I,N would search for inpatient medications and non-VA meds.

 ;;

 ;;The default is to search for all possible types of medications. So a blank

 ;;RXTYPE is equivalent to A.

 ;;

 ;;**End Text**

 Q

 ;

 ;===============================================

VRXTYPE(X) ;Rxtype input transform. Check for valid Rxtypes.

 N IND,NTYPE,RXTY,RXTYL,TEXT,VALID

 ;Do not execute as part of a verify fields.

 I $G(DIUTIL)="VERIFY FIELDS" Q 1

 ;Do not execute as part of exchange.

 I $G(PXRMEXCH) Q 1

 S VALID=1

 S NTYPE=$L(X,",")

 F IND=1:1:NTYPE D

 . S RXTY=$P(X,",",IND),RXTYL(RXTY)=""

 .;Check for valid source abbreviations.

 . I RXTY="A" Q

 . I RXTY="I" Q

 . I RXTY="N" Q

 . I RXTY="O" Q

 . S VALID=0

 . S TEXT=RXTY_" is not a valid RXTYPE"

 . D EN^DDIOL(TEXT)

 Q VALID

 ;

PXRMRXTY  ; SLC/PKR - Routines for RXTYPE. ;01/04/2005

 +1       ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005

 +2       ;

 +3       ;===============================================

RXTYXHLP  ;Rxtype executable help.

 +1        NEW DONE,IND,TEXT

 +2        SET DONE=0

 +3        FOR IND=1:1

               IF DONE

                   QUIT 

               Begin DoDot:1

 +4                SET TEXT=$PIECE($TEXT(TEXT+IND),";",3)

 +5                IF TEXT="**End Text**"

                       SET DONE=1

                       QUIT 

 +6                WRITE !,TEXT

               End DoDot:1

 +7        QUIT 

 +8       ;

 +9       ;===============================================

SRXTYL(FIND0,RXTYL) ;Set the Rxtype list.

 +1        NEW IND,NTYPE,RXTY,RXTYPE

 +2        KILL RXTYL

 +3        SET RXTYPE=$PIECE(FIND0,U,13)

 +4        IF RXTYPE=""

               SET (RXTYL("I"),RXTYL("N"),RXTYL("O"))=""

               QUIT 

 +5        SET NTYPE=$LENGTH(RXTYPE,",")

 +6        FOR IND=1:1:NTYPE

               Begin DoDot:1

 +7                SET RXTY=$PIECE(RXTYPE,",",IND)

                   SET RXTYL(RXTY)=""

               End DoDot:1

 +8        IF $DATA(RXTYL("A"))

               SET (RXTYL("I"),RXTYL("N"),RXTYL("O"))=""

               KILL RXTYL("A")

 +9        QUIT 

 +10      ;

 +11      ;===============================================

TEXT      ;RxType executable help text.

 +1       ;;RXTYPE controls the search for medications. The possible RXTYPEs are:

 +2       ;; A - all

 +3       ;; I - inpatient

 +4       ;; N - non-VA meds

 +5       ;; O - outpatient

 +6       ;;

 +7       ;;You may use any combination of the above in a comma separated list.

 +8       ;;For example I,N would search for inpatient medications and non-VA meds.

 +9       ;;

 +10      ;;The default is to search for all possible types of medications. So a blank

 +11      ;;RXTYPE is equivalent to A.

 +12      ;;

 +13      ;;**End Text**

 +14       QUIT 

 +15      ;

 +16      ;===============================================

VRXTYPE(X) ;Rxtype input transform. Check for valid Rxtypes.

 +1        NEW IND,NTYPE,RXTY,RXTYL,TEXT,VALID

 +2       ;Do not execute as part of a verify fields.

 +3        IF $GET(DIUTIL)="VERIFY FIELDS"

               QUIT 1

 +4       ;Do not execute as part of exchange.

 +5        IF $GET(PXRMEXCH)

               QUIT 1

 +6        SET VALID=1

 +7        SET NTYPE=$LENGTH(X,",")

 +8        FOR IND=1:1:NTYPE

               Begin DoDot:1

 +9                SET RXTY=$PIECE(X,",",IND)

                   SET RXTYL(RXTY)=""

 +10      ;Check for valid source abbreviations.

 +11               IF RXTY="A"

                       QUIT 

 +12               IF RXTY="I"

                       QUIT 

 +13               IF RXTY="N"

                       QUIT 

 +14               IF RXTY="O"

                       QUIT 

 +15               SET VALID=0

 +16               SET TEXT=RXTY_" is not a valid RXTYPE"

 +17               DO EN^DDIOL(TEXT)

               End DoDot:1

 +18       QUIT VALID

 +19      ;