ORPARMG1 ; SPFO/AJB - ListManager Parameter Display for Notifications ;Dec 18, 2019@08:15:15
;;3.0;ORDER ENTRY/RESULTS REPORTING;**500,518**;Dec 17, 1997;Build 11
;
; Global References
; ^VA(200, ICR 10060
; External References
; ^DIC ICR 10006 $$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 RE^VALM4 ICR 10120
; GETLST^XPAR ICR 2263 DISP^XQORM1 ICR 10102 EN^XUTMDEVQ ICR 1519
; DIV4^XUSER ICR 2343 $$RJ^XLFSTR ICR 10104 $$CJ^XLFSTR ICR 10104
; $$KSP^XUPARAM ICR 2541
Q
STATUS(VAL) ; evaluates the levels of a notification and returns the status
N ORQ,PKG,SYS,DIV,SRV,TEA,USR,X,Y S ORQ=0
S Y=0 F X="PKG","SYS","DIV","SRV","TEA","USR" D ; set values for each level
. S Y=Y+1,@X=$S($P(VAL,U,Y)="":"N",1:$P(VAL,U,Y))
S VAL="0^OFF no settings found."
I USR="E"!(USR="M") Q "ON User value is "_$S(USR="E":"ENABLED.",1:"MANDATORY.") ; evaluate USER level
I USR="D" S VAL="0^OFF User value is DISABLED"
F X=1:1:$L(TEA,"|") S Y=$P($P(TEA,"|",X),";") D Q:+ORQ ; evaluate TEAM level
. I Y="M" S VAL="1^ON "_$P($P(TEA,"|",X),";",2)_" is MANDATORY." S ORQ=1 Q
. I Y="E",USR'="D" S VAL="1^ON "_$P($P(TEA,"|",X),";",2)_" is ENABLED." S ORQ=1 Q
. I Y="D",USR'="D" S VAL="1^OFF "_$P($P(TEA,"|",X),";",2)_" is DISABLED." Q
Q:+VAL $P(VAL,U,2)
I SRV="M" Q "ON "_$$GET1^DIQ(200,IEN,29,"E")_" service is MANDATORY."
I SRV="E",USR'="D" Q "ON "_$$GET1^DIQ(200,IEN,29,"E")_" service is ENABLED."
I SRV="D",USR'="D" S VAL="0^OFF "_$$GET1^DIQ(200,IEN,29,"E")_" service is DISABLED."
Q:+VAL $P(VAL,U,2) S ORQ=0
F X=1:1:$L(DIV,"|") S Y=$P($P(DIV,"|",X),";") D Q:+ORQ ; evaluate DIVISION level
. I Y="M" S VAL="1^ON "_$P($P(DIV,"|",X),";",2)_" is MANDATORY." S ORQ=1 Q
. I Y="E",USR'="D" S VAL="1^ON "_$P($P(DIV,"|",X),";",2)_" is ENABLED." S ORQ=1 Q
. I Y="D",USR'="D" S VAL="1^OFF "_$P($P(DIV,"|",X),";",2)_" is DISABLED." Q
Q:+VAL $P(VAL,U,2)
I SYS="M" Q "ON System value is MANDATORY."
I SYS="E",USR'="D" Q "ON System value is ENABLED."
I SYS="D",USR'="D" Q "OFF System value is DISABLED."
I PKG="M" Q "ON Package value is MANDATORY."
I PKG="E",USR'="D" Q "ON Packagae value is ENABLED."
I PKG="D",USR'="D" Q "OFF Package value is DISABLED."
Q "OFF no values found."
OUTPUT ; display output for detailed view
N DIV,END,LN,NOT,NOTIFS,NUM,SVS,TM,X,Y
S (TM,X)=0 F S TM=$O(^OR(100.21,"C",IEN,TM)) Q:'+TM S X=X+1,TM(X)=TM_";"_$$GET1^DIQ(100.21,TM,.01) ; get user team(s)
S TM=X ; number of teams for user
S SVS=$$GET1^DIQ(200,IEN,29,"I") ; get user service
S DIV=$$DIV4^XUSER(.DIV,IEN) ; get user division(s)
S (DIV,X)=0 F S DIV=$O(DIV(DIV)) Q:'+DIV S X=X+1,DIV(X)=DIV_";"_$$GET1^DIQ(4,DIV,.01) K DIV(DIV)
S DIV=X ; number of divisions for user
S LN=0 S LN=LN+1,LN(LN)="Notification List for "_$$GET1^DIQ(200,IEN,.01),LN(LN)=$$CJ^XLFSTR(LN(LN),80),LN=LN+1,LN(LN)=""
I SHOW="C" D
. S LN=LN+1,LN(LN)=$S($E(IOST,1,2)="C-":ORUON,1:"")_"Notification Status Why "_$S($E(IOST,1,2)="C-":ORUOFF,1:"")
. I $E(IOST,1,2)'="C-" S LN=LN+1,LN(LN)="",$P(LN(LN),"-",80)="-"
S NOT="" F S NOT=$O(^ORD(100.9,"B",NOT)) Q:NOT="" S NUM=0 F S NUM=$O(^ORD(100.9,"B",NOT,NUM)) Q:'+NUM D
. I SHOW'="C" D
. . S LN=LN+1,LN(LN)=$S($E(IOST,1,2)="C-":ORUON,1:"")_"Notification"_$$SETSTR^VALM1("USR/TEAM/SRV/DIV/SYS/PKG","",45,24)_$S($E(IOST,1,2)="C-":ORUOFF,1:"")
. . I $E(IOST,1,2)'="C-" S LN=LN+1,LN(LN)="",$P(LN(LN),"-",80)="-" ; add 'underline' for non-display output
. N VAL S VAL=$$GET^XPAR(IEN_";VA(200,","ORB PROCESSING FLAG",NUM,"I") ; user level value
. S $P(NOTIFS,U,6)=VAL ; set user level value
. S LN=LN+1,LN(LN)=NOT S:SHOW'="C" LN(LN)=$$SETSTR^VALM1(VAL,LN(LN),58,$L(VAL))
. S VAL=$$GET^XPAR(SVS_";DIC(49,","ORB PROCESSING FLAG",NUM,"I") ; service level value
. S $P(NOTIFS,U,4)=VAL ; set service level value
. S:SHOW'="C" LN(LN)=$$SETSTR^VALM1(VAL,LN(LN),67,$L(VAL))
. S VAL=$$GET^XPAR("SYS","ORB PROCESSING FLAG",NUM,"I") ; system level value
. S $P(NOTIFS,U,2)=VAL ; set system level value
. S:SHOW'="C" LN(LN)=$$SETSTR^VALM1(VAL,LN(LN),75,$L(VAL))
. S VAL=$$GET^XPAR("PKG","ORB PROCESSING FLAG",NUM,"I") ; package level value
. S $P(NOTIFS,U,1)=VAL ; set package level value
. S:SHOW'="C" LN(LN)=$$SETSTR^VALM1(VAL,LN(LN),79,$L(VAL))
. N CNT I +TM S (CNT,X)=0,Y="" F S X=$O(TM(X)) Q:'+X D S $P(NOTIFS,U,5)=Y
. . S VAL=$$GET^XPAR(+TM(X)_";OR(100.21,","ORB PROCESSING FLAG",NUM,"I") Q:VAL=""&'+SHOW S CNT=CNT+1,$P(Y,"|",X)=VAL_";"_$P(TM(X),";",2)
. . S LN(LN+CNT)=$S(CNT=1:" Team: "_$P(TM(X),";",2),1:" "_$P(TM(X),";",2))
. . S LN(LN+CNT)=$$SETSTR^VALM1(VAL,LN(LN+CNT),63,$L(VAL))
. I +DIV S (CNT(1),X)=0,Y="" F S X=$O(DIV(X)) Q:'+X D S $P(NOTIFS,U,3)=Y
. . S VAL=$$GET^XPAR(+DIV(X)_";DIC(4,","ORB PROCESSING FLAG",NUM,"I") Q:VAL=""&'+SHOW S CNT(1)=CNT(1)+1,$P(Y,"|",X)=VAL_";"_$P(DIV(X),";",2)
. . S LN(LN+CNT(1)+$G(CNT))=$S(CNT(1)=1:" Division: "_$P(DIV(X),";",2),1:" "_$P(DIV(X),";",2))
. . S LN(LN+CNT(1)+$G(CNT))=$$SETSTR^VALM1(VAL,LN(LN+CNT(1)+$G(CNT)),71,$L(VAL))
. I SHOW'="C" S LN="",LN=$O(LN(LN),-1),LN=LN+1,LN(LN)=""
. I SHOW="C" D Q
. . S X=$$STATUS(NOTIFS),Y=$P(X," ",2,99),X=$P(X," ") S X=X_$S(X="ON":" ",1:" ")_Y,X=$TR(X,".","")
. . S LN(LN)=$$SETSTR^VALM1(X,LN(LN),35,$L(X))
. S LN=LN+1,LN(LN)=$$STATUS(NOTIFS),LN(LN+1)="",$P(LN(LN+1),"=",$L(LN(LN)))="="
. S LN(LN)=$$RJ^XLFSTR(LN(LN),80),LN(LN+1)=$$RJ^XLFSTR(LN(LN+1),80),LN=LN+1
. S LN=LN+1,LN(LN)=""
S (END,Y)=0
D:$E(IOST,1,2)="C-" HDR2
F S Y=$O(LN(Y)) Q:'+Y!(+END) D
. D HDR1:$Y+3>IOSL Q:+END W LN(Y),!
Q:+END R:$E(IOST,1,2)="C-" !,"Press <Enter> to continue ",X:DTIME
Q
ADD ;
D FULL^VALM1 W @IOF
N USRLST I +ENT(0)=200 D Q:USRLST'="N"
. S USRLST=$P($$READ("SA^A:All Active CPRS Users;D:DIVISION;S:SERVICE;T:TEAM;N:Nope","Add USERS to the ENTITY List by Team, Service, Division, or ALL? ","NO"),U)
. Q:USRLST="N"
. I USRLST="A" D Q
. . W !,"Adding All Active CPRS Users to the list..."
. . N NAME,IEN S NAME="" F S NAME=$O(^VA(200,"AUSER",NAME)) Q:NAME="" S IEN=0 F S IEN=$O(^VA(200,"AUSER",NAME,IEN)) Q:'+IEN D
. . . I +$$SCREEN(IEN) S ENTRIES(NAME,IEN)=""
. . D INIT,RE^VALM4
. I USRLST="D"!(USRLST="S") D Q
. . N DIC,VAL S DIC=$S(USRLST="D":"^DIC(4,",1:"^DIC(49,"),DIC(0)="AEMQ"
. . W ! S VAL=$$DIC(.DIC) Q:'+VAL
. . D FIND($S(USRLST="D":"^VA(200,""AH"")",1:"^VA(200,""E"")"),+VAL)
. . D INIT,RE^VALM4
. I USRLST="T" D Q
. . N DIC,VAL S DIC="^OR(100.21,",DIC(0)="AEMQ"
. . W ! S VAL=$$DIC(.DIC) Q:'+VAL
. . D FIND("^OR(100.21,"_+VAL_")",1)
. . D INIT,RE^VALM4
N DIC,POP,X,Y S DIC=ENT(1),DIC(0)="AEMQ" F W ! S Y=$$DIC(.DIC) Q:Y=-1 S ENTRIES($P(Y,U,2),+Y)=""
D INIT,RE^VALM4
Q
DIC(DIC) ;
N POP,X,Y
D ^DIC
Q Y
FIND(GBL,IEN) ; File #200 Only
N X,Y S X=0 F S X=$O(@GBL@(IEN,X)) Q:'+X S ENTRIES($$GET1^DIQ(200,X,.01),X)=""
Q
DETV ; detailed view of notifications a user can receive
W @IOF
N DIC,IEN,ORUON,ORUOFF,POP,SHOW,X,Y,ZTSAVE
S DIC="^VA(200,",DIC(0)="AEMQ",DIC("A")="Enter NEW PERSON: ",DIC("B")=DUZ D ^DIC Q:Y=-1 S IEN=+Y ; get user to evaluate
W ! S SHOW=$P($$READ("SA^C:Condensed;D:Detailed;B:Basic","Condensed, Detailed, or Basic Report? ","B"),U) S:SHOW="D" SHOW=1
D PREP^XGF S ORUON=IOUON,ORUOFF=IOUOFF S ZTSAVE("ORUON")="",ZTSAVE("ORUFF")="" D CLEAN^XGF
S ZTSAVE("IEN")="",ZTSAVE("SHOW")=""
D EN^XUTMDEVQ("OUTPUT^ORPARMG1","",.ZTSAVE)
Q
HDR1 ;
I $E(IOST,1,2)="C-" D
. R !,"Press <ENTER> to continue or '^' to exit ",X:DTIME S END='$T!(X=U)
Q:+END
HDR2 W:$E(IOST,1,2)="C-" @IOF Q
REMOVE ;
D FULL^VALM1
N IEN,X
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
. . K @VALMAR@("IDX",$P(SEL(LVL),",",J),IEN),ENTRIES($$GET1^DIQ(+ENT(0),IEN,.01),IEN)
S VALMBG=1 D INIT,RE^VALM4
Q
VIEW ;
D FULL^VALM1
N IEN,ORQ,X,Y S ORQ=1
F X=1:1:($L(SEL,",")-1) Q:'+ORQ D
. W @IOF
. S IEN=$O(@VALMAR@("IDX",$P(SEL,",",X),""))
. N LIST D GETLST^XPAR(.LIST,IEN_ENT,+PAR,"E")
. I +ENT(0)=200 N SYSLST D GETLST^XPAR(.SYSLST,SYSTEM,+PAR,"E") D
. . S Y=0 F S Y=$O(SYSLST(Y)) Q:'+Y S SYSLST($P(SYSLST(Y),U))=$P(SYSLST(Y),U,2) K SYSLST(Y)
. W "Detailed settings for: ",$$GET1^DIQ(+ENT(0),IEN,.01)
. W:+ENT(0)=200 !!,IOUON,"Instance",?57,"User [System] ",IOUOFF
. W:+ENT(0)'=200 !!,IOUON,"Instance",?75,"Value",IOUOFF
. ;S Y=0 F S Y=$O(LIST(Y)) Q:'+Y D
. I LIST'<1 F Y=1:1:LIST D
. . S LIST($P(LIST(Y),U))=LIST(Y) K LIST(Y) ; reorder list
. S Y=0 F S Y=$O(LIST(Y)) Q:Y=""!('+ORQ) D
. . N STAT S STAT=$P(LIST(Y),U,2)
. . W !,$P(LIST(Y),U),?$S(+$D(SYSLST):57,1:(IOM-$L($P(LIST(Y),U,2)))),$P(LIST(Y),U,2) W:$D(SYSLST($P(LIST(Y),U))) ?69,"["_SYSLST($P(LIST(Y),U))_"]"
. . 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 W IOCUON Q
. F Q:$Y>(IOSL-3) W !
. W IOCUOFF S ORQ=+$$READ("EA",IORVON_"Press <ENTER> to continue or '^' to exit."_IORVOFF) W IOCUON
Q
TEXT(X,Y,Z) ;
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))
; S DIC="^VA(200,",DIC(0)="AEMQ",DIC("A")="Enter NEW PERSON NAME: ",DIC("S")="I +$$SCREEN^ORNOTN(Y)"
SCREEN(USER) ;
N ORTAB,ORX
S ORX=0,ORX=+$O(^VA(200,USER,"ORD","B",1,ORX)) ; IA# 10060
I ORX=0 Q 0 ; No CPRS Tabs assigned
S ORTAB=$G(^VA(200,USER,"ORD",ORX,0))
I +ORTAB'=1 Q 0 ; check for core tab
I DT<$P(ORTAB,U,2) Q 0 ; check effective date
I +$P(ORTAB,U,3)=0 Q 1 ; check expiration date (not set)
I DT'<$P(ORTAB,U,3) Q 0 ; check expiration date
Q 1
REMALL ;
K @VALMAR,ENTRIES
D INIT,RE^VALM4
Q
ASK ;
N ACT S ACT=$P($$READ("S^REMOVE:Remove Entry;VIEW:View Entry","Select Action",$S($L(SEL,",")>2:"Remove",1:"View")),U)
D:ACT'="" @ACT
Q
HDR ;
S VALMHDR(1)=$P(ENT(0),U,2)_" ["_$P(ENT(0),U,6)_"] List"
S VALMHDR(1)=$$SETSTR^VALM1(VALMHDR(1),"",IOM-$L(VALMHDR(1))/2,$L(VALMHDR(1)))
D XQORM
Q
INIT ;
N IEN,NAME S VALMCNT=0
K @VALMAR
I +$D(ENTRIES) S ENTRIES=0 D
. S NAME="" F S NAME=$O(ENTRIES(NAME)) Q:NAME="" S IEN=0 F S IEN=$O(ENTRIES(NAME,IEN)) Q:'+IEN D
. . N X S ENTRIES=ENTRIES+1,VALMCNT=VALMCNT+1,X=""
. . S X=$$SETFLD^VALM1(VALMCNT,X,"NUMBER")
. . S X=$$SETFLD^VALM1($$GET1^DIQ(+ENT(0),IEN,.01),X,"ENTITY")
. . D SET^VALM10(VALMCNT,X,IEN)
I VALMCNT=0 S VALMCNT=1 D
. D SET^VALM10(1," ",0)
. S X="<NONE>"
. S X=$$SETSTR^VALM1(X,"",(IOM-$L(X))/2,$L(X))
. D SET^VALM10(2,X,0)
. S VALMCNT=0
Q
HELP ;
S X="?" D DISP^XQORM1 W !!
Q
EXIT ;
D XQORM
Q
EXPND ;
Q
XQORM ;
S XQORM("#")=$O(^ORD(101,"B","ORNOT DEFAULT ENTITY SELECTIONS",0))_U_"1:"_VALMCNT
Q
EN ;
D EN^VALM("OR PARAMETER SELECT")
Q
SELECT(ACT) ;
I ACT="REMALL" D @ACT Q
I VALMCNT=0 Q
D FULL^VALM1
N SEL,X,Y
S SEL(0)=$S(VALMCNT=1:"1,",1:$P(XQORNOD(0),"=",2)),SEL=SEL(0) ; if only 1 item in list, make it default SEL
I SEL="" S SEL=$$LOR^ORPARMGR(.SEL) Q:'+SEL
D @ACT
Q
READ(TYPE,PROMPT,DEFAULT,HELP,SCREEN) ;
N DIR,X,Y
S DIR(0)=TYPE
I $D(SCREEN) S DIR("S")=SCREEN
I $G(PROMPT)]"" S DIR("A")=PROMPT
I $G(DEFAULT)]"" S DIR("B")=DEFAULT
I $D(HELP) S DIR("?")=HELP
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORPARMG1 11731 printed Apr 09, 2024@21:44:14 Page 2
ORPARMG1 ; SPFO/AJB - ListManager Parameter Display for Notifications ;Dec 18, 2019@08:15:15
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**500,518**;Dec 17, 1997;Build 11
+2 ;
+3 ; Global References
+4 ; ^VA(200, ICR 10060
+5 ; External References
+6 ; ^DIC ICR 10006 $$GET1^DIQ ICR 2056 ^DIR ICR 10026
+7 ; EN^VALM ICR 10118 $$SETFLD^VALM1 ICR 10116 $$SETSTR^VALM1 ICR 10116
+8 ; FULL^VALM1 ICR 10116 SET^VALM10 ICR 10117 RE^VALM4 ICR 10120
+9 ; GETLST^XPAR ICR 2263 DISP^XQORM1 ICR 10102 EN^XUTMDEVQ ICR 1519
+10 ; DIV4^XUSER ICR 2343 $$RJ^XLFSTR ICR 10104 $$CJ^XLFSTR ICR 10104
+11 ; $$KSP^XUPARAM ICR 2541
+12 QUIT
STATUS(VAL) ; evaluates the levels of a notification and returns the status
+1 NEW ORQ,PKG,SYS,DIV,SRV,TEA,USR,X,Y
SET ORQ=0
+2 ; set values for each level
SET Y=0
FOR X="PKG","SYS","DIV","SRV","TEA","USR"
Begin DoDot:1
+3 SET Y=Y+1
SET @X=$SELECT($PIECE(VAL,U,Y)="":"N",1:$PIECE(VAL,U,Y))
End DoDot:1
+4 SET VAL="0^OFF no settings found."
+5 ; evaluate USER level
IF USR="E"!(USR="M")
QUIT "ON User value is "_$SELECT(USR="E":"ENABLED.",1:"MANDATORY.")
+6 IF USR="D"
SET VAL="0^OFF User value is DISABLED"
+7 ; evaluate TEAM level
FOR X=1:1:$LENGTH(TEA,"|")
SET Y=$PIECE($PIECE(TEA,"|",X),";")
Begin DoDot:1
+8 IF Y="M"
SET VAL="1^ON "_$PIECE($PIECE(TEA,"|",X),";",2)_" is MANDATORY."
SET ORQ=1
QUIT
+9 IF Y="E"
IF USR'="D"
SET VAL="1^ON "_$PIECE($PIECE(TEA,"|",X),";",2)_" is ENABLED."
SET ORQ=1
QUIT
+10 IF Y="D"
IF USR'="D"
SET VAL="1^OFF "_$PIECE($PIECE(TEA,"|",X),";",2)_" is DISABLED."
QUIT
End DoDot:1
if +ORQ
QUIT
+11 if +VAL
QUIT $PIECE(VAL,U,2)
+12 IF SRV="M"
QUIT "ON "_$$GET1^DIQ(200,IEN,29,"E")_" service is MANDATORY."
+13 IF SRV="E"
IF USR'="D"
QUIT "ON "_$$GET1^DIQ(200,IEN,29,"E")_" service is ENABLED."
+14 IF SRV="D"
IF USR'="D"
SET VAL="0^OFF "_$$GET1^DIQ(200,IEN,29,"E")_" service is DISABLED."
+15 if +VAL
QUIT $PIECE(VAL,U,2)
SET ORQ=0
+16 ; evaluate DIVISION level
FOR X=1:1:$LENGTH(DIV,"|")
SET Y=$PIECE($PIECE(DIV,"|",X),";")
Begin DoDot:1
+17 IF Y="M"
SET VAL="1^ON "_$PIECE($PIECE(DIV,"|",X),";",2)_" is MANDATORY."
SET ORQ=1
QUIT
+18 IF Y="E"
IF USR'="D"
SET VAL="1^ON "_$PIECE($PIECE(DIV,"|",X),";",2)_" is ENABLED."
SET ORQ=1
QUIT
+19 IF Y="D"
IF USR'="D"
SET VAL="1^OFF "_$PIECE($PIECE(DIV,"|",X),";",2)_" is DISABLED."
QUIT
End DoDot:1
if +ORQ
QUIT
+20 if +VAL
QUIT $PIECE(VAL,U,2)
+21 IF SYS="M"
QUIT "ON System value is MANDATORY."
+22 IF SYS="E"
IF USR'="D"
QUIT "ON System value is ENABLED."
+23 IF SYS="D"
IF USR'="D"
QUIT "OFF System value is DISABLED."
+24 IF PKG="M"
QUIT "ON Package value is MANDATORY."
+25 IF PKG="E"
IF USR'="D"
QUIT "ON Packagae value is ENABLED."
+26 IF PKG="D"
IF USR'="D"
QUIT "OFF Package value is DISABLED."
+27 QUIT "OFF no values found."
OUTPUT ; display output for detailed view
+1 NEW DIV,END,LN,NOT,NOTIFS,NUM,SVS,TM,X,Y
+2 ; get user team(s)
SET (TM,X)=0
FOR
SET TM=$ORDER(^OR(100.21,"C",IEN,TM))
if '+TM
QUIT
SET X=X+1
SET TM(X)=TM_";"_$$GET1^DIQ(100.21,TM,.01)
+3 ; number of teams for user
SET TM=X
+4 ; get user service
SET SVS=$$GET1^DIQ(200,IEN,29,"I")
+5 ; get user division(s)
SET DIV=$$DIV4^XUSER(.DIV,IEN)
+6 SET (DIV,X)=0
FOR
SET DIV=$ORDER(DIV(DIV))
if '+DIV
QUIT
SET X=X+1
SET DIV(X)=DIV_";"_$$GET1^DIQ(4,DIV,.01)
KILL DIV(DIV)
+7 ; number of divisions for user
SET DIV=X
+8 SET LN=0
SET LN=LN+1
SET LN(LN)="Notification List for "_$$GET1^DIQ(200,IEN,.01)
SET LN(LN)=$$CJ^XLFSTR(LN(LN),80)
SET LN=LN+1
SET LN(LN)=""
+9 IF SHOW="C"
Begin DoDot:1
+10 SET LN=LN+1
SET LN(LN)=$SELECT($EXTRACT(IOST,1,2)="C-":ORUON,1:"")_"Notification Status Why "_$SELECT($EXTRACT(IOST,1,2)="C-":ORUOFF,1:"")
+11 IF $EXTRACT(IOST,1,2)'="C-"
SET LN=LN+1
SET LN(LN)=""
SET $PIECE(LN(LN),"-",80)="-"
End DoDot:1
+12 SET NOT=""
FOR
SET NOT=$ORDER(^ORD(100.9,"B",NOT))
if NOT=""
QUIT
SET NUM=0
FOR
SET NUM=$ORDER(^ORD(100.9,"B",NOT,NUM))
if '+NUM
QUIT
Begin DoDot:1
+13 IF SHOW'="C"
Begin DoDot:2
+14 SET LN=LN+1
SET LN(LN)=$SELECT($EXTRACT(IOST,1,2)="C-":ORUON,1:"")_"Notification"_$$SETSTR^VALM1("USR/TEAM/SRV/DIV/SYS/PKG","",45,24)_$SELECT($EXTRACT(IOST,1,2)="C-":ORUOFF,1:"")
+15 ; add 'underline' for non-display output
IF $EXTRACT(IOST,1,2)'="C-"
SET LN=LN+1
SET LN(LN)=""
SET $PIECE(LN(LN),"-",80)="-"
End DoDot:2
+16 ; user level value
NEW VAL
SET VAL=$$GET^XPAR(IEN_";VA(200,","ORB PROCESSING FLAG",NUM,"I")
+17 ; set user level value
SET $PIECE(NOTIFS,U,6)=VAL
+18 SET LN=LN+1
SET LN(LN)=NOT
if SHOW'="C"
SET LN(LN)=$$SETSTR^VALM1(VAL,LN(LN),58,$LENGTH(VAL))
+19 ; service level value
SET VAL=$$GET^XPAR(SVS_";DIC(49,","ORB PROCESSING FLAG",NUM,"I")
+20 ; set service level value
SET $PIECE(NOTIFS,U,4)=VAL
+21 if SHOW'="C"
SET LN(LN)=$$SETSTR^VALM1(VAL,LN(LN),67,$LENGTH(VAL))
+22 ; system level value
SET VAL=$$GET^XPAR("SYS","ORB PROCESSING FLAG",NUM,"I")
+23 ; set system level value
SET $PIECE(NOTIFS,U,2)=VAL
+24 if SHOW'="C"
SET LN(LN)=$$SETSTR^VALM1(VAL,LN(LN),75,$LENGTH(VAL))
+25 ; package level value
SET VAL=$$GET^XPAR("PKG","ORB PROCESSING FLAG",NUM,"I")
+26 ; set package level value
SET $PIECE(NOTIFS,U,1)=VAL
+27 if SHOW'="C"
SET LN(LN)=$$SETSTR^VALM1(VAL,LN(LN),79,$LENGTH(VAL))
+28 NEW CNT
IF +TM
SET (CNT,X)=0
SET Y=""
FOR
SET X=$ORDER(TM(X))
if '+X
QUIT
Begin DoDot:2
+29 SET VAL=$$GET^XPAR(+TM(X)_";OR(100.21,","ORB PROCESSING FLAG",NUM,"I")
if VAL=""&'+SHOW
QUIT
SET CNT=CNT+1
SET $PIECE(Y,"|",X)=VAL_";"_$PIECE(TM(X),";",2)
+30 SET LN(LN+CNT)=$SELECT(CNT=1:" Team: "_$PIECE(TM(X),";",2),1:" "_$PIECE(TM(X),";",2))
+31 SET LN(LN+CNT)=$$SETSTR^VALM1(VAL,LN(LN+CNT),63,$LENGTH(VAL))
End DoDot:2
SET $PIECE(NOTIFS,U,5)=Y
+32 IF +DIV
SET (CNT(1),X)=0
SET Y=""
FOR
SET X=$ORDER(DIV(X))
if '+X
QUIT
Begin DoDot:2
+33 SET VAL=$$GET^XPAR(+DIV(X)_";DIC(4,","ORB PROCESSING FLAG",NUM,"I")
if VAL=""&'+SHOW
QUIT
SET CNT(1)=CNT(1)+1
SET $PIECE(Y,"|",X)=VAL_";"_$PIECE(DIV(X),";",2)
+34 SET LN(LN+CNT(1)+$GET(CNT))=$SELECT(CNT(1)=1:" Division: "_$PIECE(DIV(X),";",2),1:" "_$PIECE(DIV(X),";",2))
+35 SET LN(LN+CNT(1)+$GET(CNT))=$$SETSTR^VALM1(VAL,LN(LN+CNT(1)+$GET(CNT)),71,$LENGTH(VAL))
End DoDot:2
SET $PIECE(NOTIFS,U,3)=Y
+36 IF SHOW'="C"
SET LN=""
SET LN=$ORDER(LN(LN),-1)
SET LN=LN+1
SET LN(LN)=""
+37 IF SHOW="C"
Begin DoDot:2
+38 SET X=$$STATUS(NOTIFS)
SET Y=$PIECE(X," ",2,99)
SET X=$PIECE(X," ")
SET X=X_$SELECT(X="ON":" ",1:" ")_Y
SET X=$TRANSLATE(X,".","")
+39 SET LN(LN)=$$SETSTR^VALM1(X,LN(LN),35,$LENGTH(X))
End DoDot:2
QUIT
+40 SET LN=LN+1
SET LN(LN)=$$STATUS(NOTIFS)
SET LN(LN+1)=""
SET $PIECE(LN(LN+1),"=",$LENGTH(LN(LN)))="="
+41 SET LN(LN)=$$RJ^XLFSTR(LN(LN),80)
SET LN(LN+1)=$$RJ^XLFSTR(LN(LN+1),80)
SET LN=LN+1
+42 SET LN=LN+1
SET LN(LN)=""
End DoDot:1
+43 SET (END,Y)=0
+44 if $EXTRACT(IOST,1,2)="C-"
DO HDR2
+45 FOR
SET Y=$ORDER(LN(Y))
if '+Y!(+END)
QUIT
Begin DoDot:1
+46 if $Y+3>IOSL
DO HDR1
if +END
QUIT
WRITE LN(Y),!
End DoDot:1
+47 if +END
QUIT
if $EXTRACT(IOST,1,2)="C-"
READ !,"Press <Enter> to continue ",X:DTIME
+48 QUIT
ADD ;
+1 DO FULL^VALM1
WRITE @IOF
+2 NEW USRLST
IF +ENT(0)=200
Begin DoDot:1
+3 SET USRLST=$PIECE($$READ("SA^A:All Active CPRS Users;D:DIVISION;S:SERVICE;T:TEAM;N:Nope","Add USERS to the ENTITY List by Team, Service, Division, or ALL? ","NO"),U)
+4 if USRLST="N"
QUIT
+5 IF USRLST="A"
Begin DoDot:2
+6 WRITE !,"Adding All Active CPRS Users to the list..."
+7 NEW NAME,IEN
SET NAME=""
FOR
SET NAME=$ORDER(^VA(200,"AUSER",NAME))
if NAME=""
QUIT
SET IEN=0
FOR
SET IEN=$ORDER(^VA(200,"AUSER",NAME,IEN))
if '+IEN
QUIT
Begin DoDot:3
+8 IF +$$SCREEN(IEN)
SET ENTRIES(NAME,IEN)=""
End DoDot:3
+9 DO INIT
DO RE^VALM4
End DoDot:2
QUIT
+10 IF USRLST="D"!(USRLST="S")
Begin DoDot:2
+11 NEW DIC,VAL
SET DIC=$SELECT(USRLST="D":"^DIC(4,",1:"^DIC(49,")
SET DIC(0)="AEMQ"
+12 WRITE !
SET VAL=$$DIC(.DIC)
if '+VAL
QUIT
+13 DO FIND($SELECT(USRLST="D":"^VA(200,""AH"")",1:"^VA(200,""E"")"),+VAL)
+14 DO INIT
DO RE^VALM4
End DoDot:2
QUIT
+15 IF USRLST="T"
Begin DoDot:2
+16 NEW DIC,VAL
SET DIC="^OR(100.21,"
SET DIC(0)="AEMQ"
+17 WRITE !
SET VAL=$$DIC(.DIC)
if '+VAL
QUIT
+18 DO FIND("^OR(100.21,"_+VAL_")",1)
+19 DO INIT
DO RE^VALM4
End DoDot:2
QUIT
End DoDot:1
if USRLST'="N"
QUIT
+20 NEW DIC,POP,X,Y
SET DIC=ENT(1)
SET DIC(0)="AEMQ"
FOR
WRITE !
SET Y=$$DIC(.DIC)
if Y=-1
QUIT
SET ENTRIES($PIECE(Y,U,2),+Y)=""
+21 DO INIT
DO RE^VALM4
+22 QUIT
DIC(DIC) ;
+1 NEW POP,X,Y
+2 DO ^DIC
+3 QUIT Y
FIND(GBL,IEN) ; File #200 Only
+1 NEW X,Y
SET X=0
FOR
SET X=$ORDER(@GBL@(IEN,X))
if '+X
QUIT
SET ENTRIES($$GET1^DIQ(200,X,.01),X)=""
+2 QUIT
DETV ; detailed view of notifications a user can receive
+1 WRITE @IOF
+2 NEW DIC,IEN,ORUON,ORUOFF,POP,SHOW,X,Y,ZTSAVE
+3 ; get user to evaluate
SET DIC="^VA(200,"
SET DIC(0)="AEMQ"
SET DIC("A")="Enter NEW PERSON: "
SET DIC("B")=DUZ
DO ^DIC
if Y=-1
QUIT
SET IEN=+Y
+4 WRITE !
SET SHOW=$PIECE($$READ("SA^C:Condensed;D:Detailed;B:Basic","Condensed, Detailed, or Basic Report? ","B"),U)
if SHOW="D"
SET SHOW=1
+5 DO PREP^XGF
SET ORUON=IOUON
SET ORUOFF=IOUOFF
SET ZTSAVE("ORUON")=""
SET ZTSAVE("ORUFF")=""
DO CLEAN^XGF
+6 SET ZTSAVE("IEN")=""
SET ZTSAVE("SHOW")=""
+7 DO EN^XUTMDEVQ("OUTPUT^ORPARMG1","",.ZTSAVE)
+8 QUIT
HDR1 ;
+1 IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:1
+2 READ !,"Press <ENTER> to continue or '^' to exit ",X:DTIME
SET END='$TEST!(X=U)
End DoDot:1
+3 if +END
QUIT
HDR2 if $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
QUIT
REMOVE ;
+1 DO FULL^VALM1
+2 NEW IEN,X
+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 KILL @VALMAR@("IDX",$PIECE(SEL(LVL),",",J),IEN),ENTRIES($$GET1^DIQ(+ENT(0),IEN,.01),IEN)
End DoDot:2
End DoDot:1
+8 SET VALMBG=1
DO INIT
DO RE^VALM4
+9 QUIT
VIEW ;
+1 DO FULL^VALM1
+2 NEW IEN,ORQ,X,Y
SET ORQ=1
+3 FOR X=1:1:($LENGTH(SEL,",")-1)
if '+ORQ
QUIT
Begin DoDot:1
+4 WRITE @IOF
+5 SET IEN=$ORDER(@VALMAR@("IDX",$PIECE(SEL,",",X),""))
+6 NEW LIST
DO GETLST^XPAR(.LIST,IEN_ENT,+PAR,"E")
+7 IF +ENT(0)=200
NEW SYSLST
DO GETLST^XPAR(.SYSLST,SYSTEM,+PAR,"E")
Begin DoDot:2
+8 SET Y=0
FOR
SET Y=$ORDER(SYSLST(Y))
if '+Y
QUIT
SET SYSLST($PIECE(SYSLST(Y),U))=$PIECE(SYSLST(Y),U,2)
KILL SYSLST(Y)
End DoDot:2
+9 WRITE "Detailed settings for: ",$$GET1^DIQ(+ENT(0),IEN,.01)
+10 if +ENT(0)=200
WRITE !!,IOUON,"Instance",?57,"User [System] ",IOUOFF
+11 if +ENT(0)'=200
WRITE !!,IOUON,"Instance",?75,"Value",IOUOFF
+12 ;S Y=0 F S Y=$O(LIST(Y)) Q:'+Y D
+13 IF LIST'<1
FOR Y=1:1:LIST
Begin DoDot:2
+14 ; reorder list
SET LIST($PIECE(LIST(Y),U))=LIST(Y)
KILL LIST(Y)
End DoDot:2
+15 SET Y=0
FOR
SET Y=$ORDER(LIST(Y))
if Y=""!('+ORQ)
QUIT
Begin DoDot:2
+16 NEW STAT
SET STAT=$PIECE(LIST(Y),U,2)
+17 WRITE !,$PIECE(LIST(Y),U),?$SELECT(+$DATA(SYSLST):57,1:(IOM-$LENGTH($PIECE(LIST(Y),U,2)))),$PIECE(LIST(Y),U,2)
if $DATA(SYSLST($PIECE(LIST(Y),U)))
WRITE ?69,"["_SYSLST($PIECE(LIST(Y),U))_"]"
+18 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
+19 IF '+ORQ
WRITE IOCUON
QUIT
+20 FOR
if $Y>(IOSL-3)
QUIT
WRITE !
+21 WRITE IOCUOFF
SET ORQ=+$$READ("EA",IORVON_"Press <ENTER> to continue or '^' to exit."_IORVOFF)
WRITE IOCUON
End DoDot:1
+22 QUIT
TEXT(X,Y,Z) ;
+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))
+4 ; S DIC="^VA(200,",DIC(0)="AEMQ",DIC("A")="Enter NEW PERSON NAME: ",DIC("S")="I +$$SCREEN^ORNOTN(Y)"
SCREEN(USER) ;
+1 NEW ORTAB,ORX
+2 ; IA# 10060
SET ORX=0
SET ORX=+$ORDER(^VA(200,USER,"ORD","B",1,ORX))
+3 ; No CPRS Tabs assigned
IF ORX=0
QUIT 0
+4 SET ORTAB=$GET(^VA(200,USER,"ORD",ORX,0))
+5 ; check for core tab
IF +ORTAB'=1
QUIT 0
+6 ; check effective date
IF DT<$PIECE(ORTAB,U,2)
QUIT 0
+7 ; check expiration date (not set)
IF +$PIECE(ORTAB,U,3)=0
QUIT 1
+8 ; check expiration date
IF DT'<$PIECE(ORTAB,U,3)
QUIT 0
+9 QUIT 1
REMALL ;
+1 KILL @VALMAR,ENTRIES
+2 DO INIT
DO RE^VALM4
+3 QUIT
ASK ;
+1 NEW ACT
SET ACT=$PIECE($$READ("S^REMOVE:Remove Entry;VIEW:View Entry","Select Action",$SELECT($LENGTH(SEL,",")>2:"Remove",1:"View")),U)
+2 if ACT'=""
DO @ACT
+3 QUIT
HDR ;
+1 SET VALMHDR(1)=$PIECE(ENT(0),U,2)_" ["_$PIECE(ENT(0),U,6)_"] List"
+2 SET VALMHDR(1)=$$SETSTR^VALM1(VALMHDR(1),"",IOM-$LENGTH(VALMHDR(1))/2,$LENGTH(VALMHDR(1)))
+3 DO XQORM
+4 QUIT
INIT ;
+1 NEW IEN,NAME
SET VALMCNT=0
+2 KILL @VALMAR
+3 IF +$DATA(ENTRIES)
SET ENTRIES=0
Begin DoDot:1
+4 SET NAME=""
FOR
SET NAME=$ORDER(ENTRIES(NAME))
if NAME=""
QUIT
SET IEN=0
FOR
SET IEN=$ORDER(ENTRIES(NAME,IEN))
if '+IEN
QUIT
Begin DoDot:2
+5 NEW X
SET ENTRIES=ENTRIES+1
SET VALMCNT=VALMCNT+1
SET X=""
+6 SET X=$$SETFLD^VALM1(VALMCNT,X,"NUMBER")
+7 SET X=$$SETFLD^VALM1($$GET1^DIQ(+ENT(0),IEN,.01),X,"ENTITY")
+8 DO SET^VALM10(VALMCNT,X,IEN)
End DoDot:2
End DoDot:1
+9 IF VALMCNT=0
SET VALMCNT=1
Begin DoDot:1
+10 DO SET^VALM10(1," ",0)
+11 SET X="<NONE>"
+12 SET X=$$SETSTR^VALM1(X,"",(IOM-$LENGTH(X))/2,$LENGTH(X))
+13 DO SET^VALM10(2,X,0)
+14 SET VALMCNT=0
End DoDot:1
+15 QUIT
HELP ;
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
EXIT ;
+1 DO XQORM
+2 QUIT
EXPND ;
+1 QUIT
XQORM ;
+1 SET XQORM("#")=$ORDER(^ORD(101,"B","ORNOT DEFAULT ENTITY SELECTIONS",0))_U_"1:"_VALMCNT
+2 QUIT
EN ;
+1 DO EN^VALM("OR PARAMETER SELECT")
+2 QUIT
SELECT(ACT) ;
+1 IF ACT="REMALL"
DO @ACT
QUIT
+2 IF VALMCNT=0
QUIT
+3 DO FULL^VALM1
+4 NEW SEL,X,Y
+5 ; if only 1 item in list, make it default SEL
SET SEL(0)=$SELECT(VALMCNT=1:"1,",1:$PIECE(XQORNOD(0),"=",2))
SET SEL=SEL(0)
+6 IF SEL=""
SET SEL=$$LOR^ORPARMGR(.SEL)
if '+SEL
QUIT
+7 DO @ACT
+8 QUIT
READ(TYPE,PROMPT,DEFAULT,HELP,SCREEN) ;
+1 NEW DIR,X,Y
+2 SET DIR(0)=TYPE
+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 IF $DATA(HELP)
SET DIR("?")=HELP
+7 DO ^DIR
+8 IF $GET(X)="@"
SET Y="@"
QUIT Y
+9 IF Y]""
IF ($LENGTH($GET(Y),U)'=2)
SET Y=Y_U_$GET(Y(0),Y)
+10 QUIT Y
