Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XQSMD4

XQSMD4.m

Go to the documentation of this file. 
  1. XQSMD4 ; SEA/MJM,JLI - Edit a user's options ;01/25/2008
  1.  ;;8.0;KERNEL;**510**;Jul 10, 1995;Build 17
  1.  ; Per VHA Directive 2004-038, this routine should not be modified.
  1.  ; Option: XQSMD BUILD MENU
  1. BUILD ;
  1.  N XQNMSP,XQOPT
  1.  I '$D(^VA(200,DUZ,19.5,"B")) W !!?7,$C(7),"You haven't been delegated any options with which to build a menu." Q
  1.  D NAMESP(.XQNMSP) Q:'$D(XQNMSP)
  1.  D ASKOPT(.XQOPT,"M") Q:'$D(XQOPT)
  1.  I XQOPT("NEW") D NEW(.XQOPT) Q
  1.  D OLD(.XQOPT)
  1.  Q
  1. ASKOPT(XQOPT,XQTYPE) ;
  1.  N XQOPNM
  1.  D ASKNAME(.XQOPNM,.XQNMSP,XQTYPE) Q:'$D(XQOPNM)
  1.  D ADDFIND(XQOPNM,.XQOPT) Q:'$D(XQOPT)
  1.  Q
  1. ADDFIND(X,XQOPT) ;
  1.  N DIC,Y,DLAYGO
  1.  S DIC(0)="MLE",DIC=19,DLAYGO=19
  1.  D ^DIC Q:Y<0
  1.  S XQOPT("NAME")=$P(Y,U,2)
  1.  S XQOPT("IEN")=+Y
  1.  S XQOPT("NEW")=$P(Y,U,3)
  1.  Q
  1. NEW(XQOPT) ;
  1.  N DIE,DA,DIC,DR,DLAYGO,X,Y
  1.  S DIE=19,DR="1;3.5;4///M;",DA=XQOPT("IEN") D ^DIE ; Enter as new option and force type to be menu
  1.  S DIC="^VA(200,DUZ,19.5,",X=XQOPT("NAME"),DIC(0)="MLX",DA(1)=DUZ,DLAYGO=200 D ^DIC Q:Y'>0
  1.  D EDIT(.XQOPT)
  1.  Q
  1. OLD(XQOPT) ;
  1.  I $P(^DIC(19,XQOPT("IEN"),0),U,4)'="M" W !,$C(7),"This option already exists but is not a MENU." Q
  1.  I '$D(^VA(200,DUZ,19.5,XQOPT("IEN"),0)) W !,$C(7),"This option already exists but is not included in your delegated options.",!,"Choose another option name or get this option delegated to yourself." Q
  1.  D EDIT(.XQOPT)
  1.  Q
  1. EDIT(XQOPT) ;
  1.  N XQOUT
  1.  W !!,"You may only include options that have been delegated as items to you.",!
  1.  S XQOUT=0
  1.  F  D  Q:XQOUT
  1.  . N DIC,X,Y,XQITEM,XQITEMNM
  1.  . I $D(^DIC(19,XQOPT("IEN"),10,"B")) D SHOWITEM
  1.  . S DIC("A")="Select Menu Item: "
  1.  . S DIC("S")="I +Y'="_XQOPT("IEN") ; Don't select the option as a menu item
  1.  . S DIC(0)="AEQMZ"
  1.  . S DIC="^VA(200,DUZ,19.5,"
  1.  . D ^DIC I Y<0 S XQOUT=1 Q
  1.  . S XQITEM("IEN")=+Y ; Menu Item IEN
  1.  . S XQITEM("NAME")=Y(0,0) ; Menu Item Name
  1.  . I $D(^DIC(19,XQOPT("IEN"),10,"B",XQITEM("IEN"))) D  Q
  1.  . . N DIK,DA ; If already there, remove it from menu
  1.  . . S DIK="^DIC(19,"_XQOPT("IEN")_",10,",DA(1)=XQOPT("IEN"),DA=$O(^DIC(19,XQOPT("IEN"),10,"B",XQITEM("IEN"),0)) D ^DIK
  1.  . . W !,$C(7),"Menu item ",XQITEM("NAME")," deleted from menu."
  1.  . . I '$D(^DIC(19,XQOPT("IEN"),10,"B")) D
  1.  . . . W !,"This menu contains no menu items."
  1.  . . . W !,"It will be deleted if you don't add a menu item."
  1.  . . W !
  1.  . N X,Y,DIC,DLAYGO,DA,D0
  1.  . S X=XQITEM("NAME")
  1.  . S DIC(0)="EQML"
  1.  . S DLAYGO=19,(D0,DA(1))=XQOPT("IEN")
  1.  . S DIC="^DIC(19,"_XQOPT("IEN")_",10,"
  1.  . D ^DIC I Y<0 W ! Q
  1.  . N DIE,DR,DA
  1.  . S DR="2:3;" ; Set SYNONYM and DISPLAY ORDER
  1.  . S DIE=DIC,DA=+Y,DA(1)=XQOPT("IEN") D ^DIE
  1.  . W !
  1.  Q:$O(^DIC(19,XQOPT("IEN"),10,0))
  1.  I $D(^VA(200,"AP",XQOPT("IEN"))),'$G(XQOPT("NEW")) D  Q
  1.  . D NODEL(.XQOPT)
  1.  . W !,"These users now have a Primary Menu with no menu items!",$C(7)
  1.  . W !,"Recommend you add some menu items to it."
  1.  D DELETE(.XQOPT)
  1.  W !!?7,$C(7),"Empty menu removed from option file and your delegated options.",!
  1.  Q
  1. SHOWITEM ;
  1.  N I,XQREC,XQREC0
  1.  W !,"This menu contains the following menu items. You may add a new menu item."
  1.  W !,"If you select an existing menu item, it will be deleted from the menu.",!
  1.  S I=0
  1.  F  S I=$O(^DIC(19,XQOPT("IEN"),10,I)) Q:'I  S XQREC=^(I,0) D
  1.  . S XQREC0=^DIC(19,+XQREC,0)
  1.  . W !,?3,$P(XQREC0,U),?40,$P(XQREC,U,2),?46,$P(XQREC0,U,2)
  1.  W !
  1.  Q
  1. NODEL(XQOPT) ; called by ^XQSMDFM, too
  1.  N I
  1.  W !!,"This option is used as a Primary Menu for:"
  1.  S I=0
  1.  F  S I=$O(^VA(200,"AP",XQOPT("IEN"),I)) Q:'I  W !?10,$P(^VA(200,I,0),U)
  1.  W !,"Can't delete it while it is used as a primary menu."
  1.  Q
  1. DELETE(XQOPT) ; called by ^XQSMDFM, too
  1.  N DIK,DA
  1.  I $G(XQOPT("NEW")) D
  1.  . S DIK="^VA(200,DUZ,19.5,",DA(1)=DUZ,DA=XQOPT("IEN") D ^DIK
  1.  E  D
  1.  . N XQJ
  1.  . S XQJ=0
  1.  . ; Delete option from all menus
  1.  . F  S XQJ=$O(^DIC(19,"AD",XQOPT("IEN"),XQJ)) Q:'XQJ  S DA=$O(^(XQJ,0)),DA(1)=XQJ,DIK="^DIC(19,DA(1),10," D ^DIK
  1.  . ; Delete option as a secondary menu option for all users
  1.  . F  S XQJ=$O(^VA(200,"AD",XQOPT("IEN"),XQJ)) Q:'XQJ  S DA=$O(^(XQJ,0)),DA(1)=XQJ,DIK="^VA(200,DA(1),203," D ^DIK
  1.  . ; Delete option as delegated option for all users
  1.  . F  S XQJ=$O(^VA(200,XQJ)) Q:'XQJ  I $D(^(XQJ,19.5,"B",XQOPT("IEN"))) S DA=XQOPT("IEN"),DA(1)=XQJ,DIK="^VA(200,DA(1),19.5," D ^DIK
  1.  S DIK="^DIC(19,",DA=XQOPT("IEN") D ^DIK ; Delete option
  1.  Q
  1. NAMESP(XQNMSP) ; Check for available namespaces. Called by ^XQSMDFM, too.
  1.  N I
  1.  S I=0
  1.  F  S I=$O(^VA(200,DUZ,19.6,"B",I)) Q:I=""  S XQNMSP=$G(XQNMSP)+1,XQNMSP(I)=""
  1.  I $D(XQNMSP) D HLPNAME Q
  1.  I $D(^VA(200,DUZ,19.6)) K ^(19.6)
  1.  W !!?7,$C(7),"No namespace(s) have been set up for you to build new menus.",!?7,"Contact your computer service representative."
  1.  Q
  1. HLPNAME ;
  1.  N I
  1.  W !?7,"The options you build or edit must begin with ",$S(XQNMSP>1:"one of ",1:""),!?7,"the following namespace",$S(XQNMSP>1:"(s)",1:"")," and be no more than 30 characters long:",!
  1.  S I=""
  1.  F  S I=$O(XQNMSP(I)) Q:I=""  W !?35,$S($E(I,1)="A":I,1:I_"Z")
  1.  W !
  1.  Q:"^P^I^E^M^"'[(U_$G(XQTYPE)_U)
  1.  N I,XQM,XQREC
  1.  S I=0
  1.  F  S I=$O(^VA(200,DUZ,19.5,"B",I)) Q:'I  D
  1.  . S XQREC=$G(^DIC(19,I,0)) Q:$P(XQREC,U,4)'=XQTYPE
  1.  . S XQM($P(XQREC,U))=$P(XQREC,U,2)
  1.  I '$D(XQM) W !?7,"You have no existing delegated "_$$TYPE(XQTYPE)_" options. You may enter a new one." Q
  1.  W !,"The following are your existing delegated "_$$TYPE(XQTYPE)_" options:"
  1.  F  S I=$O(XQM(I)) Q:I=""  W !,I,?40,XQM(I)
  1.  Q
  1. TYPE(XQT) ;
  1.  Q $S(XQT="P":"Print",XQT="I":"Inquire",XQT="E":"Edit",1:"Menu")
  1. ASKNAME(XQOPNM,XQNMSP,XQTYPE)  ;Check for a valid option names.
  1.  ;Called by ^XQSMDFM, too.
  1.  ;XU*8*428 also allows for local namespaces, e.g., A5A, AFS, etc.
  1.  F  D  Q:$D(DIRUT)!$D(XQOPNM)
  1.  . N DIR,X,Y
  1.  . S DIR("A")="Option Name"
  1.  . S DIR("PRE")="D CHKNAME^XQSMD4"
  1.  . S DIR("?")="^D HLPNAME^XQSMD4"
  1.  . S DIR(0)="F^3:30"
  1.  . D ^DIR Q:$D(DIRUT)
  1.  . S XQOPNM=Y
  1.  Q
  1. CHKNAME ;
  1.  I $D(DTOUT)!(X[U)!(X["?") Q
  1.  I X="" S X=U Q
  1.  N I
  1.  S I=""
  1.  F  S I=$O(XQNMSP(I)) Q:I=""  Q:$E(I,1)="A"&($E(X,1,$L(I))=I)  Q:$E(X,1,$L(I))=I&($E(X,$L(I)+1)="Z")
  1.  Q:I'=""
  1.  W $C(7),!!?7,$E(X,1,4),"* is not a valid namespace for you.",!
  1.  K X
  1.  Q