source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCY220PT.m@ 738

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

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1RCY220PT ;ALB/ARH/MAF - POST INIT FILES 347.3 & 430.2 - POST INIT ; 5/1/97
2 ;;4.5;Accounts Receivable;**220**;Mar 20, 1995
3 ;
4 D EN,EN1
5 Q
6EN ; Add new Revenue Source Codes to file 347.3
7 D BMES^XPDUTL("Updating file 347.3 REVENUE SOURCE CODE with new codes...")
8 D MES^XPDUTL(" ")
9 N DLAYGO,DIC,DIE,DD,DO,DA,DR,X,Y,RCA,RCFL,RCI,RCLN,RCCNT,RCFN,RCINACT S RCCNT=0
10 ;
11 F RCI=1:1 S RCLN=$P($T(RSC+RCI),";;",2) Q:RCLN="END" D
12 . ;
13 . I $D(^RC(347.3,"B",$P(RCLN,U,1))) S RCFL=0 D SET Q
14 . ;
15 . S RCCNT=RCCNT+1,RCINACT=" "
16 . S ^RC(347.3,$P(RCLN,U,1),0)=RCLN
17 . S ^RC(347.3,"B",$P(RCLN,U,1),$P(RCLN,U,1))=""
18 . S ^RC(347.3,"C",$E($P(RCLN,U,2),1,30),$P(RCLN,U,1))=""
19 . S RCFL=1 D SET
20 D BMES^XPDUTL(" * "_RCCNT_" Revenue Source Codes #347.3 added")
21 D BSQ
22 Q
23EN1 ; Add new categories to the ACCOUNTS RECEIVABLE CATEGORY file 430.2
24 D BMES^XPDUTL("Updating file 430.2 ACCOUNTS RECEIVABLE CATEGORY with new categories...")
25 D MES^XPDUTL(" ")
26 N DLAYGO,DIC,DIE,DD,DO,DA,DR,X,Y,RCA,RCFL,RCI,RCLN,RCCNT,RCFN,RCINACT S RCCNT=0
27 ;
28 F RCI=1:1 S RCLN=$P($T(CAT+RCI),";;",2) Q:RCLN="END" D
29 . ;
30 . I $D(^PRCA(430.2,"B",$P(RCLN,U,1))) S RCFL=0 D SET Q
31 . ;
32 . K DD,DO S DLAYGO=430.2,DIC="^PRCA(430.2,",DIC(0)="L",X=$P(RCLN,U,1) D FILE^DICN K DIC I Y<1 K X,Y Q
33 . S RCFN=+Y,RCCNT=RCCNT+1,RCINACT=" "
34 . ;
35 . S DR="1////"_$P(RCLN,U,2)_";2////"_$P(RCLN,U,3)_";3////"_$P(RCLN,U,4)_";5////"_$P(RCLN,U,6)_";6////"_$P(RCLN,U,7)_";7////"_$P(RCLN,U,8)_";12////"_$P(RCLN,U,9)_";9////"_$P(RCLN,U,10)_";10////"_$P(RCLN,U,11)
36 . S DR=DR_";11////"_$P(RCLN,U,12)_";13////"_$P(RCLN,U,13)
37 . S DIE="^PRCA(430.2,",DA=+RCFN D ^DIE K DIE,DA,DR,X,Y
38 . S RCFL=1 D SET
39 . Q
40 D BMES^XPDUTL(" * "_RCCNT_" Accounts Receivable Category #430.2 added")
41 ;
42BSQ ;
43 ;S RCA(1)=" * "_RCCNT_" Revenue Source Codes (#347.3)"
44 D BMES^XPDUTL(.RCA)
45 Q
46 ;
47 ;
48SET ; SET RCA() FOR DISPLAY
49 S RCA(RCI)=" "_$P(RCLN,U,1)_" "_$P(RCLN,U,2)_" "_$S(RCFL=1:"*** Code Added ***",1:"*** Duplicate ***")
50 Q
51 ;
52 ;
53RSC ; Revenue Source Code (347.3) CODE^CODE NAME^INACTIVE
54 ;;1010^Interest Revenue
55 ;;8038^Economic Act-All Other
56 ;;8083^Enhanced Use Lease
57 ;;9041^Spec Donations
58 ;;9042^Spec Donations
59 ;;9045^General Donations
60 ;;9046^General Donations
61 ;;9057^Rental
62 ;;END
63 Q
64CAT ;New Categories to be entered into file 430.2
65 ;;NURSING HOME PROCEEDS^NH^0^1228^^O^5^2^0^1^1^1^2
66 ;;PARKING FEES^PF^0^1228^^O^6^2^0^1^1^1^2
67 ;;CWT PROCEEDS^CW^0^1228^^O^7^2^0^1^1^1^2
68 ;;COMP & PEN PROCEEDS^CM^0^1228^^O^8^2^0^1^1^1^2
69 ;;ENHANCED USE LEASE PROCEEDS^EP^0^1228^^O^10^2^0^1^1^1^2
70 ;;END
Note: See TracBrowser for help on using the repository browser.