PXRMRXTY.m

PXRMRXTY ; SLC/PKR - Routines for RXTYPE. ;09/01/2021

 ;;2.0;CLINICAL REMINDERS;**65**;Feb 04, 2005;Build 438

 ;

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

HTEXT ;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 or plain list.

 ;;For example, 'I,N' or 'IN' 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'. If the list contains 'A', it takes precedence,

 ;;and all RXTYPES will be searched for.

 ;;

 ;;**End Text**

 Q

 ;

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

RXTYXHLP ;Rxtype executable help.

 N DONE,IND,TEXT

 ;DX and DY should not be newed or killed, control by ScreenMan

 S DONE=0

 F IND=1:1 Q:DONE  D

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

 . I TEXT(IND)="**End Text**" K TEXT(IND) S DONE=1 Q

 D BROWSE^DDBR("TEXT","NR","RXTYPE Help")

 I $D(DDS) D REFRESH^DDSUTL S DY=IOSL-7,DX=0 X IOXY S $Y=DY,$X=DX

 Q

 ;

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

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

 N RXTYPE

 K RXTYL

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

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

 I RXTYPE["I" S RXTYL("I")=""

 I RXTYPE["N" S RXTYL("N")=""

 I RXTYPE["O" S RXTYL("O")=""

 Q

 ;

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

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

 N CHAR,IND,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

 F IND=1:1:$L(X) D

 . S CHAR=$E(X,IND)

 . I CHAR="," Q

 . I CHAR="A" Q

 . I CHAR="I" Q

 . I CHAR="N" Q

 . I CHAR="O" Q

 . S VALID=0

 . D EN^DDIOL(CHAR_" is not a valid RXTYPE")

 Q VALID

 ;

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

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

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PXRMRXTY   2559     printed  Feb 18, 2025@23:15:25                                                                                                                                                                                                    Page 2

PXRMRXTY  ; SLC/PKR - Routines for RXTYPE. ;09/01/2021

 +1       ;;2.0;CLINICAL REMINDERS;**65**;Feb 04, 2005;Build 438

 +2       ;

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

HTEXT     ;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 or plain list.

 +8       ;;For example, 'I,N' or 'IN' would search for inpatient medications and non-VA

 +9       ;;meds.

 +10      ;;

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

 +12      ;;RXTYPE is equivalent to 'A'. If the list contains 'A', it takes precedence,

 +13      ;;and all RXTYPES will be searched for.

 +14      ;;

 +15      ;;**End Text**

 +16       QUIT 

 +17      ;

 +18      ;===============================================

RXTYXHLP  ;Rxtype executable help.

 +1        NEW DONE,IND,TEXT

 +2       ;DX and DY should not be newed or killed, control by ScreenMan

 +3        SET DONE=0

 +4        FOR IND=1:1

               if DONE

                   QUIT 

               Begin DoDot:1

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

 +6                IF TEXT(IND)="**End Text**"

                       KILL TEXT(IND)

                       SET DONE=1

                       QUIT 

               End DoDot:1

 +7        DO BROWSE^DDBR("TEXT","NR","RXTYPE Help")

 +8        IF $DATA(DDS)

               DO REFRESH^DDSUTL

               SET DY=IOSL-7

               SET DX=0

               XECUTE IOXY

               SET $Y=DY

               SET $X=DX

 +9        QUIT 

 +10      ;

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

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

 +1        NEW RXTYPE

 +2        KILL RXTYL

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

 +4        IF (RXTYPE="")!(RXTYPE["A")

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

               QUIT 

 +5        IF RXTYPE["I"

               SET RXTYL("I")=""

 +6        IF RXTYPE["N"

               SET RXTYL("N")=""

 +7        IF RXTYPE["O"

               SET RXTYL("O")=""

 +8        QUIT 

 +9       ;

 +10      ;===============================================

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

 +1        NEW CHAR,IND,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        FOR IND=1:1:$LENGTH(X)

               Begin DoDot:1

 +8                SET CHAR=$EXTRACT(X,IND)

 +9                IF CHAR=","

                       QUIT 

 +10               IF CHAR="A"

                       QUIT 

 +11               IF CHAR="I"

                       QUIT 

 +12               IF CHAR="N"

                       QUIT 

 +13               IF CHAR="O"

                       QUIT 

 +14               SET VALID=0

 +15               DO EN^DDIOL(CHAR_" is not a valid RXTYPE")

               End DoDot:1

 +16       QUIT VALID

 +17      ;

 +18      ;===============================================

VRXTYPEO(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      ;