XHDX ; SLC/JER - Desktop Config Calls ; 01 Aug 2003 12:18 AM
;;1.0;HEALTHEVET DESKTOP;;Jul 15, 2003
PERSEL(LST) ; List perspectives for a user
N OPT,X,I
S OPT=$$GET^XPAR($$ENTSTR,"XHD PRISM PERSPECTIVE SELECTOR",1,"I")
Q:'OPT
S I=0 F S I=$O(^DIC(19,+OPT,10,I)) Q:'I D
. S X=^DIC(19,+OPT,10,I,0)
. S LST($S($P(X,U,3):$P(X,U,3),1:99999+I))=$P(^DIC(19,+X,0),U,2)
Q
ENTSTR() ; Build entities string
Q "ALL^USR.`"_DUZ_$S(+$G(^VA(200,DUZ,5)):"^SRV.`"_+$G(^(5)),1:"")
VERSRV(LST,OPT) ; Return option versions
N I,X
S I=0 F S I=$O(OPT(I)) Q:'I D
. N XHDLST
. S X=$P(OPT(I),U),LST(I)=X
. D FIND^DIC(19,"",1,"X",X,1,,,,"XHDLST")
. I 'XHDLST("DILIST",0) Q
. S $P(LST(I),U,2)=$RE($P($RE(XHDLST("DILIST","ID",1,1))," ",1))
Q
ASSIGN ; Assign perspectives to users
N DIC,DONE,X,Y,USR,OPT,ANERR,CUR,CURNM,REP,DIR,DIRUT,DUOUT,DTOUT
S DIC=19,DIC(0)="AEMQ",DIC("A")="Select Perspective Option: "
D ^DIC Q:Y<1 S OPT=+Y
W !!,"Assigning "_$P(Y,U,2)_" to Users"
S DONE=0 F D Q:DONE
. S DIC=200,DIC(0)="AEMQ",DIC("A")="Assign to: "
. D ^DIC I Y<1 S DONE=1 Q
. S USR=+Y
. S CUR=+$$GET^XPAR(USR_";VA(200,","XHD PRISM PERSPECTIVE SELECTOR",1)
. I +CUR,(CUR'=OPT) D Q:'REP
. . S CURNM=$$GET^XPAR(USR_";VA(200,","XHD PRISM PERSPECTIVE SELECTOR",1,"E")
. . S DIR(0)="Y",DIR("A")="Currently Assigned "_CURNM_". Replace",DIR("B")="Y"
. . D ^DIR S REP=Y
. D EN^XPAR(USR_";VA(200,","XHD PRISM PERSPECTIVE SELECTOR",1,"`"_OPT,.ANERR)
. I ANERR W !,$P(ANERR,U,2)
. D CHKCTXT(OPT,USR)
Q
CHKCTXT(OPT,USR) ; Check context
N HASOPT,ALLCTXT
S HASOPT=$$ACCESS^XQCHK(USR,OPT)
I +HASOPT<1 D
. S ALLCTXT=$$FIND1^DIC(19,"","QX","ORRCM CLIENT")
. S HASOPT=$$ACCESS^XQCHK(USR,ALLCTXT)
I +HASOPT<1 D
. N USRNM,OPTNM
. S USRNM=$$GET1^DIQ(200,USR_",",.01)
. S OPTNM=$$GET1^DIQ(19,OPT_",",.01)
. W !,USRNM_" does not have the "_OPTNM_" in the menu tree."
. W !,"You many need to add this as a secondary menu for this user.",!
Q
BYUSR ; Assign a perspective to a single user
N DIC,DIR,DIRUT,DUOUT,DTOUT,X,Y,USR,OPT,ANERR
S DIC=200,DIC(0)="AEMQ" ;,DIC("A")="Assign to: "
D ^DIC Q:Y<1 S USR=+Y
S DIR(0)="PAO^19:EM",DIR("A")="Select Perspective Option: "
S DIR("B")=$$GET^XPAR(USR_";VA(200,","XHD PRISM PERSPECTIVE SELECTOR",1,"E")
I DIR("B")="" K DIR("B")
D ^DIR
S OPT="" S:(Y<1)&(X="@") OPT="@" S:+Y>0 OPT="`"_+Y
Q:OPT=""
D EN^XPAR(USR_";VA(200,","XHD PRISM PERSPECTIVE SELECTOR",1,OPT,.ANERR)
I ANERR W !,$P(ANERR,U,2)
S OPT=+$P(OPT,"`",2) I OPT D CHKCTXT(OPT,USR)
Q
BYSVC ; Assign a perspective to a service
N DIC,DIR,DIRUT,DUOUT,DTOUT,X,Y,SVC,SVCNM,OPT,OPTNM,ANERR
S DIC=49,DIC(0)="AEMQ"
D ^DIC Q:Y<1 S SVC=+Y,SVCNM=$P(Y,U,2)
S DIR(0)="PAO^19:EM",DIR("A")="Select Perspective Option: "
S DIR("B")=$$GET^XPAR(SVC_";DIC(49,","XHD PRISM PERSPECTIVE SELECTOR",1,"E")
I DIR("B")="" K DIR("B")
D ^DIR
S OPT="" S:(Y<1)&(X="@") OPT="@" S:+Y>0 OPT="`"_+Y S OPTNM=$P(Y,U,2)
Q:OPT=""
D EN^XPAR(SVC_";DIC(49,","XHD PRISM PERSPECTIVE SELECTOR",1,OPT,.ANERR)
I ANERR W !,$P(ANERR,U,2)
I 'ANERR,(+$P(OPT,"`",2)) D
. W !,OPTNM_" has been set for "_SVCNM_"."
. W !,"Note: "_OPTNM_" must also be available in each user's menu tree."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXHDX 3254 printed Dec 13, 2024@01:57:23 Page 2
XHDX ; SLC/JER - Desktop Config Calls ; 01 Aug 2003 12:18 AM
+1 ;;1.0;HEALTHEVET DESKTOP;;Jul 15, 2003
PERSEL(LST) ; List perspectives for a user
+1 NEW OPT,X,I
+2 SET OPT=$$GET^XPAR($$ENTSTR,"XHD PRISM PERSPECTIVE SELECTOR",1,"I")
+3 if 'OPT
QUIT
+4 SET I=0
FOR
SET I=$ORDER(^DIC(19,+OPT,10,I))
if 'I
QUIT
Begin DoDot:1
+5 SET X=^DIC(19,+OPT,10,I,0)
+6 SET LST($SELECT($PIECE(X,U,3):$PIECE(X,U,3),1:99999+I))=$PIECE(^DIC(19,+X,0),U,2)
End DoDot:1
+7 QUIT
ENTSTR() ; Build entities string
+1 QUIT "ALL^USR.`"_DUZ_$SELECT(+$GET(^VA(200,DUZ,5)):"^SRV.`"_+$GET(^(5)),1:"")
VERSRV(LST,OPT) ; Return option versions
+1 NEW I,X
+2 SET I=0
FOR
SET I=$ORDER(OPT(I))
if 'I
QUIT
Begin DoDot:1
+3 NEW XHDLST
+4 SET X=$PIECE(OPT(I),U)
SET LST(I)=X
+5 DO FIND^DIC(19,"",1,"X",X,1,,,,"XHDLST")
+6 IF 'XHDLST("DILIST",0)
QUIT
+7 SET $PIECE(LST(I),U,2)=$REVERSE($PIECE($REVERSE(XHDLST("DILIST","ID",1,1))," ",1))
End DoDot:1
+8 QUIT
ASSIGN ; Assign perspectives to users
+1 NEW DIC,DONE,X,Y,USR,OPT,ANERR,CUR,CURNM,REP,DIR,DIRUT,DUOUT,DTOUT
+2 SET DIC=19
SET DIC(0)="AEMQ"
SET DIC("A")="Select Perspective Option: "
+3 DO ^DIC
if Y<1
QUIT
SET OPT=+Y
+4 WRITE !!,"Assigning "_$PIECE(Y,U,2)_" to Users"
+5 SET DONE=0
FOR
Begin DoDot:1
+6 SET DIC=200
SET DIC(0)="AEMQ"
SET DIC("A")="Assign to: "
+7 DO ^DIC
IF Y<1
SET DONE=1
QUIT
+8 SET USR=+Y
+9 SET CUR=+$$GET^XPAR(USR_";VA(200,","XHD PRISM PERSPECTIVE SELECTOR",1)
+10 IF +CUR
IF (CUR'=OPT)
Begin DoDot:2
+11 SET CURNM=$$GET^XPAR(USR_";VA(200,","XHD PRISM PERSPECTIVE SELECTOR",1,"E")
+12 SET DIR(0)="Y"
SET DIR("A")="Currently Assigned "_CURNM_". Replace"
SET DIR("B")="Y"
+13 DO ^DIR
SET REP=Y
End DoDot:2
if 'REP
QUIT
+14 DO EN^XPAR(USR_";VA(200,","XHD PRISM PERSPECTIVE SELECTOR",1,"`"_OPT,.ANERR)
+15 IF ANERR
WRITE !,$PIECE(ANERR,U,2)
+16 DO CHKCTXT(OPT,USR)
End DoDot:1
if DONE
QUIT
+17 QUIT
CHKCTXT(OPT,USR) ; Check context
+1 NEW HASOPT,ALLCTXT
+2 SET HASOPT=$$ACCESS^XQCHK(USR,OPT)
+3 IF +HASOPT<1
Begin DoDot:1
+4 SET ALLCTXT=$$FIND1^DIC(19,"","QX","ORRCM CLIENT")
+5 SET HASOPT=$$ACCESS^XQCHK(USR,ALLCTXT)
End DoDot:1
+6 IF +HASOPT<1
Begin DoDot:1
+7 NEW USRNM,OPTNM
+8 SET USRNM=$$GET1^DIQ(200,USR_",",.01)
+9 SET OPTNM=$$GET1^DIQ(19,OPT_",",.01)
+10 WRITE !,USRNM_" does not have the "_OPTNM_" in the menu tree."
+11 WRITE !,"You many need to add this as a secondary menu for this user.",!
End DoDot:1
+12 QUIT
BYUSR ; Assign a perspective to a single user
+1 NEW DIC,DIR,DIRUT,DUOUT,DTOUT,X,Y,USR,OPT,ANERR
+2 ;,DIC("A")="Assign to: "
SET DIC=200
SET DIC(0)="AEMQ"
+3 DO ^DIC
if Y<1
QUIT
SET USR=+Y
+4 SET DIR(0)="PAO^19:EM"
SET DIR("A")="Select Perspective Option: "
+5 SET DIR("B")=$$GET^XPAR(USR_";VA(200,","XHD PRISM PERSPECTIVE SELECTOR",1,"E")
+6 IF DIR("B")=""
KILL DIR("B")
+7 DO ^DIR
+8 SET OPT=""
if (Y<1)&(X="@")
SET OPT="@"
if +Y>0
SET OPT="`"_+Y
+9 if OPT=""
QUIT
+10 DO EN^XPAR(USR_";VA(200,","XHD PRISM PERSPECTIVE SELECTOR",1,OPT,.ANERR)
+11 IF ANERR
WRITE !,$PIECE(ANERR,U,2)
+12 SET OPT=+$PIECE(OPT,"`",2)
IF OPT
DO CHKCTXT(OPT,USR)
+13 QUIT
BYSVC ; Assign a perspective to a service
+1 NEW DIC,DIR,DIRUT,DUOUT,DTOUT,X,Y,SVC,SVCNM,OPT,OPTNM,ANERR
+2 SET DIC=49
SET DIC(0)="AEMQ"
+3 DO ^DIC
if Y<1
QUIT
SET SVC=+Y
SET SVCNM=$PIECE(Y,U,2)
+4 SET DIR(0)="PAO^19:EM"
SET DIR("A")="Select Perspective Option: "
+5 SET DIR("B")=$$GET^XPAR(SVC_";DIC(49,","XHD PRISM PERSPECTIVE SELECTOR",1,"E")
+6 IF DIR("B")=""
KILL DIR("B")
+7 DO ^DIR
+8 SET OPT=""
if (Y<1)&(X="@")
SET OPT="@"
if +Y>0
SET OPT="`"_+Y
SET OPTNM=$PIECE(Y,U,2)
+9 if OPT=""
QUIT
+10 DO EN^XPAR(SVC_";DIC(49,","XHD PRISM PERSPECTIVE SELECTOR",1,OPT,.ANERR)
+11 IF ANERR
WRITE !,$PIECE(ANERR,U,2)
+12 IF 'ANERR
IF (+$PIECE(OPT,"`",2))
Begin DoDot:1
+13 WRITE !,OPTNM_" has been set for "_SVCNM_"."
+14 WRITE !,"Note: "_OPTNM_" must also be available in each user's menu tree."
End DoDot:1
+15 QUIT
