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 ---[H[J[2J[HPXRMRXTY 2559 printed Apr 09, 2024@20:48: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 ;
