source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCUFCU.m@ 619

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

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1PRCUFCU ;WISC/SJG-OBLIGATION CONVERSION UTILITIES ;7/25/94 11:25
2 ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 QUIT
6 ; No top level entry
7BOCS ; Step 1 - Assign BOCs to Supply Fund Line Items
8 N SUBINFO,LOOP2,ITEMNO,ACCT,ITEMBOC
9 S LOOP2=0
10 F S LOOP2=$O(^PRC(442,LOOP,2,LOOP2)) Q:LOOP2'>0 D
11 .K PRCTMP(442.01)
12 .S SUBINFO="442.01^1.5;3.5;9.5^"_LOOP2
13 .D GENDIQ^PRCFFU7(442,LOOP,40,"IE",SUBINFO)
14 .S ITEMBOC=+$G(PRCTMP(442.01,LOOP2,3.5,"I"))
15 .I ITEMBOC>0 Q
16 .S ITEMNO=+$G(PRCTMP(442.01,LOOP2,1.5,"I"))
17 .S ACCT=$$ACCT^PRCPUX1($E($$NSN^PRCPUX1(ITEMNO),1,4))
18 .S ITEMBOC=$S(ACCT=1:2697,ACCT=2:2698,ACCT=3:2699,ACCT=6:2699,ACCT=8:2696,1:2699)
19 .S ITEMBOC=$P($G(^PRCD(420.2,ITEMBOC,0)),U)
20 .S DA(1)=LOOP,DA=LOOP2,DIE="^PRC(442,"_DA(1)_",2,"
21 .S DR="3.5////^S X=ITEMBOC" D ^DIE K DIE,DR,DA,X
22 .Q
23 K PRCTMP(442.01)
24 QUIT
25BOCG ; Step 1 - Assign BOCS to General Post Fund Line Items
26 N SUBINFO,LOOP2,ITEMNO,ITEMBOC
27 S LOOP2=0,FATAL=0
28 F S LOOP2=$O(^PRC(442,LOOP,2,LOOP2)) Q:LOOP2'>0 D
29 .K PRCTMP(442.01)
30 .S SUBINFO="442.01^1.5;3.5;9.5^"_LOOP2
31 .D GENDIQ^PRCFFU7(442,LOOP,40,"IE",SUBINFO)
32 .S ITEMBOC=+$G(PRCTMP(442.01,LOOP2,3.5,"I"))
33 .I ITEMBOC>0 Q
34 .S ITEMNO=+$G(PRCTMP(442.01,LOOP2,1.5,"I"))
35 .I ITEMNO>0 D
36 ..K PRCTMP(441,ITEMNO,12)
37 ..D GENDIQ^PRCFFU7(441,ITEMNO,12,"IE","")
38 ..S ITEMBOC=+$G(PRCTMP(441,ITEMNO,12,"I"))
39 ..I ITEMBOC=0 S ITEMBOC=9999
40 ..Q
41 .I ITEMNO=0 S ITEMBOC=9999
42 .S ITEMBOC=$P($G(^PRCD(420.2,ITEMBOC,0)),U)
43 .S DA(1)=LOOP,DA=LOOP2,DIE="^PRC(442,"_DA(1)_",2,"
44 .S DR="3.5////^S X=ITEMBOC" D ^DIE K DIE,DR,DA,X
45 .K PRCTMP(441,ITEMNO,12)
46 .Q
47 K PRCTMP(442.01)
48 QUIT
49AMTS ; Set variables for Total Amount, Net Amount, Liquidated Amount
50 S PRCFA("GROSS")=$G(PRCTMP(442,LOOP,91,"E"))
51 S PRCFA("NET")=$G(PRCTMP(442,LOOP,92,"E"))
52 S PRCFA("LIQ")=+$G(PRCTMP(442,LOOP,93,"E"))
53 S FATAL=0
54 I PRCFA("GROSS")-PRCFA("LIQ")=0 S FATAL=1 Q
55 I PRCFA("NET")-PRCFA("LIQ")=0 S FATAL=1 Q
56 QUIT
Note: See TracBrowser for help on using the repository browser.