- ORACCES3 ;SLC/JNM - User Read/Write Access to CPRS ;Mar 03, 2023@13:11:21
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**588**;Dec 17, 1997;Build 29
- ;
- Q
- ;
- DISPLAY(USER,CARRAY,DIV,NOPRINT,DSPLVL,DSPNAME) ;
- N ARRAY,ORPARAM,ORTABS,TABS,OTHER,ORDERS,ERROR,DARRAY,LVL
- N PNAME,L,MAX,SPACES,INDENTSIZE,INSTANCE,INSTNAME,PARAM,TYPE,X,LEN
- N TXT,TYPETXT,VALUETXT,TXTLEN,FIRST,ILVL,BUMP,NUMSPACES,DASHES
- N VMODE,MAXLEN,TXT2,DONE,SINGLE,BLANKLINE
- S USER=+$G(USER),DIV=+$G(DIV),NOPRINT=+$G(NOPRINT)
- S DSPLVL=$G(DSPLVL),DSPNAME=$G(DSPNAME)
- S SINGLE=$S((USER>0)!(DIV>0)!(DSPLVL>0):1,1:0)
- I SINGLE,(DSPLVL<1)!(DSPNAME="") D
- . I USER S DSPLVL=4,DSPNAME=$$GET1^DIQ(200,USER_",",.01)
- . I DIV S DSPLVL=3,DSPNAME=$$GET1^DIQ(4,DIV_",",.01)
- D GETPARAMS^ORACCESS(1)
- I 'NOPRINT D
- . S LVL(1,1)="Package",LVL(1,2)=LVL(1,1)
- . S LVL(2,1)="System",LVL(2,2)=LVL(2,1)_"s"
- . S LVL(3,1)="Division",LVL(3,2)=LVL(3,1)
- . S LVL(4,1)="User",LVL(4,2)=LVL(4,1)_"s"
- . S PNAME(1)="CPRS Write Access Error Message"
- . S PNAME(2)="CPRS Tabs Write Access"
- . S PNAME(3)="CPRS Other Action Write Access"
- . S PNAME(4)="CPRS Orders Tab Write Access"
- . S MAX=78,SPACES=" ",NUMSPACES=$L(SPACES),INDENTSIZE=3
- . S (ILVL,BUMP,VMODE,BLANKLINE)=0
- . S DASHES="" F X=1:1:(MAX\2)+1 S DASHES=DASHES_"-"
- . S TYPETXT="Type",VALUETXT="Value",TXTLEN=$L(TYPETXT)+$L(VALUETXT)
- I 'USER D
- . D DATA^ORACCESS(.ARRAY,ERROR,USER,DIV),DSPMERGE(1)
- . K ARRAY
- D DATA^ORACCESS(.ARRAY,TABS,USER,DIV),DSPMERGE(2)
- I USER>0 M CARRAY(1)=ARRAY
- K ARRAY
- D DATA^ORACCESS(.ARRAY,OTHER,USER,DIV),DSPMERGE(3)
- I USER>0 M CARRAY(2)=ARRAY
- K ARRAY
- D DATA^ORACCESS(.ARRAY,ORDERS,USER,DIV),DSPMERGE(4)
- I USER>0 M CARRAY(3)=ARRAY
- Q:NOPRINT
- W !,$$CJ^XLFSTR("CPRS WRITE ACCESS DISPLAY SETTINGS",MAX)
- I SINGLE,$D(DARRAY)=0 D Q
- . I ('DSPLVL)!(DSPNAME="") Q
- . S (ILVL,BUMP,VMODE)=0,TXT=LVL(DSPLVL,1)_": "_DSPNAME
- . D TXTLINE(TXT)
- . W !,?INDENTSIZE,"No Write Access Settings Defined."
- . D TXTLINE("")
- S L=0 F S L=$O(LVL(L)) Q:'L D
- . I +DSPLVL,L'=DSPLVL Q
- . S (ILVL,BUMP,VMODE)=0
- . D DOBLANKLINE
- . I $D(DARRAY(L))=0 D Q
- . . I L<3 D I 1
- . . . D GETINST^ORACCESS(L,"",.TXT)
- . . . S TXT=LVL(L,1)_": "_TXT_" Level Settings"
- . . . D TXTLINE(TXT)
- . . . W !,?INDENTSIZE,"No Write Access Settings Defined."
- . . E D
- . . . I 'SINGLE S TXT=LVL(L,1)_" Level Settings"
- . . . D TXTLINE(TXT)
- . . . W !,?INDENTSIZE,"No "_LVL(L,1)_"s have Write Access Settings Defined."
- . . S BLANKLINE=1
- . S INSTANCE="",FIRST=1
- . F S INSTANCE=$O(DARRAY(L,INSTANCE)) Q:INSTANCE="" D
- . . S (ILVL,BUMP)=0,INSTNAME=$P(INSTANCE,U)
- . . D DOBLANKLINE
- . . I FIRST D I 1
- . . . S TXT=LVL(L,1)
- . . . I (L<3)!SINGLE S TXT=TXT_": "_INSTNAME
- . . . S TXT=TXT_" Level Settings",FIRST=0
- . . . D TXTLINE(TXT)
- . . I (L>2)&('SINGLE) D
- . . . S TXT=LVL(L,1)_": "_INSTNAME,BUMP=1
- . . . D TXTLINE(TXT)
- . . S PARAM=0 F S PARAM=$O(PNAME(PARAM)) Q:'PARAM D
- . . . S ILVL=1
- . . . I USER,PARAM=1 Q
- . . . I $D(DARRAY(L,INSTANCE,PARAM))=0,'SINGLE Q
- . . . D DOBLANKLINE
- . . . D TXTLINE(PNAME(PARAM))
- . . . S ILVL=2
- . . . I PARAM=1 S TXT=-1
- . . . E S TXT=TYPETXT,VMODE=1
- . . . D DSPVALUE(TXT,VALUETXT),TXTLINE("")
- . . . S MAXLEN=MAX-($$INDENT*2),BLANKLINE=1
- . . . S TYPE="" F S TYPE=$O(DARRAY(L,INSTANCE,PARAM,TYPE)) Q:TYPE="" D
- . . . . S TXT=DARRAY(L,INSTANCE,PARAM,TYPE)
- . . . . I PARAM=1 D I 1
- . . . . . K TXT2 D WRAP^ORUTL(TXT,"TXT2",1,1,2,,MAXLEN)
- . . . . . F X=1:1:TXT2 D DSPVALUE(-1,TXT2(X))
- . . . . E D DSPVALUE(TYPE," "_TXT)
- . . . S VMODE=0
- S (ILVL,BUMP,VMODE)=0 D TXTLINE("")
- Q
- ;
- DSPMERGE(SORT) ;
- Q:NOPRINT
- N L,INSTANCE,SORTIDX
- S L=0 F S L=$O(LVL(L)) Q:'L D
- . I DSPLVL>0,L'=DSPLVL Q
- . S INSTANCE="" F S INSTANCE=$O(ARRAY(LVL(L,2),INSTANCE)) Q:INSTANCE="" D
- . . I L<4 S SORTIDX=INSTANCE
- . . E S SORTIDX=$P($G(^VA(200,+INSTANCE,0)),U)_U_INSTANCE
- . . M DARRAY(L,SORTIDX,SORT)=ARRAY(LVL(L,2),INSTANCE)
- Q
- ;
- INDENT() ;
- I VMODE Q 20
- Q INDENTSIZE*(ILVL+BUMP)
- ;
- TXTLINE(TXT) ;
- N LEN,D1,D2,X,STR,IND,IND2,S1,S2
- S IND=$$INDENT,IND2=IND*2
- S LEN=$L(TXT),D1=(MAX-LEN-IND2)\2,D2=MAX-LEN-IND2-D1
- I LEN>0 S D1=D1-NUMSPACES,D2=D2-NUMSPACES
- S STR=""_$E(DASHES,1,D1)
- I LEN>0 D
- . I D1>0 S STR=STR_SPACES
- . S STR=STR_TXT
- . I D2>0 S STR=STR_SPACES
- S STR=STR_$E(DASHES,1,D2)
- W !,?IND,STR
- Q
- ;
- DSPVALUE(TYPE,VALUE) ;
- N IND,VALIND
- S IND=$$INDENT
- I TYPE=-1 S TYPE="",VALIND=IND
- E S VALIND=MAX-IND-$L(VALUETXT)
- W !,?IND,TYPE,?VALIND,VALUE
- Q
- ;
- DOBLANKLINE ;
- I BLANKLINE W ! S BLANKLINE=0
- Q
- ;
- VIEW ;
- N FINAL,ORPARAM,ORPIEN,ORTABS,USER,TABS,OTHER,ORDERS,ERROR
- S USER=$$SELECT^ORACCESS("Select user: ",0)
- I USER<1 Q
- S FINAL=$$ASKYN^ORACCESS("No","View final settings","ORACCES3",1)
- I +FINAL=1 D OVERALL(+USER) Q
- D GETPARAMS^ORACCESS(1)
- S DSPLVL=4,DSPNAME=$P($G(^VA(200,+USER,0)),U)
- D DISPLAY(USER,"")
- Q
- ;
- OVERALL(USER) ;
- N ARRAY,ASKLVL,BLANKLINE,BUMP,DASHES,DIC,DIV,DIVNAME,DSPLVL,DSPNAME,DTOUT,DUOUT,ENT,IDX,ILVL,INDENTSIZE
- N MAX,NODE,NUMSPACES,ORPARAM,ORTABS,OUTPUT,SPACES,USERNAME,VMODE,X,Y,TABS,OTHER,ORDERS,ERROR
- S DIC=4,DIC(0)="AEMQ",DIC("A")="Select Division: "
- D ^DIC I $D(DTOUT)!$D(DUOUT)!(Y<1) Q
- S DIV=+Y
- I DIV>0 S DIVNAME=$$GET1^DIQ(4,DIV_",",.01)
- S USERNAME=$$GET1^DIQ(200,USER_",",.01)
- D GETPARAMS^ORACCESS(1)
- F IDX=1:1:3 D
- .K ARRAY
- .D DATA^ORACCESS(.ARRAY,IDX,0,0)
- .F DSPLVL="Package","Systems","Division","Users" D
- ..I DSPLVL="Package" D Q
- ...S DSPNAME=""
- ...F S DSPNAME=$O(ARRAY(DSPLVL,"ORDER ENTRY/RESULTS REPORTING",DSPNAME)) Q:DSPNAME="" D
- ....S OUTPUT(IDX,DSPNAME)=ARRAY(DSPLVL,"ORDER ENTRY/RESULTS REPORTING",DSPNAME)_U_DSPLVL
- ..S ENT=$S(DSPLVL="Division":DIVNAME,DSPLVL="Users":USER,1:$$KSP^XUPARAM("WHERE"))
- ..S DSPNAME="" F S DSPNAME=$O(ARRAY(DSPLVL,ENT,DSPNAME)) Q:DSPNAME="" D
- ...S OUTPUT(IDX,DSPNAME)=ARRAY(DSPLVL,ENT,DSPNAME)_U_DSPLVL
- I '$D(OUTPUT) W !,"No settings defined" Q
- W !,"Write access setting for user: "_USERNAME
- W !,"Write access setting for division: "_DIVNAME
- W !,$$RJ^XLFSTR("Tab/Action",50)_$$RJ^XLFSTR("Level",25),!
- F IDX=1:1:80 W "-"
- W !
- S MAX=78,SPACES=" ",NUMSPACES=$L(SPACES),INDENTSIZE=3
- S (ILVL,BUMP,VMODE,BLANKLINE)=0
- S DASHES="" F X=1:1:(MAX\2)+1 S DASHES=DASHES_"-"
- F IDX=1:1:3 D
- .I IDX>1 W !
- .D TXTLINE(ORPARAM(IDX))
- .W !
- .S DSPNAME="" F S DSPNAME=$O(OUTPUT(IDX,DSPNAME)) Q:DSPNAME="" D
- ..S NODE=$G(OUTPUT(IDX,DSPNAME)) I NODE="" Q
- ..W !,$$RJ^XLFSTR(DSPNAME_": "_$P(NODE,U),50)_$$RJ^XLFSTR("("_$P(NODE,U,2)_")",25)
- Q
- ;
- HELP(HELP) ;
- I HELP=1 D Q
- .W !,"Select Yes to return the user final settings including settings"
- .W !,"from all levels. Select No to only view the specific user settings."
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORACCES3 6753 printed Jan 18, 2025@03:28 Page 2
- 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
- +2 ;
- +3 QUIT
- +4 ;
- DISPLAY(USER,CARRAY,DIV,NOPRINT,DSPLVL,DSPNAME) ;
- +1 NEW ARRAY,ORPARAM,ORTABS,TABS,OTHER,ORDERS,ERROR,DARRAY,LVL
- +2 NEW PNAME,L,MAX,SPACES,INDENTSIZE,INSTANCE,INSTNAME,PARAM,TYPE,X,LEN
- +3 NEW TXT,TYPETXT,VALUETXT,TXTLEN,FIRST,ILVL,BUMP,NUMSPACES,DASHES
- +4 NEW VMODE,MAXLEN,TXT2,DONE,SINGLE,BLANKLINE
- +5 SET USER=+$GET(USER)
- SET DIV=+$GET(DIV)
- SET NOPRINT=+$GET(NOPRINT)
- +6 SET DSPLVL=$GET(DSPLVL)
- SET DSPNAME=$GET(DSPNAME)
- +7 SET SINGLE=$SELECT((USER>0)!(DIV>0)!(DSPLVL>0):1,1:0)
- +8 IF SINGLE
- IF (DSPLVL<1)!(DSPNAME="")
- Begin DoDot:1
- +9 IF USER
- SET DSPLVL=4
- SET DSPNAME=$$GET1^DIQ(200,USER_",",.01)
- +10 IF DIV
- SET DSPLVL=3
- SET DSPNAME=$$GET1^DIQ(4,DIV_",",.01)
- End DoDot:1
- +11 DO GETPARAMS^ORACCESS(1)
- +12 IF 'NOPRINT
- Begin DoDot:1
- +13 SET LVL(1,1)="Package"
- SET LVL(1,2)=LVL(1,1)
- +14 SET LVL(2,1)="System"
- SET LVL(2,2)=LVL(2,1)_"s"
- +15 SET LVL(3,1)="Division"
- SET LVL(3,2)=LVL(3,1)
- +16 SET LVL(4,1)="User"
- SET LVL(4,2)=LVL(4,1)_"s"
- +17 SET PNAME(1)="CPRS Write Access Error Message"
- +18 SET PNAME(2)="CPRS Tabs Write Access"
- +19 SET PNAME(3)="CPRS Other Action Write Access"
- +20 SET PNAME(4)="CPRS Orders Tab Write Access"
- +21 SET MAX=78
- SET SPACES=" "
- SET NUMSPACES=$LENGTH(SPACES)
- SET INDENTSIZE=3
- +22 SET (ILVL,BUMP,VMODE,BLANKLINE)=0
- +23 SET DASHES=""
- FOR X=1:1:(MAX\2)+1
- SET DASHES=DASHES_"-"
- +24 SET TYPETXT="Type"
- SET VALUETXT="Value"
- SET TXTLEN=$LENGTH(TYPETXT)+$LENGTH(VALUETXT)
- End DoDot:1
- +25 IF 'USER
- Begin DoDot:1
- +26 DO DATA^ORACCESS(.ARRAY,ERROR,USER,DIV)
- DO DSPMERGE(1)
- +27 KILL ARRAY
- End DoDot:1
- +28 DO DATA^ORACCESS(.ARRAY,TABS,USER,DIV)
- DO DSPMERGE(2)
- +29 IF USER>0
- MERGE CARRAY(1)=ARRAY
- +30 KILL ARRAY
- +31 DO DATA^ORACCESS(.ARRAY,OTHER,USER,DIV)
- DO DSPMERGE(3)
- +32 IF USER>0
- MERGE CARRAY(2)=ARRAY
- +33 KILL ARRAY
- +34 DO DATA^ORACCESS(.ARRAY,ORDERS,USER,DIV)
- DO DSPMERGE(4)
- +35 IF USER>0
- MERGE CARRAY(3)=ARRAY
- +36 if NOPRINT
- QUIT
- +37 WRITE !,$$CJ^XLFSTR("CPRS WRITE ACCESS DISPLAY SETTINGS",MAX)
- +38 IF SINGLE
- IF $DATA(DARRAY)=0
- Begin DoDot:1
- +39 IF ('DSPLVL)!(DSPNAME="")
- QUIT
- +40 SET (ILVL,BUMP,VMODE)=0
- SET TXT=LVL(DSPLVL,1)_": "_DSPNAME
- +41 DO TXTLINE(TXT)
- +42 WRITE !,?INDENTSIZE,"No Write Access Settings Defined."
- +43 DO TXTLINE("")
- End DoDot:1
- QUIT
- +44 SET L=0
- FOR
- SET L=$ORDER(LVL(L))
- if 'L
- QUIT
- Begin DoDot:1
- +45 IF +DSPLVL
- IF L'=DSPLVL
- QUIT
- +46 SET (ILVL,BUMP,VMODE)=0
- +47 DO DOBLANKLINE
- +48 IF $DATA(DARRAY(L))=0
- Begin DoDot:2
- +49 IF L<3
- Begin DoDot:3
- +50 DO GETINST^ORACCESS(L,"",.TXT)
- +51 SET TXT=LVL(L,1)_": "_TXT_" Level Settings"
- +52 DO TXTLINE(TXT)
- +53 WRITE !,?INDENTSIZE,"No Write Access Settings Defined."
- End DoDot:3
- IF 1
- +54 IF '$TEST
- Begin DoDot:3
- +55 IF 'SINGLE
- SET TXT=LVL(L,1)_" Level Settings"
- +56 DO TXTLINE(TXT)
- +57 WRITE !,?INDENTSIZE,"No "_LVL(L,1)_"s have Write Access Settings Defined."
- End DoDot:3
- +58 SET BLANKLINE=1
- End DoDot:2
- QUIT
- +59 SET INSTANCE=""
- SET FIRST=1
- +60 FOR
- SET INSTANCE=$ORDER(DARRAY(L,INSTANCE))
- if INSTANCE=""
- QUIT
- Begin DoDot:2
- +61 SET (ILVL,BUMP)=0
- SET INSTNAME=$PIECE(INSTANCE,U)
- +62 DO DOBLANKLINE
- +63 IF FIRST
- Begin DoDot:3
- +64 SET TXT=LVL(L,1)
- +65 IF (L<3)!SINGLE
- SET TXT=TXT_": "_INSTNAME
- +66 SET TXT=TXT_" Level Settings"
- SET FIRST=0
- +67 DO TXTLINE(TXT)
- End DoDot:3
- IF 1
- +68 IF (L>2)&('SINGLE)
- Begin DoDot:3
- +69 SET TXT=LVL(L,1)_": "_INSTNAME
- SET BUMP=1
- +70 DO TXTLINE(TXT)
- End DoDot:3
- +71 SET PARAM=0
- FOR
- SET PARAM=$ORDER(PNAME(PARAM))
- if 'PARAM
- QUIT
- Begin DoDot:3
- +72 SET ILVL=1
- +73 IF USER
- IF PARAM=1
- QUIT
- +74 IF $DATA(DARRAY(L,INSTANCE,PARAM))=0
- IF 'SINGLE
- QUIT
- +75 DO DOBLANKLINE
- +76 DO TXTLINE(PNAME(PARAM))
- +77 SET ILVL=2
- +78 IF PARAM=1
- SET TXT=-1
- +79 IF '$TEST
- SET TXT=TYPETXT
- SET VMODE=1
- +80 DO DSPVALUE(TXT,VALUETXT)
- DO TXTLINE("")
- +81 SET MAXLEN=MAX-($$INDENT*2)
- SET BLANKLINE=1
- +82 SET TYPE=""
- FOR
- SET TYPE=$ORDER(DARRAY(L,INSTANCE,PARAM,TYPE))
- if TYPE=""
- QUIT
- Begin DoDot:4
- +83 SET TXT=DARRAY(L,INSTANCE,PARAM,TYPE)
- +84 IF PARAM=1
- Begin DoDot:5
- +85 KILL TXT2
- DO WRAP^ORUTL(TXT,"TXT2",1,1,2,,MAXLEN)
- +86 FOR X=1:1:TXT2
- DO DSPVALUE(-1,TXT2(X))
- End DoDot:5
- IF 1
- +87 IF '$TEST
- DO DSPVALUE(TYPE," "_TXT)
- End DoDot:4
- +88 SET VMODE=0
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +89 SET (ILVL,BUMP,VMODE)=0
- DO TXTLINE("")
- +90 QUIT
- +91 ;
- DSPMERGE(SORT) ;
- +1 if NOPRINT
- QUIT
- +2 NEW L,INSTANCE,SORTIDX
- +3 SET L=0
- FOR
- SET L=$ORDER(LVL(L))
- if 'L
- QUIT
- Begin DoDot:1
- +4 IF DSPLVL>0
- IF L'=DSPLVL
- QUIT
- +5 SET INSTANCE=""
- FOR
- SET INSTANCE=$ORDER(ARRAY(LVL(L,2),INSTANCE))
- if INSTANCE=""
- QUIT
- Begin DoDot:2
- +6 IF L<4
- SET SORTIDX=INSTANCE
- +7 IF '$TEST
- SET SORTIDX=$PIECE($GET(^VA(200,+INSTANCE,0)),U)_U_INSTANCE
- +8 MERGE DARRAY(L,SORTIDX,SORT)=ARRAY(LVL(L,2),INSTANCE)
- End DoDot:2
- End DoDot:1
- +9 QUIT
- +10 ;
- INDENT() ;
- +1 IF VMODE
- QUIT 20
- +2 QUIT INDENTSIZE*(ILVL+BUMP)
- +3 ;
- TXTLINE(TXT) ;
- +1 NEW LEN,D1,D2,X,STR,IND,IND2,S1,S2
- +2 SET IND=$$INDENT
- SET IND2=IND*2
- +3 SET LEN=$LENGTH(TXT)
- SET D1=(MAX-LEN-IND2)\2
- SET D2=MAX-LEN-IND2-D1
- +4 IF LEN>0
- SET D1=D1-NUMSPACES
- SET D2=D2-NUMSPACES
- +5 SET STR=""_$EXTRACT(DASHES,1,D1)
- +6 IF LEN>0
- Begin DoDot:1
- +7 IF D1>0
- SET STR=STR_SPACES
- +8 SET STR=STR_TXT
- +9 IF D2>0
- SET STR=STR_SPACES
- End DoDot:1
- +10 SET STR=STR_$EXTRACT(DASHES,1,D2)
- +11 WRITE !,?IND,STR
- +12 QUIT
- +13 ;
- DSPVALUE(TYPE,VALUE) ;
- +1 NEW IND,VALIND
- +2 SET IND=$$INDENT
- +3 IF TYPE=-1
- SET TYPE=""
- SET VALIND=IND
- +4 IF '$TEST
- SET VALIND=MAX-IND-$LENGTH(VALUETXT)
- +5 WRITE !,?IND,TYPE,?VALIND,VALUE
- +6 QUIT
- +7 ;
- DOBLANKLINE ;
- +1 IF BLANKLINE
- WRITE !
- SET BLANKLINE=0
- +2 QUIT
- +3 ;
- VIEW ;
- +1 NEW FINAL,ORPARAM,ORPIEN,ORTABS,USER,TABS,OTHER,ORDERS,ERROR
- +2 SET USER=$$SELECT^ORACCESS("Select user: ",0)
- +3 IF USER<1
- QUIT
- +4 SET FINAL=$$ASKYN^ORACCESS("No","View final settings","ORACCES3",1)
- +5 IF +FINAL=1
- DO OVERALL(+USER)
- QUIT
- +6 DO GETPARAMS^ORACCESS(1)
- +7 SET DSPLVL=4
- SET DSPNAME=$PIECE($GET(^VA(200,+USER,0)),U)
- +8 DO DISPLAY(USER,"")
- +9 QUIT
- +10 ;
- OVERALL(USER) ;
- +1 NEW ARRAY,ASKLVL,BLANKLINE,BUMP,DASHES,DIC,DIV,DIVNAME,DSPLVL,DSPNAME,DTOUT,DUOUT,ENT,IDX,ILVL,INDENTSIZE
- +2 NEW MAX,NODE,NUMSPACES,ORPARAM,ORTABS,OUTPUT,SPACES,USERNAME,VMODE,X,Y,TABS,OTHER,ORDERS,ERROR
- +3 SET DIC=4
- SET DIC(0)="AEMQ"
- SET DIC("A")="Select Division: "
- +4 DO ^DIC
- IF $DATA(DTOUT)!$DATA(DUOUT)!(Y<1)
- QUIT
- +5 SET DIV=+Y
- +6 IF DIV>0
- SET DIVNAME=$$GET1^DIQ(4,DIV_",",.01)
- +7 SET USERNAME=$$GET1^DIQ(200,USER_",",.01)
- +8 DO GETPARAMS^ORACCESS(1)
- +9 FOR IDX=1:1:3
- Begin DoDot:1
- +10 KILL ARRAY
- +11 DO DATA^ORACCESS(.ARRAY,IDX,0,0)
- +12 FOR DSPLVL="Package","Systems","Division","Users"
- Begin DoDot:2
- +13 IF DSPLVL="Package"
- Begin DoDot:3
- +14 SET DSPNAME=""
- +15 FOR
- SET DSPNAME=$ORDER(ARRAY(DSPLVL,"ORDER ENTRY/RESULTS REPORTING",DSPNAME))
- if DSPNAME=""
- QUIT
- Begin DoDot:4
- +16 SET OUTPUT(IDX,DSPNAME)=ARRAY(DSPLVL,"ORDER ENTRY/RESULTS REPORTING",DSPNAME)_U_DSPLVL
- End DoDot:4
- End DoDot:3
- QUIT
- +17 SET ENT=$SELECT(DSPLVL="Division":DIVNAME,DSPLVL="Users":USER,1:$$KSP^XUPARAM("WHERE"))
- +18 SET DSPNAME=""
- FOR
- SET DSPNAME=$ORDER(ARRAY(DSPLVL,ENT,DSPNAME))
- if DSPNAME=""
- QUIT
- Begin DoDot:3
- +19 SET OUTPUT(IDX,DSPNAME)=ARRAY(DSPLVL,ENT,DSPNAME)_U_DSPLVL
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +20 IF '$DATA(OUTPUT)
- WRITE !,"No settings defined"
- QUIT
- +21 WRITE !,"Write access setting for user: "_USERNAME
- +22 WRITE !,"Write access setting for division: "_DIVNAME
- +23 WRITE !,$$RJ^XLFSTR("Tab/Action",50)_$$RJ^XLFSTR("Level",25),!
- +24 FOR IDX=1:1:80
- WRITE "-"
- +25 WRITE !
- +26 SET MAX=78
- SET SPACES=" "
- SET NUMSPACES=$LENGTH(SPACES)
- SET INDENTSIZE=3
- +27 SET (ILVL,BUMP,VMODE,BLANKLINE)=0
- +28 SET DASHES=""
- FOR X=1:1:(MAX\2)+1
- SET DASHES=DASHES_"-"
- +29 FOR IDX=1:1:3
- Begin DoDot:1
- +30 IF IDX>1
- WRITE !
- +31 DO TXTLINE(ORPARAM(IDX))
- +32 WRITE !
- +33 SET DSPNAME=""
- FOR
- SET DSPNAME=$ORDER(OUTPUT(IDX,DSPNAME))
- if DSPNAME=""
- QUIT
- Begin DoDot:2
- +34 SET NODE=$GET(OUTPUT(IDX,DSPNAME))
- IF NODE=""
- QUIT
- +35 WRITE !,$$RJ^XLFSTR(DSPNAME_": "_$PIECE(NODE,U),50)_$$RJ^XLFSTR("("_$PIECE(NODE,U,2)_")",25)
- End DoDot:2
- End DoDot:1
- +36 QUIT
- +37 ;
- HELP(HELP) ;
- +1 IF HELP=1
- Begin DoDot:1
- +2 WRITE !,"Select Yes to return the user final settings including settings"
- +3 WRITE !,"from all levels. Select No to only view the specific user settings."
- End DoDot:1
- QUIT
- +4 QUIT
- +5 ;