| 1 | PRCOER1 ;WISC/DJM-EDI REPORTS USING LIST MANAGER ; [8/31/98 2:26pm]
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | REPORTS ; 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 | ;
|
|---|
| 11 | R0 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 | ;
|
|---|
| 26 | R1 ; 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 | ;
|
|---|
| 35 | R2 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
|
|---|
| 54 | R2B 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 | ;
|
|---|
| 71 | R2C 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 | ;
|
|---|
| 83 | P2 D PAUSE
|
|---|
| 84 | G R4:X["^",R0
|
|---|
| 85 | P3 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 | ;
|
|---|
| 96 | R3 D P3
|
|---|
| 97 | I LIST'["0" G DATE
|
|---|
| 98 | D PAUSE
|
|---|
| 99 | G R4:X["^",R0
|
|---|
| 100 | ;
|
|---|
| 101 | R4 S VALMBCK="R"
|
|---|
| 102 | S VALMBG=1
|
|---|
| 103 | Q
|
|---|
| 104 | ;
|
|---|
| 105 | DATE 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 | ;
|
|---|
| 110 | IT ; SELECT ACCEPTED, REJECTED OR INCOMMING TRANSACTIONS WITH PROBLEMS.
|
|---|
| 111 | Q
|
|---|
| 112 | ;
|
|---|
| 113 | RT1 D:$G(X)'="^" PAUSE
|
|---|
| 114 | G R4:X["^",R0
|
|---|
| 115 | ;
|
|---|
| 116 | PO ; FIND OUT IF USER WANTS TO DISPLAY 'POA' RECORDS
|
|---|
| 117 | Q
|
|---|
| 118 | ;
|
|---|
| 119 | WRONG(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 | ;
|
|---|
| 128 | CHECK(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 | ;
|
|---|
| 148 | RT ; 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 | ;
|
|---|
| 164 | RT0 ; 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 | ;
|
|---|
| 185 | PAUSE ; 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
|
|---|
| 190 | LF ; Line feed
|
|---|
| 191 | D EN^DDIOL("","","!")
|
|---|
| 192 | Q
|
|---|
