source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPLO4.m@ 1806

Last change on this file since 1806 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 5.6 KB
Line 
1PRCPLO4 ;WOIFO/DAP- Option to allow users to set CLRS parameters ; 10/19/06 8:44am
2V ;;5.1;IFCAP;**83,98**;Oct 20, 2000;Build 37
3 ;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5ENT ;This allows users to enter new values for the parameters associated
6 ;with the Clinical Logistics Report Server by prompting them for
7 ;a new value for each parameter after presenting the current value.
8 ;Values are screened for validity and errors in setting the parameters
9 ;are returned to the screen. IA #2263 can be referenced for further
10 ;information on the ^XPAR calls utilized here.
11 ;
12 N PRCP1,PRCP2,PRCP3,PRCP4,PRCP5,PRCP6,PRCPW,PRCPU,PRCPV,PRCPX,PRCPY,PRCPZ,ERR
13 D PRR I ERR Q
14 D PGR I ERR Q
15 D PIR I ERR Q
16 D PED I ERR Q
17 ;
18 ;*98 Added logic for modification of PRC CLRS ADDRESS and
19 ;PRC CLRS OUTLOOK MAILGROUP parameters
20 ;
21 D PAD I ERR Q
22 D POG I ERR Q
23 Q
24 ;
25PRR ;Provide current value of and then prompt to modify the PRCPLO REPORT RANGE parameter
26 ;
27 N DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
28 S ERR=0
29 S DIR(0)="NOA^0:999",DIR("A")="Stock On Hand Report Range: "
30 S PRCP1=$$GET^XPAR("SYS","PRCPLO REPORT RANGE",1,"Q")
31 I PRCP1'="" S DIR("B")=PRCP1
32 S DIR("?")="Please enter a number between 0 and 999 with no decimal digits"
33 D ^DIR I $D(DUOUT)!$D(DTOUT) S ERR=1 Q
34 I PRCP1=X Q
35 I X'="@" S PRCP1=X
36 I X="@" D EN^DDIOL("Deletions not allowed") G PRR
37 K DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
38 D EN^XPAR("SYS","PRCPLO REPORT RANGE",1,PRCP1,.PRCPX)
39 I PRCPX=0 W ! D EN^DDIOL("Stock on Hand Report Range successfully set to "_PRCP1)
40 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))
41 Q
42 ;
43PIR ;Provide current value of and then prompt to modify the PRCPLO INACTIVITY RANGE parameter
44 ;
45 N DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
46 S ERR=0
47 S DIR(0)="NOA^0:999",DIR("A")="Stock Status Report Inactivity Range: "
48 S PRCP2=$$GET^XPAR("SYS","PRCPLO INACTIVITY RANGE",1,"Q")
49 I PRCP2'="" S DIR("B")=PRCP2
50 S DIR("?")="Please enter a number between 0 and 999 with no decimal digits"
51 D ^DIR I $D(DUOUT)!$D(DTOUT) S ERR=1 Q
52 I PRCP2=X Q
53 I X'="@" S PRCP2=X
54 I X="@" D EN^DDIOL("Deletions not allowed") G PIR
55 K DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
56 D EN^XPAR("SYS","PRCPLO INACTIVITY RANGE",1,PRCP2,.PRCPY)
57 I PRCPY=0 W ! D EN^DDIOL("Stock Status Report Inactivity Range successfully set to "_PRCP2)
58 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))
59 Q
60 ;
61PGR ;Provide current value of and then prompt to modify the PRCPLO GREATER THAN RANGE parameter
62 ;
63 N DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
64 S ERR=0
65 S DIR(0)="NOA^0:999",DIR("A")="Stock On Hand Report Greater Than Range: "
66 S PRCP3=$$GET^XPAR("SYS","PRCPLO GREATER THAN RANGE",1,"Q")
67 I PRCP3'="" S DIR("B")=PRCP3
68 S DIR("?")="Please enter a number between 0 and 999 with no decimal digits"
69 D ^DIR I $D(DUOUT)!$D(DTOUT) S ERR=1 Q
70 I PRCP3=X Q
71 I X'="@" S PRCP3=X
72 I X="@" D EN^DDIOL("Deletions not allowed") G PGR
73 K DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
74 D EN^XPAR("SYS","PRCPLO GREATER THAN RANGE",1,PRCP3,.PRCPZ)
75 I PRCPZ=0 W ! D EN^DDIOL("Stock on Hand Report Greater Than Range successfully set to "_PRCP3)
76 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))
77 ;
78 Q
79 ;
80PED ;Provide current value of and then prompt to modify the PRCPLO EXTRACT DIRECTORY parameter
81 ;
82 N DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
83 S ERR=0
84 S DIR(0)="FOr^1:245",DIR("A")="CLRS Extract Directory"
85 S PRCP4=$$GET^XPAR("SYS","PRCPLO EXTRACT DIRECTORY",1,"Q")
86 I PRCP4'="" S DIR("B")=PRCP4
87 S DIR("?")="Please enter free text character string between 1 and 245 characters"
88 D ^DIR I $D(DUOUT)!$D(DTOUT) S ERR=1 Q
89 I PRCP4=X Q
90 I X'="@" S PRCP4=X
91 I X="@" D EN^DDIOL("Deletions not allowed") G PED
92 K DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
93 D EN^XPAR("SYS","PRCPLO EXTRACT DIRECTORY",1,PRCP4,.PRCPV)
94 I PRCP4="@" Q
95 I PRCPV=0 W ! D EN^DDIOL("CLRS Extract Directory successfully set to "_PRCP4)
96 I PRCPV'=0 W ! D EN^DDIOL("Error while trying to edit the CLRS Extract Directory:") W ! D EN^DDIOL($P(PRCPV,"^",2))
97 ;
98 Q
99 ;
100PAD ;Provide current value of and then prompt to modify the PRC CLRS ADDRESS parameter
101 ;
102 N DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
103 S ERR=0
104 S DIR(0)="FOr^1:245",DIR("A")="CLRS Address"
105 S PRCP5=$$GET^XPAR("SYS","PRC CLRS ADDRESS",1,"Q")
106 I PRCP5'="" S DIR("B")=PRCP5
107 S DIR("?")="Please enter free text character string between 1 and 245 characters"
108 D ^DIR I $D(DUOUT)!$D(DTOUT) S ERR=1 Q
109 I PRCP5=X Q
110 S PRCP5=X
111 K DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
112 D EN^XPAR("SYS","PRC CLRS ADDRESS",1,PRCP5,.PRCPW)
113 I PRCP5="@" D EN^DDIOL(" <PRC CLRS ADDRESS deleted>") Q
114 I PRCPW=0 W ! D EN^DDIOL("CLRS Address successfully set to "_PRCP5)
115 I PRCPW'=0 W ! D EN^DDIOL("Error while trying to edit the CLRS Address:") W ! D EN^DDIOL($P(PRCPW,"^",2))
116 ;
117 Q
118 ;
119POG ;Provide current value of and then prompt to modify the PRC CLRS OUTLOOK MAILGROUP parameter
120 ;
121 N DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
122 S ERR=0
123 S DIR(0)="FOr^1:245",DIR("A")="CLRS Outlook Mail Group"
124 S PRCP6=$$GET^XPAR("SYS","PRC CLRS OUTLOOK MAILGROUP",1,"Q")
125 I PRCP6'="" S DIR("B")=PRCP6
126 S DIR("?")="Please enter free text character string between 1 and 245 characters"
127 D ^DIR I $D(DUOUT)!$D(DTOUT) S ERR=1 Q
128 I PRCP6=X Q
129 S PRCP6=X
130 K DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
131 D EN^XPAR("SYS","PRC CLRS OUTLOOK MAILGROUP",1,PRCP6,.PRCPU)
132 I PRCP6="@" D EN^DDIOL(" <PRC CLRS OUTLOOK MAILGROUP deleted>") Q
133 I PRCPU=0 W ! D EN^DDIOL("CLRS Outlook Mail Group successfully set to "_PRCP6)
134 I PRCPU'=0 W ! D EN^DDIOL("Error while trying to edit the CLRS Outlook Mail Group:") W ! D EN^DDIOL($P(PRCPU,"^",2))
135 ;
136 Q
Note: See TracBrowser for help on using the repository browser.