source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPDPLM.m@ 1046

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

initial load of WorldVistAEHR
File size: 6.2 KB
RevLine 
[613]1RCDPDPLM ;WISC/RFJ-deposit profile listmanager top routine ;1 Jun 99
2 ;;4.5;Accounts Receivable;**114,149**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 N RCDEPTDA,RCDPFXIT
6 ;
7 F D Q:'RCDEPTDA
8 . W !! S RCDEPTDA=$$SELDEPT^RCDPUDEP(1) ; allow adding new deposit
9 . I RCDEPTDA<1 S RCDEPTDA=0 Q
10 . D EN^VALM("RCDP DEPOSIT PROFILE")
11 . ; fast exit
12 . I $G(RCDPFXIT) S RCDEPTDA=0
13 Q
14 ;
15 ;
16INIT ; initialization for list manager list
17 N COMMDA,FMSDOC,RCDEPCNT,RCDEPTOT,RCDPDATA,RCLINE,RCRECTDA,STATUS
18 K ^TMP("RCDPDPLM",$J),^TMP("VALM VIDEO",$J)
19 ;
20 ; fast exit
21 I $G(RCDPFXIT) S VALMQUIT=1 Q
22 ;
23 ; set the listmanager line number
24 S RCLINE=0
25 ;
26 S RCRECTDA=0 F S RCRECTDA=$O(^RCY(344,"AD",RCDEPTDA,RCRECTDA)) Q:'RCRECTDA D
27 . D DIQ344^RCDPRPLM(RCRECTDA,".01:999;")
28 . S RCLINE=RCLINE+1
29 . ; create an index array for bill lookup in list
30 . S ^TMP("RCDPDPLM",$J,"IDX",RCLINE,RCLINE)=RCRECTDA
31 . D SET(RCLINE,RCLINE,1,80,0,IORVON,IORVOFF)
32 . ; receipt
33 . D SET("",RCLINE,5,80,.01)
34 . ; type of payment
35 . D SET("",RCLINE,17,80,.04)
36 . ; date opened
37 . I RCDPDATA(344,RCRECTDA,.03,"I") D
38 . . D SET($E(RCDPDATA(344,RCRECTDA,.03,"I"),4,5)_"/"_$E(RCDPDATA(344,RCRECTDA,.03,"I"),6,7)_"/"_$E(RCDPDATA(344,RCRECTDA,.03,"I"),2,3),RCLINE,35,42)
39 . ; by (check for null before calling set)
40 . I RCDPDATA(344,RCRECTDA,.02,"E")'="" D
41 . . S X=$E($P(RCDPDATA(344,RCRECTDA,.02,"E"),",",2))_$E(RCDPDATA(344,RCRECTDA,.02,"E"))
42 . . I RCDPDATA(344,RCRECTDA,.02,"I")=.5 S X="ar"
43 . . D SET(X,RCLINE,45,46)
44 . ; date processed
45 . I RCDPDATA(344,RCRECTDA,.08,"I") D
46 . . D SET($E(RCDPDATA(344,RCRECTDA,.08,"I"),4,5)_"/"_$E(RCDPDATA(344,RCRECTDA,.08,"I"),6,7)_"/"_$E(RCDPDATA(344,RCRECTDA,.08,"I"),2,3),RCLINE,49,56)
47 . ; by (check for null before calling set)
48 . I RCDPDATA(344,RCRECTDA,.07,"E")'="" D
49 . . S X=$E($P(RCDPDATA(344,RCRECTDA,.07,"E"),",",2))_$E(RCDPDATA(344,RCRECTDA,.07,"E"))
50 . . I RCDPDATA(344,RCRECTDA,.07,"I")=.5 S X="ar"
51 . . D SET(X,RCLINE,59,60)
52 . ; number of transactions
53 . D SET($J(RCDPDATA(344,RCRECTDA,101,"E"),8),RCLINE,61,69)
54 . ; total dollars
55 . D SET($J(RCDPDATA(344,RCRECTDA,.15,"E"),10,2),RCLINE,70,79)
56 . ; calculate totals
57 . S RCDEPCNT=$G(RCDEPCNT)+RCDPDATA(344,RCRECTDA,101,"E")
58 . S RCDEPTOT=$G(RCDEPTOT)+RCDPDATA(344,RCRECTDA,.15,"E")
59 . K RCDPDATA
60 ;
61 I RCLINE=0 S RCLINE=RCLINE+1 D SET(" *** No RECEIPTS for this deposit ***",RCLINE,1,80)
62 ;
63 ; show totals
64 S RCLINE=RCLINE+1
65 D SET(" -------- --------",RCLINE,1,80)
66 S RCLINE=RCLINE+1
67 D SET(" TOTAL DOLLARS FOR DEPOSIT",RCLINE,1,80)
68 D SET($J($G(RCDEPCNT),8),RCLINE,61,69)
69 D SET($J($G(RCDEPTOT),10,2),RCLINE,70,79)
70 ;
71 ; deposit data displayed on screen
72 D DIQ3441(RCDEPTDA,".01:1")
73 S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
74 S RCLINE=RCLINE+1 D SET(" Bank: "_RCDPDATA(344.1,RCDEPTDA,.13,"E"),RCLINE,1,80)
75 S RCLINE=RCLINE+1 D SET(" Bank Trace Number: "_RCDPDATA(344.1,RCDEPTDA,.05,"E"),RCLINE,1,80)
76 S RCLINE=RCLINE+1 D SET(" Agency Location Code: "_RCDPDATA(344.1,RCDEPTDA,.14,"E"),RCLINE,1,80)
77 S RCLINE=RCLINE+1 D SET(" Agency Title: "_RCDPDATA(344.1,RCDEPTDA,.17,"E"),RCLINE,1,80)
78 ;
79 ; display comments if there are any
80 I $O(^RCY(344.1,RCDEPTDA,1,0)) D
81 . S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
82 . S RCLINE=RCLINE+1 D SET("Comments",RCLINE,1,80,0,IOUON,IOUOFF)
83 . S COMMDA=0 F S COMMDA=$O(^RCY(344.1,RCDEPTDA,1,COMMDA)) Q:'COMMDA D
84 . . S RCLINE=RCLINE+1 D SET(^RCY(344.1,RCDEPTDA,1,COMMDA,0),RCLINE,1,80)
85 ;
86 ; display FMS CR documents if turned on
87 I $G(^DISV(DUZ,"RCDPDPLM","SHOWFMS")) D
88 . S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
89 . S RCLINE=RCLINE+1 D SET("FMS CR Documents",RCLINE,1,80,0,IOUON,IOUOFF)
90 . S RCRECTDA=0 F S RCRECTDA=$O(^RCY(344,"AD",RCDEPTDA,RCRECTDA)) Q:'RCRECTDA D
91 . . D DIQ344^RCDPRPLM(RCRECTDA,".01;.14;")
92 . . S FMSDOC=$$FMSSTAT^RCDPUREC(RCRECTDA)
93 . . S RCLINE=RCLINE+1
94 . . D SET("",RCLINE,5,80,.01)
95 . . D SET("",RCLINE,17,80,.14)
96 . . D SET($P(FMSDOC,"^"),RCLINE,25,80)
97 . . D SET($P(FMSDOC,"^",2),RCLINE,40,80)
98 . . K RCDPDATA
99 ;
100 ; set valmcnt to number of lines in the list
101 S VALMCNT=RCLINE
102 Q
103 ;
104 ;
105SET(STRING,LINE,COLBEG,COLEND,FIELD,ON,OFF) ; set array
106 I $G(FIELD) S STRING=STRING_$S(STRING="":"",1:": ")_$G(RCDPDATA(344,RCRECTDA,FIELD,"E"))
107 I STRING="",'$G(FIELD) D SET^VALM10(LINE,$J("",80)) Q
108 I '$D(@VALMAR@(LINE,0)) D SET^VALM10(LINE,$J("",80))
109 D SET^VALM10(LINE,$$SETSTR^VALM1(STRING,@VALMAR@(LINE,0),COLBEG,COLEND-COLBEG+1))
110 I $G(ON)]""!($G(OFF)]"") D CNTRL^VALM10(LINE,COLBEG,$L(STRING),ON,OFF)
111 Q
112 ;
113 ;
114DIQ3441(DA,DR) ; diq call to retrieve data for dr fields in file 344.1
115 N D0,DIC,DIQ,DIQ2,YY
116 K RCDPDATA(344.1,DA)
117 S DIQ(0)="IE",DIC="^RCY(344.1,",DIQ="RCDPDATA" D EN^DIQ1
118 Q
119 ;
120 ;
121HDR ; header code for list manager display
122 N DATE,RCDPDATA,SPACE
123 D DIQ3441(RCDEPTDA,".01:1")
124 S SPACE="",$P(SPACE," ",80)=""
125 S VALMHDR(1)=$E(" Deposit #: "_RCDPDATA(344.1,RCDEPTDA,.01,"E")_SPACE,1,39)_" Deposit Status: "_RCDPDATA(344.1,RCDEPTDA,.12,"E")
126 S VALMHDR(2)=$E("Deposit Date: "_RCDPDATA(344.1,RCDEPTDA,.03,"E")_SPACE,1,39)
127 S DATE=RCDPDATA(344.1,RCDEPTDA,.07,"E"),DATE=$P(DATE,"@")_" "_$P($P(DATE,"@",2),":",1,2)
128 I RCDPDATA(344.1,RCDEPTDA,.06,"I")=.5 S RCDPDATA(344.1,RCDEPTDA,.06,"E")="accounts receivable"
129 S VALMHDR(3)=$E(" Opened By: "_RCDPDATA(344.1,RCDEPTDA,.06,"E")_SPACE,1,39)_"Date/Time Opened: "_DATE
130 S DATE=RCDPDATA(344.1,RCDEPTDA,.11,"E"),DATE=$P(DATE,"@")_" "_$P($P(DATE,"@",2),":",1,2)
131 I RCDPDATA(344.1,RCDEPTDA,.1,"I")=.5 S RCDPDATA(344.1,RCDEPTDA,.1,"E")="accounts receivable"
132 S VALMHDR(4)=$E("Confirmed By: "_RCDPDATA(344.1,RCDEPTDA,.1,"E")_SPACE,1,39)_"Date/Time Confirmed: "_DATE
133 ;
134 I RCDPDATA(344.1,RCDEPTDA,.11,"I") S VALMSG="Deposit confirmed on "_RCDPDATA(344.1,RCDEPTDA,.11,"E")
135 Q
136 ;
137 ;
138EXIT ; exit list manager option and clean up
139 K ^TMP("RCDPDPLM",$J)
140 Q
141 ;
142 ;
143FASTEXIT ; this is called by the protocol file to exit any of the deposit
144 ; processing listmanager screens
145 N DIR,DIQ2,DTOUT,DUOUT,X,Y
146 ;
147 S DIR(0)="YO",DIR("B")="NO"
148 S DIR("A")=" Exit option entirely"
149 D ^DIR
150 I $G(DTOUT)!($G(DUOUT)) S Y=-1
151 I $G(DIRUT)!(Y) S RCDPFXIT=1
152 Q
Note: See TracBrowser for help on using the repository browser.