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

PRCPLO4.m

Go to the documentation of this file. 
  1. 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
  1.  ;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1. ENT ;This allows users to enter new values for the parameters associated 
  1.  ;with the Clinical Logistics Report Server by prompting them for 
  1.  ;a new value for each parameter after presenting the current value.  
  1.  ;Values are screened for validity and errors in setting the parameters 
  1.  ;are returned to the screen. IA #2263 can be referenced for further 
  1.  ;information on the ^XPAR calls utilized here.
  1.  ;  
  1.  N PRCP1,PRCP2,PRCP3,PRCP4,PRCP5,PRCP6,PRCPW,PRCPU,PRCPV,PRCPX,PRCPY,PRCPZ,ERR
  1.  D PRR I ERR Q
  1.  D PGR I ERR Q
  1.  D PIR I ERR Q
  1.  D PED I ERR Q
  1.  ;
  1.  ;*98 Added logic for modification of PRC CLRS ADDRESS and 
  1.  ;PRC CLRS OUTLOOK MAILGROUP parameters
  1.  ;
  1.  D PAD I ERR Q
  1.  D POG I ERR Q
  1.  ; PRC*5.1*130 begin
  1.  ; Added user name, password, and Regional Acquisition Center
  1.  D USN I ERR Q
  1.  D PSW I ERR Q
  1.  D RAC I ERR Q
  1.  ; PRC*5.1*130 end
  1.  Q
  1.  ;
  1. PRR ;Provide current value of and then prompt to modify the PRCPLO REPORT RANGE parameter
  1.  ;
  1.  N DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
  1.  S ERR=0
  1.  S DIR(0)="NOA^0:999",DIR("A")="Stock On Hand Report Range: "
  1.  S PRCP1=$$GET^XPAR("SYS","PRCPLO REPORT RANGE",1,"Q")
  1.  I PRCP1'="" S DIR("B")=PRCP1
  1.  S DIR("?")="Please enter a number between 0 and 999 with no decimal digits"
  1.  D ^DIR I $D(DUOUT)!$D(DTOUT) S ERR=1 Q
  1.  I PRCP1=X Q
  1.  I X'="@" S PRCP1=X
  1.  I X="@" D EN^DDIOL("Deletions not allowed") G PRR
  1.  K DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
  1.  D EN^XPAR("SYS","PRCPLO REPORT RANGE",1,PRCP1,.PRCPX)
  1.  I PRCPX=0 W ! D EN^DDIOL("Stock on Hand Report Range successfully set to "_PRCP1)
  1.  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))
  1.  Q
  1.  ;
  1. PIR ;Provide current value of and then prompt to modify the PRCPLO INACTIVITY RANGE parameter
  1.  ;
  1.  N DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
  1.  S ERR=0
  1.  S DIR(0)="NOA^0:999",DIR("A")="Stock Status Report Inactivity Range: "
  1.  S PRCP2=$$GET^XPAR("SYS","PRCPLO INACTIVITY RANGE",1,"Q")
  1.  I PRCP2'="" S DIR("B")=PRCP2
  1.  S DIR("?")="Please enter a number between 0 and 999 with no decimal digits"
  1.  D ^DIR I $D(DUOUT)!$D(DTOUT) S ERR=1 Q
  1.  I PRCP2=X Q
  1.  I X'="@" S PRCP2=X
  1.  I X="@" D EN^DDIOL("Deletions not allowed")  G PIR
  1.  K DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
  1.  D EN^XPAR("SYS","PRCPLO INACTIVITY RANGE",1,PRCP2,.PRCPY)
  1.  I PRCPY=0 W ! D EN^DDIOL("Stock Status Report Inactivity Range successfully set to "_PRCP2)
  1.  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))
  1.  Q
  1.  ;
  1. PGR ;Provide current value of and then prompt to modify the PRCPLO GREATER THAN RANGE parameter
  1.  ;
  1.  N DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
  1.  S ERR=0
  1.  S DIR(0)="NOA^0:999",DIR("A")="Stock On Hand Report Greater Than Range: "
  1.  S PRCP3=$$GET^XPAR("SYS","PRCPLO GREATER THAN RANGE",1,"Q")
  1.  I PRCP3'="" S DIR("B")=PRCP3
  1.  S DIR("?")="Please enter a number between 0 and 999 with no decimal digits"
  1.  D ^DIR I $D(DUOUT)!$D(DTOUT) S ERR=1 Q
  1.  I PRCP3=X Q
  1.  I X'="@" S PRCP3=X
  1.  I X="@" D EN^DDIOL("Deletions not allowed") G PGR
  1.  K DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
  1.  D EN^XPAR("SYS","PRCPLO GREATER THAN RANGE",1,PRCP3,.PRCPZ)
  1.  I PRCPZ=0 W ! D EN^DDIOL("Stock on Hand Report Greater Than Range successfully set to "_PRCP3)
  1.  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))
  1.  ;
  1.  Q
  1.  ;
  1. PED ;Provide current value of and then prompt to modify the PRCPLO EXTRACT DIRECTORY parameter
  1.  ;
  1.  N DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
  1.  S ERR=0
  1.  S DIR(0)="FOr^1:245",DIR("A")="CLRS Extract Directory"
  1.  S PRCP4=$$GET^XPAR("SYS","PRCPLO EXTRACT DIRECTORY",1,"Q")
  1.  I PRCP4'="" S DIR("B")=PRCP4
  1.  S DIR("?")="Please enter free text character string between 1 and 245 characters"
  1.  D ^DIR I $D(DUOUT)!$D(DTOUT) S ERR=1 Q
  1.  I PRCP4=X Q
  1.  I X'="@" S PRCP4=X
  1.  I X="@" D EN^DDIOL("Deletions not allowed") G PED
  1.  K DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
  1.  D EN^XPAR("SYS","PRCPLO EXTRACT DIRECTORY",1,PRCP4,.PRCPV)
  1.  I PRCP4="@" Q
  1.  I PRCPV=0 W ! D EN^DDIOL("CLRS Extract Directory successfully set to "_PRCP4)
  1.  I PRCPV'=0 W ! D EN^DDIOL("Error while trying to edit the CLRS Extract Directory:") W ! D EN^DDIOL($P(PRCPV,"^",2))
  1.  ;
  1.  Q
  1.  ;
  1. PAD ;Provide current value of and then prompt to modify the PRC CLRS ADDRESS parameter
  1.  ;
  1.  N DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
  1.  S ERR=0
  1.  S DIR(0)="FOr^1:245",DIR("A")="CLRS Address"
  1.  S PRCP5=$$GET^XPAR("SYS","PRC CLRS ADDRESS",1,"Q")
  1.  I PRCP5'="" S DIR("B")=PRCP5
  1.  S DIR("?")="Please enter free text character string between 1 and 245 characters"
  1.  D ^DIR I $D(DUOUT)!$D(DTOUT) S ERR=1 Q
  1.  I PRCP5=X Q
  1.  S PRCP5=X
  1.  K DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
  1.  D EN^XPAR("SYS","PRC CLRS ADDRESS",1,PRCP5,.PRCPW)
  1.  I PRCP5="@" D EN^DDIOL("  <PRC CLRS ADDRESS deleted>") Q
  1.  I PRCPW=0 W ! D EN^DDIOL("CLRS Address successfully set to "_PRCP5)
  1.  I PRCPW'=0 W ! D EN^DDIOL("Error while trying to edit the CLRS Address:") W ! D EN^DDIOL($P(PRCPW,"^",2))
  1.  ;
  1.  Q
  1.  ;
  1. POG ;Provide current value of and then prompt to modify the PRC CLRS OUTLOOK MAILGROUP parameter
  1.  ;
  1.  N DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
  1.  S ERR=0
  1.  S DIR(0)="FOr^1:245",DIR("A")="CLRS Outlook Mail Group"
  1.  S PRCP6=$$GET^XPAR("SYS","PRC CLRS OUTLOOK MAILGROUP",1,"Q")
  1.  I PRCP6'="" S DIR("B")=PRCP6
  1.  S DIR("?")="Please enter free text character string between 1 and 245 characters"
  1.  D ^DIR I $D(DUOUT)!$D(DTOUT) S ERR=1 Q
  1.  I PRCP6=X Q
  1.  S PRCP6=X
  1.  K DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
  1.  D EN^XPAR("SYS","PRC CLRS OUTLOOK MAILGROUP",1,PRCP6,.PRCPU)
  1.  I PRCP6="@" D EN^DDIOL("  <PRC CLRS OUTLOOK MAILGROUP deleted>") Q
  1.  I PRCPU=0 W ! D EN^DDIOL("CLRS Outlook Mail Group successfully set to "_PRCP6)
  1.  I PRCPU'=0 W ! D EN^DDIOL("Error while trying to edit the CLRS Outlook Mail Group:") W ! D EN^DDIOL($P(PRCPU,"^",2))
  1.  ;
  1.  Q
  1.  ; PRC*5.1*130 begin
  1. USN ;Enter User Name for CLRS Report Server Login
  1.  ;
  1.  N DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
  1.  S ERR=0
  1.  S DIR(0)="FOA^1:30",DIR("A")="User Name for CLRS Report Server Login: "
  1.  S PRCP6=$$GET^XPAR("SYS","PRCPLO USER NAME",1,"Q")
  1.  S PRCP6=$$DECRYP^XUSRB1(PRCP6)    ; Decrypted value
  1.  I PRCP6'="" S DIR("B")=PRCP6
  1.  S DIR("?")="Please enter free text character string between 1 and 30 characters"
  1.  D ^DIR I $D(DUOUT)!$D(DTOUT) S ERR=1 Q
  1.  I PRCP6=X Q
  1.  S (PRCP6,PRCP5)=X
  1.  K DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
  1.  I PRCP6'="@" S PRCP6=$$ENCRYP^XUSRB1(PRCP6)
  1.  D EN^XPAR("SYS","PRCPLO USER NAME",1,PRCP6,.PRCPU)
  1.  I PRCP6="@" D EN^DDIOL("  <PRCPLO USER NAME deleted>") Q
  1.  I PRCPU=0 W ! D EN^DDIOL("PRCPLO USER NAME successfully set to "_PRCP5)
  1.  I PRCPU'=0 W ! D EN^DDIOL("Error while trying to edit the PRCPLO USER NAME:") W ! D EN^DDIOL($P(PRCPU,"^",2))
  1.  ;
  1.  Q
  1. PSW ; Enter Password for CLRS Report Server Login
  1.  ;
  1.  N DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
  1.  S ERR=0
  1.  S DIR(0)="FOA^1:30",DIR("A")="Password for CLRS Report Server Login: "
  1.  S PRCP6=$$GET^XPAR("SYS","PRCPLO PASSWORD",1,"Q")
  1.  S PRCP6=$$DECRYP^XUSRB1(PRCP6)    ; Decrypted value
  1.  I PRCP6'="" S DIR("B")=PRCP6
  1.  S DIR("?")="Please enter free text character string between 1 and 30 characters"
  1.  D ^DIR I $D(DUOUT)!$D(DTOUT) S ERR=1 Q
  1.  I PRCP6=X Q
  1.  S (PRCP6,PRCP5)=X
  1.  K DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
  1.  I PRCP6'="@" S PRCP6=$$ENCRYP^XUSRB1(PRCP6)
  1.  D EN^XPAR("SYS","PRCPLO PASSWORD",1,PRCP6,.PRCPU)
  1.  I PRCP6="@" D EN^DDIOL("  <PRCPLO PASSWORD deleted>") Q
  1.  I PRCPU=0 W ! D EN^DDIOL("PRCPLO PASSWORD successfully set to "_PRCP5)
  1.  I PRCPU'=0 W ! D EN^DDIOL("Error while trying to edit the PRCPLO PASSWORD:") W ! D EN^DDIOL($P(PRCPU,"^",2))
  1.  ;
  1.  Q
  1. RAC ; Enter CLRS Regional Acquisition Center
  1.  ;
  1.  N DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
  1.  S ERR=0
  1.  S DIR(0)="FOA^1:30",DIR("A")="CLRS Regional Acquisition Center: "
  1.  S PRCP6=$$GET^XPAR("SYS","PRCPLO REGIONAL ACQ CENTER",1,"Q")
  1.  I PRCP6'="" S DIR("B")=PRCP6
  1.  S DIR("?")="Please enter free text character string between 1 and 30 characters"
  1.  D ^DIR I $D(DUOUT)!$D(DTOUT) S ERR=1 Q
  1.  I PRCP6=X Q
  1.  S PRCP6=X
  1.  K DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
  1.  D EN^XPAR("SYS","PRCPLO REGIONAL ACQ CENTER",1,PRCP6,.PRCPU)
  1.  I PRCP6="@" D EN^DDIOL("  <PRCPLO REGIONAL ACQ CENTER deleted>") Q
  1.  I PRCPU=0 W ! D EN^DDIOL("PRCPLO REGIONAL ACQ CENTER successfully set to "_PRCP6)
  1.  I PRCPU'=0 W ! D EN^DDIOL("Error while trying to edit the PRCPLO REGIONAL ACQ CENTER:") W ! D EN^DDIOL($P(PRCPU,"^",2))
  1.  ;
  1.  Q
  1.  ; PRC*5.1*130 end