source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCOER1.m@ 975

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

initial load of WorldVistAEHR

File size: 4.2 KB
Line 
1PRCOER1 ;WISC/DJM-EDI REPORTS USING LIST MANAGER ; [8/31/98 2:26pm]
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5REPORTS ; COME HERE TO ENTER THE REPORTS GENERATOR.
6 ;
7 N DIR,X,Y,LIST,Q1,Q2,PRCA,PRCB,PRCSA,I,PRCPOS,PRCLST,PRCBLST
8 N POSI,POS,PRCC,%DT,DTOUT,START,END,FIRST,LAST,A
9 D CLEAR^VALM1
10 ;
11R0 S LIST=""
12 D LF
13 S DIR("A")="Select PHA, RFQ or All: "
14 S DIR("?")="^D WRONG^PRCOER1()"
15 S DIR(0)="FAO^1:30"
16 D ^DIR K DIR
17 G R4:$D(DUOUT),R4:$D(DTOUT)
18 I X="" D G R4:X["^",R0
19 . D LF
20 . D PAUSE
21 . D LF
22 I X["-" G R2
23 I X["," G R3
24 I $L(X)>3 D WRONG(X) D PAUSE G R4:X["^",R0
25 ;
26R1 ; IS THIS ONE OF THE CORRECT INPUTS?
27 S Y=""
28 D CHECK(X,.Y)
29 I Y>3,Y<7 D WRONG(X),PAUSE G R0
30 I Y>0 S LIST=Y_"," G DATE
31 D WRONG(X)
32 D PAUSE
33 G R4:X["^",R0
34 ;
35R2 K Q1,Q2
36 S PRCA=$P(X,"-",1)
37 S PRCB=$P(X,"-",2)
38 I PRCA["," D G:LIST["0" P2 G R2B
39 . S PRCSA=X
40 . S X=PRCA
41 . D P3
42 . S X=PRCSA
43 . I LIST["0" Q
44 . S I=1
45 . F S:$P(LIST,",",I)]"" PRCPOS=$P(LIST,",",I) Q:$P(LIST,",",I)="" S I=I+1
46 . S Q1=$E(LIST,PRCPOS)
47 . S PRCLST=LIST
48 . Q
49 S Y=""
50 D CHECK(PRCA,.Y)
51 I Y>3,Y<7 D WRONG(X),PAUSE G R0
52 I $G(Q1)="" S PRCLST=Y
53 S Q1=Y
54R2B S PRCBLST=PRCB
55 I PRCB["," D G:LIST["0" P2 G R2C
56 . S PRCSA=X
57 . S X=PRCB
58 . D P3
59 . S X=PRCSA
60 . I LIST["0" Q
61 . S Q2=$P(LIST,",")
62 . S PRCBLST=LIST
63 . Q
64 D CHECK(PRCB,.Y)
65 I Y>3,Y<7 D WRONG(X),PAUSE G R0
66 I $G(Q2)="" S PRCBLST=Y
67 S Q2=Y
68 I Q1=0 D WRONG(PRCA) G P2
69 I Q2=0 D WRONG(PRCB) G P2
70 ;
71R2C I $G(PRCLST)[7!($G(PRCBLST)[7) S LIST=7_"," G DATE
72 S LIST=""
73 I Q1>Q2 F I=Q2:1:Q1 S LIST=LIST_I_","
74 I Q2>Q1 F I=Q1:1:Q2 S LIST=LIST_I_","
75 S:$G(PRCLST)]"" LIST=LIST_PRCLST
76 S:$G(PRCBLST)]"" LIST=LIST_PRCBLST
77 F I=1:1 S POSI=$P(LIST,",",I) Q:POSI="" S POS(POSI)=POSI
78 S LIST=""
79 F I=1:1:3 S:$G(POS(I))]"" LIST=LIST_POS(I)_","
80 K POS
81 G DATE
82 ;
83P2 D PAUSE
84 G R4:X["^",R0
85P3 S LIST=""
86 F I=1:1 S PRCC=$P(X,",",I) Q:PRCC="" D Q:"70"[LIST
87 . S Y=""
88 . D CHECK(PRCC,.Y)
89 . I Y>3,Y<7 D WRONG(X) S LIST=0 Q
90 . I Y=0 D WRONG(PRCC) S LIST=0 Q
91 . I Y=7 S LIST=7_"," Q
92 . S LIST=LIST_Y_","
93 . Q
94 Q
95 ;
96R3 D P3
97 I LIST'["0" G DATE
98 D PAUSE
99 G R4:X["^",R0
100 ;
101R4 S VALMBCK="R"
102 S VALMBG=1
103 Q
104 ;
105DATE D RT ; prompt user for from and to date range
106 I $S('$G(PRCOBEG):1,'$G(PRCOSTOP):1,1:0) G RT1
107 I LIST="" G P2
108 G ^PRCOER3
109 ;
110IT ; SELECT ACCEPTED, REJECTED OR INCOMMING TRANSACTIONS WITH PROBLEMS.
111 Q
112 ;
113RT1 D:$G(X)'="^" PAUSE
114 G R4:X["^",R0
115 ;
116PO ; FIND OUT IF USER WANTS TO DISPLAY 'POA' RECORDS
117 Q
118 ;
119WRONG(X) ; COME HERE IF THE USER'S INPUT IS WRONG.
120 S A(1)=$S($G(X)]"":X_" ?? "_$C(7),1:"")
121 S A(2)=" "
122 S A(3)="Enter a selection, more than one selection separated with a ','"
123 S A(4)="a range of selections seperated with a '-' or exclude an entry with a '."
124 S A(5)=" "
125 D EN^DDIOL(.A)
126 Q
127 ;
128CHECK(X,Y) ; COME HERE TO SEE IF INPUT IS ONE OF THE CORRECT ENTRIES.
129 ;
130 ; RETURN A NUMBER THAT REPRESENTS THE INPUT.
131 ;
132 ; PHA 1
133 ; RFQ 2
134 ; TXT 3
135 ; ACT 4
136 ; PRJ 5
137 ; POA 6
138 ; ALL 7
139 ; WRONG 0
140 ;
141 ; THE RETURNED VALUE OF "0" MEANS THAT THE USER DID NOT ENTER ANY
142 ; CORRECT ENTRY.
143 ;
144 S X=$S(X["P":"PHA",X["R":"RFQ",X["A":"ALL",1:X)
145 S Y=$S(X="PHA":1,X="RFQ":2,X="TXT":3,X="ACT":4,X="PRJ":5,X="POA":6,X="ALL":7,1:0)
146 Q
147 ;
148RT ; Ask user from date. Must be less than "NOW".
149 ; returns PRCOBEG
150 N AA
151 K PRCOBEG,PRCOSTOP
152 D LF
153 D NOW^%DTC
154 S AA=$E(X,1,3)-1
155 S Y=AA_$E(X,4,7)
156 D DD^%DT
157 S DIR(0)="D^:-NOW:AET"
158 S DIR("A")="Enter the DATE/TIME CREATED starting date"
159 S DIR("B")=Y
160 D ^DIR K DIR
161 Q:$D(DIRUT)
162 S PRCOBEG=$S(Y[".":Y,1:Y_".000001")
163 ;
164RT0 ; Ask user end date. Date must be > BEG date and less
165 ; than "NOW".
166 ; returns PRCOSTOP
167 Q:'$G(PRCOBEG)
168 S DIR(0)="D^"_PRCOBEG_":-NOW:AET"
169 S DIR("A")="Enter the DATE/TIME CREATED ending date"
170 S DIR("B")="NOW"
171 D LF
172 D ^DIR K DIR
173 Q:$D(DIRUT)
174 S PRCOSTOP=Y
175 I PRCOSTOP'["." D ;if no time entered by user
176 . ;
177 . ; set end date to "NOW" if end date is "TODAY".
178 . ;
179 . I PRCOSTOP=$G(DT) S PRCOSTOP=$$NOW^XLFDT Q
180 . S PRCOSTOP=PRCOSTOP_".235959" ;attach time for end of day
181 ;
182 K DUOUT,DIRUT,DTOUT
183 Q
184 ;
185PAUSE ; Come here to allow user to read screen before continuing.
186 N DIR,DIRUT,DUOUT,DTOUT
187 S DIR(0)="E"
188 D ^DIR
189 Q
190LF ; Line feed
191 D EN^DDIOL("","","!")
192 Q
Note: See TracBrowser for help on using the repository browser.