- 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 Feb 18, 2025@23:23:45 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