TIUMOBJ2 ;XAN/AJB - MEDICATION OBJECT LIST MANAGER ;Aug 29, 2025@06:54:46
;;1.0;TEXT INTEGRATION UTILITIES;**372**;Jun 20, 1997;Build 5
;
Q
GETDT(P) ; get TIUDATE value(s)
Q:P="" "" N DELIM S DELIM=$S(P[",X=$$LIST":",",P[" X=$$LIST":" ")
Q $TR($P($P(P,"TIUDATE=",2),DELIM),$C(34),"")
MEDFIX(HV0,HV1) ; med rec fix
N X,Y F X=1:1 S Y=$P($T(MRF+X),";;",2) Q:Y="EOM" W @Y,!
Q
MEDREC(P) ; prompt for TIUDATE values for med rec object
N HELP,MAX,PROMPT,RESPONSE,TIUDATE,X,Y
F X=1:1 S Y=$P($T(MR+X),";;",2) Q:Y="EOM" W Y,!
S MAX=7300,TIUDATE("Default")=$$GETDT($G(P("Method")))
S Y=$Y F X=1:1:4 D Q:RESPONSE=U
. I X=2!(X=4),'$P(TIUDATE,U,X-1) S $P(TIUDATE,U,X)="" Q
. S PROMPT=$P($T(@($S(X=1:"OB",X=2:"OE",X=3:"IB",X=4:"IE"))),";",2)_" "
. N I,J F I=1:1 S J=$P($T(@($S(X=1:"OB",X=2:"OE",X=3:"IB",X=4:"IE"))+I),";;",2) Q:J="EOM" S HELP(I)=J
. S HELP="Enter a number from 1-"_$S(X=1!(X=3):MAX,1:$P(TIUDATE,U,X-1))_". '^' to exit."
. S HELP($O(HELP(""),-1)+1)="",HELP($O(HELP(""),-1)+1)="Enter @ to delete an existing value."
. D IOXY^XGF(Y,0),CLEAR^XGF(Y,0,Y+($O(HELP(""),-1)+4),79),IOXY^XGF(Y-1,0)
. S RESPONSE=$$FMR^TIUMOBJLM("NOA^1:"_$S(X=1!(X=3):MAX,1:$P(TIUDATE,U,X-1)),"31;"_PROMPT,$P(TIUDATE("Default"),U,X),"^D HELP^TIUMOBJLM(30,$Y,.HELP)") Q:RESPONSE=U
. S $P(TIUDATE,U,X)=RESPONSE
. F J=1:1:$O(HELP(""),-1) K HELP(J)
Q:RESPONSE=U
S P("TIUDATE")=$S(TIUDATE="^^^":"",1:TIUDATE)
Q
README ;
N TEXT,X,Y
F X=1:1 S Y=$P($T(RM+X),";;",2) Q:Y="EOM" S TEXT(X)=Y
D BROWSE^DDBR("TEXT","NR","Medication/Reconciliation Objects")
Q
TIUDATE(TIUDATE) ; display med rec start/end values
W "Medication Reconciliation TIUDATE Start/End",!,"=============================================",!
I TIUDATE="" W " N/A TIUDATE will equal """" in method.",!! Q
I +TIUDATE,($P(TIUDATE,U,3)=""!($P(TIUDATE,U,3)=+TIUDATE)),($P(TIUDATE,U,2)=$P(TIUDATE,U,4)) D W !! Q
. N X S X="End Date: "_$S($P(TIUDATE,U,2):"T-"_$P(TIUDATE,U,2),1:"TODAY") W $$SETSTR^TIUMOBJ1(X,"Start Date: T-"_+TIUDATE,(46-$L(X)),$L(X))
N X W "Inpatient",?27,"Outpatient",!
S X="Start Date: "_$S(TIUDATE:"T-"_+TIUDATE,1:"N/A ") W $$SETSTR^TIUMOBJ1(X,"Start Date: T-"_$P(TIUDATE,U,3),28,$L(X)),!
S X="End Date: "_$S($P(TIUDATE,U,2):"T-"_$P(TIUDATE,U,2),1:"TODAY") W $$SETSTR^TIUMOBJ1(X," End Date: "_$S($P(TIUDATE,U,4):"T-"_$P(TIUDATE,U,4),1:"TODAY"),30,$L(X))
W !!
Q
UPDTMR(P,REP) ; update a med rec object
D MEDREC(.P) I '$D(P("TIUDATE")) D CLS^TIUMOBJLM Q
N DELIM S DELIM=$S(P("Method")[",X=$$LIST":",",P("Method")[" X=$$LIST":" ")
S P("TIUDATE")=$S(P("TIUDATE")=U:"""""",$L(P("TIUDATE"),U)=1&P("TIUDATE"):+P("TIUDATE"),1:""""_P("TIUDATE")_"""")
S REP("TIUDATE="_$P($P(P("Method"),"TIUDATE=",2),DELIM))="TIUDATE="_P("TIUDATE")
S REP(" K TIUDATE")=""
D CLS^TIUMOBJLM
Q
MRF ;Med Rec Objects Fix
;;" Med Rec Objects: The variable TIUDATE is set in the method and now supports"
;;" separate starting/ending dates for inpatient & outpatient"
;;" medications. See Readme.txt for additional information."
;;""
;;" DISCONTINUED medications are always excluded."
;;""
;;" Medication objects receive medication data from OUTPATIENT PHARMACY. In some"
;;" circumstances, active outpatient or non-VA medications that precede the start"
;;" date may be inadvertently excluded."
;;""
;;" A new parameter, 'Med Rec/TIUDATE Fix', may be set to "_HV1_"EXCLUDE TIUDATE"_HV0_" as part"
;;" of a temporary fix. Detailed information is included in Readme.txt."
;;""
;;" This option provides an automated process to update this new parameter for all"
;;" Med Rec objects to the desired value."
;;""
;;" Enter YES below to begin this process. No changes will be made until the"
;;" parameter value is selected and confirmed."
;;EOM
MR ;
;;
;; Medication Reconciliation:
;;
;; Date Parameters T-#
;; ================ ===
;; Outpatient Start 1-7300
;; Outpatient End Based on start
;; Inpatient Start 1-7300
;; Inpatient End Based on start
;;
;;EOM
IB ;Inpatient Start:
;;
;;Enter the desired # of days calculated from TODAY
;;to search for INPATIENT and Clinic medications.
;;EOM
IE ;Inpatient End:
;;
;;Enter the ending # of days calculated from TODAY
;;to finish the search. This value must be equal
;;to or less than the Begin INPATIENT search value.
;;
;;Leaving this value empty defaults to TODAY.
;;EOM
OB ;Outpatient Start:
;;
;;Enter the desired # of days calculated from TODAY
;;to search for OUTPATIENT and Non-VA medications.
;;EOM
OE ;Outpatient End:
;;
;;Enter the ending # of days calculated from TODAY
;;to finish the search. This value must be equal
;;to or less than the Begin OUTPATIENT search value.
;;
;;Leaving this value empty defaults to TODAY.
;;EOM
RM ;Medication Objects 101
;;
;; Important Information: If the "Med Rec/TIUDATE Fix" parameter is set to
;; EXCLUDE the TIUDATE variable for a specific object,
;; none of the values set in TIUDATE will be used.
;;
;; The object will behave like a standard medication
;; object. This specific parameter value may be updated
;; for all 'Med Rec' objects automatically to the desired
;; value via the 'Med Rec Object Auto Fix' action.
;;
;; A medication object is any TIU object that SETS the variable X by invoking
;; $$LIST from the TIULMED or TIUMOBJ routines in its method.
;;
;; Ex: S X=$$LIST^TIULMED(<parameters>) or $$LIST^TIUMOBJ(<parameters>)
;;
;; A 'Medication Reconciliation' object is a medication object that sets a
;; variable, TIUDATE, in its method. If TIUDATE exists in the object's method,
;; even with no value(s), it is still considered a 'Med Rec' object.
;;
;; Ex: S TIUDATE=<value(s)>,X=$$LIST^TIULMED(<parameters>)
;;
;; These objects behave differently than standard objects in two ways:
;;
;; - The default starting value(s) for inpatient and outpatient medications
;; are replaced by the values in the TIUDATE variable.
;;
;; - Medications with a status of "Discontinued" will always be excluded from
;; the data.
;;
;; TIUDATE now supports separate starting/ending dates for inpatient & outpatient
;; medications. This update is fully compatible with existing objects. See the
;; precedence list below on how objects with only the outpatient values will
;; function.
;;
;; TIUDATE may be set as a single numeric value, a 4-piece delimited string with
;; one or more numeric values, or an empty string (TIUDATE="").
;;
;; Ex: S TIUDATE="365^^180^"
;;
;; Piece 1: Outpatient Starting Date
;; Piece 2: Outpatient Ending Date
;; Piece 3: Inpatient Starting Date
;; Piece 4: Inpatient Ending Date
;;
;; The numeric values in TIUDATE represent the # of days calculated from TODAY
;; to search in the past for the desired medication type.
;;
;; Important note: if TIUDATE does not contain any numeric values, it will
;; function exactly like a standard medication object.
;;
;; Since all of the TIUDATE values are optional, the precedence for how specific
;; date combinations will work are detailed below.
;;
;; OUTPATIENT Start: The T-<value> date will apply to both outpatient &
;; inpatient medications if no inpatient value is set.
;; Default is T-120 if not set.
;;
;; OUTPATIENT End: May only have a value if start date exists. Default is
;; TODAY if not set.
;;
;; INPATIENT Start: Applies only to inpatient medications even if there is
;; no value set for outpatient medications. Default is
;; T-30 if not set.
;;
;; INPATIENT End: May only have a value if start date exists. Default is
;; TODAY if not set.
;;
;; The default values stated above are implemented by OUTPATIENT PHARMACY. TIU
;; will always send the value stored in the TIUDATE variable, even if it's blank.
;;
;; There must be either an OUTPATIENT or INPATIENT start date set to automatically
;; exclude DISCONTINUED medications. Re: Important note above.
;;
;; This object utility will not convert a standard object to a 'Med Rec' object.
;; A 'Med Rec' object will function exactly like a standard object if the TIUDATE
;; variable is empty.
;;
;;
;;
;;
;;
;;
;;
;;
;;
;;
;;
;;
;;
;;
;;
;;
;;
;;
;;
;;
;;
;;
;; I would like to thank everyone involved in the testing and release of this
;; patch. All of the new functionality included here was directly suggested by
;; or inspired from the wonderful people at the Fargo, Minneapolis, & Providence
;; VAMCs. Their feedback was instrumental and all of the good ideas are theirs
;; and any defects in the software are mine.
;;
;; ajb 08/28/2025
;;
;;
;;
;;
;;
;;
;;
;;
;;
;;
;;
;;
;;
;;
;;EOM
;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUMOBJ2 9445 printed Jan 29, 2026@15:41:29 Page 2
TIUMOBJ2 ;XAN/AJB - MEDICATION OBJECT LIST MANAGER ;Aug 29, 2025@06:54:46
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**372**;Jun 20, 1997;Build 5
+2 ;
+3 QUIT
GETDT(P) ; get TIUDATE value(s)
+1 if P=""
QUIT ""
NEW DELIM
SET DELIM=$SELECT(P[",X=$$LIST":",",P[" X=$$LIST":" ")
+2 QUIT $TRANSLATE($PIECE($PIECE(P,"TIUDATE=",2),DELIM),$CHAR(34),"")
MEDFIX(HV0,HV1) ; med rec fix
+1 NEW X,Y
FOR X=1:1
SET Y=$PIECE($TEXT(MRF+X),";;",2)
if Y="EOM"
QUIT
WRITE @Y,!
+2 QUIT
MEDREC(P) ; prompt for TIUDATE values for med rec object
+1 NEW HELP,MAX,PROMPT,RESPONSE,TIUDATE,X,Y
+2 FOR X=1:1
SET Y=$PIECE($TEXT(MR+X),";;",2)
if Y="EOM"
QUIT
WRITE Y,!
+3 SET MAX=7300
SET TIUDATE("Default")=$$GETDT($GET(P("Method")))
+4 SET Y=$Y
FOR X=1:1:4
Begin DoDot:1
+5 IF X=2!(X=4)
IF '$PIECE(TIUDATE,U,X-1)
SET $PIECE(TIUDATE,U,X)=""
QUIT
+6 SET PROMPT=$PIECE($TEXT(@($SELECT(X=1:"OB",X=2:"OE",X=3:"IB",X=4:"IE"))),";",2)_" "
+7 NEW I,J
FOR I=1:1
SET J=$PIECE($TEXT(@($SELECT(X=1:"OB",X=2:"OE",X=3:"IB",X=4:"IE"))+I),";;",2)
if J="EOM"
QUIT
SET HELP(I)=J
+8 SET HELP="Enter a number from 1-"_$SELECT(X=1!(X=3):MAX,1:$PIECE(TIUDATE,U,X-1))_". '^' to exit."
+9 SET HELP($ORDER(HELP(""),-1)+1)=""
SET HELP($ORDER(HELP(""),-1)+1)="Enter @ to delete an existing value."
+10 DO IOXY^XGF(Y,0)
DO CLEAR^XGF(Y,0,Y+($ORDER(HELP(""),-1)+4),79)
DO IOXY^XGF(Y-1,0)
+11 SET RESPONSE=$$FMR^TIUMOBJLM("NOA^1:"_$SELECT(X=1!(X=3):MAX,1:$PIECE(TIUDATE,U,X-1)),"31;"_PROMPT,$PIECE(TIUDATE("Default"),U,X),"^D HELP^TIUMOBJLM(30,$Y,.HELP)")
if RESPONSE=U
QUIT
+12 SET $PIECE(TIUDATE,U,X)=RESPONSE
+13 FOR J=1:1:$ORDER(HELP(""),-1)
KILL HELP(J)
End DoDot:1
if RESPONSE=U
QUIT
+14 if RESPONSE=U
QUIT
+15 SET P("TIUDATE")=$SELECT(TIUDATE="^^^":"",1:TIUDATE)
+16 QUIT
README ;
+1 NEW TEXT,X,Y
+2 FOR X=1:1
SET Y=$PIECE($TEXT(RM+X),";;",2)
if Y="EOM"
QUIT
SET TEXT(X)=Y
+3 DO BROWSE^DDBR("TEXT","NR","Medication/Reconciliation Objects")
+4 QUIT
TIUDATE(TIUDATE) ; display med rec start/end values
+1 WRITE "Medication Reconciliation TIUDATE Start/End",!,"=============================================",!
+2 IF TIUDATE=""
WRITE " N/A TIUDATE will equal """" in method.",!!
QUIT
+3 IF +TIUDATE
IF ($PIECE(TIUDATE,U,3)=""!($PIECE(TIUDATE,U,3)=+TIUDATE))
IF ($PIECE(TIUDATE,U,2)=$PIECE(TIUDATE,U,4))
Begin DoDot:1
+4 NEW X
SET X="End Date: "_$SELECT($PIECE(TIUDATE,U,2):"T-"_$PIECE(TIUDATE,U,2),1:"TODAY")
WRITE $$SETSTR^TIUMOBJ1(X,"Start Date: T-"_+TIUDATE,(46-$LENGTH(X)),$LENGTH(X))
End DoDot:1
WRITE !!
QUIT
+5 NEW X
WRITE "Inpatient",?27,"Outpatient",!
+6 SET X="Start Date: "_$SELECT(TIUDATE:"T-"_+TIUDATE,1:"N/A ")
WRITE $$SETSTR^TIUMOBJ1(X,"Start Date: T-"_$PIECE(TIUDATE,U,3),28,$LENGTH(X)),!
+7 SET X="End Date: "_$SELECT($PIECE(TIUDATE,U,2):"T-"_$PIECE(TIUDATE,U,2),1:"TODAY")
WRITE $$SETSTR^TIUMOBJ1(X," End Date: "_$SELECT($PIECE(TIUDATE,U,4):"T-"_$PIECE(TIUDATE,U,4),1:"TODAY"),30,$LENGTH(X))
+8 WRITE !!
+9 QUIT
UPDTMR(P,REP) ; update a med rec object
+1 DO MEDREC(.P)
IF '$DATA(P("TIUDATE"))
DO CLS^TIUMOBJLM
QUIT
+2 NEW DELIM
SET DELIM=$SELECT(P("Method")[",X=$$LIST":",",P("Method")[" X=$$LIST":" ")
+3 SET P("TIUDATE")=$SELECT(P("TIUDATE")=U:"""""",$LENGTH(P("TIUDATE"),U)=1&P("TIUDATE"):+P("TIUDATE"),1:""""_P("TIUDATE")_"""")
+4 SET REP("TIUDATE="_$PIECE($PIECE(P("Method"),"TIUDATE=",2),DELIM))="TIUDATE="_P("TIUDATE")
+5 SET REP(" K TIUDATE")=""
+6 DO CLS^TIUMOBJLM
+7 QUIT
MRF ;Med Rec Objects Fix
+1 ;;" Med Rec Objects: The variable TIUDATE is set in the method and now supports"
+2 ;;" separate starting/ending dates for inpatient & outpatient"
+3 ;;" medications. See Readme.txt for additional information."
+4 ;;""
+5 ;;" DISCONTINUED medications are always excluded."
+6 ;;""
+7 ;;" Medication objects receive medication data from OUTPATIENT PHARMACY. In some"
+8 ;;" circumstances, active outpatient or non-VA medications that precede the start"
+9 ;;" date may be inadvertently excluded."
+10 ;;""
+11 ;;" A new parameter, 'Med Rec/TIUDATE Fix', may be set to "_HV1_"EXCLUDE TIUDATE"_HV0_" as part"
+12 ;;" of a temporary fix. Detailed information is included in Readme.txt."
+13 ;;""
+14 ;;" This option provides an automated process to update this new parameter for all"
+15 ;;" Med Rec objects to the desired value."
+16 ;;""
+17 ;;" Enter YES below to begin this process. No changes will be made until the"
+18 ;;" parameter value is selected and confirmed."
+19 ;;EOM
MR ;
+1 ;;
+2 ;; Medication Reconciliation:
+3 ;;
+4 ;; Date Parameters T-#
+5 ;; ================ ===
+6 ;; Outpatient Start 1-7300
+7 ;; Outpatient End Based on start
+8 ;; Inpatient Start 1-7300
+9 ;; Inpatient End Based on start
+10 ;;
+11 ;;EOM
IB ;Inpatient Start:
+1 ;;
+2 ;;Enter the desired # of days calculated from TODAY
+3 ;;to search for INPATIENT and Clinic medications.
+4 ;;EOM
IE ;Inpatient End:
+1 ;;
+2 ;;Enter the ending # of days calculated from TODAY
+3 ;;to finish the search. This value must be equal
+4 ;;to or less than the Begin INPATIENT search value.
+5 ;;
+6 ;;Leaving this value empty defaults to TODAY.
+7 ;;EOM
OB ;Outpatient Start:
+1 ;;
+2 ;;Enter the desired # of days calculated from TODAY
+3 ;;to search for OUTPATIENT and Non-VA medications.
+4 ;;EOM
OE ;Outpatient End:
+1 ;;
+2 ;;Enter the ending # of days calculated from TODAY
+3 ;;to finish the search. This value must be equal
+4 ;;to or less than the Begin OUTPATIENT search value.
+5 ;;
+6 ;;Leaving this value empty defaults to TODAY.
+7 ;;EOM
RM ;Medication Objects 101
+1 ;;
+2 ;; Important Information: If the "Med Rec/TIUDATE Fix" parameter is set to
+3 ;; EXCLUDE the TIUDATE variable for a specific object,
+4 ;; none of the values set in TIUDATE will be used.
+5 ;;
+6 ;; The object will behave like a standard medication
+7 ;; object. This specific parameter value may be updated
+8 ;; for all 'Med Rec' objects automatically to the desired
+9 ;; value via the 'Med Rec Object Auto Fix' action.
+10 ;;
+11 ;; A medication object is any TIU object that SETS the variable X by invoking
+12 ;; $$LIST from the TIULMED or TIUMOBJ routines in its method.
+13 ;;
+14 ;; Ex: S X=$$LIST^TIULMED(<parameters>) or $$LIST^TIUMOBJ(<parameters>)
+15 ;;
+16 ;; A 'Medication Reconciliation' object is a medication object that sets a
+17 ;; variable, TIUDATE, in its method. If TIUDATE exists in the object's method,
+18 ;; even with no value(s), it is still considered a 'Med Rec' object.
+19 ;;
+20 ;; Ex: S TIUDATE=<value(s)>,X=$$LIST^TIULMED(<parameters>)
+21 ;;
+22 ;; These objects behave differently than standard objects in two ways:
+23 ;;
+24 ;; - The default starting value(s) for inpatient and outpatient medications
+25 ;; are replaced by the values in the TIUDATE variable.
+26 ;;
+27 ;; - Medications with a status of "Discontinued" will always be excluded from
+28 ;; the data.
+29 ;;
+30 ;; TIUDATE now supports separate starting/ending dates for inpatient & outpatient
+31 ;; medications. This update is fully compatible with existing objects. See the
+32 ;; precedence list below on how objects with only the outpatient values will
+33 ;; function.
+34 ;;
+35 ;; TIUDATE may be set as a single numeric value, a 4-piece delimited string with
+36 ;; one or more numeric values, or an empty string (TIUDATE="").
+37 ;;
+38 ;; Ex: S TIUDATE="365^^180^"
+39 ;;
+40 ;; Piece 1: Outpatient Starting Date
+41 ;; Piece 2: Outpatient Ending Date
+42 ;; Piece 3: Inpatient Starting Date
+43 ;; Piece 4: Inpatient Ending Date
+44 ;;
+45 ;; The numeric values in TIUDATE represent the # of days calculated from TODAY
+46 ;; to search in the past for the desired medication type.
+47 ;;
+48 ;; Important note: if TIUDATE does not contain any numeric values, it will
+49 ;; function exactly like a standard medication object.
+50 ;;
+51 ;; Since all of the TIUDATE values are optional, the precedence for how specific
+52 ;; date combinations will work are detailed below.
+53 ;;
+54 ;; OUTPATIENT Start: The T-<value> date will apply to both outpatient &
+55 ;; inpatient medications if no inpatient value is set.
+56 ;; Default is T-120 if not set.
+57 ;;
+58 ;; OUTPATIENT End: May only have a value if start date exists. Default is
+59 ;; TODAY if not set.
+60 ;;
+61 ;; INPATIENT Start: Applies only to inpatient medications even if there is
+62 ;; no value set for outpatient medications. Default is
+63 ;; T-30 if not set.
+64 ;;
+65 ;; INPATIENT End: May only have a value if start date exists. Default is
+66 ;; TODAY if not set.
+67 ;;
+68 ;; The default values stated above are implemented by OUTPATIENT PHARMACY. TIU
+69 ;; will always send the value stored in the TIUDATE variable, even if it's blank.
+70 ;;
+71 ;; There must be either an OUTPATIENT or INPATIENT start date set to automatically
+72 ;; exclude DISCONTINUED medications. Re: Important note above.
+73 ;;
+74 ;; This object utility will not convert a standard object to a 'Med Rec' object.
+75 ;; A 'Med Rec' object will function exactly like a standard object if the TIUDATE
+76 ;; variable is empty.
+77 ;;
+78 ;;
+79 ;;
+80 ;;
+81 ;;
+82 ;;
+83 ;;
+84 ;;
+85 ;;
+86 ;;
+87 ;;
+88 ;;
+89 ;;
+90 ;;
+91 ;;
+92 ;;
+93 ;;
+94 ;;
+95 ;;
+96 ;;
+97 ;;
+98 ;;
+99 ;; I would like to thank everyone involved in the testing and release of this
+100 ;; patch. All of the new functionality included here was directly suggested by
+101 ;; or inspired from the wonderful people at the Fargo, Minneapolis, & Providence
+102 ;; VAMCs. Their feedback was instrumental and all of the good ideas are theirs
+103 ;; and any defects in the software are mine.
+104 ;;
+105 ;; ajb 08/28/2025
+106 ;;
+107 ;;
+108 ;;
+109 ;;
+110 ;;
+111 ;;
+112 ;;
+113 ;;
+114 ;;
+115 ;;
+116 ;;
+117 ;;
+118 ;;
+119 ;;
+120 ;;EOM
+121 ;;
