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

BEHUTIL.m

Go to the documentation of this file. 
  1. BEHUTIL ;MSC/IND/DKM - General Purpose Utilities ;25-Nov-2007 10:49;DKM
  1.  ;;1.2;BEH UTILITIES;**1**;Mar 20, 2007
  1.  ;=================================================================
  1.  ; Display required header for menus
  1. TITLE(PKG,VER) ;EP
  1.  Q:$E($G(IOST),1,2)'="C-"
  1.  N X,%ZIS,IORVON,IORVOFF,MNU
  1.  S MNU=$P(XQY0,U,2),VER="Version "_$G(VER,1.1),PKG=$G(PKG,"RPMS-EHR Management")
  1.  S X="IORVON;IORVOFF"
  1.  D ENDR^%ZISS
  1.  U IO
  1.  W @IOF,IORVON,$$GET1^DIQ(4,DUZ(2),.01),?(IOM-$L(PKG)\2),PKG,?(IOM-$L(VER)),VER,!,IORVOFF,?(IOM-$L(MNU)\2-$X),MNU
  1.  Q
  1.  ; Pause for user response
  1. PAUSE ;EP
  1.  N X
  1.  R !!,"Press ENTER or RETURN to continue...",X:$G(DTIME,300),!
  1.  Q
  1.  ; Edit a parameter from a menu option
  1. EDITPAR(PARAM) ;EP
  1.  S PARAM=$G(PARAM,$P(XQY0,U))
  1.  D TITLE(),EDITPAR^XPAREDIT(PARAM):$$CHECK(8989.51,PARAM,"Parameter")
  1.  Q
  1.  ; Edit a parameter template from a menu option
  1. EDITTMPL(TMPL) ;EP
  1.  S TMPL=$G(TMPL,$P(XQY0,U))
  1.  D TITLE(),TEDH^XPAREDIT(TMPL,"BA"):$$CHECK(8989.52,TMPL,"Parameter template")
  1.  Q
  1.  ; Edit a security key assignment
  1. EDITKEY(KEY) ;EP
  1.  N USR,X,%,XQKEYT,XQPROV,XQFDA,XQIEN
  1.  S KEY=$G(KEY,$P(XQY0,U)),KEY(0)=$$FIND1^DIC(19.1,,"X",KEY)
  1.  I 'KEY(0) D  Q
  1.  .W !,"Key ",KEY," was not found.",!
  1.  .R "Press ENTER to continue...",X:DTIME,!
  1.  F  D  Q:USR'>0
  1.  .D TITLE()
  1.  .W !!!,KEY," Key Management",!
  1.  .S USR=$$LOOKUP(200,"Select a user for key assignment")
  1.  .Q:USR'>0
  1.  .I $D(^XUSEC(KEY,USR)) D
  1.  ..W !,"This user already has the ",KEY," key.",!
  1.  ..S X=$$ASK^CIAU("Do you wish to remove the key assignment","N")
  1.  ..Q:X'>0
  1.  ..I $$DEL^XQKEY(USR,KEY(0))
  1.  ..K ^XUSEC(KEY,USR)
  1.  .E  D
  1.  ..W !,"This user does not currently have the ",KEY," key.",!
  1.  ..S X=$$ASK^CIAU("Do you wish to assign this key to the selected user","N")
  1.  ..Q:X'>0
  1.  ..I $$ADD^XQKEY(USR,KEY(0))
  1.  ..S ^XUSEC(KEY,USR)=""
  1.  Q
  1.  ; Execute an option
  1. EXECOPT(OPT,PAUSE) ;EP
  1.  S:OPT'=+OPT OPT=+$$FIND1^DIC(19,,"X",OPT)
  1.  D EO(20),EO(25),EO(15),PAUSE:$G(PAUSE)
  1.  Q
  1.  ; Check to make sure entry exists
  1. CHECK(FIL,VAL,ENT) ;
  1.  Q:$$FIND1^DIC(FIL,,"X",VAL) 1
  1.  W !,ENT," ",VAL," was not found.",!
  1.  D PAUSE
  1.  Q 0
  1. EO(NODE) ;
  1.  N X
  1.  S X=$G(^DIC(19,OPT,NODE))
  1.  Q:'$L(X)
  1.  S:NODE=25 X="D "_$S(X[U:"",1:U)_X
  1.  X X
  1.  Q
  1.  ; Rename a file entry
  1. RENENTRY(FIL,OLD,NEW) ;PEP - Rename file entry
  1.  N IEN,FDA
  1.  Q:$$FIND1^DIC(FIL,,"X",NEW)
  1.  S IEN=$$FIND1^DIC(FIL,,"X",OLD)
  1.  Q:'IEN
  1.  S FDA(FIL,IEN_",",.01)=NEW
  1.  D FILE^DIE("E","FDA")
  1.  Q
  1.  ; Rename a parameter
  1.  ; Renames the parameter definition and the associated package for
  1.  ; any package-associated instances.
  1.  ;   OLD = Old parameter name
  1.  ;   NEW = New parameter name
  1. RENPARAM(OLD,NEW) ;EP
  1.  N DEFIEN,PARIEN,OLDPKG,NEWPKG,INST,FDA
  1.  D RENENTRY(8989.51,OLD,NEW)
  1.  S DEFIEN=$$FIND1^DIC(8989.51,,"XQ",NEW)
  1.  S OLDPKG=$$PARAMPKG(OLD)
  1.  S NEWPKG=$$PARAMPKG(NEW)
  1.  Q:'DEFIEN!'OLDPKG!'NEWPKG
  1.  S INST=""
  1.  F  S INST=$O(^XTV(8989.5,"AC",DEFIEN,OLDPKG,INST)),PARIEN=0 Q:'$L(INST)  D
  1.  .F  S PARIEN=$O(^XTV(8989.5,"AC",DEFIEN,OLDPKG,INST,PARIEN)) Q:'PARIEN  D
  1.  ..S FDA(8989.5,PARIEN_",",.01)=NEWPKG
  1.  D:$D(FDA) FILE^DIE(,"FDA")
  1.  Q
  1.  ; Return package reference from param name
  1. PARAMPKG(PARAM) ;
  1.  N PKG
  1.  S PKG=PARAM
  1.  F  S PKG=$O(^DIC(9.4,"C",PKG),-1) Q:$E(PARAM,1,$L(PKG))=PKG
  1.  S:$L(PKG) PKG=$O(^DIC(9.4,"C",PKG,0))
  1.  Q $S(PKG:PKG_";DIC(9.4,",1:"")
  1.  ; Register a submenu under parent menu
  1. REGMENU(MNU,SEQ,SYN,PAR) ;PEP - Register submenu
  1.  N FDA,ITM
  1.  S MNU=$$FIND1^DIC(19,,"BX",MNU),PAR=$$FIND1^DIC(19,,"BX",$G(PAR,"BEHOMENU")),SEQ=+$G(SEQ)
  1.  Q:'MNU!'PAR
  1.  S ITM=$O(^DIC(19,PAR,10,"B",MNU,0))
  1.  S:'ITM ITM="+1"
  1.  S FDA=$NA(FDA(19.01,ITM_","_PAR_","))
  1.  S @FDA@(.01)=MNU,@FDA@(2)=SYN,@FDA@(3)=$S(SEQ<1:"@",SEQ>99:99,1:SEQ)
  1.  D UPDATE^DIE("","FDA")
  1.  Q
  1.  ; Lookup an entry in file #FN using prompt PM.
  1. LOOKUP(FN,PM,FL,SC) ;EP
  1.  Q:'FN -1
  1.  N DIC,DLAYGO,X,Y
  1.  W !
  1.  F FL=''$G(FL):-1:0 D
  1.  .S DIC=FN,DIC(0)=$S(FL:"E",1:"AE"),DIC("A")=PM_": ",X="??"
  1.  .S:$L($G(SC)) DIC("S")=SC
  1.  .D ^DIC
  1.  W !
  1.  Q $S(Y>0:+Y,1:0)