ORPARMGR ; SPFO/AJB - ListManager Parameter Display for Notifications ;Jul 19, 2019@07:18:52
;;3.0;ORDER ENTRY/RESULTS REPORTING;**500**;Dec 17, 1997;Build 24
;
; Global References
; ^ORD(101,"B" ICR 3617
; External References
; HOME^%ZIS ICR 10086 $$FIND1^DIC ICR 2051 FILE^DID ICR 2051
; $$GET1^DIQ ICR 2056 ^DIR ICR 10026 EN^VALM ICR 10118
; $$SETFLD^VALM1 ICR 10116 $$SETSTR^VALM1 ICR 10116 FULL^VALM1 ICR 10116
; SET^VALM10 ICR 10117 CLEAN^XGF ICR 3173 PREP^XGF ICR 3173
; $$UP^XLFSTR ICR 10104 $$GET^XPAR ICR 2263 EN^XPAR ICR 2263
; ENVAL^XPAR ICR 2263 GETLST^XPAR ICR 2263 BLDLST^XPAREDIT ICR 2336
;
Q
PHDR D PREP^XGF W @IOF,!!,?27,IOUON,"BULK PARAMETER EDITOR MENU",IOUOFF D CLEAN^XGF Q
VIEWP ;
D FULL^VALM1 N ORQ S ORQ=1
I +ENT,+MVL,SEL="" D Q ; show all instances and quit
. N X,LST,NME,ORQ,VAL
. D ; put list in alphabetical order
. . N LIST D GETLST^XPAR(.LIST,ENT,+PAR,"E")
. . S X=0 F S X=$O(LIST(X)) Q:'+X S LST(LIST(X))=""
. W @IOF,$$TEXT($P(ENT(0),U,2)_" ["_$P(ENT(0),U,6)_"]","C",""),!!
. S X=$$TEXT("Instance",1,""),X=$$TEXT("Value","R",X) W IOUON,X,IOUOFF,!
. S ORQ=1,X="" F S X=$O(LST(X)) Q:X=""!('+ORQ) D
. . S NME=$P(X,U),VAL=$P(X,U,2) W $$TEXT(VAL,"R",NME),!
. . I $Y>(IOSL-4) W !,IOCUOFF S ORQ=+$$READ("EA",IORVON_"Press <ENTER> to continue or '^' to exit."_IORVOFF) Q:'+ORQ W @IOF
. I '+ORQ Q
. F Q:$Y>(IOSL-4) W !
. W !,IOCUOFF S ORQ=+$$READ("EA",IORVON_"Press <ENTER> to continue or '^' to exit."_IORVOFF) W IOCUON
;
N USERS S USERS="" I PAR["Processing Flag",+ENT(0)=200,$L(SEL,",")>3 D ; ask to add users to entity list for multiple selections
. W !!,"Multiple Instance Values selected to view."
. W !!,"You may add ALL or SOME of the users from all Instances to the Entity List",!,"for editing automatically.",!
. N DIR S DIR(0)="Y",DIR("?",1)="Adding users to the Entity List automatically bypasses the viewing and"
. S DIR("?")="will take you directly to the Entity List when complete."
. I +$$READ(.DIR,"Would you like to do this") D S:USERS="^" USERS=""
. . K DIR S DIR(0)="SA^A:ALL;S:SOME",DIR("L")="Please enter (A)LL or (S)OME."
. . W ! S USERS=$$READ(.DIR,"Add (A)LL or (S)OME Users: ")
. . I USERS="S^SOME" D
. . . K DIR S DIR(0)="SA^E:ENABLED;D:DISABLED;M:MANDATORY" ;,DIR("?")="Enter the Notification Value of users to add to the Entity List."
. . . W ! S USERS=$$READ(.DIR,"Enter the Notification Value of users to add to the Entity List: ")
;
W @IOF I USERS'="" W "Adding users to the list..."
; get each entry in the SELection list(s), SEL(#) for large selection lists
N LEN,LIST0,LVL S LVL="" F S LVL=$O(SEL(LVL)) Q:LVL=""!('+ORQ) S LEN=$S(+MVL:($L(SEL(LVL),",")-1),'+MVL:1) N J F J=1:1:LEN D
. N IEN S IEN=$S(+MVL:$O(@VALMAR@("IDX",$P(SEL(LVL),",",J),"")),1:1)
. N LIST1 D ENVAL^XPAR(.LIST1,+PAR,$S(+MVL:"`"_IEN,1:IEN)) ; LIST0 main list, LIST1 temp list
. I '+LIST1 D Q
. . W @IOF W:+MVL "Instance: "_$S(+PTR:$$GET1^DIQ(PTR,IEN,.01),1:$P(ENT(0),U,6)),!!
. . N X S X=$$TEXT($P(ENT(0),U,2),1,""),X=$$TEXT("Value","R",X) W IOUON,X,IOUOFF,!
. . W !,$$TEXT("No instances currently set.","C","")
. . F Q:$Y>(IOSL-4) W !
. . W !,IOCUOFF S ORQ=+$$READ("EA",IORVON_"Press <ENTER> to continue or '^' to exit."_IORVOFF) W IOCUON,@IOF S:'MVL ORQ=0 I '+ORQ S X=LEN
. N X S X="" F S X=$O(LIST1(X)) Q:'+X D ; list1 is in IEN order, list0 is alphabetical order by name
. . I $P(ENT(1),U,2)'=$P(X,";",2) Q ; quit if entry in list don't match the entity type
. . N Y S Y=U_$P(X,";",2)_+X_")" Q:'+$D(@Y) ; quit if entry is missing global root
. . S LIST0($$GET1^DIQ(+ENT(0),+X,.01),+X)=$$UP^XLFSTR($$GET^XPAR(X,+PAR,$S(+MVL:"`"_IEN,1:IEN),"E")) ; list0(name,ien)=value
. I USERS="A^ALL" M ENTRIES=LIST0 K LIST0 S USERS("ADDED")=1 Q ; add all entries to entities list, kill main list
. I USERS'="" D K LIST0 S USERS("ADDED")=1 Q ; add screened entries to entitiies list, kill main list
. . N NAME,IEN S (NAME,IEN)="" F S NAME=$O(LIST0(NAME)) Q:NAME="" F S IEN=$O(LIST0(NAME,IEN)) Q:'+IEN D
. . . I LIST0(NAME,IEN)=$P(USERS,U,2) S ENTRIES(NAME,IEN)=""
. ; begin display of data
. W:+MVL "Instance: "_$S(+PTR:$$GET1^DIQ(PTR,IEN,.01),1:$P(ENT(0),U,6)),!!
. S X=$$TEXT($P(ENT(0),U,2),1,""),X=$$TEXT("Value","R",X) W IOUON,X,IOUOFF,!
. N Y S X="" F S X=$O(LIST0(X)) Q:X=""!('+ORQ) S Y="" F S Y=$O(LIST0(X,Y)) Q:'+Y D
. . N STR S STR="",STR=$$TEXT($E(X,1,40),1,STR) ; set name
. . S STR=$$TEXT(LIST0(X,Y),"R",STR) ; set value
. . W STR,!
. . I $Y>(IOSL-4) D ASK2ADD W:+ORQ @IOF ; S ORQ=+$$READ("EA",IORVON_"Press <ENTER> to continue or '^' to exit."_IORVOFF) W:+ORQ @IOF
. I '+ORQ S J=LEN Q
. F Q:$Y>(IOSL-4) W !
. D ASK2ADD W:+ORQ @IOF
I +$G(USERS("ADDED")) K USERS W @IOF,"Users have been automatically added as entities...taking you to the list." H 3 D EN^ORPARMG1
Q
ASK2ADD ;
I +ENT(0)'=200!(PAR'["Processing Flag") D Q
. W !,IOCUOFF S ORQ=+$$READ("EA",IORVON_"Press <ENTER> to continue or '^' to exit."_IORVOFF) ; Q:'+ORQ W @IOF
D
. N DIR W IOCUOFF
. S DIR("L",1)="Selecting 'A' will add ALL of the users in this list as ENTITIES."
. S DIR("L")="Selecting 'S' will add SOME of the users based on the selected parameter value."
. S DIR("?",1)="Press <ENTER> to continue displaying the list."
. S DIR("?")="Press '^' to exit displaying the list."
. S DIR(0)="SAO^A:ALL;S:SOME",X("L")="" S ORQ=$$READ(.DIR,IORVON_"Press <ENTER> to continue, 'A', 'S' or '^' to exit"_IORVOFF_" ")
. I ORQ="" S ORQ=1 W @IOF Q
. I ORQ="^" S ORQ=0 Q
. I ORQ="A^ALL" M ENTRIES=LIST0 K LIST0 S ORQ=0,USERS("ADDED")=1 Q
. W IOCUON K DIR S DIR("?")="Enter the parameter value for users that you would like added to the ENTITY list."
. S DIR(0)="SAO^E:ENABLED;D:DISABLED;M:MANDATORY" W ! S (USERS,ORQ)=$$READ(.DIR,"Enter the parameter value for users to be added to the ENTITY list: ")
. I ORQ="" S ORQ=1 W @IOF Q
. I ORQ="^" S ORQ=0 Q
. S ORQ=1 N NAME,IEN S (NAME,IEN)="" F S NAME=$O(LIST0(NAME)) Q:NAME="" F S IEN=$O(LIST0(NAME,IEN)) Q:'+IEN D
. . I LIST0(NAME,IEN)=$P(USERS,U,2) S ENTRIES(NAME,IEN)="",USERS("ADDED")=1
. S USERS=""
Q
UPDATE(TMP) ;
S VAL=$P(TMP,U),VAL(0)=$P(TMP,U,2),VAL("X")=TMP("X")
W !!,"Updating entries..."
N LVL S LVL="" F S LVL=$O(SEL(LVL)) Q:LVL="" D
. N ERR,IEN,LEN S LEN=$L(SEL(LVL),",")-1
. N J F J=1:1:LEN D
. . S IEN=$O(@VALMAR@("IDX",$P(SEL(LVL),",",J),"")) Q:'+IEN ; error here if no IEN
. . I +ENT D EN^XPAR(ENT,+PAR,$S(+MVL:"`"_IEN,1:IEN),.VAL,.ERR) I +ERR,+ERR'=1 D ERR(.ERR)
. . I '+ENT,'MVL D EN^XPAR(IEN_ENT,+PAR,1,.VAL,.ERR) I +ERR,+ERR'=1 D ERR(.ERR)
. . N DA,NAME
. . S NAME="" F S NAME=$O(ENTRIES(NAME)) Q:NAME="" S DA="" F S DA=$O(ENTRIES(NAME,DA)) Q:'+DA D
. . . D EN^XPAR(DA_ENT,+PAR,$S(+MVL:"`"_IEN,1:IEN),.VAL,.ERR) I +ERR,+ERR'=1 D ERR(.ERR)
W "DONE!",! W IOCUOFF I $$READ("EA",IORVON_"Press <ENTER> to continue."_IORVOFF) W IOCUON
Q
SELECT(ACT) ;
D FULL^VALM1
I ACT="VIEWA" D Q
. I '+ENT D Q
. . I +MVL W !!,"Select 'Add/Remove/View Entities' to view instance settings per entity.",!
. . I '+MVL W !!,"Select 'View Instance Value(s)' to view instance settings.",!
. . I $$READ("EA",IOCUOFF_IORVON_"Press <ENTER> to continue."_IORVOFF) W IOCUON
. S ACT="VIEWP",SEL="" D @ACT
I '+ENT,+MVL,'+$D(ENTRIES),ACT'="VIEWP" D Q
. W !!,"No entities selected. Please Add/Remove Entities.",!
. I $$READ("EA",IOCUOFF_IORVON_"Press <ENTER> to continue."_IORVOFF) W IOCUON
I VALMCNT=0 Q
N SEL S SEL=$S(VALMCNT=1:"1,",1:$P(XQORNOD(0),"=",2))
I 'MVL,ACT="VIEWP" S SEL="1,"
I '+$D(SEL(0)) S SEL(0)=SEL ; LM default excludes Y(0)
I SEL="" S SEL=$$LOR(.SEL) Q:'+SEL
D @ACT
Q
INIT ;
K @VALMAR
I '+PTR,+ENT D Q ; single entry
. N X S VALMCNT=1,X=""
. S X=$$SETFLD^VALM1(VALMCNT,X,"NUMBER")
. S X=$$SETFLD^VALM1($P(ENT(0),U,6),X,"INSTANCE")
. D SET^VALM10(1,X,1)
N FNM,GBL,SCR
S FNM=$S(+PTR:PTR,1:+ENT(0))
D FILE^DID(FNM,,"GLOBAL NAME","GBL")
S GBL=$P(GBL("GLOBAL NAME"),",")_")",SCR=$$GET1^DIQ(8989.51,+PAR,8)
N IEN,NAME
S VALMCNT=0,NAME="" F S NAME=$O(@GBL@("B",NAME)) Q:NAME="" S IEN="" F S IEN=$O(@GBL@("B",NAME,IEN)) Q:'+IEN D
. I SCR'="" N RSLT D
. . N DA,ERR D FIND^DIC(FNM,,".01","PX",NAME,,"B",SCR,,"RSLT","ERR") I $D(ERR) Q
. . S DA=0 F S DA=$O(RSLT("DILIST",DA)) Q:'+DA!(+$G(RSLT)) I +RSLT("DILIST",DA,0)=IEN S RSLT=1
. I SCR'="",'+$G(RSLT) Q
. S VALMCNT=VALMCNT+1,X=""
. S X=$$SETFLD^VALM1(VALMCNT,X,"NUMBER")
. S X=$$SETFLD^VALM1($$GET1^DIQ(FNM,IEN,.01),X,"INSTANCE")
. D SET^VALM10(VALMCNT,X,IEN)
. I $$UP^XLFSTR($P(PAR,U,2))["FLAG ITEM" W:VALMCNT=1 !,"Adding instance " D SAY^XGF(1,16,VALMCNT_" to the list.")
Q
LOR(SEL) ; list or range of numbers
N DIR,X,Y
S DIR(0)="LOA^1:"_VALMCNT_":0",DIR("A")="Select Instance(s) (1-"_VALMCNT_"): "
S DIR("?")="Enter a list or range of numbers from 1 to "_VALMCNT
D ^DIR
M SEL=Y
Q SEL
HDR ;
S VALMHDR(1)="Parameter: "_$$UP^XLFSTR($P(PAR,U,2))
S VALMHDR(1)=$$SETSTR^VALM1(VALMHDR(1),"",IOM-$L(VALMHDR(1))/2,$L(VALMHDR(1)))
S VALMHDR(2)="Entity: "_$$UP^XLFSTR($P(ENT(0),U,2))_" "_$S(+$L($P(ENT(0),U,5)):"["_$P(ENT(0),U,6)_"]",+MVL:"[choose via Add/Remove]",1:"")
S VALMHDR(2)=$$SETSTR^VALM1(VALMHDR(2),"",IOM-$L(VALMHDR(2))/2,$L(VALMHDR(2)))
D XQORM
Q
EXIT ;
D XQORM
Q
EXPND ;
Q
XQORM ;
S XQORM("#")=$O(^ORD(101,"B","ORNOT DEFAULT SELECTIONS",0))_U_"1:"_VALMCNT
Q
LU(FILE,NAME,FLAGS,SCREEN,INDEXES) ; $$FIND1^DIC(FILE,IENS,FLAGS,[.]VALUE,[.]INDEXES,[.]SCREEN,MSG_ROOT)
Q $$FIND1^DIC(FILE,"",$G(FLAGS),NAME,$G(INDEXES),$G(SCREEN),"ERR")
READ(DIR,PROMPT,DEFAULT,HELP,SCREEN) ;
N X,Y
S DIR(0)=$S(+$D(DIR(0)):DIR(0),1:DIR)
I $D(SCREEN) S DIR("S")=SCREEN
I $G(PROMPT)]"" S DIR("A")=PROMPT
I $G(DEFAULT)]"" S DIR("B")=DEFAULT
D ^DIR
I $G(X)="@" S Y="@" Q Y
I Y]"",($L($G(Y),U)'=2) S Y=Y_U_$G(Y(0),Y)
Q Y
ERR(ERROR) ;
Q
ASK ;
N DA,DEF,IEN,VAL,X
S (DEF,IEN)=""
I $L(SEL,",")-1=1 S IEN=$O(@VALMAR@("IDX",+SEL,""))
I +IEN D
. I +ENT S DEF=$$GET^XPAR(ENT,+PAR,$S(+MVL:"`"_IEN,1:IEN),"B") Q:DEF'=""
. I 'MVL S DEF=$$GET^XPAR(IEN_ENT,+PAR,,"B")
I '+ENT,$G(ENTRIES)=1 D
. S VALMEVL=1,DA=$O(@VALMAR@("IDX",1,"")),VALMEVL=0
. S DEF=$$GET^XPAR(DA_ENT,+PAR,$S(+MVL:"`"_IEN,1:IEN),"B")
I $L(SEL,",")>2!($G(ENTRIES)>1) W !,"[EDIT] Multiple Values and/or Entries Selected."
S X="EDITVAL^XPAREDT2(.VAL,+PAR,""V"",DEF)" D @X
D:VAL'="" UPDATE(.VAL)
Q
ADDREM ;
I '+ENT,+MVL D EN^ORPARMG1 Q
D FULL^VALM1
W !!,"This parameter is single entity only."
W !!,"Select 'Edit Instance Value' to change the instance value.",!
W IOCUOFF I $$READ("EA",IORVON_"Press <ENTER> to continue."_IORVOFF) W IOCUON
Q
PREP(PAR,ENT) ;
N IOF,LST D HOME^%ZIS W @IOF
S ENT="",PAR=PAR_U_$$GET1^DIQ(8989.51,PAR,.02)
D BLDLST^XPAREDIT(.LST,PAR) ; ICR#2336
W $P(PAR,U,2),$S($P(PAR,U,2)[".":" M",1:" m")_"ay be set for the following:",!
N X S X=0 F S X=$O(LST(X)) Q:'+X D
. W !,?10,X,?15,$P(LST(X),U,2)
. W ?30,$S(+$L($P(LST(X),U,5)):"["_$P(LST(X),U,6)_"]",1:"[choose via ListManager]")
S X=$$KSP^XUPARAM("WHERE") ; ICR # 2541
S SYSTEM=$$FIND1^DIC(4.2,"","QX",X)_";DIC(4.2,"
;S:+$D(LST("P","SYS")) SYSTEM=$P(LST(LST("P","SYS")),U,5)
S LST(0)="SAO^" F X=1:1:LST S LST(0)=LST(0)_X_":"_$P(LST(X),U,2)_$S(X<7:";",1:"")
W ! S X=+$$READ(LST(0),"Enter selection: ","") Q:'+X
S ENT(0)=LST(X)
S ENT=$S(+$P(ENT(0),U,5):$P(ENT(0),U,5),1:"")
N Y D FILE^DID(+ENT(0),,"GLOBAL NAME","Y")
S:'+ENT ENT=";"_$P(Y("GLOBAL NAME"),U,2)
S ENT(1)=Y("GLOBAL NAME")
S MVL=$$GET1^DIQ(8989.51,+PAR,.03,"I") ; multi-valued parameter
S PTR=$$GET1^DIQ(8989.51,+PAR,6.2) ; pointer to file #
Q
EN(PAR) ;
Q:$G(PAR)=""
N ENT,ENTRIES,MVL,PTR,SYSTEM,TMPLIST,XQORM
D FULL^VALM1,HOME^%ZIS
D PREP(.PAR,.ENT) Q:ENT=""
D PREP^XGF ; ICR # 3173
D EN^VALM("OR PARAMETER MGR")
D CLEAN^XGF ; ICR # 3173
Q
PF ; processing flag
D EN($$LU(8989.51,"ORB PROCESSING FLAG","X"))
Q
UR ; urgency
D EN($$LU(8989.51,"ORB URGENCY","X"))
Q
DM ; delete mechanism
D EN($$LU(8989.51,"ORB DELETE MECHANISM","X"))
Q
DR ; default recipients
D EN($$LU(8989.51,"ORB DEFAULT RECIPIENTS","X"))
Q
DRD ; default recipient device(s)
D EN($$LU(8989.51,"ORB DEFAULT RECIPIENT DEVICES","X"))
Q
PR ; provider recipients for notifications
D EN($$LU(8989.51,"ORB PROVIDER RECIPIENTS","X"))
Q
FIO ; flag inpatient orders
D EN($$LU(8989.51,"ORB OI ORDERED - INPT","X"))
Q
FIOPR ; flag inpatient orders for provider recipients
D EN($$LU(8989.51,"ORB OI ORDERED - INPT PR","X"))
Q
FIR ; flag inpatient results
D EN($$LU(8989.51,"ORB OI RESULTS - INPT","X"))
Q
FIRPR ; flag inpatient results for provider recipients
D EN($$LU(8989.51,"ORB OI RESULTS - INPT PR","X"))
Q
FIEO ; flag inpatient expiring orders
D EN($$LU(8989.51,"ORB OI EXPIRING - INPT","X"))
Q
FIEOPR ; flag inpatient expiring orders for provider recipients
D EN($$LU(8989.51,"ORB OI EXPIRING - INPT PR","X"))
Q
FOO ; flag outpatient orders
D EN($$LU(8989.51,"ORB OI ORDERED - OUTPT","X"))
Q
FOOPR ; flag outpatient orders for provider recipients
D EN($$LU(8989.51,"ORB OI ORDERED - OUTPT PR","X"))
Q
FOR ; flag outpatient results
D EN($$LU(8989.51,"ORB OI RESULTS - OUTPT","X"))
Q
FORPR ; flag outpatient results for provider recipients
D EN($$LU(8989.51,"ORB OI RESULTS - OUTPT PR","X"))
Q
FOEO ; flag outpatient expiring orders
D EN($$LU(8989.51,"ORB OI EXPIRING - OUTPT","X"))
Q
FOEOPR ; flag outpatient expiring orders for provider recipients
D EN($$LU(8989.51,"ORB OI EXPIRING - OUTPT PR","X"))
Q
AP ; archive delete period
D EN($$LU(8989.51,"ORB ARCHIVE PERIOD","X"))
Q
FUNSUP ; forward unprocessed notifications to supervisor
D EN($$LU(8989.51,"ORB FORWARD SUPERVISOR","X"))
Q
FUNSUR ; forward unprocessed notifications to surrogates
D EN($$LU(8989.51,"ORB FORWARD SURROGATES","X"))
Q
FUNBKR ; forward unprocessed notifications to backup reviewer
D EN($$LU(8989.51,"ORB FORWARD BACKUP REVIEWER","X"))
Q
DAUO ; set delay for all unverified orders
D EN($$LU(8989.51,"ORB UNVERIFIED ORDER","X"))
Q
DUMO ; set dleay for unverified medication orders
D EN($$LU(8989.51,"ORB UNVERIFIED MED ORDER","X"))
Q
FOB ; send flag orders bulletin
D EN($$LU(8989.51,"ORB FLAGGED ORDERS BULLETIN","X"))
Q
EDSYS ; enable or disable notification system
D EN($$LU(8989.51,"ORB SYSTEM ENABLE/DISABLE","X"))
Q
HELP ;
D FULL^VALM1
W @IOF
N TXT,X,Y S Y="HLPT"
F X=1:1 S TXT=$P($T(@Y+X),";;",2) Q:TXT="EOM" D
. W @TXT,!
F Q:$Y>(IOSL-3) W !
W IOCUOFF I $$READ("EA",IORVON_"Press <ENTER> to continue."_IORVOFF) W IOCUON
S VALMBCK="R"
Q
HLPT ;
;;IOUON,$$TEXT("Page: 1 of 1","R",$$TEXT($$FMTE^XLFDT($$NOW^XLFDT),"C",VALM("TITLE"))),IOUOFF
;;VALMHDR(1)
;;VALMHDR(2)
;;IOUON,$$TEXT(" ","R",$$TEXT("Instance",8)),IOUOFF
;;@VALMAR@(1,0)
;;$S(+$L($G(@VALMAR@(2,0))):@VALMAR@(2,0),1:"")
;;"."
;;"."
;;"<end example list>"
;;""
;;IORVON,$$TEXT(" ","R",$$TEXT("+ Enter ?? for more actions")),IORVOFF
;;$$TEXT("Edit Instance Value Add/Remove/View Entities",6)
;;$$TEXT("View Instance Value(s) Show All Instances",6)
;;"Select Action:Next Screen//"
;;""
;;EOM
Q
TEXT(X,Y,Z) ;TXT,COL,INSERT
S Z=$S($G(Z)="":"",1:Z)
S Y=$S($G(Y)="C":((IOM-$L(X))/2),$G(Y)="R":(IOM-$L(X)),+$G(Y)>0:Y,1:0)
Q $$SETSTR^VALM1(X,Z,Y,$L(X))
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORPARMGR 15712 printed Dec 13, 2024@02:32:25 Page 2
ORPARMGR ; SPFO/AJB - ListManager Parameter Display for Notifications ;Jul 19, 2019@07:18:52
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**500**;Dec 17, 1997;Build 24
+2 ;
+3 ; Global References
+4 ; ^ORD(101,"B" ICR 3617
+5 ; External References
+6 ; HOME^%ZIS ICR 10086 $$FIND1^DIC ICR 2051 FILE^DID ICR 2051
+7 ; $$GET1^DIQ ICR 2056 ^DIR ICR 10026 EN^VALM ICR 10118
+8 ; $$SETFLD^VALM1 ICR 10116 $$SETSTR^VALM1 ICR 10116 FULL^VALM1 ICR 10116
+9 ; SET^VALM10 ICR 10117 CLEAN^XGF ICR 3173 PREP^XGF ICR 3173
+10 ; $$UP^XLFSTR ICR 10104 $$GET^XPAR ICR 2263 EN^XPAR ICR 2263
+11 ; ENVAL^XPAR ICR 2263 GETLST^XPAR ICR 2263 BLDLST^XPAREDIT ICR 2336
+12 ;
+13 QUIT
PHDR DO PREP^XGF
WRITE @IOF,!!,?27,IOUON,"BULK PARAMETER EDITOR MENU",IOUOFF
DO CLEAN^XGF
QUIT
VIEWP ;
+1 DO FULL^VALM1
NEW ORQ
SET ORQ=1
+2 ; show all instances and quit
IF +ENT
IF +MVL
IF SEL=""
Begin DoDot:1
+3 NEW X,LST,NME,ORQ,VAL
+4 ; put list in alphabetical order
Begin DoDot:2
+5 NEW LIST
DO GETLST^XPAR(.LIST,ENT,+PAR,"E")
+6 SET X=0
FOR
SET X=$ORDER(LIST(X))
if '+X
QUIT
SET LST(LIST(X))=""
End DoDot:2
+7 WRITE @IOF,$$TEXT($PIECE(ENT(0),U,2)_" ["_$PIECE(ENT(0),U,6)_"]","C",""),!!
+8 SET X=$$TEXT("Instance",1,"")
SET X=$$TEXT("Value","R",X)
WRITE IOUON,X,IOUOFF,!
+9 SET ORQ=1
SET X=""
FOR
SET X=$ORDER(LST(X))
if X=""!('+ORQ)
QUIT
Begin DoDot:2
+10 SET NME=$PIECE(X,U)
SET VAL=$PIECE(X,U,2)
WRITE $$TEXT(VAL,"R",NME),!
+11 IF $Y>(IOSL-4)
WRITE !,IOCUOFF
SET ORQ=+$$READ("EA",IORVON_"Press <ENTER> to continue or '^' to exit."_IORVOFF)
if '+ORQ
QUIT
WRITE @IOF
End DoDot:2
+12 IF '+ORQ
QUIT
+13 FOR
if $Y>(IOSL-4)
QUIT
WRITE !
+14 WRITE !,IOCUOFF
SET ORQ=+$$READ("EA",IORVON_"Press <ENTER> to continue or '^' to exit."_IORVOFF)
WRITE IOCUON
End DoDot:1
QUIT
+15 ;
+16 ; ask to add users to entity list for multiple selections
NEW USERS
SET USERS=""
IF PAR["Processing Flag"
IF +ENT(0)=200
IF $LENGTH(SEL,",")>3
Begin DoDot:1
+17 WRITE !!,"Multiple Instance Values selected to view."
+18 WRITE !!,"You may add ALL or SOME of the users from all Instances to the Entity List",!,"for editing automatically.",!
+19 NEW DIR
SET DIR(0)="Y"
SET DIR("?",1)="Adding users to the Entity List automatically bypasses the viewing and"
+20 SET DIR("?")="will take you directly to the Entity List when complete."
+21 IF +$$READ(.DIR,"Would you like to do this")
Begin DoDot:2
+22 KILL DIR
SET DIR(0)="SA^A:ALL;S:SOME"
SET DIR("L")="Please enter (A)LL or (S)OME."
+23 WRITE !
SET USERS=$$READ(.DIR,"Add (A)LL or (S)OME Users: ")
+24 IF USERS="S^SOME"
Begin DoDot:3
+25 ;,DIR("?")="Enter the Notification Value of users to add to the Entity List."
KILL DIR
SET DIR(0)="SA^E:ENABLED;D:DISABLED;M:MANDATORY"
+26 WRITE !
SET USERS=$$READ(.DIR,"Enter the Notification Value of users to add to the Entity List: ")
End DoDot:3
End DoDot:2
if USERS="^"
SET USERS=""
End DoDot:1
+27 ;
+28 WRITE @IOF
IF USERS'=""
WRITE "Adding users to the list..."
+29 ; get each entry in the SELection list(s), SEL(#) for large selection lists
+30 NEW LEN,LIST0,LVL
SET LVL=""
FOR
SET LVL=$ORDER(SEL(LVL))
if LVL=""!('+ORQ)
QUIT
SET LEN=$SELECT(+MVL:($LENGTH(SEL(LVL),",")-1),'+MVL:1)
NEW J
FOR J=1:1:LEN
Begin DoDot:1
+31 NEW IEN
SET IEN=$SELECT(+MVL:$ORDER(@VALMAR@("IDX",$PIECE(SEL(LVL),",",J),"")),1:1)
+32 ; LIST0 main list, LIST1 temp list
NEW LIST1
DO ENVAL^XPAR(.LIST1,+PAR,$SELECT(+MVL:"`"_IEN,1:IEN))
+33 IF '+LIST1
Begin DoDot:2
+34 WRITE @IOF
if +MVL
WRITE "Instance: "_$SELECT(+PTR:$$GET1^DIQ(PTR,IEN,.01),1:$PIECE(ENT(0),U,6)),!!
+35 NEW X
SET X=$$TEXT($PIECE(ENT(0),U,2),1,"")
SET X=$$TEXT("Value","R",X)
WRITE IOUON,X,IOUOFF,!
+36 WRITE !,$$TEXT("No instances currently set.","C","")
+37 FOR
if $Y>(IOSL-4)
QUIT
WRITE !
+38 WRITE !,IOCUOFF
SET ORQ=+$$READ("EA",IORVON_"Press <ENTER> to continue or '^' to exit."_IORVOFF)
WRITE IOCUON,@IOF
if 'MVL
SET ORQ=0
IF '+ORQ
SET X=LEN
End DoDot:2
QUIT
+39 ; list1 is in IEN order, list0 is alphabetical order by name
NEW X
SET X=""
FOR
SET X=$ORDER(LIST1(X))
if '+X
QUIT
Begin DoDot:2
+40 ; quit if entry in list don't match the entity type
IF $PIECE(ENT(1),U,2)'=$PIECE(X,";",2)
QUIT
+41 ; quit if entry is missing global root
NEW Y
SET Y=U_$PIECE(X,";",2)_+X_")"
if '+$DATA(@Y)
QUIT
+42 ; list0(name,ien)=value
SET LIST0($$GET1^DIQ(+ENT(0),+X,.01),+X)=$$UP^XLFSTR($$GET^XPAR(X,+PAR,$SELECT(+MVL:"`"_IEN,1:IEN),"E"))
End DoDot:2
+43 ; add all entries to entities list, kill main list
IF USERS="A^ALL"
MERGE ENTRIES=LIST0
KILL LIST0
SET USERS("ADDED")=1
QUIT
+44 ; add screened entries to entitiies list, kill main list
IF USERS'=""
Begin DoDot:2
+45 NEW NAME,IEN
SET (NAME,IEN)=""
FOR
SET NAME=$ORDER(LIST0(NAME))
if NAME=""
QUIT
FOR
SET IEN=$ORDER(LIST0(NAME,IEN))
if '+IEN
QUIT
Begin DoDot:3
+46 IF LIST0(NAME,IEN)=$PIECE(USERS,U,2)
SET ENTRIES(NAME,IEN)=""
End DoDot:3
End DoDot:2
KILL LIST0
SET USERS("ADDED")=1
QUIT
+47 ; begin display of data
+48 if +MVL
WRITE "Instance: "_$SELECT(+PTR:$$GET1^DIQ(PTR,IEN,.01),1:$PIECE(ENT(0),U,6)),!!
+49 SET X=$$TEXT($PIECE(ENT(0),U,2),1,"")
SET X=$$TEXT("Value","R",X)
WRITE IOUON,X,IOUOFF,!
+50 NEW Y
SET X=""
FOR
SET X=$ORDER(LIST0(X))
if X=""!('+ORQ)
QUIT
SET Y=""
FOR
SET Y=$ORDER(LIST0(X,Y))
if '+Y
QUIT
Begin DoDot:2
+51 ; set name
NEW STR
SET STR=""
SET STR=$$TEXT($EXTRACT(X,1,40),1,STR)
+52 ; set value
SET STR=$$TEXT(LIST0(X,Y),"R",STR)
+53 WRITE STR,!
+54 ; S ORQ=+$$READ("EA",IORVON_"Press <ENTER> to continue or '^' to exit."_IORVOFF) W:+ORQ @IOF
IF $Y>(IOSL-4)
DO ASK2ADD
if +ORQ
WRITE @IOF
End DoDot:2
+55 IF '+ORQ
SET J=LEN
QUIT
+56 FOR
if $Y>(IOSL-4)
QUIT
WRITE !
+57 DO ASK2ADD
if +ORQ
WRITE @IOF
End DoDot:1
+58 IF +$GET(USERS("ADDED"))
KILL USERS
WRITE @IOF,"Users have been automatically added as entities...taking you to the list."
HANG 3
DO EN^ORPARMG1
+59 QUIT
ASK2ADD ;
+1 IF +ENT(0)'=200!(PAR'["Processing Flag")
Begin DoDot:1
+2 ; Q:'+ORQ W @IOF
WRITE !,IOCUOFF
SET ORQ=+$$READ("EA",IORVON_"Press <ENTER> to continue or '^' to exit."_IORVOFF)
End DoDot:1
QUIT
+3 Begin DoDot:1
+4 NEW DIR
WRITE IOCUOFF
+5 SET DIR("L",1)="Selecting 'A' will add ALL of the users in this list as ENTITIES."
+6 SET DIR("L")="Selecting 'S' will add SOME of the users based on the selected parameter value."
+7 SET DIR("?",1)="Press <ENTER> to continue displaying the list."
+8 SET DIR("?")="Press '^' to exit displaying the list."
+9 SET DIR(0)="SAO^A:ALL;S:SOME"
SET X("L")=""
SET ORQ=$$READ(.DIR,IORVON_"Press <ENTER> to continue, 'A', 'S' or '^' to exit"_IORVOFF_" ")
+10 IF ORQ=""
SET ORQ=1
WRITE @IOF
QUIT
+11 IF ORQ="^"
SET ORQ=0
QUIT
+12 IF ORQ="A^ALL"
MERGE ENTRIES=LIST0
KILL LIST0
SET ORQ=0
SET USERS("ADDED")=1
QUIT
+13 WRITE IOCUON
KILL DIR
SET DIR("?")="Enter the parameter value for users that you would like added to the ENTITY list."
+14 SET DIR(0)="SAO^E:ENABLED;D:DISABLED;M:MANDATORY"
WRITE !
SET (USERS,ORQ)=$$READ(.DIR,"Enter the parameter value for users to be added to the ENTITY list: ")
+15 IF ORQ=""
SET ORQ=1
WRITE @IOF
QUIT
+16 IF ORQ="^"
SET ORQ=0
QUIT
+17 SET ORQ=1
NEW NAME,IEN
SET (NAME,IEN)=""
FOR
SET NAME=$ORDER(LIST0(NAME))
if NAME=""
QUIT
FOR
SET IEN=$ORDER(LIST0(NAME,IEN))
if '+IEN
QUIT
Begin DoDot:2
+18 IF LIST0(NAME,IEN)=$PIECE(USERS,U,2)
SET ENTRIES(NAME,IEN)=""
SET USERS("ADDED")=1
End DoDot:2
+19 SET USERS=""
End DoDot:1
+20 QUIT
UPDATE(TMP) ;
+1 SET VAL=$PIECE(TMP,U)
SET VAL(0)=$PIECE(TMP,U,2)
SET VAL("X")=TMP("X")
+2 WRITE !!,"Updating entries..."
+3 NEW LVL
SET LVL=""
FOR
SET LVL=$ORDER(SEL(LVL))
if LVL=""
QUIT
Begin DoDot:1
+4 NEW ERR,IEN,LEN
SET LEN=$LENGTH(SEL(LVL),",")-1
+5 NEW J
FOR J=1:1:LEN
Begin DoDot:2
+6 ; error here if no IEN
SET IEN=$ORDER(@VALMAR@("IDX",$PIECE(SEL(LVL),",",J),""))
if '+IEN
QUIT
+7 IF +ENT
DO EN^XPAR(ENT,+PAR,$SELECT(+MVL:"`"_IEN,1:IEN),.VAL,.ERR)
IF +ERR
IF +ERR'=1
DO ERR(.ERR)
+8 IF '+ENT
IF 'MVL
DO EN^XPAR(IEN_ENT,+PAR,1,.VAL,.ERR)
IF +ERR
IF +ERR'=1
DO ERR(.ERR)
+9 NEW DA,NAME
+10 SET NAME=""
FOR
SET NAME=$ORDER(ENTRIES(NAME))
if NAME=""
QUIT
SET DA=""
FOR
SET DA=$ORDER(ENTRIES(NAME,DA))
if '+DA
QUIT
Begin DoDot:3
+11 DO EN^XPAR(DA_ENT,+PAR,$SELECT(+MVL:"`"_IEN,1:IEN),.VAL,.ERR)
IF +ERR
IF +ERR'=1
DO ERR(.ERR)
End DoDot:3
End DoDot:2
End DoDot:1
+12 WRITE "DONE!",!
WRITE IOCUOFF
IF $$READ("EA",IORVON_"Press <ENTER> to continue."_IORVOFF)
WRITE IOCUON
+13 QUIT
SELECT(ACT) ;
+1 DO FULL^VALM1
+2 IF ACT="VIEWA"
Begin DoDot:1
+3 IF '+ENT
Begin DoDot:2
+4 IF +MVL
WRITE !!,"Select 'Add/Remove/View Entities' to view instance settings per entity.",!
+5 IF '+MVL
WRITE !!,"Select 'View Instance Value(s)' to view instance settings.",!
+6 IF $$READ("EA",IOCUOFF_IORVON_"Press <ENTER> to continue."_IORVOFF)
WRITE IOCUON
End DoDot:2
QUIT
+7 SET ACT="VIEWP"
SET SEL=""
DO @ACT
End DoDot:1
QUIT
+8 IF '+ENT
IF +MVL
IF '+$DATA(ENTRIES)
IF ACT'="VIEWP"
Begin DoDot:1
+9 WRITE !!,"No entities selected. Please Add/Remove Entities.",!
+10 IF $$READ("EA",IOCUOFF_IORVON_"Press <ENTER> to continue."_IORVOFF)
WRITE IOCUON
End DoDot:1
QUIT
+11 IF VALMCNT=0
QUIT
+12 NEW SEL
SET SEL=$SELECT(VALMCNT=1:"1,",1:$PIECE(XQORNOD(0),"=",2))
+13 IF 'MVL
IF ACT="VIEWP"
SET SEL="1,"
+14 ; LM default excludes Y(0)
IF '+$DATA(SEL(0))
SET SEL(0)=SEL
+15 IF SEL=""
SET SEL=$$LOR(.SEL)
if '+SEL
QUIT
+16 DO @ACT
+17 QUIT
INIT ;
+1 KILL @VALMAR
+2 ; single entry
IF '+PTR
IF +ENT
Begin DoDot:1
+3 NEW X
SET VALMCNT=1
SET X=""
+4 SET X=$$SETFLD^VALM1(VALMCNT,X,"NUMBER")
+5 SET X=$$SETFLD^VALM1($PIECE(ENT(0),U,6),X,"INSTANCE")
+6 DO SET^VALM10(1,X,1)
End DoDot:1
QUIT
+7 NEW FNM,GBL,SCR
+8 SET FNM=$SELECT(+PTR:PTR,1:+ENT(0))
+9 DO FILE^DID(FNM,,"GLOBAL NAME","GBL")
+10 SET GBL=$PIECE(GBL("GLOBAL NAME"),",")_")"
SET SCR=$$GET1^DIQ(8989.51,+PAR,8)
+11 NEW IEN,NAME
+12 SET VALMCNT=0
SET NAME=""
FOR
SET NAME=$ORDER(@GBL@("B",NAME))
if NAME=""
QUIT
SET IEN=""
FOR
SET IEN=$ORDER(@GBL@("B",NAME,IEN))
if '+IEN
QUIT
Begin DoDot:1
+13 IF SCR'=""
NEW RSLT
Begin DoDot:2
+14 NEW DA,ERR
DO FIND^DIC(FNM,,".01","PX",NAME,,"B",SCR,,"RSLT","ERR")
IF $DATA(ERR)
QUIT
+15 SET DA=0
FOR
SET DA=$ORDER(RSLT("DILIST",DA))
if '+DA!(+$GET(RSLT))
QUIT
IF +RSLT("DILIST",DA,0)=IEN
SET RSLT=1
End DoDot:2
+16 IF SCR'=""
IF '+$GET(RSLT)
QUIT
+17 SET VALMCNT=VALMCNT+1
SET X=""
+18 SET X=$$SETFLD^VALM1(VALMCNT,X,"NUMBER")
+19 SET X=$$SETFLD^VALM1($$GET1^DIQ(FNM,IEN,.01),X,"INSTANCE")
+20 DO SET^VALM10(VALMCNT,X,IEN)
+21 IF $$UP^XLFSTR($PIECE(PAR,U,2))["FLAG ITEM"
if VALMCNT=1
WRITE !,"Adding instance "
DO SAY^XGF(1,16,VALMCNT_" to the list.")
End DoDot:1
+22 QUIT
LOR(SEL) ; list or range of numbers
+1 NEW DIR,X,Y
+2 SET DIR(0)="LOA^1:"_VALMCNT_":0"
SET DIR("A")="Select Instance(s) (1-"_VALMCNT_"): "
+3 SET DIR("?")="Enter a list or range of numbers from 1 to "_VALMCNT
+4 DO ^DIR
+5 MERGE SEL=Y
+6 QUIT SEL
HDR ;
+1 SET VALMHDR(1)="Parameter: "_$$UP^XLFSTR($PIECE(PAR,U,2))
+2 SET VALMHDR(1)=$$SETSTR^VALM1(VALMHDR(1),"",IOM-$LENGTH(VALMHDR(1))/2,$LENGTH(VALMHDR(1)))
+3 SET VALMHDR(2)="Entity: "_$$UP^XLFSTR($PIECE(ENT(0),U,2))_" "_$SELECT(+$LENGTH($PIECE(ENT(0),U,5)):"["_$PIECE(ENT(0),U,6)_"]",+MVL:"[choose via Add/Remove]",1:"")
+4 SET VALMHDR(2)=$$SETSTR^VALM1(VALMHDR(2),"",IOM-$LENGTH(VALMHDR(2))/2,$LENGTH(VALMHDR(2)))
+5 DO XQORM
+6 QUIT
EXIT ;
+1 DO XQORM
+2 QUIT
EXPND ;
+1 QUIT
XQORM ;
+1 SET XQORM("#")=$ORDER(^ORD(101,"B","ORNOT DEFAULT SELECTIONS",0))_U_"1:"_VALMCNT
+2 QUIT
LU(FILE,NAME,FLAGS,SCREEN,INDEXES) ; $$FIND1^DIC(FILE,IENS,FLAGS,[.]VALUE,[.]INDEXES,[.]SCREEN,MSG_ROOT)
+1 QUIT $$FIND1^DIC(FILE,"",$GET(FLAGS),NAME,$GET(INDEXES),$GET(SCREEN),"ERR")
READ(DIR,PROMPT,DEFAULT,HELP,SCREEN) ;
+1 NEW X,Y
+2 SET DIR(0)=$SELECT(+$DATA(DIR(0)):DIR(0),1:DIR)
+3 IF $DATA(SCREEN)
SET DIR("S")=SCREEN
+4 IF $GET(PROMPT)]""
SET DIR("A")=PROMPT
+5 IF $GET(DEFAULT)]""
SET DIR("B")=DEFAULT
+6 DO ^DIR
+7 IF $GET(X)="@"
SET Y="@"
QUIT Y
+8 IF Y]""
IF ($LENGTH($GET(Y),U)'=2)
SET Y=Y_U_$GET(Y(0),Y)
+9 QUIT Y
ERR(ERROR) ;
+1 QUIT
ASK ;
+1 NEW DA,DEF,IEN,VAL,X
+2 SET (DEF,IEN)=""
+3 IF $LENGTH(SEL,",")-1=1
SET IEN=$ORDER(@VALMAR@("IDX",+SEL,""))
+4 IF +IEN
Begin DoDot:1
+5 IF +ENT
SET DEF=$$GET^XPAR(ENT,+PAR,$SELECT(+MVL:"`"_IEN,1:IEN),"B")
if DEF'=""
QUIT
+6 IF 'MVL
SET DEF=$$GET^XPAR(IEN_ENT,+PAR,,"B")
End DoDot:1
+7 IF '+ENT
IF $GET(ENTRIES)=1
Begin DoDot:1
+8 SET VALMEVL=1
SET DA=$ORDER(@VALMAR@("IDX",1,""))
SET VALMEVL=0
+9 SET DEF=$$GET^XPAR(DA_ENT,+PAR,$SELECT(+MVL:"`"_IEN,1:IEN),"B")
End DoDot:1
+10 IF $LENGTH(SEL,",")>2!($GET(ENTRIES)>1)
WRITE !,"[EDIT] Multiple Values and/or Entries Selected."
+11 SET X="EDITVAL^XPAREDT2(.VAL,+PAR,""V"",DEF)"
DO @X
+12 if VAL'=""
DO UPDATE(.VAL)
+13 QUIT
ADDREM ;
+1 IF '+ENT
IF +MVL
DO EN^ORPARMG1
QUIT
+2 DO FULL^VALM1
+3 WRITE !!,"This parameter is single entity only."
+4 WRITE !!,"Select 'Edit Instance Value' to change the instance value.",!
+5 WRITE IOCUOFF
IF $$READ("EA",IORVON_"Press <ENTER> to continue."_IORVOFF)
WRITE IOCUON
+6 QUIT
PREP(PAR,ENT) ;
+1 NEW IOF,LST
DO HOME^%ZIS
WRITE @IOF
+2 SET ENT=""
SET PAR=PAR_U_$$GET1^DIQ(8989.51,PAR,.02)
+3 ; ICR#2336
DO BLDLST^XPAREDIT(.LST,PAR)
+4 WRITE $PIECE(PAR,U,2),$SELECT($PIECE(PAR,U,2)[".":" M",1:" m")_"ay be set for the following:",!
+5 NEW X
SET X=0
FOR
SET X=$ORDER(LST(X))
if '+X
QUIT
Begin DoDot:1
+6 WRITE !,?10,X,?15,$PIECE(LST(X),U,2)
+7 WRITE ?30,$SELECT(+$LENGTH($PIECE(LST(X),U,5)):"["_$PIECE(LST(X),U,6)_"]",1:"[choose via ListManager]")
End DoDot:1
+8 ; ICR # 2541
SET X=$$KSP^XUPARAM("WHERE")
+9 SET SYSTEM=$$FIND1^DIC(4.2,"","QX",X)_";DIC(4.2,"
+10 ;S:+$D(LST("P","SYS")) SYSTEM=$P(LST(LST("P","SYS")),U,5)
+11 SET LST(0)="SAO^"
FOR X=1:1:LST
SET LST(0)=LST(0)_X_":"_$PIECE(LST(X),U,2)_$SELECT(X<7:";",1:"")
+12 WRITE !
SET X=+$$READ(LST(0),"Enter selection: ","")
if '+X
QUIT
+13 SET ENT(0)=LST(X)
+14 SET ENT=$SELECT(+$PIECE(ENT(0),U,5):$PIECE(ENT(0),U,5),1:"")
+15 NEW Y
DO FILE^DID(+ENT(0),,"GLOBAL NAME","Y")
+16 if '+ENT
SET ENT=";"_$PIECE(Y("GLOBAL NAME"),U,2)
+17 SET ENT(1)=Y("GLOBAL NAME")
+18 ; multi-valued parameter
SET MVL=$$GET1^DIQ(8989.51,+PAR,.03,"I")
+19 ; pointer to file #
SET PTR=$$GET1^DIQ(8989.51,+PAR,6.2)
+20 QUIT
EN(PAR) ;
+1 if $GET(PAR)=""
QUIT
+2 NEW ENT,ENTRIES,MVL,PTR,SYSTEM,TMPLIST,XQORM
+3 DO FULL^VALM1
DO HOME^%ZIS
+4 DO PREP(.PAR,.ENT)
if ENT=""
QUIT
+5 ; ICR # 3173
DO PREP^XGF
+6 DO EN^VALM("OR PARAMETER MGR")
+7 ; ICR # 3173
DO CLEAN^XGF
+8 QUIT
PF ; processing flag
+1 DO EN($$LU(8989.51,"ORB PROCESSING FLAG","X"))
+2 QUIT
UR ; urgency
+1 DO EN($$LU(8989.51,"ORB URGENCY","X"))
+2 QUIT
DM ; delete mechanism
+1 DO EN($$LU(8989.51,"ORB DELETE MECHANISM","X"))
+2 QUIT
DR ; default recipients
+1 DO EN($$LU(8989.51,"ORB DEFAULT RECIPIENTS","X"))
+2 QUIT
DRD ; default recipient device(s)
+1 DO EN($$LU(8989.51,"ORB DEFAULT RECIPIENT DEVICES","X"))
+2 QUIT
PR ; provider recipients for notifications
+1 DO EN($$LU(8989.51,"ORB PROVIDER RECIPIENTS","X"))
+2 QUIT
FIO ; flag inpatient orders
+1 DO EN($$LU(8989.51,"ORB OI ORDERED - INPT","X"))
+2 QUIT
FIOPR ; flag inpatient orders for provider recipients
+1 DO EN($$LU(8989.51,"ORB OI ORDERED - INPT PR","X"))
+2 QUIT
FIR ; flag inpatient results
+1 DO EN($$LU(8989.51,"ORB OI RESULTS - INPT","X"))
+2 QUIT
FIRPR ; flag inpatient results for provider recipients
+1 DO EN($$LU(8989.51,"ORB OI RESULTS - INPT PR","X"))
+2 QUIT
FIEO ; flag inpatient expiring orders
+1 DO EN($$LU(8989.51,"ORB OI EXPIRING - INPT","X"))
+2 QUIT
FIEOPR ; flag inpatient expiring orders for provider recipients
+1 DO EN($$LU(8989.51,"ORB OI EXPIRING - INPT PR","X"))
+2 QUIT
FOO ; flag outpatient orders
+1 DO EN($$LU(8989.51,"ORB OI ORDERED - OUTPT","X"))
+2 QUIT
FOOPR ; flag outpatient orders for provider recipients
+1 DO EN($$LU(8989.51,"ORB OI ORDERED - OUTPT PR","X"))
+2 QUIT
FOR ; flag outpatient results
+1 DO EN($$LU(8989.51,"ORB OI RESULTS - OUTPT","X"))
+2 QUIT
FORPR ; flag outpatient results for provider recipients
+1 DO EN($$LU(8989.51,"ORB OI RESULTS - OUTPT PR","X"))
+2 QUIT
FOEO ; flag outpatient expiring orders
+1 DO EN($$LU(8989.51,"ORB OI EXPIRING - OUTPT","X"))
+2 QUIT
FOEOPR ; flag outpatient expiring orders for provider recipients
+1 DO EN($$LU(8989.51,"ORB OI EXPIRING - OUTPT PR","X"))
+2 QUIT
AP ; archive delete period
+1 DO EN($$LU(8989.51,"ORB ARCHIVE PERIOD","X"))
+2 QUIT
FUNSUP ; forward unprocessed notifications to supervisor
+1 DO EN($$LU(8989.51,"ORB FORWARD SUPERVISOR","X"))
+2 QUIT
FUNSUR ; forward unprocessed notifications to surrogates
+1 DO EN($$LU(8989.51,"ORB FORWARD SURROGATES","X"))
+2 QUIT
FUNBKR ; forward unprocessed notifications to backup reviewer
+1 DO EN($$LU(8989.51,"ORB FORWARD BACKUP REVIEWER","X"))
+2 QUIT
DAUO ; set delay for all unverified orders
+1 DO EN($$LU(8989.51,"ORB UNVERIFIED ORDER","X"))
+2 QUIT
DUMO ; set dleay for unverified medication orders
+1 DO EN($$LU(8989.51,"ORB UNVERIFIED MED ORDER","X"))
+2 QUIT
FOB ; send flag orders bulletin
+1 DO EN($$LU(8989.51,"ORB FLAGGED ORDERS BULLETIN","X"))
+2 QUIT
EDSYS ; enable or disable notification system
+1 DO EN($$LU(8989.51,"ORB SYSTEM ENABLE/DISABLE","X"))
+2 QUIT
HELP ;
+1 DO FULL^VALM1
+2 WRITE @IOF
+3 NEW TXT,X,Y
SET Y="HLPT"
+4 FOR X=1:1
SET TXT=$PIECE($TEXT(@Y+X),";;",2)
if TXT="EOM"
QUIT
Begin DoDot:1
+5 WRITE @TXT,!
End DoDot:1
+6 FOR
if $Y>(IOSL-3)
QUIT
WRITE !
+7 WRITE IOCUOFF
IF $$READ("EA",IORVON_"Press <ENTER> to continue."_IORVOFF)
WRITE IOCUON
+8 SET VALMBCK="R"
+9 QUIT
HLPT ;
+1 ;;IOUON,$$TEXT("Page: 1 of 1","R",$$TEXT($$FMTE^XLFDT($$NOW^XLFDT),"C",VALM("TITLE"))),IOUOFF
+2 ;;VALMHDR(1)
+3 ;;VALMHDR(2)
+4 ;;IOUON,$$TEXT(" ","R",$$TEXT("Instance",8)),IOUOFF
+5 ;;@VALMAR@(1,0)
+6 ;;$S(+$L($G(@VALMAR@(2,0))):@VALMAR@(2,0),1:"")
+7 ;;"."
+8 ;;"."
+9 ;;"<end example list>"
+10 ;;""
+11 ;;IORVON,$$TEXT(" ","R",$$TEXT("+ Enter ?? for more actions")),IORVOFF
+12 ;;$$TEXT("Edit Instance Value Add/Remove/View Entities",6)
+13 ;;$$TEXT("View Instance Value(s) Show All Instances",6)
+14 ;;"Select Action:Next Screen//"
+15 ;;""
+16 ;;EOM
+17 QUIT
TEXT(X,Y,Z) ;TXT,COL,INSERT
+1 SET Z=$SELECT($GET(Z)="":"",1:Z)
+2 SET Y=$SELECT($GET(Y)="C":((IOM-$LENGTH(X))/2),$GET(Y)="R":(IOM-$LENGTH(X)),+$GET(Y)>0:Y,1:0)
+3 QUIT $$SETSTR^VALM1(X,Z,Y,$LENGTH(X))
