source: FOIAVistA/tag/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPRSEA.m

Last change on this file was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.3 KB
Line 
1RCDPRSEA ;WISC/RFJ-extended search ;1 Jun 99
2 ;;4.5;Accounts Receivable;**114,148,208**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 N DATEEND,DATESTRT,RCTRACE,RCCHECK,RCCREDIT,RCSEARCH,RCTYPE,%ZIS,ZTSAVE,ZTDESC,ZTQUEUED,ZTRTN,POP
6 ; search check or credit card
7 W !
8 S RCSEARCH=$$ASKSEA
9 I RCSEARCH<1 Q
10 ;
11 ; check to search for
12 I RCSEARCH=1 S RCCHECK=$$ASKCHEK^RCDPLPL1 I RCCHECK=-1 Q
13 ; credit card to search for
14 I RCSEARCH=2 S RCCREDIT=$$ASKCRED^RCDPLPL1 I RCCREDIT=-1 Q
15 ; ask contains or equals
16 S RCTYPE=$$ASKTYPE^RCDPLPL1 I RCTYPE=-1 Q
17 S RCTYPE=$E(RCTYPE)
18 ;
19 ; trace # to search for
20 I RCSEARCH=3 S RCTRACE=$$ASKTRACE^RCDPLPL1 I RCTRACE=-1 Q
21 ;
22 ; ask receipt open dates
23 W !
24 D DATESEL^RCRJRTRA("RECEIPT Opened")
25 I '$G(DATESTRT)!('$G(DATEEND)) Q
26 ;
27 ; select device
28 W ! S %ZIS="Q" D ^%ZIS I POP Q
29 I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK Q
30 . S ZTDESC="Extended Check/Trace#/Credit Card Search",ZTRTN="DQ^RCDPRSEA"
31 . S ZTSAVE("RC*")="",ZTSAVE("DATE*")="",ZTSAVE("ZTREQ")="@"
32 W !!,"<*> please wait <*>"
33 ;
34DQ ; queue starts here
35 N %,%I,DATA,DATEDIS1,DATEDIS2,NOW,PAGE,RCRECTDA,RCRJFLAG,RCRJLINE,RCTRANDA,SCREEN,X,Y
36 ; print report
37 S Y=$P(DATESTRT,".") D DD^%DT S DATEDIS1=Y
38 S Y=$P(DATEEND,".") D DD^%DT S DATEDIS2=Y
39 D NOW^%DTC S Y=% D DD^%DT S NOW=Y
40 S PAGE=1,RCRJLINE="",$P(RCRJLINE,"-",81)=""
41 S SCREEN=0 I '$D(ZTQUEUED),IO=IO(0),$E(IOST)="C" S SCREEN=1
42 U IO D H
43 S RCRECTDA=99999999999999
44 F S RCRECTDA=$O(^RCY(344,RCRECTDA),-1) Q:'RCRECTDA!($G(RCRJFLAG)) D
45 . S DATA=$G(^RCY(344,RCRECTDA,0))
46 . I $P(DATA,"^",3)<DATESTRT Q
47 . I $P($P(DATA,"^",3),".")>DATEEND Q
48 . S RCTRANDA=0 F S RCTRANDA=$O(^RCY(344,RCRECTDA,1,RCTRANDA)) Q:'RCTRANDA!($G(RCRJFLAG)) D
49 . . I SCREEN R X:0 I X["^" S RCRJFLAG=1 Q
50 . . S DATA=$G(^RCY(344,RCRECTDA,1,RCTRANDA,0))
51 . . ; check search
52 . . I RCSEARCH=1 D Q
53 . . . I RCTYPE="E",$P(DATA,"^",7)'=RCCHECK Q ;equals
54 . . . I $P(DATA,"^",7)'[RCCHECK Q ;contains
55 . . . D DISPLAY
56 . . ; trace # search
57 . . I RCSEARCH=3 D Q
58 . . . N RCNUM
59 . . . S RCNUM=$$TRACE(RCRECTDA)
60 . . . I RCTYPE="E",RCNUM'=RCTRACE Q ;equals
61 . . . I RCNUM'[RCTRACE Q ;contains
62 . . . D DISPLAY
63 . . ; credit card search
64 . . I RCTYPE="E",$P(DATA,"^",11)'=RCCREDIT Q ;equals
65 . . I $P(DATA,"^",11)'[RCCREDIT Q ;contains
66 . . D DISPLAY
67 ;
68 I '$G(RCRJFLAG),SCREEN U IO(0) R !,"Press RETURN to continue:",%:DTIME
69 D ^%ZISC
70 Q
71 ;
72 ;
73DISPLAY ; display the payment
74 I $Y>(IOSL-6) D:SCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) W @IOF D H
75 ;
76 N ACCOUNT,DATA,DATA1
77 S DATA=$G(^RCY(344,RCRECTDA,0)),DATA1=DATA
78 ; receipt
79 W !,$P(DATA,"^")
80 ; date opened
81 W ?13,$E($P(DATA,"^",3),4,5),"/",$E($P(DATA,"^",3),6,7),"/",$E($P(DATA,"^",3),2,3)
82 ; transaction number
83 W ?24,RCTRANDA
84 S DATA=$G(^RCY(344,RCRECTDA,1,RCTRANDA,0))
85 ; account
86 S ACCOUNT=$P(DATA,"^",3)
87 I ACCOUNT["PRCA(430," S ACCOUNT=$P($G(^PRCA(430,+$P(DATA,"^",3),0)),"^")
88 I ACCOUNT["DPT(" S ACCOUNT=$P($G(^DPT(+$P(DATA,"^",3),0)),"^")
89 W ?30,$E(ACCOUNT,1,24)
90 ; amount
91 W ?54,$J($P(DATA,"^",4),8,2)
92 ; check/trace/credit card number
93 W $J($S(RCSEARCH=1:$P(DATA,"^",7),RCSEARCH=2:$P(DATA,"^",11),1:$$TRACE(RCRECTDA)),18)
94 Q
95 ;
96 ;
97H ; header
98 S %=NOW_" PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
99 W $C(13),"EXTENDED CHECK/TRACE #/CREDIT CARD SEARCH",?(80-$L(%)),%
100 W !," FOR THE DATE RANGE: ",DATEDIS1," TO ",DATEDIS2
101 W !," SEARCHING FOR: "
102 W $S(RCSEARCH=1:"CHECK ",RCSEARCH=2:"CREDIT CARD ",1:"TRACE # ")
103 W $S(RCTYPE="E":"EQUALS ",1:"CONTAINS ")
104 W $G(RCCHECK),$G(RCTRACE),$G(RCCREDIT)
105 W !,"RECEIPT",?13,"OPENDATE",?24,"TRANS",?30,"ACCOUNT",?54,$J("AMOUNT",8),$J($S(RCSEARCH=1:"CHECK#",RCSEARCH=2:"CREDITCARD#",1:"TRACE#"),18)
106 W !,RCRJLINE
107 I SCREEN W !!?10,"********** PRESS ^ at anytime to STOP search **********"
108 Q
109 ;
110 ;
111TRACE(RCRECTDA) ; Returns the trace # on a receipt
112 N DATA
113 S DATA=$G(^RCY(344,RCRECTDA,0))
114 Q $S($P(DATA,U,18):$P($G(^RCY(344.4,+$P(DATA,"^",18),0)),U,2),$P(DATA,U,17):$P($G(^RCY(344.31,+$P(DATA,U,17),0)),U,4),1:"")
115 ;
116ASKSEA() ; ask search field
117 N DIR,DIRUT,DTOUT,DUOUT,X,Y
118 S DIR(0)="SAO^1:Check;2:Credit Card;3:Trace #;"
119 S DIR("A")="Search for Check, Trace #, or Credit Card: "
120 S DIR("B")="Check"
121 D ^DIR
122 I $G(DTOUT)!($G(DUOUT)) S Y=-1
123 Q Y
Note: See TracBrowser for help on using the repository browser.