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

ORACCES3.m

Go to the documentation of this file.
  1. ORACCES3 ;SLC/JNM - User Read/Write Access to CPRS ;Mar 03, 2023@13:11:21
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**588**;Dec 17, 1997;Build 29
  1. ;
  1. Q
  1. ;
  1. DISPLAY(USER,CARRAY,DIV,NOPRINT,DSPLVL,DSPNAME) ;
  1. N ARRAY,ORPARAM,ORTABS,TABS,OTHER,ORDERS,ERROR,DARRAY,LVL
  1. N PNAME,L,MAX,SPACES,INDENTSIZE,INSTANCE,INSTNAME,PARAM,TYPE,X,LEN
  1. N TXT,TYPETXT,VALUETXT,TXTLEN,FIRST,ILVL,BUMP,NUMSPACES,DASHES
  1. N VMODE,MAXLEN,TXT2,DONE,SINGLE,BLANKLINE
  1. S USER=+$G(USER),DIV=+$G(DIV),NOPRINT=+$G(NOPRINT)
  1. S DSPLVL=$G(DSPLVL),DSPNAME=$G(DSPNAME)
  1. S SINGLE=$S((USER>0)!(DIV>0)!(DSPLVL>0):1,1:0)
  1. I SINGLE,(DSPLVL<1)!(DSPNAME="") D
  1. . I USER S DSPLVL=4,DSPNAME=$$GET1^DIQ(200,USER_",",.01)
  1. . I DIV S DSPLVL=3,DSPNAME=$$GET1^DIQ(4,DIV_",",.01)
  1. D GETPARAMS^ORACCESS(1)
  1. I 'NOPRINT D
  1. . S LVL(1,1)="Package",LVL(1,2)=LVL(1,1)
  1. . S LVL(2,1)="System",LVL(2,2)=LVL(2,1)_"s"
  1. . S LVL(3,1)="Division",LVL(3,2)=LVL(3,1)
  1. . S LVL(4,1)="User",LVL(4,2)=LVL(4,1)_"s"
  1. . S PNAME(1)="CPRS Write Access Error Message"
  1. . S PNAME(2)="CPRS Tabs Write Access"
  1. . S PNAME(3)="CPRS Other Action Write Access"
  1. . S PNAME(4)="CPRS Orders Tab Write Access"
  1. . S MAX=78,SPACES=" ",NUMSPACES=$L(SPACES),INDENTSIZE=3
  1. . S (ILVL,BUMP,VMODE,BLANKLINE)=0
  1. . S DASHES="" F X=1:1:(MAX\2)+1 S DASHES=DASHES_"-"
  1. . S TYPETXT="Type",VALUETXT="Value",TXTLEN=$L(TYPETXT)+$L(VALUETXT)
  1. I 'USER D
  1. . D DATA^ORACCESS(.ARRAY,ERROR,USER,DIV),DSPMERGE(1)
  1. . K ARRAY
  1. D DATA^ORACCESS(.ARRAY,TABS,USER,DIV),DSPMERGE(2)
  1. I USER>0 M CARRAY(1)=ARRAY
  1. K ARRAY
  1. D DATA^ORACCESS(.ARRAY,OTHER,USER,DIV),DSPMERGE(3)
  1. I USER>0 M CARRAY(2)=ARRAY
  1. K ARRAY
  1. D DATA^ORACCESS(.ARRAY,ORDERS,USER,DIV),DSPMERGE(4)
  1. I USER>0 M CARRAY(3)=ARRAY
  1. Q:NOPRINT
  1. W !,$$CJ^XLFSTR("CPRS WRITE ACCESS DISPLAY SETTINGS",MAX)
  1. I SINGLE,$D(DARRAY)=0 D Q
  1. . I ('DSPLVL)!(DSPNAME="") Q
  1. . S (ILVL,BUMP,VMODE)=0,TXT=LVL(DSPLVL,1)_": "_DSPNAME
  1. . D TXTLINE(TXT)
  1. . W !,?INDENTSIZE,"No Write Access Settings Defined."
  1. . D TXTLINE("")
  1. S L=0 F S L=$O(LVL(L)) Q:'L D
  1. . I +DSPLVL,L'=DSPLVL Q
  1. . S (ILVL,BUMP,VMODE)=0
  1. . D DOBLANKLINE
  1. . I $D(DARRAY(L))=0 D Q
  1. . . I L<3 D I 1
  1. . . . D GETINST^ORACCESS(L,"",.TXT)
  1. . . . S TXT=LVL(L,1)_": "_TXT_" Level Settings"
  1. . . . D TXTLINE(TXT)
  1. . . . W !,?INDENTSIZE,"No Write Access Settings Defined."
  1. . . E D
  1. . . . I 'SINGLE S TXT=LVL(L,1)_" Level Settings"
  1. . . . D TXTLINE(TXT)
  1. . . . W !,?INDENTSIZE,"No "_LVL(L,1)_"s have Write Access Settings Defined."
  1. . . S BLANKLINE=1
  1. . S INSTANCE="",FIRST=1
  1. . F S INSTANCE=$O(DARRAY(L,INSTANCE)) Q:INSTANCE="" D
  1. . . S (ILVL,BUMP)=0,INSTNAME=$P(INSTANCE,U)
  1. . . D DOBLANKLINE
  1. . . I FIRST D I 1
  1. . . . S TXT=LVL(L,1)
  1. . . . I (L<3)!SINGLE S TXT=TXT_": "_INSTNAME
  1. . . . S TXT=TXT_" Level Settings",FIRST=0
  1. . . . D TXTLINE(TXT)
  1. . . I (L>2)&('SINGLE) D
  1. . . . S TXT=LVL(L,1)_": "_INSTNAME,BUMP=1
  1. . . . D TXTLINE(TXT)
  1. . . S PARAM=0 F S PARAM=$O(PNAME(PARAM)) Q:'PARAM D
  1. . . . S ILVL=1
  1. . . . I USER,PARAM=1 Q
  1. . . . I $D(DARRAY(L,INSTANCE,PARAM))=0,'SINGLE Q
  1. . . . D DOBLANKLINE
  1. . . . D TXTLINE(PNAME(PARAM))
  1. . . . S ILVL=2
  1. . . . I PARAM=1 S TXT=-1
  1. . . . E S TXT=TYPETXT,VMODE=1
  1. . . . D DSPVALUE(TXT,VALUETXT),TXTLINE("")
  1. . . . S MAXLEN=MAX-($$INDENT*2),BLANKLINE=1
  1. . . . S TYPE="" F S TYPE=$O(DARRAY(L,INSTANCE,PARAM,TYPE)) Q:TYPE="" D
  1. . . . . S TXT=DARRAY(L,INSTANCE,PARAM,TYPE)
  1. . . . . I PARAM=1 D I 1
  1. . . . . . K TXT2 D WRAP^ORUTL(TXT,"TXT2",1,1,2,,MAXLEN)
  1. . . . . . F X=1:1:TXT2 D DSPVALUE(-1,TXT2(X))
  1. . . . . E D DSPVALUE(TYPE," "_TXT)
  1. . . . S VMODE=0
  1. S (ILVL,BUMP,VMODE)=0 D TXTLINE("")
  1. Q
  1. ;
  1. DSPMERGE(SORT) ;
  1. Q:NOPRINT
  1. N L,INSTANCE,SORTIDX
  1. S L=0 F S L=$O(LVL(L)) Q:'L D
  1. . I DSPLVL>0,L'=DSPLVL Q
  1. . S INSTANCE="" F S INSTANCE=$O(ARRAY(LVL(L,2),INSTANCE)) Q:INSTANCE="" D
  1. . . I L<4 S SORTIDX=INSTANCE
  1. . . E S SORTIDX=$P($G(^VA(200,+INSTANCE,0)),U)_U_INSTANCE
  1. . . M DARRAY(L,SORTIDX,SORT)=ARRAY(LVL(L,2),INSTANCE)
  1. Q
  1. ;
  1. INDENT() ;
  1. I VMODE Q 20
  1. Q INDENTSIZE*(ILVL+BUMP)
  1. ;
  1. TXTLINE(TXT) ;
  1. N LEN,D1,D2,X,STR,IND,IND2,S1,S2
  1. S IND=$$INDENT,IND2=IND*2
  1. S LEN=$L(TXT),D1=(MAX-LEN-IND2)\2,D2=MAX-LEN-IND2-D1
  1. I LEN>0 S D1=D1-NUMSPACES,D2=D2-NUMSPACES
  1. S STR=""_$E(DASHES,1,D1)
  1. I LEN>0 D
  1. . I D1>0 S STR=STR_SPACES
  1. . S STR=STR_TXT
  1. . I D2>0 S STR=STR_SPACES
  1. S STR=STR_$E(DASHES,1,D2)
  1. W !,?IND,STR
  1. Q
  1. ;
  1. DSPVALUE(TYPE,VALUE) ;
  1. N IND,VALIND
  1. S IND=$$INDENT
  1. I TYPE=-1 S TYPE="",VALIND=IND
  1. E S VALIND=MAX-IND-$L(VALUETXT)
  1. W !,?IND,TYPE,?VALIND,VALUE
  1. Q
  1. ;
  1. DOBLANKLINE ;
  1. I BLANKLINE W ! S BLANKLINE=0
  1. Q
  1. ;
  1. VIEW ;
  1. N FINAL,ORPARAM,ORPIEN,ORTABS,USER,TABS,OTHER,ORDERS,ERROR
  1. S USER=$$SELECT^ORACCESS("Select user: ",0)
  1. I USER<1 Q
  1. S FINAL=$$ASKYN^ORACCESS("No","View final settings","ORACCES3",1)
  1. I +FINAL=1 D OVERALL(+USER) Q
  1. D GETPARAMS^ORACCESS(1)
  1. S DSPLVL=4,DSPNAME=$P($G(^VA(200,+USER,0)),U)
  1. D DISPLAY(USER,"")
  1. Q
  1. ;
  1. OVERALL(USER) ;
  1. N ARRAY,ASKLVL,BLANKLINE,BUMP,DASHES,DIC,DIV,DIVNAME,DSPLVL,DSPNAME,DTOUT,DUOUT,ENT,IDX,ILVL,INDENTSIZE
  1. N MAX,NODE,NUMSPACES,ORPARAM,ORTABS,OUTPUT,SPACES,USERNAME,VMODE,X,Y,TABS,OTHER,ORDERS,ERROR
  1. S DIC=4,DIC(0)="AEMQ",DIC("A")="Select Division: "
  1. D ^DIC I $D(DTOUT)!$D(DUOUT)!(Y<1) Q
  1. S DIV=+Y
  1. I DIV>0 S DIVNAME=$$GET1^DIQ(4,DIV_",",.01)
  1. S USERNAME=$$GET1^DIQ(200,USER_",",.01)
  1. D GETPARAMS^ORACCESS(1)
  1. F IDX=1:1:3 D
  1. .K ARRAY
  1. .D DATA^ORACCESS(.ARRAY,IDX,0,0)
  1. .F DSPLVL="Package","Systems","Division","Users" D
  1. ..I DSPLVL="Package" D Q
  1. ...S DSPNAME=""
  1. ...F S DSPNAME=$O(ARRAY(DSPLVL,"ORDER ENTRY/RESULTS REPORTING",DSPNAME)) Q:DSPNAME="" D
  1. ....S OUTPUT(IDX,DSPNAME)=ARRAY(DSPLVL,"ORDER ENTRY/RESULTS REPORTING",DSPNAME)_U_DSPLVL
  1. ..S ENT=$S(DSPLVL="Division":DIVNAME,DSPLVL="Users":USER,1:$$KSP^XUPARAM("WHERE"))
  1. ..S DSPNAME="" F S DSPNAME=$O(ARRAY(DSPLVL,ENT,DSPNAME)) Q:DSPNAME="" D
  1. ...S OUTPUT(IDX,DSPNAME)=ARRAY(DSPLVL,ENT,DSPNAME)_U_DSPLVL
  1. I '$D(OUTPUT) W !,"No settings defined" Q
  1. W !,"Write access setting for user: "_USERNAME
  1. W !,"Write access setting for division: "_DIVNAME
  1. W !,$$RJ^XLFSTR("Tab/Action",50)_$$RJ^XLFSTR("Level",25),!
  1. F IDX=1:1:80 W "-"
  1. W !
  1. S MAX=78,SPACES=" ",NUMSPACES=$L(SPACES),INDENTSIZE=3
  1. S (ILVL,BUMP,VMODE,BLANKLINE)=0
  1. S DASHES="" F X=1:1:(MAX\2)+1 S DASHES=DASHES_"-"
  1. F IDX=1:1:3 D
  1. .I IDX>1 W !
  1. .D TXTLINE(ORPARAM(IDX))
  1. .W !
  1. .S DSPNAME="" F S DSPNAME=$O(OUTPUT(IDX,DSPNAME)) Q:DSPNAME="" D
  1. ..S NODE=$G(OUTPUT(IDX,DSPNAME)) I NODE="" Q
  1. ..W !,$$RJ^XLFSTR(DSPNAME_": "_$P(NODE,U),50)_$$RJ^XLFSTR("("_$P(NODE,U,2)_")",25)
  1. Q
  1. ;
  1. HELP(HELP) ;
  1. I HELP=1 D Q
  1. .W !,"Select Yes to return the user final settings including settings"
  1. .W !,"from all levels. Select No to only view the specific user settings."
  1. Q
  1. ;