TIUMOBJLM ;XAN/AJB - MEDICATION OBJECT LIST MANAGER ;Aug 29, 2025@09:15:27
;;1.0;TEXT INTEGRATION UTILITIES;**372**;Jun 20, 1997;Build 5
;
; Reference to *^%ZIS in ICR #10086
; Reference to ^DIC in ICR #10006
; Reference to ^DIM in ICR #10016
; Reference to ^DIR in ICR #10026
; Reference to ^DPT( in ICR #10035
; Reference to *^VALM in ICR #10118
; Reference to *^VALM1 in ICR #10116
; Reference to *^VALM10 in ICR #10117
; Reference to *^XGF in ICR #3173
; Reference to *^XLFDT in ICR #10103
; Reference to *^XLFSTR in ICR #10104
; Reference to *^XPAR in ICR #2263
; Reference to *^XQORM1 in ICR #10102
;
Q
ASK(ACT) ; list manager default entry for numeric input
Q:VALMCNT=0 D FULL^VALM1 G MEDREC:ACT="MEDREC"
S ACT(1)=+$P(XQORNOD(0),"=",2) S:'ACT(1) ACT(1)=$$FMR("NAO^1:"_VALMLST_":0","Select Object (1-"_VALMLST_"): ") Q:'ACT(1)
S ACT=ACT_"("_$O(@VALMAR@("IDX",ACT(1),""))_")"
D @ACT
Q
EN ; main entry point
N %,%DT,C,DISYS,HV0,HV1,IOINHI,IOINORM,IORVOFF,IORVON,IOUOFF,IOUON,POP,RV0,RV1,UL0,UL1,VAR,XPARSYS,XQXFLG,X
D HOME^%ZIS D PREP^XGF
S HV0=IOINORM,HV1=IOINHI,UL0=IOUOFF,UL1=IOUON,RV1=IORVON,RV0=IORVOFF
D EN^VALM("TIUMOBJ MANAGER")
Q
LMEXIT ; exit
D CLEAN^XGF
Q
LMHELP(VALMANS) ; help
S:VALMANS="??" VALMANS=""
D CLS^TIUMOBJLM
W "Selectable Actions:",!!,HV1_"Create Medication Object:"_HV0_" Prompts user for medication parameters and creates",!," a new object without requiring programmer access.",!!
W HV1_"Med Rec Object Auto Fix:"_HV0_" Prompts user to automatically set the new",!," Med Rec/TIUDATE parameter for only Med Rec Objects.",!
W " After entering 'YES', prompts for desired parameter",!," value and confirmation to begin update.",!!
W HV1_"Detailed Display/Edit:"_HV0_" Displays object information and allows user to update",!," the status, print the details, test the output, and",!
W " update the medication specific parameters.",!!,HV1_"Parameter TIUMOBJ On/Off:"_HV0_" Toggles the TIUMOBJ STATUS parameter On/Off.",!
W " This alters the behavior of objects to use the ",!," original TIULMED* routines [OFF] or the updated",!
W " TIUMOBJ routine [ON]. 'Indication' will only be",!," shown when the paremter value is set to ON.",!!
W HV1_"Readme.txt:"_HV0_" Medication Objects 101 + Developer's Notes."
D IOSL^TIUMOBJLM,CLS^TIUMOBJLM,HKEYS^TIUMOBJLM,IOSL^TIUMOBJLM,LMHDR^TIUMOBJLM S VALMANS="",VALMBCK="R"
Q
LMHDR ; header
S VALMHDR(2)=$$CJ^XLFSTR("TIUMOBJ Parameter Value",80)
S VALMHDR(3)=$$SETSTR("Med",$$CJ^XLFSTR("[Status: "_$S($$GET^XPAR("SYS","TIUMOBJ STATUS"):" "_RV1_"ON",1:RV1_"OFF")_RV0_"]",88),78,3)
S VALMSG="?Help PS/PL Print +/-"
S XQORM("#")=$O(^ORD(101,"B","TIUMOBJ DISPLAY OBJECT",0))_U_"1:"_VALMCNT,XQORM("??")="D LMHELP^TIUMOBJLM(.VALMANS)"
Q
LMINIT(VAR,VALMCNT) ; build list
N IEN,NAME S (VAR("medRec"),VALMCNT)=0,NAME="" F S NAME=$O(^TIU(8925.1,"B",NAME)) Q:NAME="" S IEN=0 F S IEN=$O(^TIU(8925.1,"B",NAME,IEN)) Q:'IEN D
. Q:'$D(^TIU(8925.1,"AT","O",IEN)) N N S N(0)=$G(^TIU(8925.1,IEN,0)) Q:$P(N(0),U)="" S N(9)=$G(^TIU(8925.1,IEN,9)) Q:$S(N(9)["^TIULMED":0,N(9)["^TIUMOBJ":0,1:1)
. S VALMCNT=VALMCNT+1 S:N(9)["TIUDATE" VAR("medRec",IEN)="",VAR("medRec")=VAR("medRec")+1
. S N=$$SETFLD^VALM1(VALMCNT,"","NUMBER"),N=$$SETFLD^VALM1($P(N(0),U),N,"NAME"),N=$$SETFLD^VALM1($S(N(9)["TIUDATE":" *",1:""),N,"MEDR"),N=$$SETFLD^VALM1($S($P(N(0),U,7)=11:" YES",1:" NO"),N,"STATUS")
. D SET^VALM10(VALMCNT,N,IEN)
Q
HKEYS ; hidden menu keys
W !,"The following actions are also available:"
N XQORM,ORULT S XQORM=$O(^ORD(101,"B",$P(VALMKEY,U,2),0))_";ORD(101,"
D DISP^XQORM1:XQORM
Q
CROBJ ; create object
D CLS N P D PASK(.P) Q:'$D(P)
I $$FMR("YAO"," Would you like to make this a 'Med Rec' object? ","YES","^D HELP^TIUMOBJLM($X,$Y,"" Enter either 'Y' or 'N'. '^' to exit."")") D CLS,MEDREC^TIUMOBJ2(.P)
D CLS
W UL1_$$CJ^XLFSTR("Medication Object Creator",IOM)_UL0,!!
I $D(P("TIUDATE")) D TIUDATE^TIUMOBJ2(P("TIUDATE"))
W "Selected Parameter Values",!,"=========================",!
D DPAR(.P),IOXY^XGF($Y,0)
G EX:'$$FMR("YAO"," Create a new medication object with these parameters? ","NO","^D HELP^TIUMOBJLM($X,$Y,"" Enter either 'Y' or 'N'. '^' to exit."")")
D CLS,IOXY^XGF($Y+1,0)
S P("Name")=$$OASK($X,$Y)
G EX:$L(P("Name"))<3
D CLEAR^XGF($Y+1,0,$Y+1,130),IOXY^XGF($Y,0)
G EX:'$$FMR("YAO"," Create this object now? ","NO","^D HELP^TIUMOBJLM($X,$Y,"" Enter either 'Y' or 'N'. '^' to exit."")")
S P("IEN")=$$CROBJ^TIUCROBJ(P("Name"),"","",P("OBJM"))
I P("IEN") D CLEAR^XGF($Y+2,0,$Y+2,IOM),IOXY^XGF($Y,1) W P("Name")_" object created successfully."
E W !!?1,$P(P("IEN"),U,2) G EX
D REBLD
EX D IOSL
Q
CHGSTAT(IEN,N) ;
D IOXY^XGF($Y-1,25)
Q:'$$FMR("YAO",$S($P(N(0),U,7)=11:"INACTIVATE",1:"ACTIVATE")_" this object now? ","YES","^D HELP^TIUMOBJLM($X,$Y,""Enter either 'Y' or 'N'. '^' to exit."")")
S $P(^TIU(8925.1,IEN,0),U,7)=$S($P(N(0),U,7)=11:13,1:11)
Q
DISPLAY(IEN) ; detailed display
Q:'IEN I '$D(^TIU(8925.1,IEN)) D REBLD Q
N INPUT,N,OPT,P,PAR,PARS,PNUM,X
D2 ; redisplay
D CLS
D EXTRACT(IEN,.N,.P)
S PARS=$P($T(PARAMETERS),";",2)
F PNUM=1:1:$L(PARS,U) S PAR=$P(PARS,U,PNUM),P(PAR)=$P(P(3),",",PNUM)
D DHDR(.N) D DPAR(.P)
W !,RV1_$$SETSTR(" 'def' indicates no parameter value set, default shown","",0,80)_RV0,!,$$SETSTR("Test Object"," Change Status",45,11)
W !,$$SETSTR("Update Parameters"," Print Object",45,17),! S OPT="CHANGE STATUS PRINT OBJECT TEST OBJECT UPDATE PARAMETERS"
F D Q:$D(INPUT)
. D IOXY^XGF($Y,0) S INPUT=$$UP($E($$FMR("FAO^1:30^S X=$$UP^TIUMOBJLM(X) K:$S(OPT[X:0,""QUIT""[X:0,1:1) X","Select Action: ","Quit","^D HELP^TIUMOBJLM($X,$Y,""Enter 'C', 'P', 'T', or 'U'. '^' to exit."")")))
D:INPUT="C" CHGSTAT(IEN,.N) D:INPUT="T" CLS,TEST(IEN) D:INPUT="U" CLS,UPDATE(IEN) D:INPUT="P"
. N ZTSAVE S ZTSAVE("IEN")="",ZTSAVE("PARS")="" D IOXY^XGF($Y+1,0),EN^XUTMDEVQ("POBJ^TIUMOBJLM("_IEN_","""_PARS_""")","Print Med Object",.ZTSAVE)
G D2:INPUT="C"!(INPUT="P")!(INPUT="T")!(INPUT="U")
Q
MEDREC ; med rec auto fix
D CLS W UL1_$$CJ^XLFSTR("Medication Reconciliation Auto Fix",IOM)_UL0,!!
N NOW,P,PAR
D MEDFIX^TIUMOBJ2(HV0,HV1)
Q:'$$FMR("YAO"," Select the new parameter value and update the Med Rec objects? ","YES","^D HELP^TIUMOBJLM($X,$Y,"" Enter either 'Y' or 'N'. '^' to exit."")")
S NOW=$$FMTE^XLFDT($E($$NOW^XLFDT,1,12))
D CLS,PASK(.P,7) Q:'$D(P) S PAR=P("MR") D CLS
W HV1_"Object Method Update"_HV0,$$RJ^XLFSTR(NOW,IOM-20),!
W UL1_$$CJ^XLFSTR("Medication Reconciliation Auto Fix",IOM)_UL0,!!
W " # of Medication",!," Reconciliation Objects:",?30,VAR("medRec"),!!
W " Med Rec/TIUDATE Fix Value:",?30,P("MR")_$S(P("MR"):" Include TIUDATE [default]",1:" Exclude TIUDATE")
D IOXY^XGF($Y+1,0) Q:'$$FMR("YAO"," Begin the update process? ","NO","^D HELP^TIUMOBJLM($X,$Y,"" Enter either 'Y' or 'N'. '^' to exit."")")
D CLEAR^XGF($Y-1,0,$Y+3,130),IOXY^XGF($Y-3,0)
N IEN,NUM S (IEN,NUM)=0 F S IEN=$O(VAR("medRec",IEN)) Q:'IEN D
. N P,REP S NUM=NUM+1
. D EXTRACT(IEN,,.P)
. S $P(P(3),",",7)=PAR
. S REP(P("Parameters"))=P(1)_","""_P(2)_""","_P(3)
. S P("Update")=$$REPLACE^XLFSTR(P("Method"),.REP)
. S ^TIU(8925.1,IEN,9)=P("Update")
. D IOXY^XGF($Y,1) W "Objects Complete: ",?30,NUM
W " Done."
D IOSL
Q
README ;
D README^TIUMOBJ2
Q
TEST(IEN) ; test medication object
Q:'IEN I '$D(^TIU(8925.1,IEN)) D REBLD Q
N DFN,X,Y S DFN=+$$GETPT() Q:DFN'>0
D CLS
S X=$G(^TIU(8925.1,IEN,9))
I '$$VALIDM(X) W "Syntax error in method." D IOSL Q
; execute method
X X
S X=$P(X,"~@",2),Y=0
F S Y=$O(@X@(Y)) Q:'Y W @X@(Y,0),!
K @X
D IOSL
Q
UPDATE(IEN) ; update medication object
Q:'IEN I '$D(^TIU(8925.1,IEN)) D REBLD Q
N N,NOW,P,REP S NOW=$$FMTE^XLFDT($E($$NOW^XLFDT,1,12))
D EXTRACT(IEN,.N,.P),PASK(.P) Q:'$D(P)
; set replacement of current parameters for user selected parameters
S REP(P("Parameters"))=P(1)_","""_P(2)_""","_P
S REP("^TIUMOBJ(")="^TIULMED("
I P("Method")["TIUDATE" D UPDTMR^TIUMOBJ2(.P,.REP)
S P("Update")=$$REPLACE^XLFSTR(P("Method"),.REP) K REP
W HV1_"Object Method Update"_HV0,$$RJ^XLFSTR(NOW,IOM-20),!!,UL1_$$CJ^XLFSTR("Object "_P("Name"),IOM)_UL0,!!,"Current Method:",!!
S REP(P(1))="<no change>",REP(P(1)_",")="",REP(""""_P(2)_""",")="<no change>,"
W $$REPLACE^XLFSTR(P("Method"),.REP),!!,"Updated Method:",!!,$$REPLACE^XLFSTR(P("Update"),.REP),!
I $$REPLACE^XLFSTR(P("Method"),.REP)=$$REPLACE^XLFSTR(P("Update"),.REP) W !,"No updates needed." G EXU
I $$FMR("YAO","Update this object's method with these parameters? ","NO","^D HELP^TIUMOBJLM(,$Y,""Enter either 'Y' or 'N'."")") D
. S ^TIU(8925.1,IEN,9)=P("Update") W " Done."
EXU D IOSL
Q
; utility functions
CLS D CLEAR^VALM1 Q
;
DHDR(N) ; object detailed display
;;$S(IOST["C-":HV1,1:"")_"Detailed Display"_$S(IOST["C-":HV0,1:"")_$$RJ^XLFSTR($$FMTE^XLFDT($E($$NOW^XLFDT,1,12)),IOM-16)
;;$S(IOST["C-":UL1,1:"")_$$CJ^XLFSTR("Object: "_$P(N(0),U),IOM)_$S(IOST["C-":UL0,1:"")
;;?9,"IEN:",?15,IEN,?40,"Status:",?48,$S($P(N(0),U,7)=11:"ACTIVE",1:"INACTIVE")
;;"Abbreviation:",?15,$P(N(0),U,2),?41,"Owner:",?48,$E($S($P(N(0),U,5):$$GET1^DIQ(200,$P(N(0),U,5)_",",.01),1:$$GET1^DIQ(8930,$P(N(0),U,6)_",",.01)),1,30)
;;""
;;$S(IOST["C-":UL1,1:"")_"Technical Details"_$S(IOST["C-":UL0,1:"")
;;?6,"Method:",?15,$E(N(9),1,65)
;;?15,$S($E(N(9),66,$L(N(9)))'="":$E(N(9),66,$L(N(9))),1:"")
;;$S(IOST["C-":UL1,1:"")_"Medication Parameters"_$S(IOST["C-":UL0,1:"")
;;EOM
N X,Y F X=1:1 S Y=$P($T(DHDR+X),";;",2) Q:Y="EOM" W @Y,!
Q
DPAR(P) ; display parameter values
N PAR,PLIST,PNUM
S PLIST=$P($T(PARAMETERS),";",2) F PNUM=1:1:$L(PLIST,U) S PAR=$P(PLIST,U,PNUM) D
. W ?$S($L(PAR)=1:2,1:1),PAR,"=",$S(P(PAR)="":"def",1:P(PAR)),?9
. I PAR="A" W $S('P(PAR):"Active & Recently Expired",P(PAR)=1:"Active",P(PAR)=2:"Recently Expired")
. I PAR="D" W $S('P(PAR):"Standard",1:"Detailed")_" Output"
. I PAR="M",P(PAR)<4 W $S('P(PAR):"Inpatient or Outpatient [Based on Patient Status]",P(PAR)=1:"Inpatient, Outpatient, Clinic, & Non-VA",P(PAR)=2:"Inpatient",P(PAR)=3:"Outpatient")_" Medications"
. I PAR="M",P(PAR)>3 W $S(P(PAR)=4:"Clinic",P(PAR)=5:"Inpatient & Clinic",P(PAR)=6:"Outpatient & Clinic",P(PAR)=7:"Non-VA")_" Medications"
. I PAR="O" W "Sort by Type [Clinic, Inpatient, Outpatient, & Non-VA]" W:'P(PAR) ", and Status"
. I PAR="SC" W "and Sort by"_$S('P(PAR):" Name",1:" Class") W:P(PAR)=2 " and Display Class in Header"
. I PAR="SU" W $S('P(PAR):"Exclude",1:"Include")_" Supplies"
. I PAR="MR" W $S(P(PAR)=""!(P(PAR)):"Include",1:"Exclude")_" TIUDATE value when calling OCL^PSOORRL"
. W !
I $D(P("TIUDATE")) S P("OBJM")="S TIUDATE="""_P("TIUDATE")_""",X=$$LIST^TIULMED(DFN,""OUTPUT"","_P("A")_","_P("D")_","_P("M")_","_P("O")_","_P("SC")_","_P("SU")_","_P("MR")_")"
E S P("OBJM")="S X=$$LIST^TIULMED(DFN,""OUTPUT"","_P("A")_","_P("D")_","_P("M")_","_P("O")_","_P("SC")_","_P("SU")_","_P("MR")_")"
Q
; returns N(0),N(9) nodes
; P(1)=patient,P(2)=return loc,P(3)=csv of med parameters
; P("Name")=object name
; P("Method")=object method
; P("Parameters")=complete med parameters only
N PAR,REP
S N(0)=$G(^TIU(8925.1,IEN,0)) Q:$P(N(0),U)="" S P("Name")=$P(N(0),U)
S N(9)=$G(^TIU(8925.1,IEN,9)) S P("Method")=N(9)
S PAR=$P(N(9),"X=$$LIST^",2)
S PAR=$P(PAR,")",1,$L(PAR,")")-1)
S PAR=$P(PAR,"(",2,$L(PAR,"("))
S P("Parameters")=PAR,(P(1),P(2),P(3))=""
S P(1)=$P(PAR,",") S:P(1)'="" REP(P(1))="",PAR=$$REPLACE^XLFSTR(PAR,.REP) K REP
S P(2)=$P(PAR,"""",2,$L(PAR,"""")-1)
S P(2)=$S(P(2)="":"OUTPUT",1:P(2)) S REP(P(2))="",PAR=$$REPLACE^XLFSTR(PAR,.REP) K REP
S P(3)=$P(PAR,",",3,9)
Q
FMR(DIR,PRM,DEF,HLP,SCR) ; FM reader, PRM format: <#>Prompt to auto indent #
N DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S DIR=$G(DIR),DIR(0)=$G(DIR(0),DIR) Q:DIR(0)="" ""
I $G(PRM)'="" S DIR("A")=$S(PRM:$P(PRM,";",2),1:PRM) I PRM S DIR("A")=$$SETSTR(DIR("A"),"",+PRM,$L(DIR("A")))
I $G(DEF)'="" S DIR("B")=DEF
I $G(HLP)'="" S DIR("?")=HLP
I $G(SCR)'="" S DIR("S")=SCR
I $P(DIR(0),U)["S",$G(HLP)'="" S DIR("L")=HLP
M DIR=HLP
D ^DIR
Q Y
GETPT() ; prompt user for patient
N %H,%I,DIC,DILOCKTM,DISYS,DTOUT,DUOUT,X,Y
S DIC=2,DIC(0)="AEIMQ",DIC("A")=" Select PATIENT NAME: " D ^DIC
Q Y
HELP(COL,ROW,MSG) ; general help
D IOXY^XGF(ROW+1,$G(COL,0)) W MSG
N X,Y S Y=+$O(MSG(""),-1),X=0 F S X=$O(MSG(X)) Q:'X W !?30,MSG(X)
D IOXY^XGF(ROW-3,0)
D CLEAR^XGF(ROW-1,0,ROW-1,80)
D IOXY^XGF(ROW-3,0)
Q
IOSL F Q:$Y>(IOSL-3) W !
I $$FMR("EA"," Press <Enter> or '^' to continue.")
Q
OASK(COL,ROW) ; prompt user for object name
N RESULT F D Q:$D(RESULT)
. D CLEAR^XGF(ROW+1,0,ROW+1,IOM)
. D IOXY^XGF(ROW,0) S RESULT=$$UP($$FMR("FAO^3:60^K:'(X'?1P.E) X"," Enter the Object Name: ","","^D HELP^TIUMOBJLM($X,$Y,"" Object NAME must be 3-60 characters, not start with punctuation, and be unique."")")) Q:RESULT=""
. I $$CHKNAME^TIUCROBJ(RESULT,"B;C;D") D IOXY^XGF(ROW+3,0) W $$SETSTR(RESULT_" is already in use.","",2,IOM) K RESULT
Q RESULT
PARAMETERS ;A^D^M^O^SC^SU^MR; medication object parameters
PASK(P,PS) ; prompt user for medication object parameters, ps=parameter start
; returns P(<parameter>)=individual parameter value
; P=csv of selected parameters
N PAR,PLIST,PNUM S P(3)=$G(P(3)),PS=$G(PS,1)
S PLIST=$P($T(PARAMETERS),";",2) F PNUM=PS:1:$L(PLIST,U) S PAR=$P(PLIST,U,PNUM) D Q:P(PAR)=U
. N DEF,LINE,LNUM,RNG F LNUM=1:1 S LINE=$P($T(@PAR+LNUM),";;",2) Q:LINE="EOM" D
. . I LNUM=1 D IOXY^XGF(LNUM,30) W "Parameter "_PNUM_" (of "_$L(PLIST,U)_"):"
. . D IOXY^XGF(LNUM+2,30) W LINE
. S DEF=$S($P(P(3),",",PNUM):$P(P(3),",",PNUM),PAR="SU"!(PAR="MR"):1,1:0),RNG=$P($T(@PAR),";;",2)
. S P(PAR)=$$FMR("NOA^0:"_RNG,"31;Parameter Value: ",DEF,"^D HELP^TIUMOBJLM(30,$Y,""Enter a number from 0-""_RNG_"". '^' to exit."")") Q:P(PAR)=U
. S $P(P,",",PNUM)=P(PAR)
. D CLS
I P(PAR)=U K P
Q
POBJ(IEN,PARS) ; print object
N N,P,PAR,PNUM
D EXTRACT(IEN,.N,.P)
F PNUM=1:1:$L(PARS,U) S PAR=$P(PARS,U,PNUM),P(PAR)=$P(P(3),",",PNUM)
D DHDR(.N) D DPAR(.P) D IOSL:IOST["C-"
Q
REBLD ; rebuild list & header
D CLEAN^VALM10,LMINIT(.VAR,.VALMCNT),LMHDR
Q
SETSTR(S,V,X,L) Q $E(V_$J("",X-1),1,X-1)_$E(S_$J("",L),1,L)_$E(V,X+L,999)
;
UP(X) Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
;
VALIDM(X) ; validate object method
D ^DIM
Q $S('$D(X):0,1:1)
; parameter details
A ;;2
;;Filter by Medication Status
;;
;;Value Display
;;===== ========
;; 0 Active & Recently Expired [default]
;; 1 Active Only
;; 2 Recently Expired Only
;;
;;EOM
D ;;1
;;Standard or Detailed Display
;;
;;Value Display
;;===== =======
;; 0 Standard [default]
;; 1 Detailed
;;
;;EOM
M ;;7
;;Filter by Medication Type
;;
;;Value Display
;;===== =======
;; 0 Inpatient or Outpatient based on Patient
;; Status [default]
;; 1 Clinic, Inpatient, Outpatient, & Non-VA
;; 2 Inpatient Only
;; 3 Outpatient Only
;; 4 Clinic Only
;; 5 Inpatient and Clinic
;; 6 Outpatient and Clinic
;; 7 Non-VA Only
;;
;;EOM
O ;;1
;;Sort Medications By Type and/or Status
;;
;;Type [Inpatient/Outpatient/Clinic]
;;Status [Active/Pending/Inactive]
;;
;;Value Display
;;===== =======
;; 0 Sort Meds by Type and Status [default]
;; 1 Sort Meds by Type Only
;;
;;EOM
SC ;;2
;;Sort Medications By Class
;;
;;Value Display
;;===== =======
;; 0 Alphabetical by Name [default]
;; 1 By Class (Alphabetically)
;; 2 By Class (Alphabetically) and
;; Display Class Header
;;
;;EOM
SU ;;1
;;Filter Supplies
;;
;;Value Display
;;===== =======
;; 0 Exclude Supplies
;; 1 Include Supplies [default]
;;
;;EOM
MR ;;1
;;Med Rec/TIUDATE Fix
;;
;;Value Display
;;===== =======
;; 0 Exclude TIUDATE
;; 1 Include TIUDATE [default]
;;
;;EOM
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUMOBJLM 16399 printed Jan 29, 2026@15:41:30 Page 2
TIUMOBJLM ;XAN/AJB - MEDICATION OBJECT LIST MANAGER ;Aug 29, 2025@09:15:27
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**372**;Jun 20, 1997;Build 5
+2 ;
+3 ; Reference to *^%ZIS in ICR #10086
+4 ; Reference to ^DIC in ICR #10006
+5 ; Reference to ^DIM in ICR #10016
+6 ; Reference to ^DIR in ICR #10026
+7 ; Reference to ^DPT( in ICR #10035
+8 ; Reference to *^VALM in ICR #10118
+9 ; Reference to *^VALM1 in ICR #10116
+10 ; Reference to *^VALM10 in ICR #10117
+11 ; Reference to *^XGF in ICR #3173
+12 ; Reference to *^XLFDT in ICR #10103
+13 ; Reference to *^XLFSTR in ICR #10104
+14 ; Reference to *^XPAR in ICR #2263
+15 ; Reference to *^XQORM1 in ICR #10102
+16 ;
+17 QUIT
ASK(ACT) ; list manager default entry for numeric input
+1 if VALMCNT=0
QUIT
DO FULL^VALM1
if ACT="MEDREC"
GOTO MEDREC
+2 SET ACT(1)=+$PIECE(XQORNOD(0),"=",2)
if 'ACT(1)
SET ACT(1)=$$FMR("NAO^1:"_VALMLST_":0","Select Object (1-"_VALMLST_"): ")
if 'ACT(1)
QUIT
+3 SET ACT=ACT_"("_$ORDER(@VALMAR@("IDX",ACT(1),""))_")"
+4 DO @ACT
+5 QUIT
EN ; main entry point
+1 NEW %,%DT,C,DISYS,HV0,HV1,IOINHI,IOINORM,IORVOFF,IORVON,IOUOFF,IOUON,POP,RV0,RV1,UL0,UL1,VAR,XPARSYS,XQXFLG,X
+2 DO HOME^%ZIS
DO PREP^XGF
+3 SET HV0=IOINORM
SET HV1=IOINHI
SET UL0=IOUOFF
SET UL1=IOUON
SET RV1=IORVON
SET RV0=IORVOFF
+4 DO EN^VALM("TIUMOBJ MANAGER")
+5 QUIT
LMEXIT ; exit
+1 DO CLEAN^XGF
+2 QUIT
LMHELP(VALMANS) ; help
+1 if VALMANS="??"
SET VALMANS=""
+2 DO CLS^TIUMOBJLM
+3 WRITE "Selectable Actions:",!!,HV1_"Create Medication Object:"_HV0_" Prompts user for medication parameters and creates",!," a new object without requiring programmer access.",!!
+4 WRITE HV1_"Med Rec Object Auto Fix:"_HV0_" Prompts user to automatically set the new",!," Med Rec/TIUDATE parameter for only Med Rec Objects.",!
+5 WRITE " After entering 'YES', prompts for desired parameter",!," value and confirmation to begin update.",!!
+6 WRITE HV1_"Detailed Display/Edit:"_HV0_" Displays object information and allows user to update",!," the status, print the details, test the output, and",!
+7 WRITE " update the medication specific parameters.",!!,HV1_"Parameter TIUMOBJ On/Off:"_HV0_" Toggles the TIUMOBJ STATUS parameter On/Off.",!
+8 WRITE " This alters the behavior of objects to use the ",!," original TIULMED* routines [OFF] or the updated",!
+9 WRITE " TIUMOBJ routine [ON]. 'Indication' will only be",!," shown when the paremter value is set to ON.",!!
+10 WRITE HV1_"Readme.txt:"_HV0_" Medication Objects 101 + Developer's Notes."
+11 DO IOSL^TIUMOBJLM
DO CLS^TIUMOBJLM
DO HKEYS^TIUMOBJLM
DO IOSL^TIUMOBJLM
DO LMHDR^TIUMOBJLM
SET VALMANS=""
SET VALMBCK="R"
+12 QUIT
LMHDR ; header
+1 SET VALMHDR(2)=$$CJ^XLFSTR("TIUMOBJ Parameter Value",80)
+2 SET VALMHDR(3)=$$SETSTR("Med",$$CJ^XLFSTR("[Status: "_$SELECT($$GET^XPAR("SYS","TIUMOBJ STATUS"):" "_RV1_"ON",1:RV1_"OFF")_RV0_"]",88),78,3)
+3 SET VALMSG="?Help PS/PL Print +/-"
+4 SET XQORM("#")=$ORDER(^ORD(101,"B","TIUMOBJ DISPLAY OBJECT",0))_U_"1:"_VALMCNT
SET XQORM("??")="D LMHELP^TIUMOBJLM(.VALMANS)"
+5 QUIT
LMINIT(VAR,VALMCNT) ; build list
+1 NEW IEN,NAME
SET (VAR("medRec"),VALMCNT)=0
SET NAME=""
FOR
SET NAME=$ORDER(^TIU(8925.1,"B",NAME))
if NAME=""
QUIT
SET IEN=0
FOR
SET IEN=$ORDER(^TIU(8925.1,"B",NAME,IEN))
if 'IEN
QUIT
Begin DoDot:1
+2 if '$DATA(^TIU(8925.1,"AT","O",IEN))
QUIT
NEW N
SET N(0)=$GET(^TIU(8925.1,IEN,0))
if $PIECE(N(0),U)=""
QUIT
SET N(9)=$GET(^TIU(8925.1,IEN,9))
if $SELECT(N(9)["^TIULMED"
QUIT
+3 SET VALMCNT=VALMCNT+1
if N(9)["TIUDATE"
SET VAR("medRec",IEN)=""
SET VAR("medRec")=VAR("medRec")+1
+4 SET N=$$SETFLD^VALM1(VALMCNT,"","NUMBER")
SET N=$$SETFLD^VALM1($PIECE(N(0),U),N,"NAME")
SET N=$$SETFLD^VALM1($SELECT(N(9)["TIUDATE":" *",1:""),N,"MEDR")
SET N=$$SETFLD^VALM1($SELECT($PIECE(N(0),U,7)=11:" YES",1:" NO"),N,"STATUS")
+5 DO SET^VALM10(VALMCNT,N,IEN)
End DoDot:1
+6 QUIT
HKEYS ; hidden menu keys
+1 WRITE !,"The following actions are also available:"
+2 NEW XQORM,ORULT
SET XQORM=$ORDER(^ORD(101,"B",$PIECE(VALMKEY,U,2),0))_";ORD(101,"
+3 if XQORM
DO DISP^XQORM1
+4 QUIT
CROBJ ; create object
+1 DO CLS
NEW P
DO PASK(.P)
if '$DATA(P)
QUIT
+2 IF $$FMR("YAO"," Would you like to make this a 'Med Rec' object? ","YES","^D HELP^TIUMOBJLM($X,$Y,"" Enter either 'Y' or 'N'. '^' to exit."")")
DO CLS
DO MEDREC^TIUMOBJ2(.P)
+3 DO CLS
+4 WRITE UL1_$$CJ^XLFSTR("Medication Object Creator",IOM)_UL0,!!
+5 IF $DATA(P("TIUDATE"))
DO TIUDATE^TIUMOBJ2(P("TIUDATE"))
+6 WRITE "Selected Parameter Values",!,"=========================",!
+7 DO DPAR(.P)
DO IOXY^XGF($Y,0)
+8 if '$$FMR("YAO"," Create a new medication object with these parameters? ","NO","^D HELP^TIUMOBJLM($X,$Y,"" Enter either 'Y' or 'N'. '^' to exit."")")
GOTO EX
+9 DO CLS
DO IOXY^XGF($Y+1,0)
+10 SET P("Name")=$$OASK($X,$Y)
+11 if $LENGTH(P("Name"))<3
GOTO EX
+12 DO CLEAR^XGF($Y+1,0,$Y+1,130)
DO IOXY^XGF($Y,0)
+13 if '$$FMR("YAO"," Create this object now? ","NO","^D HELP^TIUMOBJLM($X,$Y,"" Enter either 'Y' or 'N'. '^' to exit."")")
GOTO EX
+14 SET P("IEN")=$$CROBJ^TIUCROBJ(P("Name"),"","",P("OBJM"))
+15 IF P("IEN")
DO CLEAR^XGF($Y+2,0,$Y+2,IOM)
DO IOXY^XGF($Y,1)
WRITE P("Name")_" object created successfully."
+16 IF '$TEST
WRITE !!?1,$PIECE(P("IEN"),U,2)
GOTO EX
+17 DO REBLD
EX DO IOSL
+1 QUIT
CHGSTAT(IEN,N) ;
+1 DO IOXY^XGF($Y-1,25)
+2 if '$$FMR("YAO",$SELECT($PIECE(N(0),U,7)=11
QUIT
+3 SET $PIECE(^TIU(8925.1,IEN,0),U,7)=$SELECT($PIECE(N(0),U,7)=11:13,1:11)
+4 QUIT
DISPLAY(IEN) ; detailed display
+1 if 'IEN
QUIT
IF '$DATA(^TIU(8925.1,IEN))
DO REBLD
QUIT
+2 NEW INPUT,N,OPT,P,PAR,PARS,PNUM,X
D2 ; redisplay
+1 DO CLS
+2 DO EXTRACT(IEN,.N,.P)
+3 SET PARS=$PIECE($TEXT(PARAMETERS),";",2)
+4 FOR PNUM=1:1:$LENGTH(PARS,U)
SET PAR=$PIECE(PARS,U,PNUM)
SET P(PAR)=$PIECE(P(3),",",PNUM)
+5 DO DHDR(.N)
DO DPAR(.P)
+6 WRITE !,RV1_$$SETSTR(" 'def' indicates no parameter value set, default shown","",0,80)_RV0,!,$$SETSTR("Test Object"," Change Status",45,11)
+7 WRITE !,$$SETSTR("Update Parameters"," Print Object",45,17),!
SET OPT="CHANGE STATUS PRINT OBJECT TEST OBJECT UPDATE PARAMETERS"
+8 FOR
Begin DoDot:1
+9 DO IOXY^XGF($Y,0)
SET INPUT=$$UP($EXTRACT($$FMR("FAO^1:30^S X=$$UP^TIUMOBJLM(X) K:$S(OPT[X:0,""QUIT""[X:0,1:1) X","Select Action: ","Quit","^D HELP^TIUMOBJLM($X,$Y,""Enter 'C', 'P', 'T', or 'U'. '^' to exit."")")))
End DoDot:1
if $DATA(INPUT)
QUIT
+10 if INPUT="C"
DO CHGSTAT(IEN,.N)
if INPUT="T"
DO CLS
DO TEST(IEN)
if INPUT="U"
DO CLS
DO UPDATE(IEN)
if INPUT="P"
Begin DoDot:1
+11 NEW ZTSAVE
SET ZTSAVE("IEN")=""
SET ZTSAVE("PARS")=""
DO IOXY^XGF($Y+1,0)
DO EN^XUTMDEVQ("POBJ^TIUMOBJLM("_IEN_","""_PARS_""")","Print Med Object",.ZTSAVE)
End DoDot:1
+12 if INPUT="C"!(INPUT="P")!(INPUT="T")!(INPUT="U")
GOTO D2
+13 QUIT
MEDREC ; med rec auto fix
+1 DO CLS
WRITE UL1_$$CJ^XLFSTR("Medication Reconciliation Auto Fix",IOM)_UL0,!!
+2 NEW NOW,P,PAR
+3 DO MEDFIX^TIUMOBJ2(HV0,HV1)
+4 if '$$FMR("YAO"," Select the new parameter value and update the Med Rec objects? ","YES","^D HELP^TIUMOBJLM($X,$Y,"" Enter either 'Y' or 'N'. '^' to exit."")")
QUIT
+5 SET NOW=$$FMTE^XLFDT($EXTRACT($$NOW^XLFDT,1,12))
+6 DO CLS
DO PASK(.P,7)
if '$DATA(P)
QUIT
SET PAR=P("MR")
DO CLS
+7 WRITE HV1_"Object Method Update"_HV0,$$RJ^XLFSTR(NOW,IOM-20),!
+8 WRITE UL1_$$CJ^XLFSTR("Medication Reconciliation Auto Fix",IOM)_UL0,!!
+9 WRITE " # of Medication",!," Reconciliation Objects:",?30,VAR("medRec"),!!
+10 WRITE " Med Rec/TIUDATE Fix Value:",?30,P("MR")_$SELECT(P("MR"):" Include TIUDATE [default]",1:" Exclude TIUDATE")
+11 DO IOXY^XGF($Y+1,0)
if '$$FMR("YAO"," Begin the update process? ","NO","^D HELP^TIUMOBJLM($X,$Y,"" Enter either 'Y' or 'N'. '^' to exit."")")
QUIT
+12 DO CLEAR^XGF($Y-1,0,$Y+3,130)
DO IOXY^XGF($Y-3,0)
+13 NEW IEN,NUM
SET (IEN,NUM)=0
FOR
SET IEN=$ORDER(VAR("medRec",IEN))
if 'IEN
QUIT
Begin DoDot:1
+14 NEW P,REP
SET NUM=NUM+1
+15 DO EXTRACT(IEN,,.P)
+16 SET $PIECE(P(3),",",7)=PAR
+17 SET REP(P("Parameters"))=P(1)_","""_P(2)_""","_P(3)
+18 SET P("Update")=$$REPLACE^XLFSTR(P("Method"),.REP)
+19 SET ^TIU(8925.1,IEN,9)=P("Update")
+20 DO IOXY^XGF($Y,1)
WRITE "Objects Complete: ",?30,NUM
End DoDot:1
+21 WRITE " Done."
+22 DO IOSL
+23 QUIT
README ;
+1 DO README^TIUMOBJ2
+2 QUIT
TEST(IEN) ; test medication object
+1 if 'IEN
QUIT
IF '$DATA(^TIU(8925.1,IEN))
DO REBLD
QUIT
+2 NEW DFN,X,Y
SET DFN=+$$GETPT()
if DFN'>0
QUIT
+3 DO CLS
+4 SET X=$GET(^TIU(8925.1,IEN,9))
+5 IF '$$VALIDM(X)
WRITE "Syntax error in method."
DO IOSL
QUIT
+6 ; execute method
+7 XECUTE X
+8 SET X=$PIECE(X,"~@",2)
SET Y=0
+9 FOR
SET Y=$ORDER(@X@(Y))
if 'Y
QUIT
WRITE @X@(Y,0),!
+10 KILL @X
+11 DO IOSL
+12 QUIT
UPDATE(IEN) ; update medication object
+1 if 'IEN
QUIT
IF '$DATA(^TIU(8925.1,IEN))
DO REBLD
QUIT
+2 NEW N,NOW,P,REP
SET NOW=$$FMTE^XLFDT($EXTRACT($$NOW^XLFDT,1,12))
+3 DO EXTRACT(IEN,.N,.P)
DO PASK(.P)
if '$DATA(P)
QUIT
+4 ; set replacement of current parameters for user selected parameters
+5 SET REP(P("Parameters"))=P(1)_","""_P(2)_""","_P
+6 SET REP("^TIUMOBJ(")="^TIULMED("
+7 IF P("Method")["TIUDATE"
DO UPDTMR^TIUMOBJ2(.P,.REP)
+8 SET P("Update")=$$REPLACE^XLFSTR(P("Method"),.REP)
KILL REP
+9 WRITE HV1_"Object Method Update"_HV0,$$RJ^XLFSTR(NOW,IOM-20),!!,UL1_$$CJ^XLFSTR("Object "_P("Name"),IOM)_UL0,!!,"Current Method:",!!
+10 SET REP(P(1))="<no change>"
SET REP(P(1)_",")=""
SET REP(""""_P(2)_""",")="<no change>,"
+11 WRITE $$REPLACE^XLFSTR(P("Method"),.REP),!!,"Updated Method:",!!,$$REPLACE^XLFSTR(P("Update"),.REP),!
+12 IF $$REPLACE^XLFSTR(P("Method"),.REP)=$$REPLACE^XLFSTR(P("Update"),.REP)
WRITE !,"No updates needed."
GOTO EXU
+13 IF $$FMR("YAO","Update this object's method with these parameters? ","NO","^D HELP^TIUMOBJLM(,$Y,""Enter either 'Y' or 'N'."")")
Begin DoDot:1
+14 SET ^TIU(8925.1,IEN,9)=P("Update")
WRITE " Done."
End DoDot:1
EXU DO IOSL
+1 QUIT
+2 ; utility functions
CLS DO CLEAR^VALM1
QUIT
+1 ;
DHDR(N) ; object detailed display
+1 ;;$S(IOST["C-":HV1,1:"")_"Detailed Display"_$S(IOST["C-":HV0,1:"")_$$RJ^XLFSTR($$FMTE^XLFDT($E($$NOW^XLFDT,1,12)),IOM-16)
+2 ;;$S(IOST["C-":UL1,1:"")_$$CJ^XLFSTR("Object: "_$P(N(0),U),IOM)_$S(IOST["C-":UL0,1:"")
+3 ;;?9,"IEN:",?15,IEN,?40,"Status:",?48,$S($P(N(0),U,7)=11:"ACTIVE",1:"INACTIVE")
+4 ;;"Abbreviation:",?15,$P(N(0),U,2),?41,"Owner:",?48,$E($S($P(N(0),U,5):$$GET1^DIQ(200,$P(N(0),U,5)_",",.01),1:$$GET1^DIQ(8930,$P(N(0),U,6)_",",.01)),1,30)
+5 ;;""
+6 ;;$S(IOST["C-":UL1,1:"")_"Technical Details"_$S(IOST["C-":UL0,1:"")
+7 ;;?6,"Method:",?15,$E(N(9),1,65)
+8 ;;?15,$S($E(N(9),66,$L(N(9)))'="":$E(N(9),66,$L(N(9))),1:"")
+9 ;;$S(IOST["C-":UL1,1:"")_"Medication Parameters"_$S(IOST["C-":UL0,1:"")
+10 ;;EOM
+11 NEW X,Y
FOR X=1:1
SET Y=$PIECE($TEXT(DHDR+X),";;",2)
if Y="EOM"
QUIT
WRITE @Y,!
+12 QUIT
DPAR(P) ; display parameter values
+1 NEW PAR,PLIST,PNUM
+2 SET PLIST=$PIECE($TEXT(PARAMETERS),";",2)
FOR PNUM=1:1:$LENGTH(PLIST,U)
SET PAR=$PIECE(PLIST,U,PNUM)
Begin DoDot:1
+3 WRITE ?$SELECT($LENGTH(PAR)=1:2,1:1),PAR,"=",$SELECT(P(PAR)="":"def",1:P(PAR)),?9
+4 IF PAR="A"
WRITE $SELECT('P(PAR):"Active & Recently Expired",P(PAR)=1:"Active",P(PAR)=2:"Recently Expired")
+5 IF PAR="D"
WRITE $SELECT('P(PAR):"Standard",1:"Detailed")_" Output"
+6 IF PAR="M"
IF P(PAR)<4
WRITE $SELECT('P(PAR):"Inpatient or Outpatient [Based on Patient Status]",P(PAR)=1:"Inpatient, Outpatient, Clinic, & Non-VA",P(PAR)=2:"Inpatient",P(PAR)=3:"Outpatient")_" Medications"
+7 IF PAR="M"
IF P(PAR)>3
WRITE $SELECT(P(PAR)=4:"Clinic",P(PAR)=5:"Inpatient & Clinic",P(PAR)=6:"Outpatient & Clinic",P(PAR)=7:"Non-VA")_" Medications"
+8 IF PAR="O"
WRITE "Sort by Type [Clinic, Inpatient, Outpatient, & Non-VA]"
if 'P(PAR)
WRITE ", and Status"
+9 IF PAR="SC"
WRITE "and Sort by"_$SELECT('P(PAR):" Name",1:" Class")
if P(PAR)=2
WRITE " and Display Class in Header"
+10 IF PAR="SU"
WRITE $SELECT('P(PAR):"Exclude",1:"Include")_" Supplies"
+11 IF PAR="MR"
WRITE $SELECT(P(PAR)=""!(P(PAR)):"Include",1:"Exclude")_" TIUDATE value when calling OCL^PSOORRL"
+12 WRITE !
End DoDot:1
+13 IF $DATA(P("TIUDATE"))
SET P("OBJM")="S TIUDATE="""_P("TIUDATE")_""",X=$$LIST^TIULMED(DFN,""OUTPUT"","_P("A")_","_P("D")_","_P("M")_","_P("O")_","_P("SC")_","_P("SU")_","_P("MR")_")"
+14 IF '$TEST
SET P("OBJM")="S X=$$LIST^TIULMED(DFN,""OUTPUT"","_P("A")_","_P("D")_","_P("M")_","_P("O")_","_P("SC")_","_P("SU")_","_P("MR")_")"
+15 QUIT
+1 ; returns N(0),N(9) nodes
+2 ; P(1)=patient,P(2)=return loc,P(3)=csv of med parameters
+3 ; P("Name")=object name
+4 ; P("Method")=object method
+5 ; P("Parameters")=complete med parameters only
+6 NEW PAR,REP
+7 SET N(0)=$GET(^TIU(8925.1,IEN,0))
if $PIECE(N(0),U)=""
QUIT
SET P("Name")=$PIECE(N(0),U)
+8 SET N(9)=$GET(^TIU(8925.1,IEN,9))
SET P("Method")=N(9)
+9 SET PAR=$PIECE(N(9),"X=$$LIST^",2)
+10 SET PAR=$PIECE(PAR,")",1,$LENGTH(PAR,")")-1)
+11 SET PAR=$PIECE(PAR,"(",2,$LENGTH(PAR,"("))
+12 SET P("Parameters")=PAR
SET (P(1),P(2),P(3))=""
+13 SET P(1)=$PIECE(PAR,",")
if P(1)'=""
SET REP(P(1))=""
SET PAR=$$REPLACE^XLFSTR(PAR,.REP)
KILL REP
+14 SET P(2)=$PIECE(PAR,"""",2,$LENGTH(PAR,"""")-1)
+15 SET P(2)=$SELECT(P(2)="":"OUTPUT",1:P(2))
SET REP(P(2))=""
SET PAR=$$REPLACE^XLFSTR(PAR,.REP)
KILL REP
+16 SET P(3)=$PIECE(PAR,",",3,9)
+17 QUIT
FMR(DIR,PRM,DEF,HLP,SCR) ; FM reader, PRM format: <#>Prompt to auto indent #
+1 NEW DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+2 SET DIR=$GET(DIR)
SET DIR(0)=$GET(DIR(0),DIR)
if DIR(0)=""
QUIT ""
+3 IF $GET(PRM)'=""
SET DIR("A")=$SELECT(PRM:$PIECE(PRM,";",2),1:PRM)
IF PRM
SET DIR("A")=$$SETSTR(DIR("A"),"",+PRM,$LENGTH(DIR("A")))
+4 IF $GET(DEF)'=""
SET DIR("B")=DEF
+5 IF $GET(HLP)'=""
SET DIR("?")=HLP
+6 IF $GET(SCR)'=""
SET DIR("S")=SCR
+7 IF $PIECE(DIR(0),U)["S"
IF $GET(HLP)'=""
SET DIR("L")=HLP
+8 MERGE DIR=HLP
+9 DO ^DIR
+10 QUIT Y
GETPT() ; prompt user for patient
+1 NEW %H,%I,DIC,DILOCKTM,DISYS,DTOUT,DUOUT,X,Y
+2 SET DIC=2
SET DIC(0)="AEIMQ"
SET DIC("A")=" Select PATIENT NAME: "
DO ^DIC
+3 QUIT Y
HELP(COL,ROW,MSG) ; general help
+1 DO IOXY^XGF(ROW+1,$GET(COL,0))
WRITE MSG
+2 NEW X,Y
SET Y=+$ORDER(MSG(""),-1)
SET X=0
FOR
SET X=$ORDER(MSG(X))
if 'X
QUIT
WRITE !?30,MSG(X)
+3 DO IOXY^XGF(ROW-3,0)
+4 DO CLEAR^XGF(ROW-1,0,ROW-1,80)
+5 DO IOXY^XGF(ROW-3,0)
+6 QUIT
IOSL FOR
if $Y>(IOSL-3)
QUIT
WRITE !
+1 IF $$FMR("EA"," Press <Enter> or '^' to continue.")
+2 QUIT
OASK(COL,ROW) ; prompt user for object name
+1 NEW RESULT
FOR
Begin DoDot:1
+2 DO CLEAR^XGF(ROW+1,0,ROW+1,IOM)
+3 DO IOXY^XGF(ROW,0)
SET RESULT=$$UP($$FMR("FAO^3:60^K:'(X'?1P.E) X"," Enter the Object Name: ","","^D HELP^TIUMOBJLM($X,$Y,"" Object NAME must be 3-60 characters, not start with punctuation, and be unique."")"))
if RESULT=""
QUIT
+4 IF $$CHKNAME^TIUCROBJ(RESULT,"B;C;D")
DO IOXY^XGF(ROW+3,0)
WRITE $$SETSTR(RESULT_" is already in use.","",2,IOM)
KILL RESULT
End DoDot:1
if $DATA(RESULT)
QUIT
+5 QUIT RESULT
PARAMETERS ;A^D^M^O^SC^SU^MR; medication object parameters
PASK(P,PS) ; prompt user for medication object parameters, ps=parameter start
+1 ; returns P(<parameter>)=individual parameter value
+2 ; P=csv of selected parameters
+3 NEW PAR,PLIST,PNUM
SET P(3)=$GET(P(3))
SET PS=$GET(PS,1)
+4 SET PLIST=$PIECE($TEXT(PARAMETERS),";",2)
FOR PNUM=PS:1:$LENGTH(PLIST,U)
SET PAR=$PIECE(PLIST,U,PNUM)
Begin DoDot:1
+5 NEW DEF,LINE,LNUM,RNG
FOR LNUM=1:1
SET LINE=$PIECE($TEXT(@PAR+LNUM),";;",2)
if LINE="EOM"
QUIT
Begin DoDot:2
+6 IF LNUM=1
DO IOXY^XGF(LNUM,30)
WRITE "Parameter "_PNUM_" (of "_$LENGTH(PLIST,U)_"):"
+7 DO IOXY^XGF(LNUM+2,30)
WRITE LINE
End DoDot:2
+8 SET DEF=$SELECT($PIECE(P(3),",",PNUM):$PIECE(P(3),",",PNUM),PAR="SU"!(PAR="MR"):1,1:0)
SET RNG=$PIECE($TEXT(@PAR),";;",2)
+9 SET P(PAR)=$$FMR("NOA^0:"_RNG,"31;Parameter Value: ",DEF,"^D HELP^TIUMOBJLM(30,$Y,""Enter a number from 0-""_RNG_"". '^' to exit."")")
if P(PAR)=U
QUIT
+10 SET $PIECE(P,",",PNUM)=P(PAR)
+11 DO CLS
End DoDot:1
if P(PAR)=U
QUIT
+12 IF P(PAR)=U
KILL P
+13 QUIT
POBJ(IEN,PARS) ; print object
+1 NEW N,P,PAR,PNUM
+2 DO EXTRACT(IEN,.N,.P)
+3 FOR PNUM=1:1:$LENGTH(PARS,U)
SET PAR=$PIECE(PARS,U,PNUM)
SET P(PAR)=$PIECE(P(3),",",PNUM)
+4 DO DHDR(.N)
DO DPAR(.P)
if IOST["C-"
DO IOSL
+5 QUIT
REBLD ; rebuild list & header
+1 DO CLEAN^VALM10
DO LMINIT(.VAR,.VALMCNT)
DO LMHDR
+2 QUIT
SETSTR(S,V,X,L) QUIT $EXTRACT(V_$JUSTIFY("",X-1),1,X-1)_$EXTRACT(S_$JUSTIFY("",L),1,L)_$EXTRACT(V,X+L,999)
+1 ;
UP(X) QUIT $TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+1 ;
VALIDM(X) ; validate object method
+1 DO ^DIM
+2 QUIT $SELECT('$DATA(X):0,1:1)
+3 ; parameter details
A ;;2
+1 ;;Filter by Medication Status
+2 ;;
+3 ;;Value Display
+4 ;;===== ========
+5 ;; 0 Active & Recently Expired [default]
+6 ;; 1 Active Only
+7 ;; 2 Recently Expired Only
+8 ;;
+9 ;;EOM
D ;;1
+1 ;;Standard or Detailed Display
+2 ;;
+3 ;;Value Display
+4 ;;===== =======
+5 ;; 0 Standard [default]
+6 ;; 1 Detailed
+7 ;;
+8 ;;EOM
M ;;7
+1 ;;Filter by Medication Type
+2 ;;
+3 ;;Value Display
+4 ;;===== =======
+5 ;; 0 Inpatient or Outpatient based on Patient
+6 ;; Status [default]
+7 ;; 1 Clinic, Inpatient, Outpatient, & Non-VA
+8 ;; 2 Inpatient Only
+9 ;; 3 Outpatient Only
+10 ;; 4 Clinic Only
+11 ;; 5 Inpatient and Clinic
+12 ;; 6 Outpatient and Clinic
+13 ;; 7 Non-VA Only
+14 ;;
+15 ;;EOM
O ;;1
+1 ;;Sort Medications By Type and/or Status
+2 ;;
+3 ;;Type [Inpatient/Outpatient/Clinic]
+4 ;;Status [Active/Pending/Inactive]
+5 ;;
+6 ;;Value Display
+7 ;;===== =======
+8 ;; 0 Sort Meds by Type and Status [default]
+9 ;; 1 Sort Meds by Type Only
+10 ;;
+11 ;;EOM
SC ;;2
+1 ;;Sort Medications By Class
+2 ;;
+3 ;;Value Display
+4 ;;===== =======
+5 ;; 0 Alphabetical by Name [default]
+6 ;; 1 By Class (Alphabetically)
+7 ;; 2 By Class (Alphabetically) and
+8 ;; Display Class Header
+9 ;;
+10 ;;EOM
SU ;;1
+1 ;;Filter Supplies
+2 ;;
+3 ;;Value Display
+4 ;;===== =======
+5 ;; 0 Exclude Supplies
+6 ;; 1 Include Supplies [default]
+7 ;;
+8 ;;EOM
MR ;;1
+1 ;;Med Rec/TIUDATE Fix
+2 ;;
+3 ;;Value Display
+4 ;;===== =======
+5 ;; 0 Exclude TIUDATE
+6 ;; 1 Include TIUDATE [default]
+7 ;;
+8 ;;EOM
