PRCPLO4 ;WOIFO/DAP- Option to allow users to set CLRS parameters ; 10/19/06 8:44am
;;5.1;IFCAP;**83,98,130**;Oct 20, 2000;Build 25
;Per VHA Directive 2004-038, this routine should not be modified.
;
ENT ;This allows users to enter new values for the parameters associated
;with the Clinical Logistics Report Server by prompting them for
;a new value for each parameter after presenting the current value.
;Values are screened for validity and errors in setting the parameters
;are returned to the screen. IA #2263 can be referenced for further
;information on the ^XPAR calls utilized here.
;
N PRCP1,PRCP2,PRCP3,PRCP4,PRCP5,PRCP6,PRCPW,PRCPU,PRCPV,PRCPX,PRCPY,PRCPZ,ERR
D PRR I ERR Q
D PGR I ERR Q
D PIR I ERR Q
D PED I ERR Q
;
;*98 Added logic for modification of PRC CLRS ADDRESS and
;PRC CLRS OUTLOOK MAILGROUP parameters
;
D PAD I ERR Q
D POG I ERR Q
; PRC*5.1*130 begin
; Added user name, password, and Regional Acquisition Center
D USN I ERR Q
D PSW I ERR Q
D RAC I ERR Q
; PRC*5.1*130 end
Q
;
PRR ;Provide current value of and then prompt to modify the PRCPLO REPORT RANGE parameter
;
N DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
S ERR=0
S DIR(0)="NOA^0:999",DIR("A")="Stock On Hand Report Range: "
S PRCP1=$$GET^XPAR("SYS","PRCPLO REPORT RANGE",1,"Q")
I PRCP1'="" S DIR("B")=PRCP1
S DIR("?")="Please enter a number between 0 and 999 with no decimal digits"
D ^DIR I $D(DUOUT)!$D(DTOUT) S ERR=1 Q
I PRCP1=X Q
I X'="@" S PRCP1=X
I X="@" D EN^DDIOL("Deletions not allowed") G PRR
K DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
D EN^XPAR("SYS","PRCPLO REPORT RANGE",1,PRCP1,.PRCPX)
I PRCPX=0 W ! D EN^DDIOL("Stock on Hand Report Range successfully set to "_PRCP1)
I PRCPX'=0 W ! D EN^DDIOL("Error while trying to edit the Stock on Hand Report Range:") W ! D EN^DDIOL($P(PRCPX,"^",2))
Q
;
PIR ;Provide current value of and then prompt to modify the PRCPLO INACTIVITY RANGE parameter
;
N DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
S ERR=0
S DIR(0)="NOA^0:999",DIR("A")="Stock Status Report Inactivity Range: "
S PRCP2=$$GET^XPAR("SYS","PRCPLO INACTIVITY RANGE",1,"Q")
I PRCP2'="" S DIR("B")=PRCP2
S DIR("?")="Please enter a number between 0 and 999 with no decimal digits"
D ^DIR I $D(DUOUT)!$D(DTOUT) S ERR=1 Q
I PRCP2=X Q
I X'="@" S PRCP2=X
I X="@" D EN^DDIOL("Deletions not allowed") G PIR
K DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
D EN^XPAR("SYS","PRCPLO INACTIVITY RANGE",1,PRCP2,.PRCPY)
I PRCPY=0 W ! D EN^DDIOL("Stock Status Report Inactivity Range successfully set to "_PRCP2)
I PRCPY'=0 W ! D EN^DDIOL("Error while trying to edit the Stock Status Report Inactivity Range:") W ! D EN^DDIOL($P(PRCPY,"^",2))
Q
;
PGR ;Provide current value of and then prompt to modify the PRCPLO GREATER THAN RANGE parameter
;
N DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
S ERR=0
S DIR(0)="NOA^0:999",DIR("A")="Stock On Hand Report Greater Than Range: "
S PRCP3=$$GET^XPAR("SYS","PRCPLO GREATER THAN RANGE",1,"Q")
I PRCP3'="" S DIR("B")=PRCP3
S DIR("?")="Please enter a number between 0 and 999 with no decimal digits"
D ^DIR I $D(DUOUT)!$D(DTOUT) S ERR=1 Q
I PRCP3=X Q
I X'="@" S PRCP3=X
I X="@" D EN^DDIOL("Deletions not allowed") G PGR
K DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
D EN^XPAR("SYS","PRCPLO GREATER THAN RANGE",1,PRCP3,.PRCPZ)
I PRCPZ=0 W ! D EN^DDIOL("Stock on Hand Report Greater Than Range successfully set to "_PRCP3)
I PRCPZ'=0 W ! D EN^DDIOL("Error while trying to edit the Stock on Hand Report Greater Than Range:") W ! D EN^DDIOL($P(PRCPZ,"^",2))
;
Q
;
PED ;Provide current value of and then prompt to modify the PRCPLO EXTRACT DIRECTORY parameter
;
N DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
S ERR=0
S DIR(0)="FOr^1:245",DIR("A")="CLRS Extract Directory"
S PRCP4=$$GET^XPAR("SYS","PRCPLO EXTRACT DIRECTORY",1,"Q")
I PRCP4'="" S DIR("B")=PRCP4
S DIR("?")="Please enter free text character string between 1 and 245 characters"
D ^DIR I $D(DUOUT)!$D(DTOUT) S ERR=1 Q
I PRCP4=X Q
I X'="@" S PRCP4=X
I X="@" D EN^DDIOL("Deletions not allowed") G PED
K DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
D EN^XPAR("SYS","PRCPLO EXTRACT DIRECTORY",1,PRCP4,.PRCPV)
I PRCP4="@" Q
I PRCPV=0 W ! D EN^DDIOL("CLRS Extract Directory successfully set to "_PRCP4)
I PRCPV'=0 W ! D EN^DDIOL("Error while trying to edit the CLRS Extract Directory:") W ! D EN^DDIOL($P(PRCPV,"^",2))
;
Q
;
PAD ;Provide current value of and then prompt to modify the PRC CLRS ADDRESS parameter
;
N DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
S ERR=0
S DIR(0)="FOr^1:245",DIR("A")="CLRS Address"
S PRCP5=$$GET^XPAR("SYS","PRC CLRS ADDRESS",1,"Q")
I PRCP5'="" S DIR("B")=PRCP5
S DIR("?")="Please enter free text character string between 1 and 245 characters"
D ^DIR I $D(DUOUT)!$D(DTOUT) S ERR=1 Q
I PRCP5=X Q
S PRCP5=X
K DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
D EN^XPAR("SYS","PRC CLRS ADDRESS",1,PRCP5,.PRCPW)
I PRCP5="@" D EN^DDIOL(" <PRC CLRS ADDRESS deleted>") Q
I PRCPW=0 W ! D EN^DDIOL("CLRS Address successfully set to "_PRCP5)
I PRCPW'=0 W ! D EN^DDIOL("Error while trying to edit the CLRS Address:") W ! D EN^DDIOL($P(PRCPW,"^",2))
;
Q
;
POG ;Provide current value of and then prompt to modify the PRC CLRS OUTLOOK MAILGROUP parameter
;
N DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
S ERR=0
S DIR(0)="FOr^1:245",DIR("A")="CLRS Outlook Mail Group"
S PRCP6=$$GET^XPAR("SYS","PRC CLRS OUTLOOK MAILGROUP",1,"Q")
I PRCP6'="" S DIR("B")=PRCP6
S DIR("?")="Please enter free text character string between 1 and 245 characters"
D ^DIR I $D(DUOUT)!$D(DTOUT) S ERR=1 Q
I PRCP6=X Q
S PRCP6=X
K DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
D EN^XPAR("SYS","PRC CLRS OUTLOOK MAILGROUP",1,PRCP6,.PRCPU)
I PRCP6="@" D EN^DDIOL(" <PRC CLRS OUTLOOK MAILGROUP deleted>") Q
I PRCPU=0 W ! D EN^DDIOL("CLRS Outlook Mail Group successfully set to "_PRCP6)
I PRCPU'=0 W ! D EN^DDIOL("Error while trying to edit the CLRS Outlook Mail Group:") W ! D EN^DDIOL($P(PRCPU,"^",2))
;
Q
; PRC*5.1*130 begin
USN ;Enter User Name for CLRS Report Server Login
;
N DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
S ERR=0
S DIR(0)="FOA^1:30",DIR("A")="User Name for CLRS Report Server Login: "
S PRCP6=$$GET^XPAR("SYS","PRCPLO USER NAME",1,"Q")
S PRCP6=$$DECRYP^XUSRB1(PRCP6) ; Decrypted value
I PRCP6'="" S DIR("B")=PRCP6
S DIR("?")="Please enter free text character string between 1 and 30 characters"
D ^DIR I $D(DUOUT)!$D(DTOUT) S ERR=1 Q
I PRCP6=X Q
S (PRCP6,PRCP5)=X
K DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
I PRCP6'="@" S PRCP6=$$ENCRYP^XUSRB1(PRCP6)
D EN^XPAR("SYS","PRCPLO USER NAME",1,PRCP6,.PRCPU)
I PRCP6="@" D EN^DDIOL(" <PRCPLO USER NAME deleted>") Q
I PRCPU=0 W ! D EN^DDIOL("PRCPLO USER NAME successfully set to "_PRCP5)
I PRCPU'=0 W ! D EN^DDIOL("Error while trying to edit the PRCPLO USER NAME:") W ! D EN^DDIOL($P(PRCPU,"^",2))
;
Q
PSW ; Enter Password for CLRS Report Server Login
;
N DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
S ERR=0
S DIR(0)="FOA^1:30",DIR("A")="Password for CLRS Report Server Login: "
S PRCP6=$$GET^XPAR("SYS","PRCPLO PASSWORD",1,"Q")
S PRCP6=$$DECRYP^XUSRB1(PRCP6) ; Decrypted value
I PRCP6'="" S DIR("B")=PRCP6
S DIR("?")="Please enter free text character string between 1 and 30 characters"
D ^DIR I $D(DUOUT)!$D(DTOUT) S ERR=1 Q
I PRCP6=X Q
S (PRCP6,PRCP5)=X
K DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
I PRCP6'="@" S PRCP6=$$ENCRYP^XUSRB1(PRCP6)
D EN^XPAR("SYS","PRCPLO PASSWORD",1,PRCP6,.PRCPU)
I PRCP6="@" D EN^DDIOL(" <PRCPLO PASSWORD deleted>") Q
I PRCPU=0 W ! D EN^DDIOL("PRCPLO PASSWORD successfully set to "_PRCP5)
I PRCPU'=0 W ! D EN^DDIOL("Error while trying to edit the PRCPLO PASSWORD:") W ! D EN^DDIOL($P(PRCPU,"^",2))
;
Q
RAC ; Enter CLRS Regional Acquisition Center
;
N DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
S ERR=0
S DIR(0)="FOA^1:30",DIR("A")="CLRS Regional Acquisition Center: "
S PRCP6=$$GET^XPAR("SYS","PRCPLO REGIONAL ACQ CENTER",1,"Q")
I PRCP6'="" S DIR("B")=PRCP6
S DIR("?")="Please enter free text character string between 1 and 30 characters"
D ^DIR I $D(DUOUT)!$D(DTOUT) S ERR=1 Q
I PRCP6=X Q
S PRCP6=X
K DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
D EN^XPAR("SYS","PRCPLO REGIONAL ACQ CENTER",1,PRCP6,.PRCPU)
I PRCP6="@" D EN^DDIOL(" <PRCPLO REGIONAL ACQ CENTER deleted>") Q
I PRCPU=0 W ! D EN^DDIOL("PRCPLO REGIONAL ACQ CENTER successfully set to "_PRCP6)
I PRCPU'=0 W ! D EN^DDIOL("Error while trying to edit the PRCPLO REGIONAL ACQ CENTER:") W ! D EN^DDIOL($P(PRCPU,"^",2))
;
Q
; PRC*5.1*130 end
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPLO4 8558 printed Dec 13, 2024@02:14:09 Page 2
PRCPLO4 ;WOIFO/DAP- Option to allow users to set CLRS parameters ; 10/19/06 8:44am
+1 ;;5.1;IFCAP;**83,98,130**;Oct 20, 2000;Build 25
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
ENT ;This allows users to enter new values for the parameters associated
+1 ;with the Clinical Logistics Report Server by prompting them for
+2 ;a new value for each parameter after presenting the current value.
+3 ;Values are screened for validity and errors in setting the parameters
+4 ;are returned to the screen. IA #2263 can be referenced for further
+5 ;information on the ^XPAR calls utilized here.
+6 ;
+7 NEW PRCP1,PRCP2,PRCP3,PRCP4,PRCP5,PRCP6,PRCPW,PRCPU,PRCPV,PRCPX,PRCPY,PRCPZ,ERR
+8 DO PRR
IF ERR
QUIT
+9 DO PGR
IF ERR
QUIT
+10 DO PIR
IF ERR
QUIT
+11 DO PED
IF ERR
QUIT
+12 ;
+13 ;*98 Added logic for modification of PRC CLRS ADDRESS and
+14 ;PRC CLRS OUTLOOK MAILGROUP parameters
+15 ;
+16 DO PAD
IF ERR
QUIT
+17 DO POG
IF ERR
QUIT
+18 ; PRC*5.1*130 begin
+19 ; Added user name, password, and Regional Acquisition Center
+20 DO USN
IF ERR
QUIT
+21 DO PSW
IF ERR
QUIT
+22 DO RAC
IF ERR
QUIT
+23 ; PRC*5.1*130 end
+24 QUIT
+25 ;
PRR ;Provide current value of and then prompt to modify the PRCPLO REPORT RANGE parameter
+1 ;
+2 NEW DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
+3 SET ERR=0
+4 SET DIR(0)="NOA^0:999"
SET DIR("A")="Stock On Hand Report Range: "
+5 SET PRCP1=$$GET^XPAR("SYS","PRCPLO REPORT RANGE",1,"Q")
+6 IF PRCP1'=""
SET DIR("B")=PRCP1
+7 SET DIR("?")="Please enter a number between 0 and 999 with no decimal digits"
+8 DO ^DIR
IF $DATA(DUOUT)!$DATA(DTOUT)
SET ERR=1
QUIT
+9 IF PRCP1=X
QUIT
+10 IF X'="@"
SET PRCP1=X
+11 IF X="@"
DO EN^DDIOL("Deletions not allowed")
GOTO PRR
+12 KILL DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
+13 DO EN^XPAR("SYS","PRCPLO REPORT RANGE",1,PRCP1,.PRCPX)
+14 IF PRCPX=0
WRITE !
DO EN^DDIOL("Stock on Hand Report Range successfully set to "_PRCP1)
+15 IF PRCPX'=0
WRITE !
DO EN^DDIOL("Error while trying to edit the Stock on Hand Report Range:")
WRITE !
DO EN^DDIOL($PIECE(PRCPX,"^",2))
+16 QUIT
+17 ;
PIR ;Provide current value of and then prompt to modify the PRCPLO INACTIVITY RANGE parameter
+1 ;
+2 NEW DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
+3 SET ERR=0
+4 SET DIR(0)="NOA^0:999"
SET DIR("A")="Stock Status Report Inactivity Range: "
+5 SET PRCP2=$$GET^XPAR("SYS","PRCPLO INACTIVITY RANGE",1,"Q")
+6 IF PRCP2'=""
SET DIR("B")=PRCP2
+7 SET DIR("?")="Please enter a number between 0 and 999 with no decimal digits"
+8 DO ^DIR
IF $DATA(DUOUT)!$DATA(DTOUT)
SET ERR=1
QUIT
+9 IF PRCP2=X
QUIT
+10 IF X'="@"
SET PRCP2=X
+11 IF X="@"
DO EN^DDIOL("Deletions not allowed")
GOTO PIR
+12 KILL DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
+13 DO EN^XPAR("SYS","PRCPLO INACTIVITY RANGE",1,PRCP2,.PRCPY)
+14 IF PRCPY=0
WRITE !
DO EN^DDIOL("Stock Status Report Inactivity Range successfully set to "_PRCP2)
+15 IF PRCPY'=0
WRITE !
DO EN^DDIOL("Error while trying to edit the Stock Status Report Inactivity Range:")
WRITE !
DO EN^DDIOL($PIECE(PRCPY,"^",2))
+16 QUIT
+17 ;
PGR ;Provide current value of and then prompt to modify the PRCPLO GREATER THAN RANGE parameter
+1 ;
+2 NEW DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
+3 SET ERR=0
+4 SET DIR(0)="NOA^0:999"
SET DIR("A")="Stock On Hand Report Greater Than Range: "
+5 SET PRCP3=$$GET^XPAR("SYS","PRCPLO GREATER THAN RANGE",1,"Q")
+6 IF PRCP3'=""
SET DIR("B")=PRCP3
+7 SET DIR("?")="Please enter a number between 0 and 999 with no decimal digits"
+8 DO ^DIR
IF $DATA(DUOUT)!$DATA(DTOUT)
SET ERR=1
QUIT
+9 IF PRCP3=X
QUIT
+10 IF X'="@"
SET PRCP3=X
+11 IF X="@"
DO EN^DDIOL("Deletions not allowed")
GOTO PGR
+12 KILL DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
+13 DO EN^XPAR("SYS","PRCPLO GREATER THAN RANGE",1,PRCP3,.PRCPZ)
+14 IF PRCPZ=0
WRITE !
DO EN^DDIOL("Stock on Hand Report Greater Than Range successfully set to "_PRCP3)
+15 IF PRCPZ'=0
WRITE !
DO EN^DDIOL("Error while trying to edit the Stock on Hand Report Greater Than Range:")
WRITE !
DO EN^DDIOL($PIECE(PRCPZ,"^",2))
+16 ;
+17 QUIT
+18 ;
PED ;Provide current value of and then prompt to modify the PRCPLO EXTRACT DIRECTORY parameter
+1 ;
+2 NEW DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
+3 SET ERR=0
+4 SET DIR(0)="FOr^1:245"
SET DIR("A")="CLRS Extract Directory"
+5 SET PRCP4=$$GET^XPAR("SYS","PRCPLO EXTRACT DIRECTORY",1,"Q")
+6 IF PRCP4'=""
SET DIR("B")=PRCP4
+7 SET DIR("?")="Please enter free text character string between 1 and 245 characters"
+8 DO ^DIR
IF $DATA(DUOUT)!$DATA(DTOUT)
SET ERR=1
QUIT
+9 IF PRCP4=X
QUIT
+10 IF X'="@"
SET PRCP4=X
+11 IF X="@"
DO EN^DDIOL("Deletions not allowed")
GOTO PED
+12 KILL DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
+13 DO EN^XPAR("SYS","PRCPLO EXTRACT DIRECTORY",1,PRCP4,.PRCPV)
+14 IF PRCP4="@"
QUIT
+15 IF PRCPV=0
WRITE !
DO EN^DDIOL("CLRS Extract Directory successfully set to "_PRCP4)
+16 IF PRCPV'=0
WRITE !
DO EN^DDIOL("Error while trying to edit the CLRS Extract Directory:")
WRITE !
DO EN^DDIOL($PIECE(PRCPV,"^",2))
+17 ;
+18 QUIT
+19 ;
PAD ;Provide current value of and then prompt to modify the PRC CLRS ADDRESS parameter
+1 ;
+2 NEW DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
+3 SET ERR=0
+4 SET DIR(0)="FOr^1:245"
SET DIR("A")="CLRS Address"
+5 SET PRCP5=$$GET^XPAR("SYS","PRC CLRS ADDRESS",1,"Q")
+6 IF PRCP5'=""
SET DIR("B")=PRCP5
+7 SET DIR("?")="Please enter free text character string between 1 and 245 characters"
+8 DO ^DIR
IF $DATA(DUOUT)!$DATA(DTOUT)
SET ERR=1
QUIT
+9 IF PRCP5=X
QUIT
+10 SET PRCP5=X
+11 KILL DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
+12 DO EN^XPAR("SYS","PRC CLRS ADDRESS",1,PRCP5,.PRCPW)
+13 IF PRCP5="@"
DO EN^DDIOL(" <PRC CLRS ADDRESS deleted>")
QUIT
+14 IF PRCPW=0
WRITE !
DO EN^DDIOL("CLRS Address successfully set to "_PRCP5)
+15 IF PRCPW'=0
WRITE !
DO EN^DDIOL("Error while trying to edit the CLRS Address:")
WRITE !
DO EN^DDIOL($PIECE(PRCPW,"^",2))
+16 ;
+17 QUIT
+18 ;
POG ;Provide current value of and then prompt to modify the PRC CLRS OUTLOOK MAILGROUP parameter
+1 ;
+2 NEW DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
+3 SET ERR=0
+4 SET DIR(0)="FOr^1:245"
SET DIR("A")="CLRS Outlook Mail Group"
+5 SET PRCP6=$$GET^XPAR("SYS","PRC CLRS OUTLOOK MAILGROUP",1,"Q")
+6 IF PRCP6'=""
SET DIR("B")=PRCP6
+7 SET DIR("?")="Please enter free text character string between 1 and 245 characters"
+8 DO ^DIR
IF $DATA(DUOUT)!$DATA(DTOUT)
SET ERR=1
QUIT
+9 IF PRCP6=X
QUIT
+10 SET PRCP6=X
+11 KILL DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
+12 DO EN^XPAR("SYS","PRC CLRS OUTLOOK MAILGROUP",1,PRCP6,.PRCPU)
+13 IF PRCP6="@"
DO EN^DDIOL(" <PRC CLRS OUTLOOK MAILGROUP deleted>")
QUIT
+14 IF PRCPU=0
WRITE !
DO EN^DDIOL("CLRS Outlook Mail Group successfully set to "_PRCP6)
+15 IF PRCPU'=0
WRITE !
DO EN^DDIOL("Error while trying to edit the CLRS Outlook Mail Group:")
WRITE !
DO EN^DDIOL($PIECE(PRCPU,"^",2))
+16 ;
+17 QUIT
+18 ; PRC*5.1*130 begin
USN ;Enter User Name for CLRS Report Server Login
+1 ;
+2 NEW DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
+3 SET ERR=0
+4 SET DIR(0)="FOA^1:30"
SET DIR("A")="User Name for CLRS Report Server Login: "
+5 SET PRCP6=$$GET^XPAR("SYS","PRCPLO USER NAME",1,"Q")
+6 ; Decrypted value
SET PRCP6=$$DECRYP^XUSRB1(PRCP6)
+7 IF PRCP6'=""
SET DIR("B")=PRCP6
+8 SET DIR("?")="Please enter free text character string between 1 and 30 characters"
+9 DO ^DIR
IF $DATA(DUOUT)!$DATA(DTOUT)
SET ERR=1
QUIT
+10 IF PRCP6=X
QUIT
+11 SET (PRCP6,PRCP5)=X
+12 KILL DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
+13 IF PRCP6'="@"
SET PRCP6=$$ENCRYP^XUSRB1(PRCP6)
+14 DO EN^XPAR("SYS","PRCPLO USER NAME",1,PRCP6,.PRCPU)
+15 IF PRCP6="@"
DO EN^DDIOL(" <PRCPLO USER NAME deleted>")
QUIT
+16 IF PRCPU=0
WRITE !
DO EN^DDIOL("PRCPLO USER NAME successfully set to "_PRCP5)
+17 IF PRCPU'=0
WRITE !
DO EN^DDIOL("Error while trying to edit the PRCPLO USER NAME:")
WRITE !
DO EN^DDIOL($PIECE(PRCPU,"^",2))
+18 ;
+19 QUIT
PSW ; Enter Password for CLRS Report Server Login
+1 ;
+2 NEW DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
+3 SET ERR=0
+4 SET DIR(0)="FOA^1:30"
SET DIR("A")="Password for CLRS Report Server Login: "
+5 SET PRCP6=$$GET^XPAR("SYS","PRCPLO PASSWORD",1,"Q")
+6 ; Decrypted value
SET PRCP6=$$DECRYP^XUSRB1(PRCP6)
+7 IF PRCP6'=""
SET DIR("B")=PRCP6
+8 SET DIR("?")="Please enter free text character string between 1 and 30 characters"
+9 DO ^DIR
IF $DATA(DUOUT)!$DATA(DTOUT)
SET ERR=1
QUIT
+10 IF PRCP6=X
QUIT
+11 SET (PRCP6,PRCP5)=X
+12 KILL DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
+13 IF PRCP6'="@"
SET PRCP6=$$ENCRYP^XUSRB1(PRCP6)
+14 DO EN^XPAR("SYS","PRCPLO PASSWORD",1,PRCP6,.PRCPU)
+15 IF PRCP6="@"
DO EN^DDIOL(" <PRCPLO PASSWORD deleted>")
QUIT
+16 IF PRCPU=0
WRITE !
DO EN^DDIOL("PRCPLO PASSWORD successfully set to "_PRCP5)
+17 IF PRCPU'=0
WRITE !
DO EN^DDIOL("Error while trying to edit the PRCPLO PASSWORD:")
WRITE !
DO EN^DDIOL($PIECE(PRCPU,"^",2))
+18 ;
+19 QUIT
RAC ; Enter CLRS Regional Acquisition Center
+1 ;
+2 NEW DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
+3 SET ERR=0
+4 SET DIR(0)="FOA^1:30"
SET DIR("A")="CLRS Regional Acquisition Center: "
+5 SET PRCP6=$$GET^XPAR("SYS","PRCPLO REGIONAL ACQ CENTER",1,"Q")
+6 IF PRCP6'=""
SET DIR("B")=PRCP6
+7 SET DIR("?")="Please enter free text character string between 1 and 30 characters"
+8 DO ^DIR
IF $DATA(DUOUT)!$DATA(DTOUT)
SET ERR=1
QUIT
+9 IF PRCP6=X
QUIT
+10 SET PRCP6=X
+11 KILL DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
+12 DO EN^XPAR("SYS","PRCPLO REGIONAL ACQ CENTER",1,PRCP6,.PRCPU)
+13 IF PRCP6="@"
DO EN^DDIOL(" <PRCPLO REGIONAL ACQ CENTER deleted>")
QUIT
+14 IF PRCPU=0
WRITE !
DO EN^DDIOL("PRCPLO REGIONAL ACQ CENTER successfully set to "_PRCP6)
+15 IF PRCPU'=0
WRITE !
DO EN^DDIOL("Error while trying to edit the PRCPLO REGIONAL ACQ CENTER:")
WRITE !
DO EN^DDIOL($PIECE(PRCPU,"^",2))
+16 ;
+17 QUIT
+18 ; PRC*5.1*130 end
