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

ORACCESS.m

Go to the documentation of this file.
  1. ORACCESS ;SLC/AGP - User Read/Write Access to CPRS ; Apr 20, 2023@17:48
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**588**;Dec 17, 1997;Build 29
  1. ;
  1. ; Direct reads of PARAMETERS File (#8989.5) - IA #2686
  1. ; Direct reads of PARAMETER DEFINITION File (#8989.51) - IA #2685
  1. ; Reference to CRNRSITE^VAFCCRNR in ICR #7346
  1. ;
  1. Q
  1. ;
  1. PROMPT(USER) ;
  1. N DIR,Y
  1. S DIR(0)="S^A:Copy/Add settings;O:Copy/Overwrite settings;S:Skip User"
  1. S DIR("A")="Select copy access for "_USER
  1. S DIR("?")="Select the copy action, enter ?? for more information"
  1. S DIR("??")=U_"D HELP^ORACCESS"
  1. D ^DIR
  1. Q Y
  1. ;
  1. ASKYN(DEF,TEXT,RTN,HLP) ;
  1. N DIR,X,Y
  1. K DIROUT,DIRUT,DTOUT,DUOUT
  1. S DIR(0)="Y0"
  1. S DIR("A")=TEXT
  1. S DIR("B")=DEF
  1. S DIR("?")="Enter Y or N."
  1. I $G(RTN)'="",$G(HLP)'="" D
  1. . S DIR("?")="Enter Y or N. For detailed help type ??"
  1. . S DIR("??")=U_"D HELP^"_RTN_"(HLP)"
  1. W !
  1. D ^DIR
  1. I $D(DTOUT)!$D(DUOUT) S Y=0
  1. Q Y
  1. ;
  1. ACCESS(RESULTS,USER,GETNOTES,NOTES) ;
  1. D ACCESS^ORACCES2(.RESULTS,$G(USER),$G(GETNOTES),.NOTES)
  1. Q
  1. ;
  1. GETNOTES(ORY,USER) ;
  1. N TEMP
  1. D ACCESS^ORACCES2(.TEMP,USER,2,.ORY)
  1. Q
  1. ;
  1. CHECK(IEN,NAME) ;
  1. N ACT,ARRAY,CARRAY,HASDATA,RESULT,YN
  1. S HASDATA=0,RESULT="O"
  1. D DATA(.ARRAY,TABS,IEN)
  1. I $D(ARRAY) S HASDATA=1
  1. I HASDATA=0 D
  1. .D DATA(.ARRAY,OTHER,IEN)
  1. .I $D(ARRAY) S HASDATA=1
  1. I HASDATA=0 D
  1. .D DATA(.ARRAY,ORDERS,IEN)
  1. .I $D(ARRAY) S HASDATA=1
  1. I HASDATA=1 D
  1. .W !,NAME_" has settings already defined",!
  1. .D DISPLAY^ORACCES3(IEN,.CARRAY)
  1. .W !
  1. .S ACT=$$PROMPT(NAME)
  1. .I ACT=-1!(ACT="S") S RESULT="S" Q
  1. .S RESULT=ACT
  1. .;S YN=$$ASKYN("N","Replace "_NAME_" settings")
  1. .;I YN'=1 S RESULT=0 W !,"Settings not copied over!"
  1. Q RESULT
  1. ;
  1. COPY ;
  1. N ACT,CARRAY,IEN,INITIAL,NAME,TEXT,UARRAY,YN,CRLF
  1. N ORPARAM,ORTABS,ORPIEN,TABS,OTHER,ORDERS,ERROR
  1. D GETPARAMS(1) S CRLF=$C(13,10)
  1. S TEXT=CRLF_"Only users with write access settings are selectable."_CRLF
  1. S TEXT=TEXT_"May take a few seconds to display a list of users."_CRLF
  1. S TEXT=TEXT_"Select user to copy from: "
  1. S INITIAL=$$SELECT(TEXT,1)
  1. I INITIAL=-1 Q
  1. W !
  1. D DISPLAY^ORACCES3(+INITIAL,.CARRAY)
  1. W !
  1. S YN=$$ASKYN("N","Copy "_$P(INITIAL,U,2)_" settings")
  1. Q:$D(DTOUT) G:$D(DUOUT) COPY
  1. I 'YN Q
  1. W !
  1. D GETUSER(.UARRAY)
  1. I '$D(UARRAY) W !," No user selected" Q
  1. S IEN=0 F S IEN=$O(UARRAY(IEN)) Q:IEN'>0 D
  1. .S NAME=UARRAY(IEN)
  1. .S ACT=$$CHECK(IEN,NAME)
  1. .I ACT'="O",ACT'="A" Q
  1. .D SETUSER(IEN,NAME,INITIAL,ACT,.CARRAY)
  1. Q
  1. ;
  1. CLEAR ;
  1. N DA,DIR,DA,DIC,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,DLAYGO,DINUM,USERLEVEL,LVLTXT,DONE
  1. N ENT,ENT2,ORENT,ORCNT,LVLPREFIX,IEN,NAME,LVLNAME,USR,DIV,IDX,ORERR,TXT,CRLF
  1. N ORPARAM,ORTABS,ORPIEN,TABS,OTHER,ORDERS,ERROR,DSPLVL,DSPNAME
  1. D GETPARAMS(1)
  1. S CRLF=$C(13,10)
  1. S DONE=0 F D Q:DONE
  1. . K DA,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1. . S DIR(0)="SO^S:System;D:Division;U:User"
  1. . S DIR("A")="Remove Settings for System, Division or User?"
  1. . D ^DIR I $D(DIRUT) S DONE=1 Q
  1. . I $G(Y)="S" D S DONE=1 Q
  1. . . S DSPLVL=2 D GETINST(DSPLVL,"",.DSPNAME)
  1. . . W !!!,"Current settings for System "_DSPNAME_":",!
  1. . . D DISPLAY^ORACCES3(0,"",0,0,DSPLVL,DSPNAME)
  1. . . S TXT="All settings will be removed and CPRS Write Access for"_CRLF
  1. . . S TXT=TXT_"the system will revert to package level settings."_CRLF
  1. . . S TXT=TXT_"Are you sure you want to remove all system level settings"
  1. . . I $$ASKYN("N",TXT) D I 1
  1. . . . D CLEARSYS
  1. . . . W !!,"*** System level settings removed ***",!!
  1. . . E W !!,"System level settings not removed.",!!
  1. . S USERLEVEL=$S($G(Y)="U":1,$G(Y)="D":0,1:-1),LVLTXT=$$LOW^XLFSTR($G(Y(0)))
  1. . I USERLEVEL<0 S DONE=1 Q
  1. . I USERLEVEL S ENT="VA(200,",LVLPREFIX="USR",ORCNT=3
  1. . E S ENT="DIC(4,",LVLPREFIX="DIV",ORCNT=4
  1. . S ORENT=";"_ENT,ENT2=LVLPREFIX_".`"
  1. . F D Q:DONE
  1. . . K DIC,X,Y,DTOUT,DUOUT
  1. . . S DIC=U_ENT
  1. . . S DIC("A")=CRLF_"Only "_LVLTXT_"s with write access settings are selectable."_CRLF
  1. . . I USERLEVEL S DIC("A")=DIC("A")_"May take a few seconds to display a list of users."_CRLF
  1. . . S DIC("A")=DIC("A")_"Remove all settings for which "_LVLTXT_"? ",DIC(0)="AEQM"
  1. . . S DIC("S")="N ORX F ORX=1:1:ORCNT I $D(^XTV(8989.5,""AC"",ORPIEN(ORX),Y_ORENT)) Q"
  1. . . D ^DIC I $D(DTOUT)!$D(DUOUT) S DONE=1 Q
  1. . . S IEN=$P(Y,U),NAME=$P(Y,U,2),LVLNAME=LVLTXT_" "_NAME
  1. . . I IEN'>0 S DONE=1 Q
  1. . . S USR=$S(USERLEVEL:IEN,1:0),DIV=$S(USERLEVEL:0,1:IEN)
  1. . . W !!!,"Current settings for "_LVLNAME_":",!
  1. . . D DISPLAY^ORACCES3(USR,"",DIV)
  1. . . S TXT="All settings will be removed and CPRS Write Access for "_LVLTXT_CRLF
  1. . . S TXT=TXT_NAME_" will revert to the "_$S(USERLEVEL:"Division",1:"System")_" level settings."_CRLF
  1. . . S TXT=TXT_"Are you sure you want to remove all settings for this "_LVLTXT
  1. . . I $$ASKYN("N",TXT) D I 1
  1. . . . F IDX=1:1:ORCNT D
  1. . . . . K ORERR
  1. . . . . D NDEL^XPAR(ENT2_IEN,ORPARAM(IDX),.ORERR)
  1. . . . . I +$G(ORERR)'=0 W !,"ERROR: "_ORERR
  1. . . . W !!!,"New settings for "_LVLNAME_":",!
  1. . . . D DISPLAY^ORACCES3(USR,"",DIV)
  1. . . . W !!,"*** Settings removed for "_LVLNAME_" ***",!!
  1. . . E W !!,"Settings not removed for "_LVLNAME_".",!!
  1. Q
  1. ;
  1. GETINST(LVL,ENT,NAME) ;
  1. I LVL=1 D
  1. . N PKG,NAM
  1. . S NAM=$P(^XTV(8989.51,ORPIEN(TABS),0),"^",1),PKG=NAM
  1. . F S PKG=$O(^DIC(9.4,"C",PKG),-1) Q:$E(NAM,1,$L(PKG))=PKG
  1. . S PKG=$O(^DIC(9.4,"C",PKG,0))
  1. . I PKG S ENT=PKG_";DIC(9.4,",NAME=$P($G(^DIC(9.4,PKG,0)),U)
  1. I LVL=2 D
  1. . S ENT=$$FIND1^DIC(4.2,"","QX",$$KSP^XUPARAM("WHERE"))_";DIC(4.2,"
  1. . S NAME=$P($G(^DIC(4.2,+ENT,0)),U)
  1. Q
  1. ;
  1. EDITOR ;
  1. N INST,ORERR,TEMPLATE,ENT,DIC,DTOUT,DUOUT,IDX,Y,MESSAGE
  1. N ORPARAM,ORTABS,ORPIEN,TABS,OTHER,ORDERS,ERROR,NAME
  1. N USER,DIV,DSPLVL,DSPNAME,ASKLVL
  1. S (USER,DIV,DSPLVL)=0,(DSPNAME,ASKLVL)=""
  1. D GETPARAMS(1)
  1. S (ENT,NAME)="",INST=$$SELECTINST
  1. I "^U^S^P^D^"'[(U_INST_U) Q
  1. S TEMPLATE="OR TABS WRITE ACCESS BY "_$S(INST="U":"USER",INST="S":"SYS",INST="P":"PKG",INST="D":"DIV",1:"")
  1. I INST="P" D
  1. . S DSPLVL=1 D GETINST(DSPLVL,.ENT,.DSPNAME)
  1. . S ASKLVL="PKG",NAME="Package: "_DSPNAME
  1. I INST="S" D
  1. . S DSPLVL=2 D GETINST(DSPLVL,.ENT,.DSPNAME)
  1. . S ASKLVL="SYS",NAME="System: "_DSPNAME
  1. I INST="D" D
  1. .S DIC=4,DIC(0)="AEMQ"
  1. .D ^DIC I $D(DTOUT)!$D(DUOUT)!(Y<1) S ENT="" Q
  1. .S DIV=+Y,DSPLVL=3,DSPNAME=$P($G(^DIC(4,DIV,0)),U)
  1. .S ENT=+Y_";DIC(4,",NAME="Division: "_DSPNAME
  1. I INST="U" D
  1. .S DIC=200,DIC(0)="AEMQ"
  1. .D ^DIC I $D(DTOUT)!$D(DUOUT)!(Y<1) S ENT="" Q
  1. .S USER=+Y,DSPLVL=4,DSPNAME=$P($G(^VA(200,+Y,0)),U)
  1. .S ENT=+Y_";VA(200,",NAME="User: "_DSPNAME
  1. I ENT="" Q
  1. D DISPLAY^ORACCES3(USER,"",DIV,0,DSPLVL,DSPNAME)
  1. D VALUEMSG^ORACCES2(ENT,,,1,.MESSAGE,NAME)
  1. I $D(MESSAGE) D K MESSAGE
  1. .S IDX=0 F S IDX=$O(MESSAGE(IDX)) Q:'IDX W !,MESSAGE(IDX)
  1. .W ! F IDX=1:1:78 W "-"
  1. .W !
  1. I ASKLVL'="" D ASK4RESET(ASKLVL)
  1. D TEDH^XPAREDIT(TEMPLATE,"",ENT)
  1. D DISPLAY^ORACCES3(USER,"",DIV,0,DSPLVL,DSPNAME)
  1. D VALUEMSG^ORACCES2(ENT,,,1,.MESSAGE,NAME)
  1. I $D(MESSAGE) D
  1. .S IDX=0 F S IDX=$O(MESSAGE(IDX)) Q:'IDX W !,MESSAGE(IDX)
  1. .W ! F IDX=1:1:78 W "-"
  1. .W !
  1. .R "Type <Enter> to continue: ",IDX:DTIME
  1. Q
  1. ;
  1. GETIINST(DESC) ;
  1. N IDX,RESULT
  1. S RESULT=""
  1. S IDX=0 F S IDX=$O(ORTABS(IDX)) Q:IDX'>0!(RESULT'="") D
  1. .I $G(ORTABS(IDX,4))=DESC S RESULT=$G(ORTABS(IDX,2))
  1. Q RESULT
  1. ;
  1. SELECTINST() ;
  1. N DIR,Y
  1. S DIR(0)=$S($G(DUZ(0))="@":"S^P:PACKAGE;S:SYSTEM;D:DIVISION;U:USER",1:"S^S:SYSTEM;D:DIVISION;U:USER")
  1. D ^DIR
  1. Q Y
  1. ;
  1. GETUSER(UARRAY) ;
  1. N STOP,USER
  1. S STOP=0
  1. F D Q:STOP=1
  1. .S USER=$$SELECT("Select user to copy setting to: ")
  1. .I +USER=-1 S STOP=1 Q
  1. .S UARRAY($P(USER,U))=$P(USER,U,2)
  1. Q
  1. ;
  1. DATA(ARRAY,PARM,USER,DIV) ;
  1. N EXT,EXT1,FILE,IEN,ORPARMS,PARAM,TYPE,TYPE1,VALUE,X
  1. S PARAM=$G(ORPARAM(PARM))
  1. I PARAM="" Q
  1. D ENVAL^XPAR(.ORPARMS,PARAM,"",.ERR,0)
  1. S DIV=$G(DIV)
  1. S X="" F S X=$O(ORPARMS(X)) Q:X="" D
  1. .S TYPE="" F S TYPE=$O(ORPARMS(X,TYPE)) Q:TYPE="" D
  1. ..S VALUE=$S(PARM<4:$S(ORPARMS(X,TYPE)=1:"Yes",1:"No"),1:ORPARMS(X,TYPE))
  1. ..I (PARM=1)!(PARM=2) D
  1. ...S EXT=$$TABDESC2(PARM,TYPE)
  1. ..I PARM=3 D
  1. ...S EXT=$P($G(^ORD(100.98,TYPE,0)),U)
  1. ..I PARM=4 S EXT=-1
  1. ..I $G(EXT)="" Q
  1. ..S FILE=$S(X["DIC(9.4":9.4,X["VA(200":200,X["DIC(4.2":4.2,X["DIC(4,":4,1:"")
  1. ..I FILE="" Q
  1. ..S EXT1=$S(FILE=200:+X,1:$$GET1^DIQ(FILE,+X,.01))
  1. ..S TYPE1=$S(FILE=9.4:"Package",FILE=4.2:"Systems",FILE=200:"Users",FILE=4:"Division",1:"")
  1. ..I TYPE1="" Q
  1. ..I USER>0,TYPE1'="Users" Q
  1. ..I USER>0,+X'=USER Q
  1. ..I DIV>0,TYPE1'="Division" Q
  1. ..I DIV>0,+X'=DIV Q
  1. ..S ARRAY(TYPE1,EXT1,EXT)=VALUE
  1. Q
  1. ;
  1. SETUSER(IEN,NAME,INITIAL,ACT,CARRAY) ;
  1. N INST,ORERR,PARAM,PARAMID,SETINST,VALUE,ENT,RARRAY
  1. W !,"Updating user: "_NAME
  1. S ENT="USR.`"_IEN
  1. I ACT="A" D DISPLAY^ORACCES3(IEN,.RARRAY,"",1)
  1. I ACT="O" D I +$G(ORERR)'=0 Q
  1. .F PARAMID=1,2,3 D
  1. ..S PARAM=$G(ORPARAM(PARAMID))
  1. ..I PARAM="" Q
  1. ..D NDEL^XPAR(ENT,PARAM,.ORERR)
  1. ..I +$G(ORERR)'=0 W !,"ERROR clearing user parameter: "_ORERR
  1. F PARAMID=1,2,3 D
  1. .S PARAM=$G(ORPARAM(PARAMID))
  1. .I PARAM="" Q
  1. .K ORERR
  1. .I '$D(CARRAY(PARAMID)) Q
  1. .S INST=""
  1. .F S INST=$O(CARRAY(PARAMID,"Users",+INITIAL,INST)) Q:INST="" D
  1. ..I ACT="A",$G(RARRAY(PARAMID,"Users",IEN,INST))'="" Q
  1. ..S VALUE=CARRAY(PARAMID,"Users",+INITIAL,INST)
  1. ..I VALUE="" Q
  1. ..K ORERR
  1. ..S SETINST=$S(PARAMID<3:$$GETIINST(INST),1:INST)
  1. ..I SETINST="" Q
  1. ..W !,PARAM_" instance "_INST
  1. ..D EN^XPAR(ENT,PARAM,SETINST,VALUE,.ORERR)
  1. ..I +$G(ORERR)'=0 W !,"ERROR: "_ORERR Q
  1. ..W !," done"
  1. W !,"User "_NAME_" settings:"
  1. D DISPLAY^ORACCES3(IEN,"","",0)
  1. Q
  1. ;
  1. SELECT(TEXT,SCREEN) ;
  1. N DIC,Y
  1. S DIC="^VA(200,",DIC("A")=TEXT,DIC(0)="AEQM"
  1. I $G(SCREEN) S DIC("S")="N ORX F ORX=1:1:3 I $D(^XTV(8989.5,""AC"",ORPIEN(ORX),Y_"";VA(200,"")) Q"
  1. D ^DIC
  1. Q Y
  1. ;
  1. POST ;
  1. N ORPARAM,ORTABS,TABS,OTHER,ORDERS,ERROR,NODEPENDENCIES
  1. S NODEPENDENCIES=1
  1. D GETPARAMS
  1. D POSTTABS
  1. D POSTDG
  1. D POSTERR
  1. Q
  1. ;
  1. POSTDG ;
  1. N IEN,ERR
  1. S IEN=0 F S IEN=$O(^ORD(100.98,IEN)) Q:IEN'>0 D
  1. .D EN^XPAR("PKG",ORPARAM(ORDERS),"`"_IEN,1,.ERR)
  1. Q
  1. ;
  1. POSTERR ;
  1. N ERR,TXT
  1. S TXT="New information cannot be added into CPRS. Exceptions: contact CACs."
  1. D EN^XPAR("PKG",ORPARAM(ERROR),1,TXT,.ERR)
  1. I +ERR>0 D
  1. .D BMES^XPDUTL(" Problem updating error message")
  1. Q
  1. ;
  1. POSTTABS ;
  1. N TAB,ERR
  1. S TAB=0 F S TAB=$O(ORTABS(TAB)) Q:'TAB D
  1. .D EN^XPAR("PKG",ORPARAM(ORTABS(TAB,1)),ORTABS(TAB,2),1,.ERR)
  1. .I +ERR>0 D
  1. ..D BMES^XPDUTL(" Problem updating "_ORTABS(TAB,4)_" level")
  1. Q
  1. ;
  1. ASK4RESET(LEVEL) ;
  1. N TAB,VALUE,ASK,IEN,DIR,Y,TXT,YN,LVLTXT,EXPECTED,ERR,NODEPENDENCIES
  1. I LEVEL="PKG" S EXPECTED=1
  1. E S EXPECTED=0
  1. S (ASK,TAB)=0 F S TAB=$O(ORTABS(TAB)) Q:'TAB D Q:ASK
  1. . S VALUE=$$GET^XPAR(LEVEL,ORPARAM(ORTABS(TAB,1)),ORTABS(TAB,2))
  1. . I VALUE'=EXPECTED S ASK=1
  1. I 'ASK D
  1. . S IEN=0 F S IEN=$O(^ORD(100.98,IEN)) Q:IEN'>0 D Q:ASK
  1. . . S VALUE=$$GET^XPAR(LEVEL,ORPARAM(ORDERS),"`"_IEN)
  1. . . I VALUE'=EXPECTED S ASK=1
  1. I 'ASK Q
  1. I EXPECTED S YN="Yes"
  1. E S YN="No"
  1. I LEVEL="SYS" S LVLTXT="System"
  1. E S LVLTXT="Package"
  1. S DIR(0)="YO"
  1. S TXT="Not all "_LVLTXT_" level settings are set to "_YN
  1. S TXT=TXT_". Do you want to set all "_LVLTXT_" level settings to "_YN
  1. S TXT=TXT_"? (Yes or No): "
  1. D WRAP^ORUTL(TXT,"DIR(""A"")",1,0,2,0,70)
  1. S IDX=$O(DIR("A",99999),-1) S DIR("A")=DIR("A",IDX) K DIR("A",IDX)
  1. D ^DIR I $D(DIRUT) S Y=0
  1. I '+Y Q
  1. S NODEPENDENCIES=1
  1. S TAB=0 F S TAB=$O(ORTABS(TAB)) Q:'TAB D
  1. .D EN^XPAR(LEVEL,ORPARAM(ORTABS(TAB,1)),ORTABS(TAB,2),EXPECTED,.ERR)
  1. S IEN=0 F S IEN=$O(^ORD(100.98,IEN)) Q:IEN'>0 D
  1. .D EN^XPAR(LEVEL,ORPARAM(ORDERS),"`"_IEN,EXPECTED,.ERR)
  1. W !,"Done"
  1. Q
  1. ;
  1. CLEARPKG ;
  1. N ORERR,IDX,ORPARAM,ORTABS,TABS,OTHER,ORDERS,ERROR
  1. D GETPARAMS
  1. S IDX=0 F S IDX=$O(ORPARAM(IDX)) Q:'IDX D NDEL^XPAR("PKG",ORPARAM(IDX),.ORERR)
  1. Q
  1. CLEARSYS ;
  1. N ORERR,IDX,ORPARAM,ORTABS,TABS,OTHER,ORDERS,ERROR
  1. D GETPARAMS
  1. S IDX=0 F S IDX=$O(ORPARAM(IDX)) Q:'IDX D NDEL^XPAR("SYS",ORPARAM(IDX),.ORERR)
  1. Q
  1. ;
  1. GETPARAMS(GETCODE) ;
  1. I '$D(ORPARAM) D
  1. . S TABS=1,ORPARAM(TABS)="OR CPRS TABS WRITE ACCESS"
  1. . S OTHER=2,ORPARAM(OTHER)="OR CPRS OTHER WRITE ACCESS"
  1. . S ORDERS=3,ORPARAM(ORDERS)="OR CPRS ORDERS WRITE ACCESS"
  1. . S ERROR=4,ORPARAM(ERROR)="OR CPRS WRITE ACCESS ERROR"
  1. I +$G(GETCODE),'$D(ORPIEN) D
  1. . N IDX F IDX=1:1:4 S ORPIEN(IDX)=$O(^XTV(8989.51,"B",ORPARAM(IDX),0))
  1. ; ORTABS 2nd Index 1:Parameter, 2:Code 3:Internal Name 4:Display Name 5=1=Template access, 2=Cover Sheet param
  1. I '$D(ORTABS) D
  1. . N IDX,DATA,LINE,SUB
  1. . S IDX=0,LINE="ORTABINFO"
  1. . F S IDX=IDX+1,DATA=$P($T(@LINE+IDX),";;",2) Q:DATA="" D
  1. .. F SUB=1:1:5 S ORTABS(IDX,SUB)=$P(DATA,U,SUB)
  1. Q
  1. ;
  1. TABIDX(PARAM,CODE) ;
  1. N IDX,TAB
  1. S (IDX,TAB)=0
  1. F S TAB=$O(ORTABS(TAB)) Q:'TAB D Q:IDX
  1. . I PARAM=ORTABS(TAB,1),CODE=ORTABS(TAB,2) S IDX=TAB
  1. Q IDX
  1. ;
  1. TABDESC(IDX,EXTRA) ;
  1. N DESC
  1. S DESC=ORTABS(IDX,4)
  1. I +$G(EXTRA) D
  1. . I ORTABS(IDX,5)=1 S DESC=DESC_", template access allowed"
  1. . I ORTABS(IDX,5)=2 S DESC="Cover Sheet "_DESC
  1. Q DESC
  1. ;
  1. TABDESC2(PARAM,CODE,EXTRA) ;
  1. N DESC,TAB
  1. S TAB=0,DESC=""
  1. F S TAB=$O(ORTABS(TAB)) Q:'TAB D Q:DESC'=""
  1. . I PARAM=ORTABS(TAB,1),CODE=ORTABS(TAB,2) D
  1. . . S DESC=$$TABDESC(TAB,$G(EXTRA))
  1. Q DESC
  1. ;
  1. ;
  1. ORTABINFO ; Pieces: 1:ORPARAM idx 2:Code 3:Internal Name 4:Display Name 5:1=Template access, 2=Cover Sheet param
  1. ;;1^C^consults^Consults^1
  1. ;;1^D^dcSumm^Discharge Summaries^1
  1. ;;1^M^meds^Meds
  1. ;;1^N^notes^Notes^1
  1. ;;1^O^orders^Orders
  1. ;;1^P^problems^Problems
  1. ;;1^S^surgery^Surgery^1
  1. ;;2^A^allergy^Allergies
  1. ;;2^D^delayedOrders^Delayed Orders
  1. ;;2^E^encounters^Encounters
  1. ;;2^I^immunization^Immunizations^2
  1. ;;2^R^reminderEditor^Reminders List Editor^2
  1. ;;2^V^vital^Vitals^2
  1. ;;2^W^womenHealth^Women's Health^2
  1. ;;
  1. ONEHR() ;
  1. N ORPRIMARY
  1. ;
  1. ; For testing purposes, OR SIMULATE ON EHR can be used to have this API return a 1 in a non-prod account
  1. I '$$PROD^XUPROD,$$GET^XPAR("ALL","OR SIMULATE ON EHR",1,"I") Q 1
  1. ;
  1. S ORPRIMARY=$P($$SITE^VASITE,U,3)
  1. Q $$CRNRSITE^VAFCCRNR(ORPRIMARY) ;ICR #7346
  1. ;
  1. EHRACTIVE(ORY) ;
  1. S ORY=$$ONEHR
  1. Q
  1. ;
  1. TABNAMES(TABS) ;
  1. N IDX,DATA,LINE,SUB
  1. S IDX=0,LINE="ORTABINFO"
  1. F S IDX=IDX+1,DATA=$P($T(@LINE+IDX),";;",2) Q:DATA="" D
  1. .;F SUB=1:1:5 S ORTABS(IDX,SUB)=$P(DATA,U,SUB)
  1. .S TABS($P(DATA,U,3))=$P(DATA,U,4)
  1. Q
  1. ;
  1. HELP ;
  1. W !,"Select the copy action:",!
  1. W !," Copy/Add settings - Select Copy/Add settings to add the settings"
  1. W !," from the initial user to the receiving user, without overwriting"
  1. W !," any existing settings.",!
  1. W !," Copy/Overwrite settings - Select Copy/Overwrite settings to replace"
  1. W !," the receiving user settings with the initial user settings.",!
  1. W !," Skip User - do not copy any of the user settings."
  1. Q